/* MGAUS1.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 <MathBase.h>
#else 
#define  __MathBase_API
#endif
/* Subroutine */ __MathBase_API int mmgaus1_(ndimf, bfunx, k, xd, xf, saux1, saux2, somme, 
	niter, iercod)
integer *ndimf;
/* Subroutine */ int (*bfunx) ();
integer *k;
doublereal *xd, *xf, *saux1, *saux2, *somme;
integer *niter, *iercod;
{
    /* System generated locals */
    integer i__1, i__2;

    /* Local variables */
    static integer ndeg;
    static doublereal h__[20];
    static integer j;
    static doublereal t, u[20], x;
    static integer idimf;
    static doublereal c1x, c2x;
    extern /* Subroutine */ int mvgaus0_(), mvriraz_();





/* < */
/* **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 de l'integrale de la fonction BFUNX passee en parametre */
/*      entre les bornes XD et XF . */
/*      La fonction doit etre calculable pour n'importe quelle valeur */
/*      de la variable dans l'intervalle donne.. */
/*      La methode utilisee est celle de GAUSS-LEGENDRE. Des explications 
*/
/*      peuvent etre obtenus sur le livre : */
/*          Complements de mathematiques a l'usage des Ingenieurs de */
/*          l'electrotechnique et des telecommunications. */
/*          Par Andre ANGOT - Collection technique et scientifique du CNET
 */
/*          page 772 .... */
/*      Le degre des polynomes de LEGENDRE utilise est passe en parametre.
 */

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

/*      ARGUMENTS D'ENTREE : */
/*      ------------------ */

/*      NDIMF : Dimension de la fonction */
/*      BFUNX : Fonction a integrer passee en argument */
/*              Doit etre declaree en EXTERNAL dans la routine d'appel. */
/*                   SUBROUTINE BFUNX(NDIMF,X,VAL,IER) */
/*                   REAL *8 X,VAL */
/*     K      : Parametre determinant le degre du polynome de LEGENDRE qui
*/
/*               peut prendre une valeur comprise entre 0 et 10. */
/*               Le degre du polynome est egal a 4 k, c'est a dire 4, 8, 
*/
/*               12, 16, 20, 24, 28, 32, 36 et 40. */
/*               Si K n'est pas bon, le degre est pris a 40 directement. 
*/
/*      XD     : Borne inferieure de l'intervalle d'integration. */
/*      XF     : Borne superieure de l'intervalle d'integration. */
/*      SAUX1  : Tableau auxiliaire */
/*      SAUX2  : Tableau auxiliaire */

/*      ARGUMENTS DE SORTIE : */
/*      ------------------- */

/*      SOMME : Valeur de l'integrale */
/*      NITER : Nombre d'iterations effectues. */
/*              Il est egal au degre du polynome. */

/*      IER   : Code d'erreur : */
/*              < 0 ==> Attention - Warning */
/*              = 0 ==> Tout est OK */
/*              > 0 ==> Erreur severe - Faire un traitement special */
/*                  ==> Erreur dans le calcul de BFUNX (code de retour */
/*                      de cette routine */

/*              Si erreur => SOMME = 0 */

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



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

/*     Type  Name */
/*    @      BFUNX               MVGAUS0 */

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

/*      Voir les explications detaillees sur le listing */

/*      Utilisation de la methode de GAUSS (polynomes orthogonaux) */
/*      On utilise la symetrie des racines de ces polynomes */

/*      En fonction de K, le degre du polynome d'interpolation augmente. 
*/
/*      Si vous voulez calculer l'integrale avec une precision donnee, */
/*     boucler sur k variant de 1 a 10 et tester la difference de 2 iteres
*/
/*      consecutifs. Arreter la boucle si cette difference est inferieure 
*/
/*      a une valeur epsilon fixee a 10E-6 par exemple. */
/*      Si S1 et S2 sont 2 iteres successifs, tester suivant cet exemple :
 */

/*            AF=DABS(S1-S2) */
/*            AS=DABS(S2) */
/*            Si AS < 1 alors tester si FS < eps sinon tester AF/AS < eps 
*/
/*            --        -----                    ----- */

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ---------------------------- */
/*         3-09-1993 : PMN; CREATION D'APRES VGAUS1 (SAUX1 et SAUX2 en */
/*                    arguments) */
/*        . 04-10-89 : JP;AJOUT EXTERNAL BFUNX SGI_420_144 */
/*        . 20-08-87 : JP;INTEGRATION D'UNE FONCTION VECTORIELLE */
/*        . 08-08-87 : GD; Version originale */

/* > */
/************************************************************************
******/
/*     DECLARATIONS */
/************************************************************************
******/



/* ****** Initialisation generale ** */

    /* Parameter adjustments */
    --somme;
    --saux2;
    --saux1;

    /* Function Body */
    mvriraz_(ndimf, &somme[1]);
    *iercod = 0;

/* ****** Chargement des coefficients U et H ** */
/* -------------------------------------------- */

    mvgaus0_(k, u, h__, &ndeg, iercod);
    if (*iercod > 0) {
	goto L9999;
    }

/* ****** C1X => Point milieu intervalle  [XD,XF] */
/* ****** C2X => 1/2 amplitude intervalle [XD,XF] */

    c1x = (*xf + *xd) * .5;
    c2x = (*xf - *xd) * .5;

/* ---------------------------------------- */
/* ****** Integration pour un degre NDEG ** */
/* ---------------------------------------- */

    i__1 = ndeg;
    for (j = 1; j <= i__1; ++j) {
	t = c2x * u[j - 1];

	x = c1x + t;
	(*bfunx)(ndimf, &x, &saux1[1], iercod);
	if (*iercod != 0) {
	    goto L9999;
	}

	x = c1x - t;
	(*bfunx)(ndimf, &x, &saux2[1], iercod);
	if (*iercod != 0) {
	    goto L9999;
	}

	i__2 = *ndimf;
	for (idimf = 1; idimf <= i__2; ++idimf) {
	    somme[idimf] += h__[j - 1] * (saux1[idimf] + saux2[idimf]);
	}

    }

    *niter = ndeg << 1;
    i__1 = *ndimf;
    for (idimf = 1; idimf <= i__1; ++idimf) {
	somme[idimf] *= c2x;
    }

/* ****** Fin du sous-programme ** */

L9999:

 return 0   ;
} /* mmgaus1_ */

