/* MEXTHI.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>
/* Common Block Declarations */

/*extern __Data_API struct {*/
extern struct {
    doublereal rootab[930]	/* was [465][2] */, hiltab[930]	/* was [465][
	    2] */, hi0tab[31];
} mlgdrtl_;

#define mlgdrtl_1 mlgdrtl_

/* Subroutine */ int mmexthi_(ndegre, hwgaus)
integer *ndegre;
doublereal *hwgaus;
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    static integer iadd, ideb, ndeg2, nmod2, ii, ibb;
    extern integer mnfndeb_();
    static integer kpt;
    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 : */
/*     ---------- */
/*  Extrait du commun LDGRTL les poids des formules de quadrature de */
/*  Gauss sur toutes les racines des polynomes de Legendre de degre */
/*  NDEGRE defini sur [-1,1]. */

/*     MOTS CLES : */
/*     ----------- */
/*     TOUS, AB_SPECIFI::COMMON&, EXTRACTION, &POIDS, &GAUSS. */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*   NDEGRE : Degre mathematique du polynome de Legendre. On doit avoir */
/*            2 <= NDEGRE <= 61. */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*   HWGAUS : Le tableau des poids des formules de quadrature de Gauss */
/*            relatifs aux NDEGRE racines d' un polynome de Legendre de */
/*            degre NDEGRE. */

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

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

/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*     ATTENTION: La condition sur NDEGRE ( 2 <= NDEGRE <= 61) n'est */
/*     pas testee. A l'appelant de faire le test. */

/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/* 23-03-90 : RBD ; Mise a jour en-tete, declaration variables locales, */
/*                  correction poids associe racines negatives (bug */
/*                  ENORME). */
/* 15-01-90 : NAK ; MLGDRTL PAR INCLUDE MMLGDRT */
/* 22-04-88 : JJM ; Creation. */
/* > */
/* ********************************************************************** 
*/

/*   Le nom de la routine */


/*   Le common MLGDRTL: */
/*   Ce common comprend les racines POSITIVES des polynomes de Legendre */
/*   ET les poids des formules de quadrature de Gauss sur toutes les */
/*   racines POSITIVES des polynomes de Legendre. */


/*     INCLUDE MMLGDRT */
/* < */
/* **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 : */
/*     ---------- */
/*   Le common des racines de Legendre. */

/*     MOTS CLES : */
/*     ----------- */
/*        BASE LEGENDRE */

/*     DEMSCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     11-01-90 : NAK  ; Creation version originale */
/* > */
/* ***********************************************************************
 */




/*   ROOTAB : Tableau de toutes les racines des polynomes de Legendre */
/*   comprises entre ]0,1]. Elles sont rangees pour des degres croissants 
*/
/*   de 2 a 61. */
/*   HILTAB : Tableau des interpolants de Legendre concernant ROOTAB. */
/*   L' adressage est le meme. */
/*   HI0TAB : Tableau des interpolants de Legendre pour la racine x=0 */
/*   des polynomes de degre IMPAIR. */
/*   RTLTB0 : Tableau des Li(uk) ou les uk sont les racines d' un */
/*  polynome de Legendre de degre PAIR. */
/*   RTLTB1 : Tableau des Li(uk) ou les uk sont les racines d' un */
/*  polynome de Legendre de degre IMPAIR. */


/************************************************************************
*****/
    /* Parameter adjustments */
    --hwgaus;

    /* Function Body */
    ibb = mnfndeb_();
    if (ibb >= 3) {
	mgenmsg_("MMEXTHI", 7L);
    }

    ndeg2 = *ndegre / 2;
    nmod2 = *ndegre % 2;

/*   Adresse du poids de Gauss associe a la 1ere racine strictement */
/*   positive du polynome de Legendre de degre NDEGRE dans MLGDRTL. */

    iadd = ndeg2 * (ndeg2 - 1) / 2 + 1;

/*   Indice du 1er element de HWGAUS associe a la 1ere racine */
/*   strictement positive du polynome de Legendre de degre NDEGRE. */

    ideb = (*ndegre + 1) / 2 + 1;

/*   Lecture des poids associes aux racines strictement positives. */

    i__1 = *ndegre;
    for (ii = ideb; ii <= i__1; ++ii) {
	kpt = iadd + ii - ideb;
	hwgaus[ii] = mlgdrtl_1.hiltab[kpt + nmod2 * 465 - 1];
/* L100: */
    }

/*   Pour les racines strictement negatives, les poids sont les memes. */
/*   i.e HW(1) = HW(NDEGRE), HW(2) = HW(NDEGRE-1), etc... */

    i__1 = ndeg2;
    for (ii = 1; ii <= i__1; ++ii) {
	hwgaus[ii] = hwgaus[*ndegre + 1 - ii];
/* L200: */
    }

/*   Cas NDEGRE impair, 0 est racine du polynome de Legendre, on */
/*   charge le poids de Gauss associe. */

    if (nmod2 == 1) {
	hwgaus[ndeg2 + 1] = mlgdrtl_1.hi0tab[ndeg2];
    }

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

    if (ibb >= 3) {
	mgsomsg_("MMEXTHI", 7L);
    }
    return 0;
} /* mmexthi_ */

