/* MA2ER2.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 mma2er2_(ndjacu, ndjacv, ndimen, mindgu, maxdgu, mindgv, 
	maxdgv, iordru, iordrv, xmaxju, xmaxjv, patjac, epmscut, vecerr, 
	erreur, newdgu, newdgv)
integer *ndjacu, *ndjacv, *ndimen, *mindgu, *maxdgu, *mindgv, *maxdgv, *
	iordru, *iordrv;
doublereal *xmaxju, *xmaxjv, *patjac, *epmscut, *vecerr, *erreur;
integer *newdgu, *newdgv;
{
    /* System generated locals */
    integer patjac_dim1, patjac_dim2, patjac_offset, i__1, i__2;
    doublereal d__1;

    /* Local variables */
    static logical ldbg;
    static doublereal vaux[2];
    static integer i2rdu, i2rdv;
    static doublereal errnu, errnv;
    static integer ii, nd, jj, nu, nv;
    extern integer mnfndeb_();
    extern /* Subroutine */ int mgenmsg_();
    static doublereal bid0, bid1;
    extern /* Subroutine */ int mgsomsg_();
    extern doublereal mzsnorm_();



/* < */
/* **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 : */
/*     ---------- */
/*  Enleve des coefficients de PATJAC jusqu'a obtenir les degre en U */
/*  et V minimum verifiant la tolerance imposee. */

/*     MOTS CLES : */
/*     ----------- */
/*     TOUS,AB_SPECIFI:: CARREAU&,CALCUL,&ERREUR */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/* NDJACU: Degre en U du tableau PATJAC. */
/* NDJACV: Degre en V du tableau PATJAC. */
/* NDIMEN: Dimension de l'espace. */
/* MINDGU: Borne de l'indice en U des coeff. de PATJAC a GARDER */
/*         (doit etre >= 0). */
/* MAXDGU: Borne sup de l'indice en U des coeff. de PATJAC a prendre */
/*         en compte. */
/* MINDGV: Borne de l'indice en V des coeff. de PATJAC a GARDER */
/*         (doit etre >= 0). */
/* MAXDGV: Borne sup de l'indice en V des coeff. de PATJAC a prendre */
/*         en compte. */
/* IORDRU: Ordre de continuite en U assure par le carreau PATJAC */
/*         (de -1 a 2) */
/* IORDRV: Ordre de continuite en V assure par le carreau PATJAC */
/*         (de -1 a 2) */
/* XMAXJU: Valeur maximale des polynomes de Jacobi d'ordre IORDRU, */
/*         du degre 0 a MAXDGU - 2*(IORDU+1) */
/* XMAXJV: Valeur maximale des polynomes de Jacobi d'ordre IORDRV, */
/*         du degre 0 a MAXDGV - 2*(IORDV+1) */
/* PATJAC: Table des coeff. du carreau d'approximation avec */
/*         contraintes d'ordre IORDRU en U et IORDRV en V. */
/* EPMSCUT: Tolerance d'approximation. */
/* VECERR: tableau auxiliaire. */
/* ERREUR: L'erreur MAXI commise DEJA CALCULEE. */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/* ERREUR: L'erreur MAXI commise en ne gardant que les coeff de */
/*         PATJAC d'indices 0 a NEWDGU en U et 0 a NEWDGV en V, */
/*         PLUS l'erreur maxi deja calculee. */
/* NEWDGU: Degre en U minimum t.q. le carreau d'approximation */
/*         verifie la tolerance. On a toujours NEWDGU >= MINDGU >= 0. */
/* NEWDGV: Degre en V minimum t.q. le carreau d'approximation */
/*         verifie la tolerance. On a toujours NEWDGV >= MINDGV >= 0. */

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

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

/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*     Dans le tableau PATJAC sont stockes les coeff. Cij du carreau */
/*     d'approximation de F(U,V). Les indices i et j indique le degre */
/*     en U et en V des polynomes de base. Ces polynomes de base sont */
/*     de la forme: */

/*          ((1 - U*U)**(IORDRU+1)).J(i-2*(IORDRU+1)(U), ou */

/*     le polynome J(i-2*(IORDU+1)(U) est le polynome de Jacobi d'ordre */
/*     IORDRU+1 (idem en V en remplacant U par V dans l'expression ci */
/*     dessus). */

/*     La contribution a l'erreur du terme Cij lorsque celui-ci est */
/*     enleve de PATJAC est majoree par: */

