/* MJ1REF.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"

/* Common Block Declarations */

extern struct {
    integer nelbas, orherm;
} mmcheba_;

#define mmcheba_1 mmcheba_

/* Subroutine */ int mmj1ref_(borinf, borsup, nebase, ordher, matj1r, iercod)
doublereal *borinf, *borsup;
integer *nebase, *ordher;
doublereal *matj1r;
integer *iercod;
{
    static logical ldbg;
    static doublereal ta1bid[231], ta2bid[231];
    static integer klegen, nitbid, ninteg;
    extern /* Subroutine */ int mmgaus1_();
    extern /* Subroutine */ int mmfunj1_();
    static integer ier;
    extern integer mnfndeb_();
    extern /* Subroutine */ int 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 : */
/*     ---------- */
/*     CALCUL DE LA PARTIE TRIANGULAIRE INFERIEURE DE LA MATRICE */
/*     SYMETRIQUE CORRESPONDANTE AU CRITERE DE QUALITE J1(C) */
/*     (C'est la matrice hessienne de J1  Hx en abscisse, Hx=Hy=Hz ) */

/*     MOTS CLES : */
/*     ----------- */
/*      INTEGRATION, TENSION, HERIMTE, JACOBI */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*       BORINF: BORNE INFERIEUR DE L'INTEGRAL (-1 SUR L'ELEMENT DE */
/*               REFERNECE (-1,1)) */
/*       BORSUP: BORNE SUPERIEUR DE L'INTEGRAL (1 SUR ELEMENT DE */
/*               REFERENCE) */
/*       NEBASE: NOMBRE D'ELEMENTS DIFFERENTS DE LA BASE POLYNOMIALE */
/*               HERMITE-JACOBI */
/*       ORDHER: ORDRE D'HERMITE OU ORDRE DE LA CONTINUITE INTERNE D'UNE 
*/
/*               COURBE POLYNOMIALE PAR MORCEAUX */
/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*       MATJ1R: PARTIE TRIANGULAIRE INFERIEURE DE LA MATRICE */
/*               REPRESENTANT LE CRITERE J1 SUR UN ELEMENT DE REFERENCE */

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

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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     04-08-95 : KHN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */

/*      INCLUDE MMCHEBA */

/* < */
/* **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 : */
/*     ---------- */
/*       Contient les parametres necessaires a l' integration par */
/*     MMGAUS1, des criteres variationnel des lissage de courbes */

/*     MOTS CLES : */
/*     ----------- */
/*     RESERVE, INTEGRATION, DERIVATION, LISSAGE */

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

/*     NELBAS : Nombre de coefficients dans la base d'Hermite-Jacobi */
/*     ORHERM : Ordre des polynomes d'Hermite. */

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*      20-09-1995: KHN; CREATION VERSION ORIGINALE. */

/* > */
/* ***********************************************************************
 */




/* ***********************************************************************
 */
/*                      INITIALISATIONS */
/* ***********************************************************************
 */

    /* Parameter adjustments */
    --matj1r;

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

/* ***********************************************************************
 */
/*                     TRAITEMENT */
/* ***********************************************************************
 */


    ninteg = *nebase * (*nebase + 1) / 2;
    if (ninteg > 231) {
	goto L9101;
    }
    mmcheba_1.nelbas = *nebase;
    mmcheba_1.orherm = *ordher;
    klegen = (*nebase - 1) / 2 + 1;
    mmgaus1_(&ninteg, mmfunj1_, &klegen, borinf, borsup, ta1bid, ta2bid, &
	    matj1r[1], &nitbid, &ier);
    if (ier > 0) {
	goto L9102;
    }
    goto L9999;

/* ***********************************************************************
 */
/*                   TRAITEMENT DES ERREURS */
/* ***********************************************************************
 */

L9101:
    *iercod = 1;
    goto L9999;
L9102:
    *iercod = 2;
    goto L9999;


/* ***********************************************************************
 */
/*                   RETOUR PROGRAMME APPELANT */
/* ***********************************************************************
 */

L9999:

/* ___ DESALLOCATION, ... */

    maermsg_("MMJ1REF", iercod, 7L);
    if (ldbg) {
	mgsomsg_("MMJ1REF", 7L);
    }
 return 0 ;
} /* mmj1ref_ */

