/* MA2CDI.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 mma2cdi_(ndimen, nbpntu, urootl, nbpntv, vrootl, iordru, 
	iordrv, contr1, contr2, contr3, contr4, sotbu1, sotbu2, ditbu1, 
	ditbu2, sotbv1, sotbv2, ditbv1, ditbv2, sosotb, soditb, disotb, 
	diditb, iercod)
const integer *ndimen, *nbpntu;
const doublereal *urootl;
const integer *nbpntv;
const doublereal *vrootl;
const integer *iordru, *iordrv;
const doublereal *contr1, *contr2, *contr3, *contr4, *sotbu1, *sotbu2, *ditbu1, *
	ditbu2, *sotbv1, *sotbv2, *ditbv1, *ditbv2, *sosotb, *soditb, *disotb,
	 *diditb;
integer *iercod;
{
    /* System generated locals */
    integer contr1_dim1, contr1_dim2, contr1_offset, contr2_dim1, contr2_dim2,
	     contr2_offset, contr3_dim1, contr3_dim2, contr3_offset, 
	    contr4_dim1, contr4_dim2, contr4_offset, sosotb_dim1, sosotb_dim2,
	     sosotb_offset, diditb_dim1, diditb_dim2, diditb_offset, 
	    soditb_dim1, soditb_dim2, soditb_offset, disotb_dim1, disotb_dim2,
	     disotb_offset;

    /* Local variables */
    static integer ilong;
    static long int iofwr;
    static doublereal wrkar[1];
    static integer iszwr;
    extern /* Subroutine */ int mma2cd1_(), mma2cd2_(), mma2cd3_(), mma1her_()
	    ;
    static integer ibb, ier;
    extern integer mnfndeb_();
    extern /* Subroutine */ int mcrdelt_(), maermsg_(), mgenmsg_(), mgsomsg_()
	    , mvriraz_(), mcrrqst_();
    static integer isz1, isz2, isz3, isz4;
    static long int ipt1, ipt2, ipt3, ipt4;




/* < */
/* **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 sur les parametres des polynomes d'interpolation */
/*     des contraintes a l'ordre IORDRE. */