/*  DABS(Cij)*XMAXJU(i-2*(IORDRU+1))*XMAXJV(J-2*(IORDRV+1)) ou on a */

/*  XMAXJU(i-2*(IORDRU+1) = ((1 - U*U)**(IORDRU+1)).J(i-2*(IORDRU+1)(U), 
*/
/*  XMAXJV(i-2*(IORDRV+1) = ((1 - V*V)**(IORDRV+1)).J(j-2*(IORDRV+1)(V). 
*/

/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     23-01-1992: RBD; Creation d'apres MA2CUT. */
/* > */
/* ********************************************************************** 
*/
/*   Le nom de la routine */


/* ----------------------------- Initialisations ------------------------ 
*/

    /* Parameter adjustments */
    --vecerr;
    patjac_dim1 = *ndjacu + 1;
    patjac_dim2 = *ndjacv + 1;
    patjac_offset = patjac_dim1 * patjac_dim2;
    patjac -= patjac_offset;

    /* Function Body */
    ldbg = mnfndeb_() >= 3;
    if (ldbg) {
	mgenmsg_("MMA2ER2", 7L);
    }

    i2rdu = (*iordru + 1) << 1;
    i2rdv = (*iordrv + 1) << 1;
    nu = *maxdgu;
    nv = *maxdgv;

/* ********************************************************************** 
*/
/* -------------------- Coupure des coefficients ------------------------ 
*/
/* ********************************************************************** 
*/

L1001:

/* ------------------- Calcul du majorant de l'erreur max --------------- 
*/
/* ----- lorsque sont enleves les coeff. d'indices MINDGU a MAXDGU ------ 
*/
/* ---------------- en U, le degre en V etant fixe a NV ----------------- 
*/

    bid0 = 0.;
    if (nv > *mindgv) {
	bid0 = xmaxjv[nv - i2rdv];
	i__1 = *ndimen;
	for (nd = 1; nd <= i__1; ++nd) {
	    bid1 = 0.;
	    i__2 = nu;
	    for (ii = i2rdu; ii <= i__2; ++ii) {
		bid1 += (d__1 = patjac[ii + (nv + nd * patjac_dim2) * 
			patjac_dim1], abs(d__1)) * xmaxju[ii - i2rdu] * bid0;
/* L200: */
	    }
	    vecerr[nd] = bid1;
/* L100: */
	}
    } else {
	vecerr[1] = *epmscut * 2;
    }
    errnv = mzsnorm_(ndimen, &vecerr[1]);

/* ------------------- Calcul du majorant de l'erreur max --------------- 
*/
/* ----- lorsque sont enleves les coeff. d'indices MINDGV a MAXDGV ------ 
*/
/* ---------------- en V, le degre en U etant fixe a NU ----------------- 
*/

    bid0 = 0.;
    if (nu > *mindgu) {
	bid0 = xmaxju[nu - i2rdu];
	i__1 = *ndimen;
	for (nd = 1; nd <= i__1; ++nd) {
	    bid1 = 0.;
	    i__2 = nv;
	    for (jj = i2rdv; jj <= i__2; ++jj) {
		bid1 += (d__1 = patjac[nu + (jj + nd * patjac_dim2) * 
			patjac_dim1], abs(d__1)) * xmaxjv[jj - i2rdv] * bid0;
/* L400: */
	    }
	    vecerr[nd] = bid1;
/* L300: */
	}
    } else {
	vecerr[1] = *epmscut * 2;
    }
    errnu = mzsnorm_(ndimen, &vecerr[1]);

/* ----------------------- Calcul de l' erreur max ---------------------- 
*/

    vaux[0] = *erreur;
    vaux[1] = errnu;
    nd = 2;
    errnu = mzsnorm_(&nd, vaux);
    vaux[1] = errnv;
    errnv = mzsnorm_(&nd, vaux);

    if (errnu > errnv) {
	if (errnv < *epmscut) {
	    *erreur = errnv;
	    --nv;
	} else {
	    goto L2001;
	}
    } else {
	if (errnu < *epmscut) {
	    *erreur = errnu;
	    --nu;
	} else {
	    goto L2001;
	}
    }

    goto L1001;

/* -------------------------- Recuperation des degres ------------------- 
*/

L2001:
    *newdgu = max(nu,1);
    *newdgv = max(nv,1);

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

    if (ldbg) {
	mgsomsg_("MMA2ER2", 7L);
    }
    return 0;
} /* mma2er2_ */

