/* MAPCOE.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>
#else
#define __ApproxF2var_API
#endif
/* Subroutine */ __ApproxF2var_API int mmmapcoe_(ndim, ndgjac, iordre, nbpnts, somtab, diftab, 
	gsstab, crvjac)
integer *ndim, *ndgjac, *iordre, *nbpnts;
doublereal *somtab, *diftab, *gsstab, *crvjac;
{
    /* System generated locals */
    integer somtab_dim1, somtab_offset, diftab_dim1, diftab_offset, 
	    crvjac_dim1, crvjac_offset, gsstab_dim1, i__1, i__2, i__3;

    /* Local variables */
    static integer igss, ikdeb;
    static doublereal bidon;
    static integer nd, ik, ir, nbroot, ibb;
    extern integer mnfndeb_();
    extern /* Subroutine */ int 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 : */
/*     ---------- */
/*     Calcul des coefficients de la courbe d' approximation polynomiale 
*/
/*     de degre NDGJAC par la methode des moindres carres a partir de la 
*/
/*     discretisation de la fonction sur les racines du polynome de */
/*     Legendre de degre NBPNTS. */

/*     MOTS CLES : */
/*     ----------- */
/*     FONCTION,APPROXIMATION,COEFFICIENT,POLYNOME */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*        NDIM   : Dimension de l' espace. */
/*        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 */
/*        IORDRE : Ordre de la base de Jacobi (-1,0,1 ou 2). Correspond */
/*                 a pas de contraintes, contraintes C0,C1 ou C2. */
/*        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=30,40,50 ou 61 
*/
/*                 et NDGJAC < NBPNTS. */
/*        SOMTAB : Tableau de F(ti)+F(-ti) avec ti dans ROOTAB. */
/*        DIFTAB : Tableau de F(ti)-F(-ti) avec ti dans ROOTAB. */
/*        GSSTAB(i,k) : Table des coefficients d' integration par la */
/*                      methode de Gauss : i varie de 0 a NBPNTS et */
/*                      k varie de 0 a NDGJAC-2*(JORDRE+1). */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*        CRVJAC : Courbe d' approximation de FONCNP avec eventuellement 
*/
/*                 prise en compte des contraintes aux extremites. */
/*                 Cette courbe est de degre NDGJAC. */

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

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

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

/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     11-04-1989 : RBD ; Creation. */
/* > */
/* ********************************************************************** 
*/

/*   Le nom de la routine */

    /* Parameter adjustments */
    crvjac_dim1 = *ndgjac + 1;
    crvjac_offset = crvjac_dim1;
    crvjac -= crvjac_offset;
    gsstab_dim1 = *nbpnts / 2 + 1;
    diftab_dim1 = *nbpnts / 2 + 1;
    diftab_offset = diftab_dim1;
    diftab -= diftab_offset;
    somtab_dim1 = *nbpnts / 2 + 1;
    somtab_offset = somtab_dim1;
    somtab -= somtab_offset;

    /* Function Body */
    ibb = mnfndeb_();
    if (ibb >= 2) {
	mgenmsg_("MMMAPCO", 7L);
    }
    ikdeb = (*iordre + 1) << 1;
    nbroot = *nbpnts / 2;

    i__1 = *ndim;
    for (nd = 1; nd <= i__1; ++nd) {

/* ----------------- Calcul des coefficients de degre pair ----------
---- */

	i__2 = *ndgjac;
	for (ik = ikdeb; ik <= i__2; ik += 2) {
	    igss = ik - ikdeb;
	    bidon = 0.;
	    i__3 = nbroot;
	    for (ir = 1; ir <= i__3; ++ir) {
		bidon += somtab[ir + nd * somtab_dim1] * gsstab[ir + igss * 
			gsstab_dim1];
/* L300: */
	    }
	    crvjac[ik + nd * crvjac_dim1] = bidon;
/* L200: */
	}

/* --------------- Calcul des coefficients de degre impair ----------
---- */

	i__2 = *ndgjac;
	for (ik = ikdeb + 1; ik <= i__2; ik += 2) {
	    igss = ik - ikdeb;
	    bidon = 0.;
	    i__3 = nbroot;
	    for (ir = 1; ir <= i__3; ++ir) {
		bidon += diftab[ir + nd * diftab_dim1] * gsstab[ir + igss * 
			gsstab_dim1];
/* L500: */
	    }
	    crvjac[ik + nd * crvjac_dim1] = bidon;
/* L400: */
	}

/* L100: */
    }

/* ------- Ajout des termes lies a la racine supplementaire (0.D0) ------ 
*/
/* ----------- du polynome de Legendre de degre impair NBPNTS ----------- 
*/

    if (*nbpnts % 2 == 0) {
	goto L9999;
    }
    i__1 = *ndim;
    for (nd = 1; nd <= i__1; ++nd) {
	i__2 = *ndgjac;
	for (ik = ikdeb; ik <= i__2; ik += 2) {
	    igss = ik - ikdeb;
	    crvjac[ik + nd * crvjac_dim1] += somtab[nd * somtab_dim1] * 
		    gsstab[igss * gsstab_dim1];
/* L700: */
	}
/* L600: */
    }

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

L9999:
    if (ibb >= 2) {
	mgsomsg_("MMMAPCO", 7L);
    }
    return 0;
} /* mmmapcoe_ */