/*     MOTS CLES : */
/*     ----------- */
/*     TOUS, AB_SPECIFI::CONTRAINTE&, DISCRETISATION, &POINT */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*     NDIMEN: Dimension de l' espace. */
/*     NBPNTU: Nbre de parametres INTERNES de discretisation EN U. */
/*             C'est aussi le nbre de racine du polynome de Legendre ou */
/*             on discretise. */
/*     UROOTL: Tableau des parametres de discretisation SUR (-1,1) EN U. 
*/
/*     NBPNTV: Nbre de parametres INTERNES de discretisation EN V. */
/*             C'est aussi le nbre de racine du polynome de Legendre ou */
/*             on discretise. */
/*     VROOTL: Tableau des parametres de discretisation SUR (-1,1) EN V. 
*/
/*     IORDRU: Ordre de contrainte impose aux extremites de l'iso-V */
/*             = 0, on calcule les extremites de l'iso-V */
/*             = 1, on calcule, en plus, la derivee 1ere dans le sens */
/*                  de l'iso-V */
/*             = 2, on calcule, en plus, la derivee 2nde dans le sens */
/*                  de l'iso-V */
/*     IORDRV: Ordre de contrainte impose aux extremites de l'iso-U */
/*             = 0, on calcule les extremites de l'iso-U. */
/*             = 1, on calcule, en plus, la derivee 1ere dans le sens */
/*                  de l'iso-U */
/*             = 2, on calcule, en plus, la derivee 2nde dans le sens */
/*                  de l'iso-U */
/*     CONTR1: Contient, si IORDRU et IORDRV>=0, les valeurs aux */
/*             extremitees de F(U0,V0)et de ses derivees. */
/*     CONTR2: Contient, si IORDRU et IORDRV>=0, les valeurs aux */
/*             extremitees de F(U1,V0)et de ses derivees. */
/*     CONTR3: Contient, si IORDRU et IORDRV>=0, les valeurs aux */
/*             extremitees de F(U0,V1)et de ses derivees. */
/*     CONTR4: Contient, si IORDRU et IORDRV>=0, les valeurs aux */
/*             extremitees de F(U1,V1)et de ses derivees. */
/*     SOTBU1: Tableau des NBPNTU/2 sommes des 2 points d'indices */
/*             NBPNTU-II+1 et II, pour II = 1, NBPNTU/2 sur l'iso-U0. */
/*     SOTBU2: Tableau des NBPNTU/2 sommes des 2 points d'indices */
/*             NBPNTU-II+1 et II, pour II = 1, NBPNTU/2 sur l'iso-U1. */
/*     DITBU1: Tableau des NBPNTU/2 differences des 2 points d'indices */
/*             NBPNTU-II+1 et II, pour II = 1, NBPNTU/2 sur l'iso-U0. */
/*     DITBU2: Tableau des NBPNTU/2 differences des 2 points d'indices */
/*             NBPNTU-II+1 et II, pour II = 1, NBPNTU/2 sur l'iso-U1. */
/*     SOTBV1: Tableau des NBPNTV/2 sommes des 2 points d'indices */
/*             NBPNTV-II+1 et II, pour II = 1, NBPNTV/2 sur l'iso-V0. */
/*     SOTBV2: Tableau des NBPNTV/2 sommes des 2 points d'indices */
/*             NBPNTV-II+1 et II, pour II = 1, NBPNTV/2 sur l'iso-V1. */
/*     DITBV1: Tableau des NBPNTV/2 differences des 2 points d'indices */
/*             NBPNTV-II+1 et II, pour II = 1, NBPNTV/2 sur l'iso-V0. */
/*     DITBV2: Tableau des NBPNTV/2 differences des 2 points d'indices */
/*             NBPNTV-II+1 et II, pour II = 1, NBPNTV/2 sur l'iso-V1. */
/*     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 de contraintes */
/*           C(ui,vj) + C(ui,-vj) + C(-ui,vj) + C(-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 de contraintes */
/*           C(ui,vj) + C(ui,-vj) - C(-ui,vj) - C(-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 de contraintes */
/*           C(ui,vj) - C(ui,-vj) + C(-ui,vj) - C(-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 de contraintes */
/*           C(ui,vj) - C(ui,-vj) - C(-ui,vj) + C(-ui,-vj) */
/*           avec ui et vj racines positives du polynome de Legendre */
/*           de degre NBPNTU et NBPNTV respectivement. */
/*   IERCOD: = 0, OK, */
/*           = 1, Valeur de IORDRV ou IORDRU hors des valeurs permises. */
/*           =13, Pb d'alloc dynamique. */

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

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

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


/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     08-08-1991: RBD; Creation. */
/* > */
/* ********************************************************************** 
*/

/*   Le nom de la routine */


    /* Parameter adjustments */
    --urootl;
    diditb_dim1 = *nbpntu / 2 + 1;
    diditb_dim2 = *nbpntv / 2 + 1;
    diditb_offset = diditb_dim1 * diditb_dim2;
    diditb -= diditb_offset;
    disotb_dim1 = *nbpntu / 2;
    disotb_dim2 = *nbpntv / 2;
    disotb_offset = disotb_dim1 * (disotb_dim2 + 1) + 1;
    disotb -= disotb_offset;
    soditb_dim1 = *nbpntu / 2;
    soditb_dim2 = *nbpntv / 2;
    soditb_offset = soditb_dim1 * (soditb_dim2 + 1) + 1;
    soditb -= soditb_offset;
    sosotb_dim1 = *nbpntu / 2 + 1;
    sosotb_dim2 = *nbpntv / 2 + 1;
    sosotb_offset = sosotb_dim1 * sosotb_dim2;
    sosotb -= sosotb_offset;
    --vrootl;
    contr4_dim1 = *ndimen;
    contr4_dim2 = *iordru + 2;
    contr4_offset = contr4_dim1 * (contr4_dim2 + 1) + 1;
    contr4 -= contr4_offset;
    contr3_dim1 = *ndimen;
    contr3_dim2 = *iordru + 2;
    contr3_offset = contr3_dim1 * (contr3_dim2 + 1) + 1;
    contr3 -= contr3_offset;
    contr2_dim1 = *ndimen;
    contr2_dim2 = *iordru + 2;
    contr2_offset = contr2_dim1 * (contr2_dim2 + 1) + 1;
    contr2 -= contr2_offset;
    contr1_dim1 = *ndimen;
    contr1_dim2 = *iordru + 2;
    contr1_offset = contr1_dim1 * (contr1_dim2 + 1) + 1;
    contr1 -= contr1_offset;
    --sotbu1;
    --sotbu2;
    --ditbu1;
    --ditbu2;
    --sotbv1;
    --sotbv2;
    --ditbv1;
    --ditbv2;

    /* Function Body */
    ibb = mnfndeb_();
    if (ibb >= 3) {
	mgenmsg_("MMA2CDI", 7L);
    }
    *iercod = 0;
    iofwr = 0;
    if (*iordru < -1 || *iordru > 2) {
	goto L9100;
    }
    if (*iordrv < -1 || *iordrv > 2) {
	goto L9100;
    }

