/* MARC41.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 mmarc41_(ndimax, ndimen, ncoeff, crvold, upara0, upara1, 
	crvnew, iercod)
integer *ndimax, *ndimen, *ncoeff;
doublereal *crvold, *upara0, *upara1, *crvnew;
integer *iercod;
{
    /* System generated locals */
    integer crvold_dim1, crvold_offset, crvnew_dim1, crvnew_offset, i__1, 
	    i__2, i__3;

    /* Local variables */
    static integer nboct;
    static doublereal tbaux[61];
    static integer nd;
    static doublereal bid;
    extern /* Subroutine */ int mvcvin2_();
    static integer ncf, ncj;
    extern /* Subroutine */ int mcrfill_(), maermsg_(), mvcvinv_();


/*      IMPLICIT DOUBLE PRECISION(A-H,O-Z) */
/*      IMPLICIT INTEGER (I-N) */


/* < */
/* **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 : */
/*     ---------- */
/*     Creation de la courbe C2(v) definie sur (0,1) identique a la */
/*     courbe C1(u) definie sur (U0,U1) (changement du parametre d' une */
/*     courbe). */

/*     MOTS CLES : */
/*     ----------- */
/*        LIMITATION, RESTRICTION, COURBE */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*   NDIMAX : Dimensionnement de l' espace. */
/*   NDIMEN   : Dimension de la courbe. */
/*   NCOEFF : Nbre de coefficients de la courbe. */
/*   CRVOLD : La courbe a limiter. */
/*   UPARA0     : Borne min de l' intervalle de restriction de la courbe. 
*/
/*   UPARA1     : Borne max de l' intervalle de restriction de la courbe. 
*/

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*   CRVNEW : La courbe relimitee, definie dans (0,1) et egale a */
/*            CRVOLD definie dans (U0,U1). */
/*   IERCOD : = 0, OK */
/*            =10, Nbre de coeff. <1 ou > 61. */

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

/*      .Neant. */

/*     REFERENCES APPELEES   : */
/*     ---------------------- */
/*     Type  Name */
/*           MAERMSG              MCRFILL              MVCVIN2 */
/*           MVCVINV */

/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/* ---> L' algorithme employe dans le cas general est base sur le */
/*     principe suivant : */
/*        Soient S(t) = a0 + a1*t + a2*t**2 + ... de degre NCOEFF-1, et */
/*               U(t) = b0 + b1*t, on calcule alors les coeff. de */
/*        S(U(t)) de proche en proche a l' aide du tableau TBAUX. */
/*        A chaque etape numero N (N=2 a NCOEFF), TBAUX(n) contient le */
/*        n-ieme coefficient de U(t)**N pour n=1 a N. (RBD) */
/* ---> Reference : KNUTH, 'The Art of Computer Programming', */
/*                        Vol. 2/'Seminumerical Algorithms', */
/*                        Ex. 11 p:451 et solution p:562. (RBD) */

/* ---> L' ecrasement de l' argument d' entree CRVOLD par CRVNEW est */
/*     possible, c' est a dire que l' appel : */
/*       CALL MMARC41(NDIMAX,NDIMEN,NCOEFF,CURVE,UPARA0,UPARA1 */
/*                  ,CURVE,IERCOD) */
/*     est tout a fait LEGAL. (RBD) */

/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     18-09-1995 : JMF ; Verfor + implicit none */
/*     18-10-88   : RBD ; Documentation de la FONCTION. */
/*     24-06-88   : RBD ; Refonte totale du code pour le cas general : */
/*                        optimisation et suppression du commun des CNP */
/*                        qui ne sert plus. */
/*     22-06-88   : NAK ; TRAITEMENT DES CAS PARTICULIERS SIMPLES ET */
/*                        FREQUENTS. */
/*     22-02-1988 : JJM ; Appel MFNDEB -> MNFNDEB. */
/*     22-02-1988 : JJM ; Appel GERMSG -> MAERMSG. */
/*     26-07-1985 : Remplacement de CAUX par CRVNEW, ajout du */
/*                  common MBLANK. */
/*     28-11-1985 : Creation JJM (NDIMAX en plus). */

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

/*   Le nom de la routine */

/*   Tableau auxiliaire des coefficients de (UPARA1-UPARA0)T+UPARA0 a */
/*   la puissance N=1 a NCOEFF-1. */


    /* Parameter adjustments */
    crvnew_dim1 = *ndimax;
    crvnew_offset = crvnew_dim1 + 1;
    crvnew -= crvnew_offset;
    crvold_dim1 = *ndimax;
    crvold_offset = crvold_dim1 + 1;
    crvold -= crvold_offset;

    /* Function Body */
    *iercod = 0;
