/* MA2CE1.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 <ApproxF2var.h>
#endif 
/* Table of constant values */

static integer c__8 = 8;

/* Subroutine */ int mma2ce1_(numdec, ndimen, nbsesp, ndimse, ndminu, ndminv, 
	ndguli, ndgvli, ndjacu, ndjacv, iordru, iordrv, nbpntu, nbpntv, 
	epsapr, sosotb, disotb, soditb, diditb, patjac, errmax, errmoy, 
	ndegpu, ndegpv, itydec, iercod)
const integer *numdec, *ndimen, *nbsesp, *ndimse, *ndminu, *ndminv, *ndguli, *
	ndgvli, *ndjacu, *ndjacv, *iordru, *iordrv, *nbpntu, *nbpntv;
const doublereal *epsapr, *sosotb, *disotb, *soditb, *diditb;
doublereal *patjac, *errmax, *errmoy;
integer *ndegpu, *ndegpv, *itydec, *iercod;
{
    /* System generated locals */
    integer sosotb_dim1, sosotb_dim2, sosotb_offset, disotb_dim1, disotb_dim2,
	     disotb_offset, soditb_dim1, soditb_dim2, soditb_offset, 
	    diditb_dim1, diditb_dim2, diditb_offset, patjac_dim1, patjac_dim2,
	     patjac_offset;

    /* Local variables */
    static logical ldbg;
    static long int iofwr;
    static doublereal wrkar[1];
    static integer iszwr;
    extern /* Subroutine */ int mma2ce2_(), mma2jmx_();
    static integer ier;
    extern integer mnfndeb_();
    extern /* Subroutine */ int mcrdelt_(), maermsg_(), mgenmsg_(), mgsomsg_()
	    , mmapptt_(), mcrrqst_();
    static integer isz1, isz2, isz3, isz4, isz5, isz6, isz7;
    static long int ipt1, ipt2, ipt3, ipt4, ipt5, ipt6, ipt7;





/* < */
/* **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 des coefficients de l' approximation polynomiale de degre */
/*     (NDJACU,NDJACV) d'une fonction F(u,v) quelconque, a partir de sa */
/*     discretisation sur les racines du polynome de Legendre de degre */
/*     NBPNTU en U et NBPNTV en V. */

/*     MOTS CLES : */
/*     ----------- */
/*     TOUS,AB_SPECIFI::FONCTION&,APPROXIMATION,&POLYNOME,&ERREUR */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*   NUMDEC: Indique si on PEUT decouper encore la fonction F(u,v). */
/*           = 5, On PEUT couper en U ou en V ou dans les 2 sens a la */
/*                fois. */
/*           = 4, On PEUT couper en U ou en V MAIS PAS dans les 2 sens */
/*                a la fois (decoupe en V favorisee). */
/*           = 3, On PEUT couper en U ou en V MAIS PAS dans les 2 sens */
/*                a la fois (decoupe en U favorisee). */
/*           = 2, on ne PEUT couper qu'en V (i.e. inserer un parametre */
/*                de decoupe Vj). */
/*           = 1, on ne PEUT couper qu'en U (i.e. inserer un parametre */
/*                de decoupe Ui). */
/*           = 0, on ne PEUT plus rien couper */
/*   NDIMEN: Dimension de l'espace. */
/*   NBSESP: Nbre de sous-espaces independant sur lesquels on calcule */
/*           les erreurs. */
/*   NDIMSE: Table des dimensions de chacun des sous-espaces. */
/*   NDMINU: Degre minimum en U a conserver pour l'approximation. */
/*   NDMINV: Degre minimum en V a conserver pour l'approximation. */
/*   NDGULI: Limite du nbre de coefficients en U de la solution. */
/*   NDGVLI: Limite du nbre de coefficients en V de la solution. */
/*   NDJACU: Degre maxi du polynome d' approximation en U. La */
/*           representation dans la base orthogonale part du degre */
/*           0 au degre NDJACU-2*(IORDRU+1). La base polynomiale est */
/*           la base de Jacobi d' ordre -1 (Legendre), 0, 1 ou 2. */
/*           On doit avoir 2*IORDRU+1 <= NDMINU <= NDGULI < NDJACU */
/*   NDJACV: Degre maxi du polynome d' approximation en V. La */
/*           representation dans la base orthogonale part du degre */
/*           0 au degre NDJACV-2*(IORDRV+1). La base polynomiale est */
/*           la base de Jacobi d' ordre -1 (Legendre), 0, 1 ou 2 */
/*           On doit avoir 2*IORDRV+1 <= NDMINV <= NDGVLI < NDJACV */
/*   IORDRU: Ordre de la base de Jacobi (-1,0,1 ou 2) en U. Correspond */
/*           a pas de contraintes, contraintes C0, C1 ou C2. */
/*   IORDRV: Ordre de la base de Jacobi (-1,0,1 ou 2) en V. Correspond */
/*           a pas de contraintes, contraintes C0, C1 ou C2. */
/*   NBPNTU: Degre du polynome de Legendre sur les racines duquel */
/*           sont calcules les coefficients d' integration suivant u */
/*           par la methode de Gauss. On doit avoir NBPNTU = 30, 40, */
/*           50 ou 61 et NDJACU-2*(IORDRU+1) < NBPNTU. */
/*   NBPNTV: Degre du polynome de Legendre sur les racines duquel */
/*           sont calcules les coefficients d' integration suivant v */
/*           par la methode de Gauss. On doit avoir NBPNTV = 30, 40, */
/*           50 ou 61 et NDJACV-2*(IORDRV+1) < NBPNTV. */
/*   EPSAPR: Table des NBSESP tolerances imposees sur chacun des */
/*           sous-espaces. */
/*   SOSOTB: Tableau de F(ui,vj) + F(ui,-vj) + F(-ui,vj) + F(-ui,-vj) */
/*           avec ui et vj racines positives du polynome de Legendre */
/*           de degre NBPNTU et NBPNTV respectivement. De plus, */
/*           le tableau SOSOTB(0,j) contient F(0,vj) + F(0,-vj), */
/*           le tableau SOSOTB(i,0) contient F(ui,0) + F(-ui,0) et */
/*           SOSOTB(0,0) contient F(0,0). */
/*   DISOTB: Tableau de F(ui,vj) + F(ui,-vj) - F(-ui,vj) - F(-ui,-vj) */
/*           avec ui et vj racines positives du polynome de Legendre */
/*           de degre NBPNTU et NBPNTV respectivement. */
/*   SODITB: Tableau de F(ui,vj) - F(ui,-vj) + F(-ui,vj) - F(-ui,-vj) */
/*           avec ui et vj racines positives du polynome de Legendre */
/*           de degre NBPNTU et NBPNTV respectivement. */
/*   DIDITB: Tableau de F(ui,vj) - F(ui,-vj) - F(-ui,vj) + F(-ui,-vj) */
/*           avec ui et vj racines positives du polynome de Legendre */
/*           de degre NBPNTU et NBPNTV respectivement. De plus, */
/*           le tableau DIDITB(0,j) contient F(0,vj) - F(0,-vj), */
/*           et le tableau DIDITB(i,0) contient F(ui,0) - F(-ui,0). */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*   PATJAC: Table des coefficients du polynome P(u,v) d' approximation */
/*           de F(u,v) avec eventuellement prise en compte des */
/*           contraintes. P(u,v) est de degre (NDJACU,NDJACV). */
/*           Ce tableau ne contient les coeff que si ITYDEC = 0. */
/*   ERRMAX: Pour 1<=i<=NBSESP, ERRMAX(i) contient les erreurs maxi */
/*           sur chacun des sous-espaces SI ITYDEC = 0. */
/*   ERRMOY: Contient les erreurs moyennes pour chacun des NBSESP */
/*           sous-espaces SI ITYDEC = 0. */
/*   NDEGPU: Degre en U pour le carreau PATJAC. Valable si ITYDEC=0. */
/*   NDEGPV: Degre en V pour le carreau PATJAC. Valable si ITYDEC=0. */
/*   ITYDEC: Indique si on DOIT decouper encore la fonction F(u,v). */
/*           = 0, on ne DOIT plus rien couper, PATJAC est OK. */
/*           = 1, on ne DOIT couper qu'en U (i.e. inserer un parametre */
/*                de decoupe Ui). */
/*           = 2, on ne DOIT couper qu'en V (i.e. inserer un parametre */
/*                de decoupe Vj). */
/*           = 3, On DOIT couper en U ET en V a la fois. */
/*   IERCOD: Code d'erreur. */
/*           =  0, Eh bien tout va tres bien. */
/*           = -1, On a une solution, la meilleure possible, mais la */
/*                 tolerance utilisateur n'est pas satisfaite (3*helas) */
/*           =  1, Entrees incoherentes. */

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

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

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

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


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

    /* Parameter adjustments */
    --errmoy;
    --errmax;
    --epsapr;
    --ndimse;
    patjac_dim1 = *ndjacu + 1;
    patjac_dim2 = *ndjacv + 1;
    patjac_offset = patjac_dim1 * patjac_dim2;
    patjac -= patjac_offset;
    diditb_dim1 = *nbpntu / 2 + 1;
    diditb_dim2 = *nbpntv / 2 + 1;
    diditb_offset = diditb_dim1 * diditb_dim2;
    diditb -= diditb_offset;
    soditb_dim1 = *nbpntu / 2;
    soditb_dim2 = *nbpntv / 2;
    soditb_offset = soditb_dim1 * (soditb_dim2 + 1) + 1;
    soditb -= soditb_offset;
    disotb_dim1 = *nbpntu / 2;
    disotb_dim2 = *nbpntv / 2;
    disotb_offset = disotb_dim1 * (disotb_dim2 + 1) + 1;
    disotb -= disotb_offset;
    sosotb_dim1 = *nbpntu / 2 + 1;
    sosotb_dim2 = *nbpntv / 2 + 1;
    sosotb_offset = sosotb_dim1 * sosotb_dim2;
    sosotb -= sosotb_offset;

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

    isz1 = (*nbpntu / 2 + 1) * (*ndjacu - ((*iordru + 1) << 1) + 1);
    isz2 = (*nbpntv / 2 + 1) * (*ndjacv - ((*iordrv + 1) << 1) + 1);
    isz3 = (*nbpntv / 2 + 1) * (*ndjacu - ((*iordru + 1) << 1) + 1) * *ndimen;
    isz4 = *nbpntv / 2 * (*ndjacu - ((*iordru + 1) << 1) + 1) * *ndimen;
    isz5 = *ndjacu + 1 - ((*iordru + 1) << 1);
    isz6 = *ndjacv + 1 - ((*iordrv + 1) << 1);
    isz7 = *ndimen << 2;
    iszwr = isz1 + isz2 + isz3 + isz4 + isz5 + isz6 + isz7;
    mcrrqst_(&c__8, &iszwr, wrkar, &iofwr, &ier);
    if (ier > 0) {
	goto L9013;
    }
    ipt1 = iofwr;
    ipt2 = ipt1 + isz1;
    ipt3 = ipt2 + isz2;
    ipt4 = ipt3 + isz3;
    ipt5 = ipt4 + isz4;
    ipt6 = ipt5 + isz5;
    ipt7 = ipt6 + isz6;

/* ----------------- Recup des coeff. d'integr. de Gauss ---------------- 
*/

    mmapptt_(ndjacu, nbpntu, iordru, &wrkar[ipt1], iercod);
    if (*iercod > 0) {
	goto L9999;
    }
    mmapptt_(ndjacv, nbpntv, iordrv, &wrkar[ipt2], iercod);
    if (*iercod > 0) {
	goto L9999;
    }

/* ------------------- Recup des max des polynomes de Jacobi ------------ 
*/

    mma2jmx_(ndjacu, iordru, &wrkar[ipt5]);
    mma2jmx_(ndjacv, iordrv, &wrkar[ipt6]);

/* ------ Calcul des coefficients et de leur contribution a l'erreur ---- 
*/

    mma2ce2_(numdec, ndimen, nbsesp, &ndimse[1], ndminu, ndminv, ndguli, 
	    ndgvli, ndjacu, ndjacv, iordru, iordrv, nbpntu, nbpntv, &epsapr[1]
	    , &sosotb[sosotb_offset], &disotb[disotb_offset], &soditb[
	    soditb_offset], &diditb[diditb_offset], &wrkar[ipt1], &wrkar[ipt2]
	    , &wrkar[ipt5], &wrkar[ipt6], &wrkar[ipt7], &wrkar[ipt3], &wrkar[
	    ipt4], &patjac[patjac_offset], &errmax[1], &errmoy[1], ndegpu, 
	    ndegpv, itydec, iercod);
    if (*iercod > 0) {
	goto L9999;
    }
    goto L9999;

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

L9013:
    *iercod = 13;
    goto L9999;

L9999:
    if (iofwr != 0) {
	mcrdelt_(&c__8, &iszwr, wrkar, &iofwr, &ier);
    }
    if (ier > 0) {
	*iercod = 13;
    }
    maermsg_("MMA2CE1", iercod, 7L);
    if (ldbg) {
	mgsomsg_("MMA2CE1", 7L);
    }
    return 0;
} /* mma2ce1_ */

