/* MA2FNC.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"
#if defined(WNT) && !defined(__CYGWIN32__) && !defined(__MINGW32__)
#include <ApproxF2var.h>
#endif 
/* Table of constant values */

static integer c__8 = 8;

/* Subroutine */ int mma2fnc_(ndimen, nbsesp, ndimse, uvfonc, foncnp, tconst, 
	isofav, nbroot, rootlg, iordre, ideriv, ndgjac, nbcrmx, ncflim, 
	epsapr, ncoeff, courbe, nbcrbe, somtab, diftab, contr1, contr2, 
	tabdec, errmax, errmoy, iercod)
const integer *ndimen, *nbsesp, *ndimse;
const doublereal *uvfonc;
/* Subroutine */ int (*foncnp) ();
const doublereal *tconst;
const integer *isofav, *nbroot;
const doublereal *rootlg;
const integer *iordre, *ideriv, *ndgjac, *nbcrmx, *ncflim;
const doublereal *epsapr;
integer *ncoeff;
doublereal *courbe;
integer *nbcrbe;
doublereal *somtab, *diftab, *contr1, *contr2, *tabdec, *errmax, *errmoy;
integer *iercod;
{
    /* System generated locals */
    integer courbe_dim1, courbe_dim2, courbe_offset, somtab_dim1, somtab_dim2,
	     somtab_offset, diftab_dim1, diftab_dim2, diftab_offset, 
	    contr1_dim1, contr1_dim2, contr1_offset, contr2_dim1, contr2_dim2,
	     contr2_offset, errmax_dim1, errmax_offset, errmoy_dim1, 
	    errmoy_offset, i__1;
    doublereal d__1;

    /* Local variables */
    static integer ideb;
    static doublereal tmil;
    static integer  ideb1, ibid1, ibid2, ncfja, ndgre, ilong, 
	    ndwrk;
    static doublereal wrkar[1];
    static integer nupil;
    static long int iofwr;
    static doublereal uvpav[4]	/* was [2][2] */;
    static integer nd, ii;
    extern /* Subroutine */ int mma1cdi_(), mma1fdi_(), mma1jak_(), mma1fer_()
	    , mmfmca8_(), mma1noc_(), mma1cnt_(), mma1nop_();
    static integer ibb;
    extern /* Subroutine */ int mmveps3_();
    static integer ier;
    extern /* Subroutine */ int mmjacan_();
    extern integer mnfndeb_();
    static doublereal uv11[4]	/* was [2][2] */;
    extern /* Subroutine */ int mcrfill_(), mmapcmp_(), mcrdelt_(), maermsg_()
	    , mgenmsg_();
    static integer ncb1;
    extern /* Subroutine */ int mgsomsg_(), mvriraz_();
    static doublereal eps3;
    extern /* Subroutine */ int mcrrqst_();
    static integer isz1, isz2, isz3, isz4, isz5;
    static long int ipt1, ipt2, ipt3, ipt4, ipt5,iptt, jptt;




/* < */
/* **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 : */
/*     ---------- */
/* Approximation d'UNE frontiere d'une fonction non polynomiale F(u,v) */
/* (dans l' espace de dimension NDIMEN) par PLUSIEURS courbes */
/* polynomiales, par la methode des moindres carres. Le parametre de la */
/* fonction est conserve. */

/*     MOTS CLES : */
/*     ----------- */
/* TOUS, AB_SPECIFI :: FONCTION&,EXTREMITE&, APPROXIMATION, &COURBE. */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*     NDIMEN: Dimension totale de l' espace (somme des dimensions */
/*             des sous-espaces) */
/*     NBSESP: Nombre de sous-espaces "independants". */
/*     NDIMSE: Table des dimensions des sous-espaces. */
/*     UVFONC: Bornes de l' intervalle (a,b)x(c,d) de definition de la */
/*             fonction a approcher en U (UVFONC(*,1) contient (a,b)) */
/*             et en V (UVFONC(*,2) contient (c,d)). */
/*     FONCNP: Fonction externe de positionnement sur la fonction non */
/*             polynomiale a approcher. */
/*     TCONST: Valeur de l'isoparametre de F(u,v) a discretiser. */
/*     ISOFAV: Type d'iso choisi, = 1, indique que l'on discretise a u */
/*             fixe; = 2, indique que v est fixe. */
/*     NBROOT: Nbre de points de discretisation de l'iso, extremites non 
*/
/*             comprises. */
/*     ROOTLG: Table des racines du polynome de Legendre defini sur */
/*             (-1,1), de degre NBROOT. */
/*     IORDRE: Ordre de contrainte aux extremites de la frontiere */
/*              -1 = pas de contraintes, */
/*               0 = contraintes de passage aux bornes (i.e. C0), */
/*               1 = C0 + contraintes de derivees 1eres (i.e. C1), */
/*               2 = C1 + contraintes de derivees 2ndes (i.e. C2). */
/*     IDERIV: Ordre de derivee de la frontiere. */
/*     NDGJAC: Degre du developpement en serie a utiliser pour le calcul 
*/
/*             dans la base de Jacobi. */
/*     NBCRMX: Nbre maxi de courbes a creer. */
/*     NCFLIM: Nombre maxi de coeff de la "courbe" polynomiale */
/*             d' approximation (doit etre superieur ou egal a */
/*             2*IORDRE+2 et inferieur ou egal a 50). */
/*     EPSAPR: Table des erreurs d' approximations souhaitees */
/*             sous-espace par sous-espace. */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*     NCOEFF: Nombre de coeff. significatifs des courbes calculees. */
/*     COURBE: Tableau des coeff. des courbes polynomiales calculees. */
/*             Doit etre dimensionne en (NCFLIM,NDIMEN,NBCRMX). */
/*             Ces courbes sont TOUJOURS parametrees dans (-1,1). */
/*     NBCRBE: Nbre de courbes calculees. */
/*     SOMTAB: Pour F definie sur (-1,1) (sinon on recale les */
/*             parametres), c'est la table des sommes F(u,vj) + F(u,-vj) 
*/
/*             si ISOFAV = 1 (et IDERIV=0, sinon on prend les derivees */
/*             en u d'ordre IDERIV) ou des sommes F(ui,v) + F(-ui,v) si */
/*             ISOFAV = 2 (et IDERIV=0, sinon on prend les derivees en */
/*             v d'ordre IDERIV). */
/*     DIFTAB: Pour F definie sur (-1,1) (sinon on recale les */
/*             parametres), c'est la table des sommes F(u,vj) - F(u,-vj) 
*/
/*             si ISOFAV = 1 (et IDERIV=0, sinon on prend les derivees */
/*             en u d'ordre IDERIV) ou des sommes F(ui,v) - F(-ui,v) si */
/*             ISOFAV = 2 (et IDERIV=0, sinon on prend les derivees en */
/*             v d'ordre IDERIV). */
/*     CONTR1: Contient les coordonnees de l'extremite gauche de l'iso */
/*             et de ses derivees jusqu'a l'ordre IORDRE */
/*     CONTR2: Contient les coordonnees de l'extremite droite de l'iso */
/*             et de ses derivees jusqu'a l'ordre IORDRE */
/*     TABDEC: Table des NBCRBE+1 parametres de decoupe de UVFONC(1:2,1) 
*/
/*             si ISOFAV=2, ou de UVFONC(1:2,2) si ISOFAV=1. */
/*     ERRMAX: Table des erreurs (sous-espace par sous espace) */
/*             MAXIMALES commises dans l' approximation de FONCNP par */
/*             les NBCRBE courbes. */
/*     ERRMOY: Table des erreurs (sous-espace par sous espace) */
/*             MOYENNES commises dans l' approximation de FONCNP par */
/*             les NBCRBE courbes. */
/*     IERCOD: Code d' erreur : */
/*             -1 = ERRMAX > EPSAPR pour au moins un des sous-espace. */
/*                  (les courbes resultat de degre mathematique NCFLIM-1 
*/
/*                  au plus , sont quand meme calculees). */
/*              0 = Tout est ok. */
/*              1 = Pb d' incoherence des entrees. */
/*             10 = Pb de calcul de l' interpolation des contraintes. */
/*             13 = Pb dans l' allocation dynamique. */
/*             33 = Pb dans la recuperation des donnees du block data */
/*                  des coeff. d' integration par la methode de GAUSS. */
/*             >100 Pb dans l' evaluation de FONCNP, le code d' erreur */
/*                  renvoye est egal au code d' erreur de FONCNP + 100. */

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

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

/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/* --> La partie approximation est faite dans l' espace de dimension */
/*    NDIMEN (la somme des dimensions des sous-espaces). Par exemple : */
/*        Si NBSESP=2 et NDIMSE(1)=3, NDIMSE(2)=2, on a un lissage avec */
/*        NDIMEN=5. Le resultat (dans COURBE(NDIMEN,NCOEFF,i) ), sera */
/*        compose du resultat du lissage de la fonction 3D dans */
/*        COURBE(1:3,1:NCOEFF,i) et du lissage de la fonction 2D dans */
/*        COURBE(4:5,1:NCOEFF,i). */

/* -->  La routine FONCNP doit etre declaree EXTERNAL dans le programme */
/*     appelant MMA2FNC. */

/* -->  La fonction FONCNP, declaree ici en externe, doit etre declaree */
/*     IMPERATIVEMENT sous la forme : */
/*          SUBROUTINE FONCNP(NDIMEN,UINTFN,VINTFN,IIUOUV,TCONST,NBPTAB */
/*                           ,TTABLE,IDERIU,IDERIV,IERCOD) */
/*     ou les arguments d' entree sont : */
/*      - NDIMEN est un entier defini comme la somme des dimensions des */
/*               sous-espaces (i.e. dimension totale du probleme). */
/*      - UINTFN(2) est un tableau de 2 reels contenant l' intervalle */
/*                en U ou est definie la fonction a approximer */
/*                (donc ici egal a UIFONC). */
/*      - VINTFN(2) est un tableau de 2 reels contenant l' intervalle */
/*                en V ou est definie la fonction a approximer */
/*                (donc ici egal a VIFONC). */
/*      - IIUOUV, indique que les points a calculer sont a U constant */
/*                (IIUOUV=1) ou a V constant (IIUOUV=2). */
/*      - TCONST, un reel, le parametre fixe de discretisation qui prend 
*/
/*                ses valeurs dans (UINTFN(1),UINTFN(2)) si IIUOUV=1, */
/*                ou dans (VINTFN(1),VINTFN(2)) si IIUOUV=2. */
/*      - NBPTAB, Le nbre de point de discretisation suivant la variable 
*/
/*                libre: V si IIUOUV=1 ou U si IIUOUV = 2. */
/*      - TTABLE, La table des NBPTAB parametres de discretisation. */
/*      - IDERIU, un entier, prend ses valeurs entre 0 (positionnement) */
/*                et IORDRU (derivee partielle en U de la fonction a */
/*                l' ordre IORDRU si IORDRU > 0). */
/*      - IDERIV, un entier, prend ses valeurs entre 0 (positionnement) */
/*                et IORDRV (derivee partielle en V de la fonction a */
/*                l' ordre IORDRV si IORDRV > 0). */
/*     et les arguments de sortie sont : */
/*      - FPNTAB(NDIMEN,NBPTAB) contient, en sortie, le tableau des */
/*                NBPTAB points calcules de dimension NDIMEN. */
/*      - IERCOD est, en sortie, le code d' erreur de FONCNP. Ce code */
/*               (entier) doit etre strictement positif s' il y a eu */
/*               un probleme. */
/*     Les arguments d' entree NE DOIVENT PAS etre modifies sous FONCNP. 
*/

/* -->  Si IERCOD=-1, la precision demandee n' est pas atteinte (ERRMAX */
/*     est superieur a EPSAPR sur au moins l' un des sous espaces), mais 
*/
/*     on donne le meilleur resultat possible pour NCFLIM et EPSAPR */
/*     choisis par l'utilisateur. Dans ce cas (ainsi que pour */
/*     IERCOD=0), on a une solution. */


/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     04-02-1992: RBD; Correction passage SOMTAB et DIFTAB en argument */
/*                      et appel a MMFMCA8. */
/*     26-09-1991: RBD; Creation. */
/* > */
/* ********************************************************************** 
*/
/*   Le nom de la routine */

    /* Parameter adjustments */
    --epsapr;
    --ndimse;
    uvfonc -= 3;
    --rootlg;
    errmoy_dim1 = *nbsesp;
    errmoy_offset = errmoy_dim1 + 1;
    errmoy -= errmoy_offset;
    errmax_dim1 = *nbsesp;
    errmax_offset = errmax_dim1 + 1;
    errmax -= errmax_offset;
    contr2_dim1 = *ndimen;
    contr2_dim2 = *iordre + 2;
    contr2_offset = contr2_dim1 * (contr2_dim2 + 1) + 1;
    contr2 -= contr2_offset;
    contr1_dim1 = *ndimen;
    contr1_dim2 = *iordre + 2;
    contr1_offset = contr1_dim1 * (contr1_dim2 + 1) + 1;
    contr1 -= contr1_offset;
    diftab_dim1 = *nbroot / 2 + 1;
    diftab_dim2 = *ndimen;
    diftab_offset = diftab_dim1 * (diftab_dim2 + 1);
    diftab -= diftab_offset;
    somtab_dim1 = *nbroot / 2 + 1;
    somtab_dim2 = *ndimen;
    somtab_offset = somtab_dim1 * (somtab_dim2 + 1);
    somtab -= somtab_offset;
    --ncoeff;
    courbe_dim1 = *ncflim;
    courbe_dim2 = *ndimen;
    courbe_offset = courbe_dim1 * (courbe_dim2 + 1) + 1;
    courbe -= courbe_offset;

    /* Function Body */
    ibb = mnfndeb_();
    if (ibb >= 1) {
	mgenmsg_("MMA2FNC", 7L);
    }
    *iercod = 0;
    iofwr = 0;

/* ---------------- Mise a zero des coefficients de COURBE -------------- 
*/

    ilong = *ndimen * *ncflim * *nbcrmx;
    mvriraz_(&ilong, &courbe[courbe_offset]);

/* ********************************************************************** 
*/
/* -------------------------- Verification des entrees ------------------ 
*/
/* ********************************************************************** 
*/

    mmveps3_(&eps3);
    if ((d__1 = uvfonc[4] - uvfonc[3], abs(d__1)) < eps3) {
	goto L9100;
    }
    if ((d__1 = uvfonc[6] - uvfonc[5], abs(d__1)) < eps3) {
	goto L9100;
    }

    uv11[0] = -1.;
    uv11[1] = 1.;
    uv11[2] = -1.;
    uv11[3] = 1.;

/* ********************************************************************** 
*/
/* ------------- Preparation des parametres de discretisation ----------- 
*/
/* ********************************************************************** 
*/

/* -- Allocation d'une table de parametres et de pts de discretisation -- 
*/
/* --> Pour les parametres de discretisation. */
    isz1 = *nbroot + 2;
/* --> Pour les pts de discretisation dans MMA1FDI et MMA1CDI et la courbe
 */
/*    auxiliaire pour MMAPCMP */
    ibid1 = *ndimen * (*nbroot + 2);
    ibid2 = ((*iordre + 1) << 1) * *nbroot;
    isz2 = max(ibid1,ibid2);
    ibid1 = (((*ncflim - 1) / 2 + 1) << 1) * *ndimen;
    isz2 = max(ibid1,isz2);
/* --> Pour recuperer les polynomes d'hermite. */
    isz3 = ((*iordre + 1) << 2) * (*iordre + 1);
/* --> Pour les coeff. d'integration de Gauss. */
    isz4 = (*nbroot / 2 + 1) * (*ndgjac + 1 - ((*iordre + 1) << 1));
/* --> Pour les coeff de la courbe dans la base de Jacobi */
    isz5 = (*ndgjac + 1) * *ndimen;

    ndwrk = isz1 + isz2 + isz3 + isz4 + isz5;
    mcrrqst_(&c__8, &ndwrk, wrkar, &iofwr, &ier);
    if (ier > 0) {
	goto L9013;    }
/* --> Pour les parametres de discretisation (NBROOT+2 extremites). */
    ipt1 = iofwr;
/* --> Pour les pts de discretisation FPNTAB(NDIMEN,NBROOT+2), */
/*    FPNTAB(NBROOT,2*(IORDRE+1)) et pour WRKAR de MMAPCMP. */
    ipt2 = ipt1 + isz1;
/* --> Pour les polynomes d'Hermite */
    ipt3 = ipt2 + isz2;
/* --> Pour les coeff d'integration de Gauss. */
    ipt4 = ipt3 + isz3;
/* --> Pour la courbe dans Jacobi. */
    ipt5 = ipt4 + isz4;

/* ------------------ Initialisation de la gestion des decoupes --------- 
*/

    if (*isofav == 1) {
	uvpav[0] = uvfonc[3];
	uvpav[1] = uvfonc[4];
	tabdec[0] = uvfonc[5];
	tabdec[1] = uvfonc[6];
    } else if (*isofav == 2) {
	tabdec[0] = uvfonc[3];
	tabdec[1] = uvfonc[4];
	uvpav[2] = uvfonc[5];
	uvpav[3] = uvfonc[6];
    } else {
	goto L9100;
    }

    nupil = 1;
    *nbcrbe = 0;

/* ********************************************************************** 
*/
/*                       APPROXIMATION AVEC DECOUPES */
/* ********************************************************************** 
*/

L1000:
/* --> Lorsque l' on a atteint le haut de la pile, c' est fini ! */
    if (nupil - *nbcrbe == 0) {
	goto L9900;
    }
    ncb1 = *nbcrbe + 1;
    if (*isofav == 1) {
	uvpav[2] = tabdec[*nbcrbe];
	uvpav[3] = tabdec[*nbcrbe + 1];
    } else if (*isofav == 2) {
	uvpav[0] = tabdec[*nbcrbe];
	uvpav[1] = tabdec[*nbcrbe + 1];
    } else {
	goto L9100;
    }

/* -------------------- Normalisation des parametres -------------------- 
*/

    mma1nop_(nbroot, &rootlg[1], uvpav, isofav, &wrkar[ipt1], &ier);
    if (ier > 0) {
	goto L9100;
    }

/* -------------------- Discretisation de FONCNP ------------------------ 
*/

    mma1fdi_(ndimen, uvpav, foncnp, isofav, tconst, nbroot, &wrkar[ipt1], 
	    iordre, ideriv, &wrkar[ipt2], &somtab[(ncb1 * somtab_dim2 + 1) * 
	    somtab_dim1], &diftab[(ncb1 * diftab_dim2 + 1) * diftab_dim1], &
	    contr1[(ncb1 * contr1_dim2 + 1) * contr1_dim1 + 1], &contr2[(ncb1 
	    * contr2_dim2 + 1) * contr2_dim1 + 1], iercod);
    if (*iercod > 0) {
	goto L9900;
    }

/* -----------On retranche la discretisation des contraintes ------------ 
*/

    if (*iordre >= 0) {
	mma1cdi_(ndimen, nbroot, &rootlg[1], iordre, &contr1[(ncb1 * 
		contr1_dim2 + 1) * contr1_dim1 + 1], &contr2[(ncb1 * 
		contr2_dim2 + 1) * contr2_dim1 + 1], &somtab[(ncb1 * 
		somtab_dim2 + 1) * somtab_dim1], &diftab[(ncb1 * diftab_dim2 
		+ 1) * diftab_dim1], &wrkar[ipt2], &wrkar[ipt3], &ier);
	if (ier > 0) {
	    goto L9100;
	}
    }

/* ********************************************************************** 
*/
/* -------------------- Calcul de la courbe d'approximation ------------- 
*/
/* ********************************************************************** 
*/

    mma1jak_(ndimen, nbroot, iordre, ndgjac, &somtab[(ncb1 * somtab_dim2 + 1) 
	    * somtab_dim1], &diftab[(ncb1 * diftab_dim2 + 1) * diftab_dim1], &
	    wrkar[ipt4], &wrkar[ipt5], &ier);
    if (ier > 0) {
	goto L9100;
    }

/* ********************************************************************** 
*/
/* ---------------- Ajout du polynome d'interpolation ------------------- 
*/
/* ********************************************************************** 
*/

    if (*iordre >= 0) {
	mma1cnt_(ndimen, iordre, &contr1[(ncb1 * contr1_dim2 + 1) * 
		contr1_dim1 + 1], &contr2[(ncb1 * contr2_dim2 + 1) * 
		contr2_dim1 + 1], &wrkar[ipt3], ndgjac, &wrkar[ipt5]);
    }

/* ********************************************************************** 
*/
/* --------------- Calcul de l'erreur Max et Moyenne -------------------- 
*/
/* ********************************************************************** 
*/

    mma1fer_(ndimen, nbsesp, &ndimse[1], iordre, ndgjac, &wrkar[ipt5], ncflim,
	     &epsapr[1], &wrkar[ipt2], &errmax[ncb1 * errmax_dim1 + 1], &
	    errmoy[ncb1 * errmoy_dim1 + 1], &ncoeff[ncb1], &ier);
    if (ier > 0) {
	goto L9100;
    }

    if (ier == 0 || (ier == -1 && nupil == *nbcrmx)) {

/* ******************************************************************
**** */
/* ----------------------- Compression du resultat ------------------
---- */
/* ******************************************************************
**** */

	if (ier == -1) {
	    *iercod = -1;
	}
	ncfja = *ndgjac + 1;
/* -> Compression du resultat dans WRKAR(IPT2) */
	mmapcmp_(ndimen, &ncfja, &ncoeff[ncb1], &wrkar[ipt5], &wrkar[ipt2]);
	ilong = *ndimen * *ncflim;
	mvriraz_(&ilong, &wrkar[ipt5]);
/* -> Passage a la base canonique (-1,1) (resultat dans WRKAR(IPT5)). 
*/
	ndgre = ncoeff[ncb1] - 1;
	i__1 = *ndimen;
	for (nd = 1; nd <= i__1; ++nd) {
	    iptt = ipt2 + ((nd - 1) << 1) * (ndgre / 2 + 1);
	    jptt = ipt5 + (nd - 1) * ncoeff[ncb1];
	    mmjacan_(iordre, &ndgre, &wrkar[iptt], &wrkar[jptt]);
/* L400: */
	}

/* -> On stocke la courbe calculee */
	ibid1 = 1;
	mmfmca8_(&ncoeff[ncb1], ndimen, &ibid1, ncflim, ndimen, &ibid1, &
		wrkar[ipt5], &courbe[(ncb1 * courbe_dim2 + 1) * courbe_dim1 + 
		1]);

/* -> Les contraintes ayant ete normalisee sur (-1,1), on recalcule */
/*   les contraintes vraies. */
	i__1 = *iordre;
	for (ii = 0; ii <= i__1; ++ii) {
	    mma1noc_(uv11, ndimen, &ii, &contr1[(ii + 1 + ncb1 * contr1_dim2) 
		    * contr1_dim1 + 1], uvpav, isofav, ideriv, &contr1[(ii + 
		    1 + ncb1 * contr1_dim2) * contr1_dim1 + 1]);
	    mma1noc_(uv11, ndimen, &ii, &contr2[(ii + 1 + ncb1 * contr2_dim2) 
		    * contr2_dim1 + 1], uvpav, isofav, ideriv, &contr2[(ii + 
		    1 + ncb1 * contr2_dim2) * contr2_dim1 + 1]);
/* L200: */
	}
	ii = 0;
	ibid1 = (*nbroot / 2 + 1) * *ndimen;
	mma1noc_(uv11, &ibid1, &ii, &somtab[(ncb1 * somtab_dim2 + 1) * 
		somtab_dim1], uvpav, isofav, ideriv, &somtab[(ncb1 * 
		somtab_dim2 + 1) * somtab_dim1]);
	mma1noc_(uv11, &ibid1, &ii, &diftab[(ncb1 * diftab_dim2 + 1) * 
		diftab_dim1], uvpav, isofav, ideriv, &diftab[(ncb1 * 
		diftab_dim2 + 1) * diftab_dim1]);
	ii = 0;
	i__1 = *ndimen;
	for (nd = 1; nd <= i__1; ++nd) {
	    mma1noc_(uv11, &ncoeff[ncb1], &ii, &courbe[(nd + ncb1 * 
		    courbe_dim2) * courbe_dim1 + 1], uvpav, isofav, ideriv, &
		    courbe[(nd + ncb1 * courbe_dim2) * courbe_dim1 + 1]);
/* L210: */
	}

/* -> Mise ajour du nbre de courbes deja crees */
	++(*nbcrbe);

/* -> ...sinon on essai de decouper l' intervalle courant en 2... */
    } else {
	tmil = (tabdec[*nbcrbe + 1] + tabdec[*nbcrbe]) / 2.;
	ideb = *nbcrbe + 1;
	ideb1 = ideb + 1;
	ilong = (nupil - *nbcrbe) << 3;
	mcrfill_(&ilong, &tabdec[ideb], &tabdec[ideb1]);
	tabdec[ideb] = tmil;
	++nupil;
    }

/* ---------- On fait l' approximation de la suite de la pile ----------- 
*/

    goto L1000;

/* --------------------- Recuperation du code d' erreur ----------------- 
*/
/* --> Pb alloc. dynamique. */
L9013:
    *iercod = 13;
    goto L9900;
/* --> Entrees incoherentes. */
L9100:
    *iercod = 1;
    goto L9900;

/* -------------------------- Desallocation dynamique ------------------- 
*/

L9900:
    if (iofwr != 0) {
	mcrdelt_(&c__8, &ndwrk, wrkar, &iofwr, &ier);
    }
    if (ier > 0) {
	*iercod = 13;
    }
    goto L9999;

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

L9999:
    if (*iercod != 0) {
	maermsg_("MMA2FNC", iercod, 7L);
    }
    if (ibb >= 2) {
	mgsomsg_("MMA2FNC", 7L);
    }
    return 0;
} /* mma2fnc_ */

