/* MLISCN.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 mlimscn_(ndimen, nbrpnt, nbcntr, tabpar, typcnt, tabcnt, 
	tangt1, tangt2, eslong, numpnt, vsecn, iercod)
integer *ndimen, *nbrpnt, *nbcntr;
doublereal *tabpar;
integer *typcnt;
doublereal *tabcnt, *tangt1, *tangt2, *eslong;
integer *numpnt;
doublereal *vsecn;
integer *iercod;
{
    /* Initialized data */

    static doublereal epsiln = 1e-9;

    /* System generated locals */
    integer tabcnt_dim1, tabcnt_offset, i__1;

    /* Local variables */
    static logical ldbg;
    static doublereal vcnt[3], wcnt, wpnt;
    static integer idcnt;
    static doublereal denom;
    static integer ii;
    extern integer mnfndeb_();
    static doublereal aux;
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mswrdbg_(), msrfill_()
	    , 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 : */
/*     ---------- */
/*       Estimation de la derive seconde au point (ti) */
/*       En fait on estime C''(t) / ESLONG */

/*     MOTS CLES : */
/*     ----------- */
/*      LISSAGE, ESTIMATION, COURBE, EN_DEVELOPPEMENT */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*     NDIMEN : Dimension de l'espace */
/*     NBRPNT : Nombre de points a lisser  (>= 2) */
/*     NBCNTR : Nombre de point contraints (<= NBRPNT) */
/*     TABPAR : parametres associes aux points */
/*     TYPCNT : Tableau caracterisant les points contraints */
/*     TYPCNT(1,i) :  Indice du point contraints */
/*     TYPCNT(2,i) :  Type de la contrainte */
/*                    0 -> de passage (G0) */
/*                    1 -> de tangence (G1) */
/*                    2 -> de courbure (G2) */
/*     TABCNT(*,1,i) : Vecteur tangent a respecter */
/*     TABCNT(*,2,i) : Vecteur courbure a respecter */
/*     TABCNT : Valeur des contraintes */
/*     TANGT1 : premiere tangente */
/*     TANGT2 : seconde tangente */
/*     ESLONG : Estimation de la longueur */
/*     NUMPNT : Numero du point pour lequel on estime la derive seconde */

/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */

/*     VSECN : Vecteur estime de la derive seconde au point NUMPNT */
/*     IERCOD : code d'erreur */
/*          0   : Ok */
/*          1   : Pb avec les arguments */

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


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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     17-11-1995: PMN; Probleme sur le numero de contrainte */
/*      3-11-1995: PMN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */


/* ---  Variables statiques */


/*     VARIABLES LOCALES */


    /* Parameter adjustments */
    --vsecn;
    --tangt2;
    --tangt1;
    tabcnt_dim1 = *ndimen;
    tabcnt_offset = tabcnt_dim1 * 3 + 1;
    tabcnt -= tabcnt_offset;
    --tabpar;
    typcnt -= 3;

    /* Function Body */

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

    ldbg = mnfndeb_() >= 4;
    if (ldbg) {
	mgenmsg_("MLIMSCN", 7L);
    }
    *iercod = 0;

    if (*numpnt == 1) {
	idcnt = 1;
    }

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

    if (*ndimen > 3) {
	goto L9101;
    }
    if (*numpnt < 1) {
	goto L9101;
    }
    if (*numpnt > *nbrpnt) {
	goto L9101;
    }

/* (1) Estimation via les tangentes */

    wpnt = 1.;

    if (*numpnt == 1) {
	aux = tabpar[2] - tabpar[1];
    } else if (*numpnt == *nbrpnt) {
	aux = tabpar[*nbrpnt] - tabpar[*nbrpnt - 1];
    } else {
	aux = tabpar[*numpnt + 1] - tabpar[*numpnt - 1];
    }

    if (aux < epsiln) {
	aux = 1.;
    } else {
	aux = 1. / aux;
    }
    i__1 = *ndimen;
    for (ii = 1; ii <= i__1; ++ii) {
	vsecn[ii] = (tangt2[ii] - tangt1[ii]) * aux;
    }

/* (2) Estimation via les contraintes */

    wcnt = 0.;
    if (*nbcntr > 0) {

	if (idcnt > *nbcntr || idcnt < 1) {
	    idcnt = 1;
	}

/*           ---> Recherche d'une contrainte en NUMPNT */
	if (typcnt[(idcnt << 1) + 1] > *numpnt) {
	    idcnt = 1;
	}
	while(typcnt[(idcnt << 1) + 1] < *numpnt && idcnt <= *nbcntr) {
	    ++idcnt;
	}

/*           ---> Affectation de la contrainte */
	if (typcnt[(idcnt << 1) + 1] == *numpnt) {
	    if (typcnt[(idcnt << 1) + 2] >= 2) {
		msrfill_(ndimen, &tabcnt[((idcnt << 1) + 2) * tabcnt_dim1 + 1]
			, vcnt);
		wcnt = 1.;

/*                 C''(t) = rho(t) * C'(t) * C'(t) */
/*                 si le parametrage est ACR */
/*                 donc C''(t)/L(C) = rho(t) * C'(t) */

		i__1 = *ndimen;
		for (ii = 1; ii <= i__1; ++ii) {
		    vcnt[ii - 1] = *eslong * vcnt[ii - 1];
		}
	    }
	} else {
	    --idcnt;
	}
    }


/* (3) Moyenne des estimations */

    denom = wpnt + wcnt;
    if (denom == (float)0.) {
	denom = 1.;
    } else {
	denom = 1. / denom;
    }

    i__1 = *ndimen;
    for (ii = 1; ii <= i__1; ++ii) {
	vsecn[ii] = (wpnt * vsecn[ii] + wcnt * vcnt[ii - 1]) * denom;
    }

    goto L9999;

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

L9101:
    mswrdbg_("MLIMSCN: PROBLEME AVEC LES ARGUMENTS", 36L);
    *iercod = 1;
    goto L9999;

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

L9999:

    if (*iercod > 0) {
	maermsg_("MLIMSCN", iercod, 7L);
    }
    if (ldbg) {
	mgsomsg_("MLIMSCN", 7L);
    }
 return 0 ;
} /* mlimscn_ */

