/* MA2DS1.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 
/* Subroutine */ int mma2ds1_(ndimen, uintfn, vintfn, foncnp, nbpntu, nbpntv, 
	urootb, vrootb, isofav, sosotb, disotb, soditb, diditb, fpntab, 
	ttable, iercod)
const integer *ndimen;
const doublereal *uintfn, *vintfn;
/* Subroutine */ int (*foncnp) ();
const integer *nbpntu, *nbpntv;
const doublereal *urootb, *vrootb;
const integer *isofav;
doublereal *sosotb, *disotb, *soditb, *diditb, *fpntab, *ttable;
integer *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, fpntab_dim1, 
	    fpntab_offset, i__1;

    /* Local variables */
    static logical ldbg;
    static integer ibid1, ibid2, iuouv, nd;
    extern /* Subroutine */ int mma2ds2_(), mmfmtb1_();
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mgsomsg_();
    static integer isz1, isz2;




/* < */
/* **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 : */
/*     ---------- */
/*     Discretisation d'une fonction F(u,v) sur les racines des */
/*     polynomes de Legendre. */

/*     MOTS CLES : */
/*     ----------- */
/*     FONCTION&,DISCRETISATION,&POINT */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*   NDIMEN: Dimension de l' espace. */
/*   UINTFN: Bornes de l' intervalle de definition en u de la fonction */
/*           a approcher: (UINTFN(1),UINTFN(2)). */
/*   VINTFN: Bornes de l' intervalle de definition en v de la fonction */
/*           a approcher: (VINTFN(1),VINTFN(2)). */
/*   FONCNP: Le NOM de la fonction non polynomiale a approcher. */
/*   NBPNTU: Le degre du polynome de Legendre sur les racines duquel */
/*           on discretise FONCNP en u. */
/*   NBPNTV: Le degre du polynome de Legendre sur les racines duquel */
/*           on discretise FONCNP en v. */
/*   UROOTB: Tableau des racines STRICTEMENTS POSITIVES du polynome */
/*           de Legendre de degre NBPNTU defini sur (-1,1). */
/*   VROOTB: Tableau des racines STRICTEMENTS POSITIVES du polynome */
/*           de Legendre de degre NBPNTV defini sur (-1,1). */
/*   ISOFAV: Indique le type d'iso de F(u,v) a extraire pour ameliorer */
/*           la rapidite de calcul (n'a aucune influence sur la forme */
/*           du resultat) */
/*           = 1, indique que l'on doit calculer les points de F(u,v) */
/*           avec u fixe (donc avec NBPNTV valeurs differentes de v). */
/*           = 2, indique que l'on doit calculer les points de F(u,v) */
/*           avec v fixe (donc avec NBPNTU valeurs differentes de u). */
/*   SOSOTB: Tableau deja initialise (argument d'entree/sortie). */
/*   DISOTB: Tableau deja initialise (argument d'entree/sortie). */
/*   SODITB: Tableau deja initialise (argument d'entree/sortie). */
/*   DIDITB: Tableau deja initialise (argument d'entree/sortie). */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*   SOSOTB: Tableau ou l'on ajoute les termes */
/*           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. */
/*   DISOTB: Tableau ou l'on ajoute les termes */
/*           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 ou l'on ajoute les termes */
/*           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 ou l'on ajoute les termes */
/*           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. */
/*   FPNTAB: Tableau auxiliaire. */
/*   TTABLE: Tableau auxiliaire. */
/*   IERCOD: Code d' erreur >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 fonction externe creee par l' appelant de MA2F1K, MA2FDK */
/*   ou de MA2FXK doit etre de la forme : */
/*    SUBROUTINE FONCNP(NDIMEN,UINTFN,VINTFN,ISOFAV,TCONST,NBPTAB */
/*                     ,TTABLE,IDERIU,IDERIV,PPNTAB,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). */
/*      - ISOFAV, vaut 1 si l'on veut calculer des points a u constant, */
/*                vaut 2 si l'on calcule les points a v constant. Tout */
/*                autre valeur est une erreur. */
/*      - TCONST, un reel, valeur du parametre fixe. Prend ses valeurs */
/*                dans (UIFONC(1),UIFONC(2)) si ISOFAV = 1 ou dans */
/*                dans (VIFONC(1),VIFONC(2)) si ISOFAV = 2. */
/*      - NBPTAB, un entier. Indique le nombre de points a calculer. */
/*      - TTABLE, un tableau de NBPTAB reels. Ce sont les valeurs du */
/*                parametre 'libre' de discretisation (v si IISOFAV=1, */
/*                u si IISOFAV=2). */
/*      - IDERIU, un entier, prend ses valeurs entre 0 (positionnement) */
/*                et IORDRE(1) (derivee partielle de la fonction en u a */
/*                l' ordre IORDRE(1) si IORDRE(1) > 0). */
/*      - IDERIV, un entier, prend ses valeurs entre 0 (positionnement) */
/*                et IORDRE(2) (derivee partielle de la fonction en v a */
/*                l' ordre IORDRE(2) si IORDRE(2) > 0). */
/*                Si IDERIU=i et IDERIV=j, FONCNP devra calculer des */
/*                points de la derivee: */
/*                            i+j */
/*                           d     F(u,v) */
/*                        -------- */
/*                           i  j */
/*                         du dv */