/* ------------------------- Mise a zero -------------------------------- 
*/

    ilong = (*nbpntu / 2 + 1) * (*nbpntv / 2 + 1) * *ndimen;
    mvriraz_(&ilong, &sosotb[sosotb_offset]);
    mvriraz_(&ilong, &diditb[diditb_offset]);
    ilong = *nbpntu / 2 * (*nbpntv / 2) * *ndimen;
    mvriraz_(&ilong, &soditb[soditb_offset]);
    mvriraz_(&ilong, &disotb[disotb_offset]);
    if (*iordru == -1 && *iordrv == -1) {
	goto L9999;
    }



    isz1 = ((*iordru + 1) << 2) * (*iordru + 1);
    isz2 = ((*iordrv + 1) << 2) * (*iordrv + 1);
    isz3 = ((*iordru + 1) << 1) * *nbpntu;
    isz4 = ((*iordrv + 1) << 1) * *nbpntv;
    iszwr = isz1 + isz2 + isz3 + isz4;
    mcrrqst_(&c__8, &iszwr, wrkar, &iofwr, &ier);
    if (ier > 0) {
	goto L9013;
    }
    ipt1 = iofwr;
    ipt2 = ipt1 + isz1;
    ipt3 = ipt2 + isz2;
    ipt4 = ipt3 + isz3;

    if (*iordru >= 0 && *iordru <= 2) {

/* --- Recup des 2*(IORDRU+1) coeff des 2*(IORDRU+1) polyn. d'Hermite 
--- */

	mma1her_(iordru, &wrkar[ipt1], iercod);
	if (*iercod > 0) {
	    goto L9100;
	}

/* ---- On retranche les discretisations des polynomes de contrainte 
---- */

	mma2cd3_(ndimen, nbpntu, &urootl[1], nbpntv, iordru, &sotbu1[1], &
		sotbu2[1], &ditbu1[1], &ditbu2[1], &wrkar[ipt3], &wrkar[ipt1],
		 &sosotb[sosotb_offset], &soditb[soditb_offset], &disotb[
		disotb_offset], &diditb[diditb_offset]);
    }

    if (*iordrv >= 0 && *iordrv <= 2) {

/* --- Recup des 2*(IORDRV+1) coeff des 2*(IORDRV+1) polyn. d'Hermite 
--- */

	mma1her_(iordrv, &wrkar[ipt2], iercod);
	if (*iercod > 0) {
	    goto L9100;
	}

/* ---- On retranche les discretisations des polynomes de contrainte 
---- */

	mma2cd2_(ndimen, nbpntu, nbpntv, &vrootl[1], iordrv, &sotbv1[1], &
		sotbv2[1], &ditbv1[1], &ditbv2[1], &wrkar[ipt4], &wrkar[ipt2],
		 &sosotb[sosotb_offset], &soditb[soditb_offset], &disotb[
		disotb_offset], &diditb[diditb_offset]);
    }

/* --------------- On retranche les contraintes de coins ---------------- 
*/

    if (*iordru >= 0 && *iordrv >= 0) {
	mma2cd1_(ndimen, nbpntu, &urootl[1], nbpntv, &vrootl[1], iordru, 
		iordrv, &contr1[contr1_offset], &contr2[contr2_offset], &
		contr3[contr3_offset], &contr4[contr4_offset], &wrkar[ipt3], &
		wrkar[ipt4], &wrkar[ipt1], &wrkar[ipt2], &sosotb[
		sosotb_offset], &soditb[soditb_offset], &disotb[disotb_offset]
		, &diditb[diditb_offset]);
    }
    goto L9999;

/* ------------------------------ The End ------------------------------- 
*/
/* --> IORDRE n'est pas dans la plage autorisee. */
L9100:
    *iercod = 1;
    goto L9999;
/* --> PB d'alloc dyn. */
L9013:
    *iercod = 13;
    goto L9999;

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

