/* MLI3PT.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"
#include <Data_Data.h>
/* Common Block Declarations */

/*extern __Data_API struct {*/
extern struct {
    integer nbr[1001];
} minombr_;

#define minombr_1 minombr_

/* Subroutine */ int mmli3pt_(ndimen, point1, point2, point3, parbol, iercod)
integer *ndimen;
doublereal *point1, *point2, *point3, *parbol;
integer *iercod;
{
    /* Initialized data */

    static doublereal amat[9]	/* was [3][3] */ = { 1.,0.,0.,0.,0.,1.,0.,0.,
	    1. };

    /* System generated locals */
    integer parbol_dim1, parbol_offset, i__1;
    doublereal d__1;

    /* Builtin functions */
    double sqrt();

    /* Local variables */
    static logical ldbg;
    static doublereal caux[9]	/* was [3][3] */;
    extern /* Subroutine */ int mmmrslwd_();
    static doublereal delta, bvect[9]	/* was [3][3] */;
    static integer isens;
    static doublereal v1, v2;
    extern /* Subroutine */ int mmeps1_();
    static integer ii;
    extern /* Subroutine */ int mmfmcb5_();
    static integer ier;
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mgsomsg_();
    static doublereal eps1, abid[18];



/* < */
/* **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 : */
/*     ---------- */
/*       Interpolation parbolique de 3 points */

/*     MOTS CLES : */
/*     ----------- */
/*      POINT_ENTREE, LISSAGE, VARIATIONNEL, COURBE, EN_DEVELOPPEMENT */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*     NDIMEN : Dimension de l'espace */
/*     POINT1 : Premier point a interpoler */
/*     POINT2 : second point a interpoler */
/*     POINT3 : Troisieme  point a interpoler */

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

/*       PARBOL : Equation de la parabole */
/*       IERCOD : code d'erreur */
/*          1 : Les points sont confondus */
/*          2 : Erreur dans un sous-programme */

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


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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     23-10-1995: PMN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */


/*     INCLUDE MINOMBR */
/* < */
/* **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 : */
/*     ---------- */
/*        Sert a fournir les constantes entieres de 0 a 1000 */

/*     MOTS CLES : */
/*     ----------- */
/*        TOUS,ENTIERS */

/*     DEMSCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     11-10-89 : DH ; Creation version originale */
/* > */
/* ***********************************************************************
 */


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


/*     VARIABLES LOCALES */


    /* Parameter adjustments */
    parbol_dim1 = *ndimen;
    parbol_offset = parbol_dim1 + 1;
    parbol -= parbol_offset;
    --point3;
    --point2;
    --point1;

    /* Function Body */

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

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

    mmeps1_(&eps1);

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

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

    v1 = 0.;
    v2 = 0.;
    i__1 = *ndimen;
    for (ii = 1; ii <= i__1; ++ii) {
/* Computing 2nd power */
	d__1 = point2[ii] - point1[ii];
	v1 += d__1 * d__1;
/* Computing 2nd power */
	d__1 = point3[ii] - point2[ii];
	v2 += d__1 * d__1;
    }

    v1 = sqrt(v1);
    v2 = sqrt(v2);

    if (v1 <= eps1) {
	goto L9101;
    }
    if (v2 <= eps1) {
	goto L9101;
    }

    delta = v1 / (v1 + v2);

/*     Construction du systeme lineaire */

    amat[4] = delta;
    amat[7] = delta * delta;

    i__1 = *ndimen;
    for (ii = 1; ii <= i__1; ++ii) {
	bvect[ii * 3 - 3] = point1[ii];
	bvect[ii * 3 - 2] = point2[ii] - point1[ii];
	bvect[ii * 3 - 1] = point3[ii] - point1[ii];
    }

    mmmrslwd_(&minombr_1.nbr[3], &minombr_1.nbr[3], ndimen, amat, bvect, &
	    eps1, abid, caux, &ier);
    if (ier > 0) {
	goto L9102;
    }

    isens = -1;
    mmfmcb5_(&isens, ndimen, &minombr_1.nbr[3], &parbol[parbol_offset], &
	    minombr_1.nbr[3], &minombr_1.nbr[3], ndimen, caux, &ier);
    if (ier > 0) {
	goto L9102;
    }

    goto L9999;

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

L9101:
    *iercod = 1;
    goto L9999;

L9102:
    *iercod = 2;
    goto L9999;

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

L9999:

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

