/* MOTEST.f -- translated by f2c (version 19960827).
   You must link the resulting object file with the libraries:
	-lf2c -lm   (in that order)
*/

#include "Data_f2c.h"

/* Subroutine */ int mmotest_(ncflim, math10, math20, math30, nbcrbe, tbvcri, 
	alpha, jestim, jesmin, math11, math21, math31, valcri, icdana, iercod)
integer *ncflim;
doublereal *math10, *math20, *math30;
integer *nbcrbe;
doublereal *tbvcri, *alpha, *jestim, *jesmin, *math11, *math21, *math31, *
	valcri;
integer *icdana, *iercod;
{
    /* System generated locals */
    integer i__1;
    doublereal d__1, d__2;

    /* Local variables */
    static logical ldbg;
    static doublereal poid1, poid2, poid3;
    static integer nsize, ii;
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mgsomsg_();



/* < */
/* **NOTICE */
/*  THIS SOFTWARE IS THE PROPERTY OF CISIGRAPH. */
/*  THIS CODE MUST NOT BE DISTRIBUTED OR COPIED WITHOUT THE PRIOR */
/*  WRITTEN PERMISSION OF CISIGRAPH AND IS ONLY TO BE USED ON THE */
/*  SITE WHERE IT IS INSTALLED BY CISIGRAPH */
/* **NOTICE */

/* ***********************************************************************
 */

/*     FONCTION : */
/*     ---------- */
/*       Calcul et estimation des critere variationels */

/*     MOTS CLES : */
/*     ----------- */
/*      LISSAGE, VARIATIONNELLE, ESTIMATION, CRITERES */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*     NCFLIM : Nombre de coefficients minimum */
/*     MATH10 : Matrice de J1 non pondere */
/*     MATH20 : Matrice de J2 non pondere */
/*     MATH30 : Matrice de J3 non pondere */
/*     NBRCBE : Nombre d'elements */
/*     TBVCRI : Valeurs des criteres variationnels sur chaque element */
/*     ALPHA  : Ponderation utilisateur des criteres. */
/*     JESTIM : Estimation des criteres. */
/*     JESMIN : Minimum accepter pour l'estimation des criteres. */


/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*     JESTIM : Nouvelles estimation des criteres (si ICDANA > 0) */
/*     MATH11 : Matrice de J1  pondere (si ICDANA > 0) */
/*     MATH21 : Matrice de J2  pondere (si ICDANA > 0) */
/*     MATH31 : Matrice de J3  pondere (si ICDANA > 0) */
/*     VALCRI : Valeurs des criteres integraux. */
/*     ICDANA : Code d'analyse */
/*        0 : Rien a signaler */
/*        1 : Nouvelle estimation des criteres */
/*        2 : Estimation des criteres tres inferieur (superieur) */
/*      IERCOD : code d'erreur */
/*         > 0 : Echec */

/*     COMMONS UTILISES : */
/*     ------------------ */


/*     REFERENCES APPELEES : */
/*     --------------------- */


/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     20-11-1995: PMN; ELIMINE LES PRINT */
/*     20-11-1995: PMN; ELIMINE LES PRINT */
/*     11-10-1995: PMN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */







/* ***********************************************************************
 */
/*                      INITIALISATIONS */
/* ***********************************************************************
 */

    /* Parameter adjustments */
    --math31;
    --math21;
    --math11;
    --math30;
    --math20;
    --math10;
    tbvcri -= 4;
    --alpha;
    --jestim;
    --jesmin;
    --valcri;

    /* Function Body */
    ldbg = mnfndeb_() >= 3;
    if (ldbg) {
	mgenmsg_("MMOTEST", 7L);
    }
    *iercod = 0;

/* ***********************************************************************
 */
/*                     TRAITEMENT */
/* ***********************************************************************
 */

/*  (1) Calcul global des criteres */

    poid1 = alpha[1] / jestim[1];
    poid2 = alpha[2] / jestim[2];
    poid3 = alpha[3] / jestim[3];

    valcri[1] = 0.;
    valcri[2] = 0.;
    valcri[3] = 0.;

    i__1 = *nbcrbe;
    for (ii = 1; ii <= i__1; ++ii) {
	valcri[1] += tbvcri[ii * 3 + 1];
	valcri[2] += tbvcri[ii * 3 + 2];
	valcri[3] += tbvcri[ii * 3 + 3];
    }

    valcri[1] /= poid1;
    valcri[2] /= poid2;
    valcri[3] /= poid3;


/*   (2) Test l'amelioration des estimations */
/*       (critere sureleve => Non minimisation ) */

    *icdana = 0;

    for (ii = 1; ii <= 3; ++ii) {
	if (valcri[ii] < jestim[ii] * (float).8 && jestim[ii] > jesmin[ii]) {

	    if (*icdana < 1) {
		*icdana = 1;
	    }
	    if (valcri[ii] < jestim[ii] * (float).1) {
		*icdana = 2;
	    }
/* Computing MAX */
	    d__1 = valcri[ii] * (float)1.05, d__2 = jesmin[ii];
	    jestim[ii] = max(d__1,d__2);
	}
    }

/*  (3) Mise a jours des Estimation */
/*     (critere sous-estimer => mauvais conditionement) */

    if (valcri[1] > jestim[1] * 2) {
	jestim[1] += valcri[1] * (float).1;
	if (*icdana == 0) {
	  if (valcri[1] > jestim[1] * 10) {
	    *icdana = 2;
	  }
	  else *icdana = 1;
	}
	else {
	  *icdana = 2;
	}
    }
    if (valcri[2] > jestim[2] * 20) {
	jestim[2] += valcri[2] * (float).1;
	if (*icdana == 0) {
	  if (valcri[2] > jestim[2] * 100) {
	    *icdana = 2;
	  }
	  else *icdana = 1;
	}
	else {
	   *icdana = 2;
	}
    }
    if (valcri[3] > jestim[3] * 20) {
	jestim[3] += valcri[3] * (float).05;
	if (*icdana == 0) {
	  if (valcri[3] > jestim[3] * 100) {
	    *icdana = 2;
	  }
	  else  *icdana = 1;
	}
	else {
	   *icdana = 2;
	}
    }

/*  (4) Mise a jours des poids */

    if (*icdana > 0) {

	poid1 = alpha[1] / jestim[1];
	poid2 = alpha[2] / jestim[2];
	poid3 = alpha[3] / jestim[3];

	nsize = *ncflim * (*ncflim + 1) / 2;
	i__1 = nsize;
	for (ii = 1; ii <= i__1; ++ii) {
	    math11[ii] = math10[ii] * poid1;
	    math21[ii] = math20[ii] * poid2;
	    math31[ii] = math30[ii] * poid3;
	}

    }

    goto L9999;

/* ***********************************************************************
 */
/*                   TRAITEMENT DES ERREURS */
/* ***********************************************************************
 */



/* ***********************************************************************
 */
/*                   RETOUR PROGRAMME APPELANT */
/* ***********************************************************************
 */

L9999:


/* ___ DESALLOCATION, ... */


    maermsg_("MMOTEST", iercod, 7L);
    if (ldbg) {
	mgsomsg_("MMOTEST", 7L);
    }
 return 0 ;
} /* mmotest_ */

