/* MA1FER.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 mma1fer_(ndimen, nbsesp, ndimse, iordre, ndgjac, crvjac, 
	ncflim, epsapr, ycvmax, errmax, errmoy, ncoeff, iercod)
integer *ndimen, *nbsesp, *ndimse, *iordre, *ndgjac;
doublereal *crvjac;
integer *ncflim;
doublereal *epsapr, *ycvmax, *errmax, *errmoy;
integer *ncoeff, *iercod;
{
    /* System generated locals */
    integer crvjac_dim1, crvjac_offset, i__1, i__2;

    /* Local variables */
    static integer idim, ncfja, ncfnw, ndses, ii, kk, ibb, ier;
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mmaperm_(), mmaperx_()
	    , mgsomsg_();
    static integer nbr0;
    extern /* Subroutine */ int mmtrpjj_(), mvriraz_();



/* < */
/* **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 du degre et les erreurs d'approximation d'une frontiere. */

/*     MOTS CLES : */
/*     ----------- */
/*      TOUS,AB_SPECIFI :: COURBE&,TRONCATURE, &PRECISION */

/*     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. */
/*     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). */
/*     NDGJAC: Degre du developpement en serie a utiliser pour le calcul 
*/
/*             dans la base de Jacobi. */
/*     CRVJAC: Table des coeff. de la courbe d'approximation dans la */
/*             base de Jacobi. */
/*     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 a ne pas depasser, */
/*             sous-espace par sous-espace. */

/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*     YCVMAX: Tableau auxiliaire. */
/*     ERRMAX: Table des erreurs (sous-espace par sous espace) */
/*             MAXIMALES commises dans l' approximation de FONCNP par */
/*             COURBE. */
/*     ERRMOY: Table des erreurs (sous-espace par sous espace) */
/*             MOYENNES commises dans l' approximation de FONCNP par */
/*             COURBE. */
/*     NCOEFF: Nombre de coeff. significatifs de la "courbe" calculee. */
/*     IERCOD: Code d'erreur */
/*             = 0, ok, */
/*             =-1, warning, la tolerance demandee ne peut etre */
/*                  satisfaite avec NCFLIM coefficients. */
/*             = 1, L'ordre des contraintes (IORDRE) n'est pas dans les */
/*                  valeurs autorisees. */

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

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

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

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     07-02-92: RBD; Correction du retour du code d'erreur negatif. */
/*     07-08-91: RBD; VERSION ORIGINALE */
/* > */
/* ********************************************************************** 
*/

/*   Le nom de la routine */


    /* Parameter adjustments */
    --ycvmax;
    --errmoy;
    --errmax;
    --epsapr;
    --ndimse;
    crvjac_dim1 = *ndgjac + 1;
    crvjac_offset = crvjac_dim1;
    crvjac -= crvjac_offset;

    /* Function Body */
    ibb = mnfndeb_();
    if (ibb >= 3) {
	mgenmsg_("MMA1FER", 7L);
    }
    *iercod = 0;
    idim = 1;
    *ncoeff = 0;
    ncfja = *ndgjac + 1;

/* ------------ Calcul du degre de la courbe et de l' erreur Max -------- 
*/
/* -------------- de l' approximation pour tous les sous-espaces -------- 
*/

    i__1 = *nbsesp;
    for (ii = 1; ii <= i__1; ++ii) {
	ndses = ndimse[ii];

/* ------------ coupure des coeff. et calcul de l' erreur Max -------
---- */

	mmtrpjj_(&ncfja, &ndses, &ncfja, &epsapr[ii], iordre, &crvjac[idim * 
		crvjac_dim1], &ycvmax[1], &errmax[ii], &ncfnw);

/* ******************************************************************
**** */
/* ------------- Si precision OK, calcul de l' erreur moyenne -------
---- */
/* ******************************************************************
**** */

	if (ncfnw <= *ncflim) {
	    mmaperm_(&ncfja, &ndses, &ncfja, iordre, &crvjac[idim * 
		    crvjac_dim1], &ncfnw, &errmoy[ii]);
	    *ncoeff = max(ncfnw,*ncoeff);

/* ------------- Mise a 0.D0 des coefficients ecartes -----------
-------- */

	    nbr0 = *ncflim - ncfnw;
	    if (nbr0 > 0) {
		i__2 = ndses;
		for (kk = 1; kk <= i__2; ++kk) {
		    mvriraz_(&nbr0, &crvjac[ncfnw + (idim + kk - 1) * 
			    crvjac_dim1]);
/* L200: */
		}
	    }
	} else {

/* **************************************************************
******** */
/* ------------------- Si precision souhaitee non atteinte ------
-------- */
/* **************************************************************
******** */

	    *iercod = -1;

/* ------------------------- calcul de l' erreur Max ------------
-------- */

	    mmaperx_(&ncfja, &ndses, &ncfja, iordre, &crvjac[idim * 
		    crvjac_dim1], ncflim, &ycvmax[1], &errmax[ii], &ier);
	    if (ier > 0) {
		goto L9100;
	    }

/* -------------------- du nbre de coeff a renvoyer -------------
-------- */

	    *ncoeff = *ncflim;

/* ------------------- et calcul de l' erreur moyenne -----------
-------- */

	    mmaperm_(&ncfja, &ndses, &ncfja, iordre, &crvjac[idim * 
		    crvjac_dim1], ncflim, &errmoy[ii]);
	}
	idim += ndses;
/* L100: */
    }

    goto L9999;

/* ------------------------------ The end ------------------------------- 
*/
/* --> L'ordre des contraintes n'est pas dans les valeurs autorisees. */
L9100:
    *iercod = 1;
    goto L9999;

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

