/* MNEWT3.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"

/* Table of constant values */

static integer c__1 = 1;

/* Subroutine */ int mmnewt3_(mxiter, ndimen, npoint, ncflim, ncftab, ncourb, 
	tabpnt, tabcrb, tabint, tabpar, taberr, errmax, numpnt, errqua, 
	errmoy, iercod)
integer *mxiter, *ndimen, *npoint, *ncflim, *ncftab, *ncourb;
doublereal *tabpnt, *tabcrb, *tabint, *tabpar, *taberr, *errmax;
integer *numpnt;
doublereal *errqua, *errmoy;
integer *iercod;
{
    /* System generated locals */
    integer tabpnt_dim1, tabpnt_offset, tabcrb_dim1, tabcrb_dim2, 
	    tabcrb_offset, i__1, i__2;

    /* Local variables */
    static logical ldbg;
    static doublereal valc[3], valf;
    static integer iter, ipnt, ncfd1, ncfd2;
    static doublereal valc1[3], valc2[3], valf0, tpar0;
    static integer ncoef;
    static doublereal csecn[63], ecart, vdiff, spara, cprim[63];
    static integer nitcv;
    static doublereal tparn, f1, f2, vsomm;
    static integer ii, icourb;
    static doublereal ctenor;
    static logical encour;
    extern integer mnfndeb_();
    static doublereal aux;
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mmpocrb_(), mmcdriv_()
	    , mgsomsg_(), mdsptpt_();



/* < */
/* **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 : */
/*     ---------- */
/*      OPTIMISATION DES PARAMETRES ti PAR LA METHODE DE NEWTON */

/*     MOTS CLES : */
/*     ----------- */
/*      RESERVE, LISSAGE, DISTANCE, NEWTON, PROJECTION */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*   MXITER : Nombre maximum d'iteration */
/*   NDIMEN : Dimension spatiale */
/*   NPOINT : Nombre de points a projeter */
/*   NCFLIM : Nombre de coef max (format) des courbes */
/*   NCFTAB : Table du nombre de coeff par courbe */
/*   NCOURB : Nombre de courbe */
/*   TABPNT : Tableau des points */
/*   TABCRB : Tableau des courbes */
/*   TABINT : Tableau des noeuds */



/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*   TABPAR : Tableau des parametres optimises */
/*   TABERR : Tableau des erreurs associes a chaque points */
/*   ERRMAX : Erreur maximum */
/*   NUMPNT : Numero du plus mauvais point */
/*   ERRQUA : Erreur quadratique */
/*   ERRMOY : erreur moyenne */
/*   IERCOD : CODE D'ERREUR */
/*       0 : OK */
/*       1 : Erreur */



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


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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*      7-11-1995: PMN; Decription des arguments */
/*      5-10-1995: PMN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */







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

    /* Parameter adjustments */
    --taberr;
    --tabpar;
    tabpnt_dim1 = *ndimen;
    tabpnt_offset = tabpnt_dim1 + 1;
    tabpnt -= tabpnt_offset;
    tabcrb_dim1 = *ndimen;
    tabcrb_dim2 = *ncflim;
    tabcrb_offset = tabcrb_dim1 * (tabcrb_dim2 + 1) + 1;
    tabcrb -= tabcrb_offset;
    --ncftab;

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

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



    if (*ncflim > 21) {
	goto L9101;
    }
    if (*ndimen > 3) {
	goto L9101;
    }

/*     --- Initialisation */

    icourb = 1;
    vsomm = tabint[1] + tabint[0];
    vdiff = 1. / (tabint[1] - tabint[0]);
    ctenor = vdiff * 2;
    ncoef = ncftab[1];
    mmcdriv_(ndimen, &ncoef, &tabcrb[(tabcrb_dim2 + 1) * tabcrb_dim1 + 1], &
	    c__1, &ncfd1, cprim);
    mmcdriv_(ndimen, &ncfd1, cprim, &c__1, &ncfd2, csecn);

    *numpnt = 0;
    *errmoy = 0.;
    *errmax = 0.;
    *errqua = 0.;

    i__1 = *npoint;
    for (ipnt = 1; ipnt <= i__1; ++ipnt) {

	tparn = tabpar[ipnt];

/*         --- Doit on changer de courbe ? */

	if (tparn > tabint[icourb] || tparn < tabint[icourb - 1]) {

	    while(tparn < tabint[icourb - 1] && icourb > 1) {
		--icourb;
	    }

	    while(tparn > tabint[icourb] && icourb < *ncourb) {
		++icourb;
	    }

/*        --- Derivation de la courbe */

	    vsomm = tabint[icourb] + tabint[icourb - 1];
	    vdiff = 1. / (tabint[icourb] - tabint[icourb - 1]);
	    ctenor = vdiff * 2;
	    ncoef = ncftab[icourb];

	    mmcdriv_(ndimen, &ncoef, &tabcrb[(icourb * tabcrb_dim2 + 1) * 
		    tabcrb_dim1 + 1], &c__1, &ncfd1, cprim);
	    mmcdriv_(ndimen, &ncfd1, cprim, &c__1, &ncfd2, csecn);

	}

/*         --- Initialise le processus */

	spara = (tparn * 2. - vsomm) * vdiff;
	mmpocrb_(ndimen, &ncoef, &tabcrb[(icourb * tabcrb_dim2 + 1) * 
		tabcrb_dim1 + 1], ndimen, &spara, valc);
	mdsptpt_(ndimen, valc, &tabpnt[ipnt * tabpnt_dim1 + 1], &valf);

	encour = TRUE_;
	nitcv = 0;
	iter = 0;

/*        -------------------- NEWTON --------------------------- */

	while(encour) {

	    ++iter;
	    tpar0 = tparn;
	    valf0 = valf;

	    mmpocrb_(ndimen, &ncfd1, cprim, ndimen, &spara, valc1);
	    mmpocrb_(ndimen, &ncfd2, csecn, ndimen, &spara, valc2);

	    f1 = 0.;
	    f2 = 0.;
	    i__2 = *ndimen;
	    for (ii = 1; ii <= i__2; ++ii) {
		aux = valc[ii - 1] - tabpnt[ii + ipnt * tabpnt_dim1];
		f1 += aux * valc1[ii - 1];
		f2 = f2 + valc1[ii - 1] * valc1[ii - 1] + aux * valc2[ii - 1];
	    }

	    if (abs(f2) < 1e-12) {
		encour = FALSE_;
	    } else {

/*              Formule de newton */
		tparn -= f1 / (f2 * ctenor);
		if (tparn < 0.) {
		    tparn = 0.;
		}
		if (tparn > 1.) {
		    tparn = 1.;
		}


/*         --- Doit on changer de courbe ? */

		if (tparn > tabint[icourb] || tparn < tabint[icourb - 1]) {

		    while(tparn < tabint[icourb - 1] && icourb > 1) {
			--icourb;
		    }

		    while(tparn > tabint[icourb] && icourb < *ncourb) {
			++icourb;
		    }

		    vsomm = tabint[icourb] + tabint[icourb - 1];
		    vdiff = 1. / (tabint[icourb] - tabint[icourb - 1]);
		    ctenor = vdiff * 2;
		    ncoef = ncftab[icourb];

		    mmcdriv_(ndimen, &ncoef, &tabcrb[(icourb * tabcrb_dim2 + 
			    1) * tabcrb_dim1 + 1], &c__1, &ncfd1, cprim);
		    mmcdriv_(ndimen, &ncfd1, cprim, &c__1, &ncfd2, csecn);
		}

/*              Analyse du resultat */

		spara = (tparn * 2. - vsomm) * vdiff;

		mmpocrb_(ndimen, &ncoef, &tabcrb[(icourb * tabcrb_dim2 + 1) * 
			tabcrb_dim1 + 1], ndimen, &spara, valc);
		mdsptpt_(ndimen, valc, &tabpnt[ipnt * tabpnt_dim1 + 1], &valf)
			;

		ecart = valf0 - valf;

		if (ecart <= -1e-9) {

/*              --> Pas d'amelioration on s'arrete */
		    encour = FALSE_;
		    tparn = tpar0;
		    valf = valf0;

		} else if (ecart <= 1e-9) {

/*              --> Convergence */
		    ++nitcv;
		} else {
		    nitcv = 0;
		}

		if (nitcv >= 2 || iter >= *mxiter) {
		    encour = FALSE_;
		}
	    }
	}

	tabpar[ipnt] = tparn;
	taberr[ipnt] = valf;
	if (valf > *errmax) {
	    *errmax = valf;
	    *numpnt = ipnt;
	}
	*errqua += valf * valf;
	*errmoy += valf;

    }

    goto L9999;

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


L9101:
    *iercod = 1;
    goto L9999;


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

L9999:

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