/* ********************************************************************** 
*/
/*                CAS OU LE TRAITEMENT NE PEUT ETRE FAIT */
/* ********************************************************************** 
*/
    if (*ncoeff > 61 || *ncoeff < 1) {
	*iercod = 10;
	goto L9999;
    }
/* ********************************************************************** 
*/
/*                         SI PAS DE CHANGEMENT */
/* ********************************************************************** 
*/
    if (*ndimen == *ndimax && *upara0 == 0. && *upara1 == 1.) {
	nboct = (*ndimax << 3) * *ncoeff;
	mcrfill_(&nboct, &crvold[crvold_offset], &crvnew[crvnew_offset]);
	goto L9999;
    }
/* ********************************************************************** 
*/
/*                    INVERSION 3D : TRAITEMENT RAPIDE */
/* ********************************************************************** 
*/
    if (*upara0 == 1. && *upara1 == 0.) {
	if (*ndimen == 3 && *ndimax == 3 && *ncoeff <= 21) {
	    mvcvinv_(ncoeff, &crvold[crvold_offset], &crvnew[crvnew_offset], 
		    iercod);
	    goto L9999;
	}
/* ******************************************************************
**** */
/*                    INVERSION 2D : TRAITEMENT RAPIDE */
/* ******************************************************************
**** */
	if (*ndimen == 2 && *ndimax == 2 && *ncoeff <= 21) {
	    mvcvin2_(ncoeff, &crvold[crvold_offset], &crvnew[crvnew_offset], 
		    iercod);
	    goto L9999;
	}
    }
/* ********************************************************************** 
*/
/*                          TRAITEMENT GENERAL */
/* ********************************************************************** 
*/
/* -------------------------- Initialisations --------------------------- 
*/

    i__1 = *ndimen;
    for (nd = 1; nd <= i__1; ++nd) {
	crvnew[nd + crvnew_dim1] = crvold[nd + crvold_dim1];
/* L100: */
    }
    if (*ncoeff == 1) {
	goto L9999;
    }
    tbaux[0] = *upara0;
    tbaux[1] = *upara1 - *upara0;

/* ----------------------- Calcul des coeff. de CRVNEW ------------------ 
*/

    i__1 = *ncoeff - 1;
    for (ncf = 2; ncf <= i__1; ++ncf) {

/* ------------ Prise en compte du NCF-ieme coeff. de CRVOLD --------
---- */

	i__2 = ncf - 1;
	for (ncj = 1; ncj <= i__2; ++ncj) {
	    bid = tbaux[ncj - 1];
	    i__3 = *ndimen;
	    for (nd = 1; nd <= i__3; ++nd) {
		crvnew[nd + ncj * crvnew_dim1] += crvold[nd + ncf * 
			crvold_dim1] * bid;
/* L400: */
	    }
/* L300: */
	}

	bid = tbaux[ncf - 1];
	i__2 = *ndimen;
	for (nd = 1; nd <= i__2; ++nd) {
	    crvnew[nd + ncf * crvnew_dim1] = crvold[nd + ncf * crvold_dim1] * 
		    bid;
/* L500: */
	}

/* --------- Calcul des (NCF+1) coeff. de ((U1-U0)*t + U0)**(NCF) ---
---- */

	bid = *upara1 - *upara0;
	tbaux[ncf] = tbaux[ncf - 1] * bid;
	for (ncj = ncf; ncj >= 2; --ncj) {
	    tbaux[ncj - 1] = tbaux[ncj - 1] * *upara0 + tbaux[ncj - 2] * bid;
/* L600: */
	}
	tbaux[0] *= *upara0;

/* L200: */
    }

/* -------------- Prise en compte du dernier coeff. de CRVOLD ----------- 
*/

    i__1 = *ncoeff - 1;
    for (ncj = 1; ncj <= i__1; ++ncj) {
	bid = tbaux[ncj - 1];
	i__2 = *ndimen;
	for (nd = 1; nd <= i__2; ++nd) {
	    crvnew[nd + ncj * crvnew_dim1] += crvold[nd + *ncoeff * 
		    crvold_dim1] * bid;
/* L800: */
	}
/* L700: */
    }
    i__1 = *ndimen;
    for (nd = 1; nd <= i__1; ++nd) {
	crvnew[nd + *ncoeff * crvnew_dim1] = crvold[nd + *ncoeff * 
		crvold_dim1] * tbaux[*ncoeff - 1];
/* L900: */
    }

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

L9999:
    if (*iercod != 0) {
	maermsg_("MMARC41", iercod, 7L);
    }

 return 0 ;
} /* mmarc41_ */

