/* MAPPTT.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"
#include <Data_Data.h>
#ifdef WNT
#include <SysBase.h>
#include <MathBase.h>
#include <ApproxF2var.h>
#else
#define __ApproxF2var_API
#endif
/* Common Block Declarations */

extern __Data_API struct {
    doublereal gslxjs[5017], gsl0js[52];
} mmapgss_;

#define mmapgss_1 mmapgss_

extern __Data_API struct {
    doublereal gslxj0[4761], gsl0j0[49];
} mmapgs0_;

#define mmapgs0_1 mmapgs0_

extern __Data_API struct {
    doublereal gslxj1[4505], gsl0j1[46];
} mmapgs1_;

#define mmapgs1_1 mmapgs1_

extern __Data_API struct {
    doublereal gslxj2[4249], gsl0j2[43];
} mmapgs2_;

#define mmapgs2_1 mmapgs2_

/* Subroutine */ __ApproxF2var_API int mmapptt_(ndgjac, nbpnts, jordre, cgauss, iercod)
const integer *ndgjac, *nbpnts, *jordre;
doublereal *cgauss;
integer *iercod;
{
    /* System generated locals */
    integer cgauss_dim1, i__1;

    /* Local variables */
    static integer kjac, iptt, ipdb0, infdg, iptdb, mxjac, ilong, ibb;
    extern integer mnfndeb_();
    extern /* Subroutine */ int mcrfill_(), maermsg_(), mgenmsg_(), mgsomsg_()
	    ;




/* < */
/* **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 : */
/*     ---------- */
/*        Charge les elements necessaires a une integration par la */
/*        methode de Gauss pour obtenir les coefficients dans la base de 
*/
/*        Legendre de l' approximation par les moindres carres d' une */
/*        fonction. les elements sont stockes dans les communs MMAPGSS */
/*        (cas sans contrainte), MMAPGS0 (contraintes C0), MMAPGS1 */
/*        (contraintes C1) et MMAPGS2 (contraintes C2). */

/*     MOTS CLES : */
/*     ----------- */
/*        INTEGRATION,GAUSS,JACOBI */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*        NDGJAC : Degre maxi du polynome d' approximation. La */
/*                 representation dans la base orthogonale part du degre 
*/
/*                 0 au degre NDGJAC-2*(JORDRE+1). La base polynomiale */
/*                 est la base de Jacobi d' ordre -1 (Legendre), 0, 1 */
/*                 et 2 */
/*        NBPNTS : Degre du polynome de Legendre sur les racines duquel */
/*                 sont calcules les coefficients d' integration par la */
/*                 methode de Gauss. On doit avoir NBPNTS=8,10,15,20,25, 
*/
/*                  30,40,50 ou 61 et NDGJAC < NBPNTS. */
/*        JORDRE : Ordre de la base de Jacobi (-1,0,1 ou 2). Correspond */
/*                 a pas de contraintes, contraintes C0,C1 ou C2. */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*        CGAUSS(i,k) : Table des coefficients d' integration par la */
/*                      methode de Gauss : i varie de 0 a la partie */
/*                      entiere de NBPNTS/2 et k varie de 0 a */
/*                      NDGJAC-2*(JORDRE+1). */
/*                      Ce sont donc les coeff. d'integration associes */
/*                      aux racines positives du polynome de Legendre de 
*/
/*                      degre NBPNTS. CGAUSS(0,k) contient les coeff. */
/*                      d'integration associes a la racine t = 0 lorsque 
*/
/*                      NBPNTS est impair. */
/*        IERCOD : Code d' erreur. */
/*                 = 0 OK, */
/*                 = 11 NBPNTS ne vaut pas 8,10,15,20,25,30,40,50 ou 61. 
*/
/*                 = 21 JORDRE ne vaut pas -1,0,1 ou 2. */
/*                 = 31 NDGJAC est trop grand ou trop petit. */

/*     COMMONS UTILISES   : */
/*     ---------------- */
/*        MMAPGSS,MMAPGS0,MMAPGS1,MMAPGS2. */

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

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

/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     12-03-93  : MPS ; Ajout des valeurs 8,10,15,20,25 pour */
/*                       le nombre de points d'integration */
/*     13-05-91  : RBD ; Ajout commentaires. */
/*     03-03-90  : NAK ; Includes. */
/*     21-04-87  : RBD ; Creation. */
/* > */
/* ********************************************************************** 
*/
/*   Le nom de la routine */


/*     INCLUDE MMAPGSS */
/* < */
/* **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 : */
/*     ---------- */

/*     MOTS CLES : */
/*     ----------- */

/*     DEMSCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*      INITIALISATION : BLOCK DATA */
/*      FONCTION D'ACCES SEULEMENT : MMAPPTT */

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     12-03-93 : MPS ; Modification des parametres IPTGSS et IP0GSS */
/*     02-03-90 : NAK ; Creation version originale */
/* > */
/* ***********************************************************************
 */







/* ***********************************************************************
 */
/*     INCLUDE MMAPGS0 */
/* < */
/* **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 : */
/*     ---------- */

/*     MOTS CLES : */
/*     ----------- */

/*     DEMSCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*      INITIALISATION : BLOCK DATA */
/*      FONCTION D'ACCES SEULEMENT : MMAPPTT */

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     12-03-93: MPS ; Modification des parametres IPTGS0 et IP0GS0 */
/*     02-03-90 : NAK ; Creation version originale */
/* > */
/* ***********************************************************************
 */







/* ***********************************************************************
 */
/*     INCLUDE MMAPGS1 */
/* < */
/* **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 : */
/*     ---------- */

/*     MOTS CLES : */
/*     ----------- */

/*     DEMSCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*      INITIALISATION : BLOCK DATA */
/*      FONCTION D'ACCES SEULEMENT : MMAPPTT */

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     12-03-93 : MPS ; Modification des parametres IPTGS1 etIP0GS1 */
/*     02-03-90 : NAK ; Creation version originale */
/* > */
/* ***********************************************************************
 */







/* ***********************************************************************
 */

/*     INCLUDE MMAPGS2 */
/* < */
/* **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 : */
/*     ---------- */

/*     MOTS CLES : */
/*     ----------- */

/*     DEMSCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*      INITIALISATION : BLOCK DATA */
/*      FONCTION D'ACCES SEULEMENT : MMAPPTT */

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     12-03-93 : MPS ; Modification des parametres IPTGS2 et IP0GS2 */
/*     02-03-90 : NAK ; Creation version originale */
/* > */
/* ***********************************************************************
 */







/* ***********************************************************************
 */
    /* Parameter adjustments */
    cgauss_dim1 = *nbpnts / 2 + 1;

    /* Function Body */
    ibb = mnfndeb_();
    if (ibb >= 2) {
	mgenmsg_("MMAPPTT", 7L);
    }
    *iercod = 0;

/* ------------------- Tests sur la validite des entrees ---------------- 
*/

    infdg = (*jordre + 1) << 1;
    if (*nbpnts != 8 && *nbpnts != 10 && *nbpnts != 15 && *nbpnts != 20 && *
	    nbpnts != 25 && *nbpnts != 30 && *nbpnts != 40 && *nbpnts != 50 &&
	     *nbpnts != 61) {
	goto L9100;
    }

    if (*jordre < -1 || *jordre > 2) {
	goto L9200;
    }

    if (*ndgjac >= *nbpnts || *ndgjac < infdg) {
	goto L9300;
    }

/* --------------- Calcul du pointeur de debut suivant NBPNTS ----------- 
*/

    iptdb = 0;
    if (*nbpnts > 8) {
	iptdb += (8 - infdg) << 2;
    }
    if (*nbpnts > 10) {
	iptdb += (10 - infdg) * 5;
    }
    if (*nbpnts > 15) {
	iptdb += (15 - infdg) * 7;
    }
    if (*nbpnts > 20) {
	iptdb += (20 - infdg) * 10;
    }
    if (*nbpnts > 25) {
	iptdb += (25 - infdg) * 12;
    }
    if (*nbpnts > 30) {
	iptdb += (30 - infdg) * 15;
    }
    if (*nbpnts > 40) {
	iptdb += (40 - infdg) * 20;
    }
    if (*nbpnts > 50) {
	iptdb += (50 - infdg) * 25;
    }

    ipdb0 = 1;
    if (*nbpnts > 15) {
	ipdb0 = ipdb0 + (14 - infdg) / 2 + 1;
    }
    if (*nbpnts > 25) {
	ipdb0 = ipdb0 + (24 - infdg) / 2 + 1;
    }

/* ------------------ Choix du commun en fonction de JORDRE ------------- 
*/

    if (*jordre == -1) {
	goto L1000;
    }
    if (*jordre == 0) {
	goto L2000;
    }
    if (*jordre == 1) {
	goto L3000;
    }
    if (*jordre == 2) {
	goto L4000;
    }

/* ---------------- Commun MMAPGSS (cas sans contraintes) ----------------
 */

L1000:
    ilong = *nbpnts / 2 << 3;
    i__1 = *ndgjac;
    for (kjac = 0; kjac <= i__1; ++kjac) {
	iptt = iptdb + kjac * (*nbpnts / 2) + 1;
	mcrfill_(&ilong, &mmapgss_1.gslxjs[iptt - 1], &cgauss[kjac * 
		cgauss_dim1 + 1]);
/* L100: */
    }
/* --> Cas ou le nbre de points est impair. */
    if (*nbpnts % 2 == 1) {
	iptt = ipdb0;
	i__1 = *ndgjac;
	for (kjac = 0; kjac <= i__1; kjac += 2) {
	    cgauss[kjac * cgauss_dim1] = mmapgss_1.gsl0js[iptt - 1];
	    ++iptt;
/* L150: */
	}
	i__1 = *ndgjac;
	for (kjac = 1; kjac <= i__1; kjac += 2) {
	    cgauss[kjac * cgauss_dim1] = 0.;
/* L160: */
	}
    }
    goto L9999;

/* ---------------- Commun MMAPGS0 (cas avec contraintes C0) -------------
 */

L2000:
    mxjac = *ndgjac - infdg;
    ilong = *nbpnts / 2 << 3;
    i__1 = mxjac;
    for (kjac = 0; kjac <= i__1; ++kjac) {
	iptt = iptdb + kjac * (*nbpnts / 2) + 1;
	mcrfill_(&ilong, &mmapgs0_1.gslxj0[iptt - 1], &cgauss[kjac * 
		cgauss_dim1 + 1]);
/* L200: */
    }
/* --> Cas ou le nbre de points est impair. */
    if (*nbpnts % 2 == 1) {
	iptt = ipdb0;
	i__1 = mxjac;
	for (kjac = 0; kjac <= i__1; kjac += 2) {
	    cgauss[kjac * cgauss_dim1] = mmapgs0_1.gsl0j0[iptt - 1];
	    ++iptt;
/* L250: */
	}
	i__1 = mxjac;
	for (kjac = 1; kjac <= i__1; kjac += 2) {
	    cgauss[kjac * cgauss_dim1] = 0.;
/* L260: */
	}
    }
    goto L9999;

/* ---------------- Commun MMAPGS1 (cas avec contraintes C1) -------------
 */

L3000:
    mxjac = *ndgjac - infdg;
    ilong = *nbpnts / 2 << 3;
    i__1 = mxjac;
    for (kjac = 0; kjac <= i__1; ++kjac) {
	iptt = iptdb + kjac * (*nbpnts / 2) + 1;
	mcrfill_(&ilong, &mmapgs1_1.gslxj1[iptt - 1], &cgauss[kjac * 
		cgauss_dim1 + 1]);
/* L300: */
    }
/* --> Cas ou le nbre de points est impair. */
    if (*nbpnts % 2 == 1) {
	iptt = ipdb0;
	i__1 = mxjac;
	for (kjac = 0; kjac <= i__1; kjac += 2) {
	    cgauss[kjac * cgauss_dim1] = mmapgs1_1.gsl0j1[iptt - 1];
	    ++iptt;
/* L350: */
	}
	i__1 = mxjac;
	for (kjac = 1; kjac <= i__1; kjac += 2) {
	    cgauss[kjac * cgauss_dim1] = 0.;
/* L360: */
	}
    }
    goto L9999;

/* ---------------- Commun MMAPGS2 (cas avec contraintes C2) -------------
 */

L4000:
    mxjac = *ndgjac - infdg;
    ilong = *nbpnts / 2 << 3;
    i__1 = mxjac;
    for (kjac = 0; kjac <= i__1; ++kjac) {
	iptt = iptdb + kjac * (*nbpnts / 2) + 1;
	mcrfill_(&ilong, &mmapgs2_1.gslxj2[iptt - 1], &cgauss[kjac * 
		cgauss_dim1 + 1]);
/* L400: */
    }
/* --> Cas ou le nbre de points est impair. */
    if (*nbpnts % 2 == 1) {
	iptt = ipdb0;
	i__1 = mxjac;
	for (kjac = 0; kjac <= i__1; kjac += 2) {
	    cgauss[kjac * cgauss_dim1] = mmapgs2_1.gsl0j2[iptt - 1];
	    ++iptt;
/* L450: */
	}
	i__1 = mxjac;
	for (kjac = 1; kjac <= i__1; kjac += 2) {
	    cgauss[kjac * cgauss_dim1] = 0.;
/* L460: */
	}
    }
    goto L9999;

/* ------------------------- Recuperation du code d' erreur --------------
 */
/* --> NBPNTS n' est pas bon */
L9100:
    *iercod = 11;
    goto L9999;
/* --> JORDRE n' est pas bon */
L9200:
    *iercod = 21;
    goto L9999;
/* --> NDGJAC n' est pas bon */
L9300:
    *iercod = 31;
    goto L9999;

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

L9999:
    if (*iercod > 0) {
	maermsg_("MMAPPTT", iercod, 7L);
    }
    if (ibb >= 2) {
	mgsomsg_("MMAPPTT", 7L);
    }

 return 0 ;
} /* mmapptt_ */

