/* MCVCTX.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"
#ifdef WNT
#include <MathBase.h>
#else 
#define  __MathBase_API
#endif
/* Subroutine */ __MathBase_API int mmcvctx_(ndimen, ncofmx, nderiv, ctrtes, crvres, tabaux, 
	xmatri, iercod)
integer *ndimen, *ncofmx, *nderiv;
doublereal *ctrtes, *crvres, *tabaux, *xmatri;
integer *iercod;
{
    /* System generated locals */
    integer ctrtes_dim1, ctrtes_offset, crvres_dim1, crvres_offset, 
	    xmatri_dim1, xmatri_offset, tabaux_dim1, tabaux_offset, i__1, 
	    i__2;

    /* Local variables */
    static integer moup1, nordr;
    extern /* Subroutine */ int mmeps1_();
    static integer nd;
    extern /* Subroutine */ int mmrslw_();
    static integer ibb, ncf, ndv;
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mgsomsg_();
    static doublereal eps1;



/* < */
/* **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 d' une courbe polynomiale verifiant des */
/*        contraintes de passages (interpolation) */
/*        de derivees premieres etc... aux extremites. */
/*        Les parametres aux extremites sont supposes etre -1 et 1. */

/*     MOTS CLES : */
/*     ----------- */
/*     TOUS, AB_SPECIFI::CONTRAINTES&,INTERPOLATION,&COURBE */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*     NDIMEN : Dimension de l' espace. */
/*     NCOFMX : Nre de coeff. de la courbe CRVRES sur chaque */
/*              dimension. */
/*     NDERIV : Ordre de contrainte aux derivees : */
/*              0 --> interpolation simple. */
/*              1 --> interpolation+contraintes aux derivees 1eres. */
/*              2 --> cas (0)+ (1) +   "         "     "     2emes. */
/*                 etc... */
/*     CTRTES : Tableau des contraintes. */
/*              CTRTES(*,1,*) = contraintes en -1. */
/*              CTRTES(*,2,*) = contraintes en  1. */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*     CRVRES : La courbe resultat definie dans (-1,1). */
/*     TABAUX : Matrice auxilliaire. */
/*     XMATRI : Matrice auxilliaire. */

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

/*      .Neant. */

/*     REFERENCES APPELEES   : */
/*     ---------------------- */
/*     Type  Name */
/*           MAERMSG         R*8  DFLOAT              MGENMSG */
/*           MGSOMSG              MMEPS1               MMRSLW */
/*      I*4  MNFNDEB */

/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*        Le polynome (ou la courbe) est calculee en resolvant un */
/*        systeme d' equations lineaires. Si le degre impose est grand */
/*        il est preferable de faire appel a une routine basee sur */
/*        l' interpolation de Lagrange ou d' Hermite suivant le cas. */
/*        (pour un degre eleve la matrice du systeme peut etre mal */
/*        conditionnee). */
/*        Cette routine retourne une courbe definie dans (-1,1). */
/*        Pour un cas general, il faut utiliser MCVCTG. */

/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     18-09-1995 : JMF ; Verfor */
/*     14-02-1990 : RBD ; Correction declaration de NOMPRG. */
/*     12-04-1989 : RBD ; Suppression des chaines de caracteres pour */
/*                        les appel a MMRSLW. */
/*     31-05-1988 : JJM ; Reorganisation contraintes. */
/*     22-02-1988 : JJM ; Appel MFNDEB -> MNFNDEB */
/*     22-02-1988 : JJM ; Appel GERMSG -> MAERMSG */
/*     24-11-1987 : Cree par RBD. */

/* > */
/* ***********************************************************************
 */

/*   Le nom de la routine */


    /* Parameter adjustments */
    crvres_dim1 = *ncofmx;
    crvres_offset = crvres_dim1 + 1;
    crvres -= crvres_offset;
    xmatri_dim1 = *nderiv + 1;
    xmatri_offset = xmatri_dim1 + 1;
    xmatri -= xmatri_offset;
    tabaux_dim1 = *nderiv + 1 + *ndimen;
    tabaux_offset = tabaux_dim1 + 1;
    tabaux -= tabaux_offset;
    ctrtes_dim1 = *ndimen;
    ctrtes_offset = ctrtes_dim1 * 3 + 1;
    ctrtes -= ctrtes_offset;

    /* Function Body */
    ibb = mnfndeb_();
    if (ibb >= 3) {
	mgenmsg_("MMCVCTX", 7L);
    }
/*   Les precisions. */
    mmeps1_(&eps1);

/* ****************** CALCUL DES COEFFICIENTS PAIRS ********************* 
*/
/* ------------------------- Initialisation ----------------------------- 
*/

    nordr = *nderiv + 1;
    i__1 = nordr;
    for (ncf = 1; ncf <= i__1; ++ncf) {
	tabaux[ncf + tabaux_dim1] = 1.;
/* L100: */
    }

/* ---------------- Calcul des termes correspondants aux derivees ------- 
*/

    i__1 = nordr;
    for (ndv = 2; ndv <= i__1; ++ndv) {
	i__2 = nordr;
	for (ncf = 1; ncf <= i__2; ++ncf) {
	    tabaux[ncf + ndv * tabaux_dim1] = tabaux[ncf + (ndv - 1) * 
		    tabaux_dim1] * (doublereal) ((ncf << 1) - ndv);
/* L300: */
	}
/* L200: */
    }

/* ------------------ Ecriture du deuxieme membre ----------------------- 
*/

    moup1 = 1;
    i__1 = nordr;
    for (ndv = 1; ndv <= i__1; ++ndv) {
	i__2 = *ndimen;
	for (nd = 1; nd <= i__2; ++nd) {
	    tabaux[nordr + nd + ndv * tabaux_dim1] = (ctrtes[nd + ((ndv << 1) 
		    + 2) * ctrtes_dim1] + moup1 * ctrtes[nd + ((ndv << 1) + 1)
		     * ctrtes_dim1]) / 2.;
/* L500: */
	}
	moup1 = -moup1;
/* L400: */
    }

/* -------------------- Resolution du systeme --------------------------- 
*/

    mmrslw_(&nordr, &nordr, ndimen, &eps1, &tabaux[tabaux_offset], &xmatri[
	    xmatri_offset], iercod);
    if (*iercod > 0) {
	goto L9999;
    }
    i__1 = *ndimen;
    for (nd = 1; nd <= i__1; ++nd) {
	i__2 = nordr;
	for (ncf = 1; ncf <= i__2; ++ncf) {
	    crvres[(ncf << 1) - 1 + nd * crvres_dim1] = xmatri[ncf + nd * 
		    xmatri_dim1];
/* L700: */
	}
/* L600: */
    }

/* ***************** CALCUL DES COEFFICIENTS IMPAIRS ******************** 
*/
/* ------------------------- Initialisation ----------------------------- 
*/


    i__1 = nordr;
    for (ncf = 1; ncf <= i__1; ++ncf) {
	tabaux[ncf + tabaux_dim1] = 1.;
/* L1100: */
    }

/* ---------------- Calcul des termes correspondants aux derivees ------- 
*/

    i__1 = nordr;
    for (ndv = 2; ndv <= i__1; ++ndv) {
	i__2 = nordr;
	for (ncf = 1; ncf <= i__2; ++ncf) {
	    tabaux[ncf + ndv * tabaux_dim1] = tabaux[ncf + (ndv - 1) * 
		    tabaux_dim1] * (doublereal) ((ncf << 1) - ndv + 1);
/* L1300: */
	}
/* L1200: */
    }

/* ------------------ Ecriture du deuxieme membre ----------------------- 
*/

    moup1 = -1;
    i__1 = nordr;
    for (ndv = 1; ndv <= i__1; ++ndv) {
	i__2 = *ndimen;
	for (nd = 1; nd <= i__2; ++nd) {
	    tabaux[nordr + nd + ndv * tabaux_dim1] = (ctrtes[nd + ((ndv << 1) 
		    + 2) * ctrtes_dim1] + moup1 * ctrtes[nd + ((ndv << 1) + 1)
		     * ctrtes_dim1]) / 2.;
/* L1500: */
	}
	moup1 = -moup1;
/* L1400: */
    }

/* -------------------- Resolution du systeme --------------------------- 
*/

    mmrslw_(&nordr, &nordr, ndimen, &eps1, &tabaux[tabaux_offset], &xmatri[
	    xmatri_offset], iercod);
    if (*iercod > 0) {
	goto L9999;
    }
    i__1 = *ndimen;
    for (nd = 1; nd <= i__1; ++nd) {
	i__2 = nordr;
	for (ncf = 1; ncf <= i__2; ++ncf) {
	    crvres[(ncf << 1) + nd * crvres_dim1] = xmatri[ncf + nd * 
		    xmatri_dim1];
/* L1700: */
	}
/* L1600: */
    }

/* --------------------------- The end ---------------------------------- 
*/

L9999:
    if (*iercod != 0) {
	maermsg_("MMCVCTX", iercod, 7L);
    }
    if (ibb >= 3) {
	mgsomsg_("MMCVCTX", 7L);
    }

 return 0 ;
} /* mmcvctx_ */

