/* MLIERQ.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 mmlierq_(ndimen, npoint, ncflim, ncftab, ncourb, tabpnt, 
	tabcrb, tabint, tabpar, errmax, errqua, errmoy, iercod)
integer *ndimen, *npoint, *ncflim, *ncftab, *ncourb;
doublereal *tabpnt, *tabcrb, *tabint, *tabpar, *errmax, *errqua, *errmoy;
integer *iercod;
{
    /* System generated locals */
    integer tabpnt_dim1, tabpnt_offset, tabcrb_dim1, tabcrb_dim2, 
	    tabcrb_offset, i__1;

    /* Local variables */
    static logical ldbg;
    static doublereal valc[3], valf;
    static integer ipnt, ncoef;
    static doublereal vdiff, spara, tparn, vsomm;
    static integer icourb;
    static doublereal ctenor;
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mmpocrb_(), 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 : */
/*     ---------- */
/*      Calcul de l'ecart Parametrique dans le lissageA */

/*     MOTS CLES : */
/*     ----------- */
/*      RESERVE, LISSAGE, DISTANCE, ERREUR */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*   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 : */
/*     --------------------- */
/*   ERRMAX : Erreur maximum */
/*   ERRQUA : Erreur quadratique */
/*   ERRMOY : erreur moyenne */
/*   IERCOD : CODE D'ERREUR */
/*       0 : OK */
/*       1 : Erreur */



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


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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*      17-06-1996: PMN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */






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

    /* Parameter adjustments */
    --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];

    *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];

	}

/*         --- 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);

	if (valf > *errmax) {
	    *errmax = valf;
	}
	*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 ;
} /* mmlierq_ */