/*     et les arguments de sortie sont : */
/*        - FPNTAB(NDIMEN,NBPTAB) contient, en sortie, le tableau des */
/*                                NBPTAB points calcules dans FONCNP. */
/*        - 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. 
*/

/* -->Comme FONCNP n' est pas forcement definie dans (-1,1)*(-1,1), on */
/* modifie les valeurs de UROOTB et VROOTB en consequence. */

/* -->Les resultats de la discretisation sont ranges dans 4 tableaux */
/* SOSOTB, DISOTB, SODITB et DIDITB pour gagner du temps par la suite */
/* lors du calcul des coefficients du polynome d' approximation. */

/*     Lorsque NBPNTU est impair: */
/*        le tableau SOSOTB(0,j) contient F(0,vj) + F(0,-vj), */
/*        le tableau DIDITB(0,j) contient F(0,vj) - F(0,-vj), */
/*     Lorsque NBPNTV est impair: */
/*        le tableau SOSOTB(i,0) contient F(ui,0) + F(-ui,0), */
/*        le tableau DIDITB(i,0) contient F(ui,0) - F(-ui,0), */
/*     Lorsque NBPNTU et NBPNTV sont impairs: */
/*        le terme SOSOTB(0,0) contient F(0,0). */


/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     06-06-1991: RBD; Creation. */
/* > */
/* ********************************************************************** 
*/
/*   Le nom de la routine */


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

    /* Parameter adjustments */
    fpntab_dim1 = *ndimen;
    fpntab_offset = fpntab_dim1 + 1;
    fpntab -= fpntab_offset;
    --uintfn;
    --vintfn;
    --urootb;
    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;
    --vrootb;
    --ttable;

    /* Function Body */
    ldbg = mnfndeb_() >= 3;
    if (ldbg) {
	mgenmsg_("MMA2DS1", 7L);
    }
    *iercod = 0;
    if (*isofav < 1 || *isofav > 2) {
	iuouv = 2;
    } else {
	iuouv = *isofav;
    }

/* ********************************************************************** 
*/
/* --------- Discretisation en U sur les racines du polynome de --------- 
*/
/* --------------- Legendre de degre NBPNTU, iso-V par iso-V ------------ 
*/
/* ********************************************************************** 
*/

    if (iuouv == 2) {
	mma2ds2_(ndimen, &uintfn[1], &vintfn[1], foncnp, nbpntu, nbpntv, &
		urootb[1], &vrootb[1], &iuouv, &sosotb[sosotb_offset], &
		disotb[disotb_offset], &soditb[soditb_offset], &diditb[
		diditb_offset], &fpntab[fpntab_offset], &ttable[1], iercod);

/* ******************************************************************
**** */
/* --------- Discretisation en V sur les racines du polynome de -----
---- */
/* --------------- Legendre de degre NBPNTV, iso-U par iso-U --------
---- */
/* ******************************************************************
**** */

    } else {
/* --> Inversion des indices des tableaux */
	i__1 = *ndimen;
	for (nd = 1; nd <= i__1; ++nd) {
	    isz1 = *nbpntu / 2 + 1;
	    isz2 = *nbpntv / 2 + 1;
	    mmfmtb1_(&isz1, &sosotb[nd * sosotb_dim2 * sosotb_dim1], &isz1, &
		    isz2, &isz2, &sosotb[nd * sosotb_dim2 * sosotb_dim1], &
		    ibid1, &ibid2, iercod);
	    if (*iercod > 0) {
		goto L9999;
	    }
	    mmfmtb1_(&isz1, &diditb[nd * diditb_dim2 * diditb_dim1], &isz1, &
		    isz2, &isz2, &diditb[nd * diditb_dim2 * diditb_dim1], &
		    ibid1, &ibid2, iercod);
	    if (*iercod > 0) {
		goto L9999;
	    }
	    isz1 = *nbpntu / 2;
	    isz2 = *nbpntv / 2;
	    mmfmtb1_(&isz1, &soditb[(nd * soditb_dim2 + 1) * soditb_dim1 + 1],
		     &isz1, &isz2, &isz2, &soditb[(nd * soditb_dim2 + 1) * 
		    soditb_dim1 + 1], &ibid1, &ibid2, iercod);
	    if (*iercod > 0) {
		goto L9999;
	    }
	    mmfmtb1_(&isz1, &disotb[(nd * disotb_dim2 + 1) * disotb_dim1 + 1],
		     &isz1, &isz2, &isz2, &disotb[(nd * disotb_dim2 + 1) * 
		    disotb_dim1 + 1], &ibid1, &ibid2, iercod);
	    if (*iercod > 0) {
		goto L9999;
	    }
/* L100: */
	}

	mma2ds2_(ndimen, &vintfn[1], &uintfn[1], foncnp, nbpntv, nbpntu, &
		vrootb[1], &urootb[1], &iuouv, &sosotb[sosotb_offset], &
		soditb[soditb_offset], &disotb[disotb_offset], &diditb[
		diditb_offset], &fpntab[fpntab_offset], &ttable[1], iercod);
/* --> Inversion des indices des tableaux */
	i__1 = *ndimen;
	for (nd = 1; nd <= i__1; ++nd) {
	    isz1 = *nbpntv / 2 + 1;
	    isz2 = *nbpntu / 2 + 1;
	    mmfmtb1_(&isz1, &sosotb[nd * sosotb_dim2 * sosotb_dim1], &isz1, &
		    isz2, &isz2, &sosotb[nd * sosotb_dim2 * sosotb_dim1], &
		    ibid1, &ibid2, iercod);
	    if (*iercod > 0) {
		goto L9999;
	    }
	    mmfmtb1_(&isz1, &diditb[nd * diditb_dim2 * diditb_dim1], &isz1, &
		    isz2, &isz2, &diditb[nd * diditb_dim2 * diditb_dim1], &
		    ibid1, &ibid2, iercod);
	    if (*iercod > 0) {
		goto L9999;
	    }
	    isz1 = *nbpntv / 2;
	    isz2 = *nbpntu / 2;
	    mmfmtb1_(&isz1, &soditb[(nd * soditb_dim2 + 1) * soditb_dim1 + 1],
		     &isz1, &isz2, &isz2, &soditb[(nd * soditb_dim2 + 1) * 
		    soditb_dim1 + 1], &ibid1, &ibid2, iercod);
	    if (*iercod > 0) {
		goto L9999;
	    }
	    mmfmtb1_(&isz1, &disotb[(nd * disotb_dim2 + 1) * disotb_dim1 + 1],
		     &isz1, &isz2, &isz2, &disotb[(nd * disotb_dim2 + 1) * 
		    disotb_dim1 + 1], &ibid1, &ibid2, iercod);
	    if (*iercod > 0) {
		goto L9999;
	    }
/* L200: */
	}
    }

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

L9999:
    if (*iercod > 0) {
	*iercod += 100;
	maermsg_("MMA2DS1", iercod, 7L);
    }
    if (ldbg) {
	mgsomsg_("MMA2DS1", 7L);
    }
    return 0;
} /* mma2ds1_ */

