/* MHJCAN.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 <MathBase.h>
#else 
#define  __MathBase_API
#endif

/* Common Block Declarations */

/*extern __Data_API struct {*/
extern struct {
    integer nbr[1001];
} minombr_;

#define minombr_1 minombr_

/* Table of constant values */

static integer c__2 = 2;
static integer c__21 = 21;

/* Subroutine */ __MathBase_API int mmhjcan_(ndimen, ncourb, ncftab, orcont, ncflim, tcbold, 
	tdecop, tcbnew, iercod)
integer *ndimen, *ncourb, *ncftab, *orcont, *ncflim;
doublereal *tcbold, *tdecop, *tcbnew;
integer *iercod;
{
    /* System generated locals */
    integer tcbold_dim1, tcbold_dim2, tcbold_offset, tcbnew_dim1, tcbnew_dim2,
	     tcbnew_offset, i__1, i__2, i__3, i__4, i__5;

    /* Builtin functions */
    double pow__di();

    /* Local variables */
    static logical ldbg;
    static integer ndeg;
    static doublereal taux1[21];
    static integer d__, e, i__, k;
    static doublereal mfact;
    static integer ncoeff;
    static doublereal tjacap[21];
    static integer iordre[2];
    static doublereal hermit[36]	/* was [6][3][2] */, ctenor, bornes[2]
	    ;
    extern /* Subroutine */ int mmherm1_();
    static integer ier;
    extern /* Subroutine */ int mmjacan_();
    extern integer mnfndeb_();
    extern /* Subroutine */ int mmapcmp_(), maermsg_(), mgenmsg_(), mgsomsg_()
	    , mvriraz_();
    static integer aux1, aux2;



/* < */
/* **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 : */
/*     ---------- */
/*       CONVERSION LA TABLE TCBOLD DES COEFFICIENTS DES  COURBES */
/*       POLYNOMIALES EXPRIMEES DANS LA BASE HERMITE JACOBI, EN UNE */
/*       TABLE DE COEFFICIENTS TCBNEW DES COURBES EXPRIMEES DANS LA */
/*       BASE CANONIQUE */

/*     MOTS CLES : */
/*     ----------- */
/*      CANNONIQUE, HERMITE, JACCOBI */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*       ORDHER : ORDRE DES POLYNOMES D'HERMITE OU ORDRE DE CONTINUITE */
/*       NCOEFS : NOMBRE DE COEFFICIENTS DE UNE LA COURBE POLYNOMIALE */
/*                POUR UNE DE SES NDIM COMPOSANTS;(DEGRE+1 DE LA COURBE) 
*/
/*       NDIM   : DIMENSION DE LA COURBE */
/*       CBHEJA : TABLE DE COEFFICIENTS DE LA COURBE DANS LA BASE */
/*                HERMITE JACOBI */
/*                (H(0,-1),..,H(ORDHER,-1),H(0,1),..,H(ORDHER,1), */
/*                 JA(ORDHER+1,2*ORDHER+2),....,JA(ORDHER+1,NCOEFS-1) */

/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*       CBRCAN : TABLE DE COEFFICIENTS DE LA COURBE DANS LA BASE */
/*                CANONIQUE */
/*                (1, t, ...) */

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


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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     8-09-95 : KHN/PMN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */


/*     INCLUDE MINOMBR */
/* < */
/* **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 : */
/*     ---------- */
/*        Sert a fournir les constantes entieres de 0 a 1000 */

/*     MOTS CLES : */
/*     ----------- */
/*        TOUS,ENTIERS */

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

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     11-10-89 : DH ; Creation version originale */
/* > */
/* ***********************************************************************
 */


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




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

    /* Parameter adjustments */
    --ncftab;
    tcbnew_dim1 = *ndimen;
    tcbnew_dim2 = *ncflim;
    tcbnew_offset = tcbnew_dim1 * (tcbnew_dim2 + 1) + 1;
    tcbnew -= tcbnew_offset;
    tcbold_dim1 = *ndimen;
    tcbold_dim2 = *ncflim;
    tcbold_offset = tcbold_dim1 * (tcbold_dim2 + 1) + 1;
    tcbold -= tcbold_offset;

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

    bornes[0] = -1.;
    bornes[1] = 1.;

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

    if (*orcont > 2) {
	goto L9101;
    }
    if (*ncflim > 21) {
	goto L9101;
    }

/*     CALCUL DES POLYNOMES D'HERMITE DANS LA BASE CANONIQUE SUR (-1,1) */


    iordre[0] = *orcont;
    iordre[1] = *orcont;
    mmherm1_(bornes, &c__2, iordre, hermit, &ier);
    if (ier > 0) {
	goto L9102;
    }


    aux1 = *orcont + 1;
    aux2 = aux1 << 1;

    i__1 = *ncourb;
    for (e = 1; e <= i__1; ++e) {

	ctenor = (tdecop[e] - tdecop[e - 1]) / 2;
	ncoeff = ncftab[e];
	ndeg = ncoeff - 1;
	if (ncoeff > 21) {
	    goto L9101;
	}

	i__2 = *ndimen;
	for (d__ = 1; d__ <= i__2; ++d__) {

/*     CONVERSION DES COEFFICIENTS DE LA PARTIE DE LA COURBE EXPRI
MEE */
/*     DANS LA BASE HERMITE, DANS LA BASE CANONIQUE */

	    mvriraz_(&ncoeff, taux1);

	    i__3 = aux2;
	    for (k = 1; k <= i__3; ++k) {
		i__4 = aux1;
		for (i__ = 1; i__ <= i__4; ++i__) {
		    i__5 = i__ - 1;
		    mfact = pow__di(&ctenor, &i__5);
		    taux1[k - 1] += (tcbold[d__ + (i__ + e * tcbold_dim2) * 
			    tcbold_dim1] * hermit[k + (i__ + 2) * 6 - 19] + 
			    tcbold[d__ + (i__ + aux1 + e * tcbold_dim2) * 
			    tcbold_dim1] * hermit[k + (i__ + 5) * 6 - 19]) * 
			    mfact;
		}
	    }


	    i__3 = ncoeff;
	    for (i__ = aux2 + 1; i__ <= i__3; ++i__) {
		taux1[i__ - 1] = tcbold[d__ + (i__ + e * tcbold_dim2) * 
			tcbold_dim1];
	    }

/*     CONVERSION DES COEFFICIENTS DE LA PARTIE DE LA COURBE EXPRI
MEE */
/*     DANS LA BASE CANONIQUE-JACOBI , DANS LA BASE CANONIQUE */


	    mmapcmp_(&minombr_1.nbr[1], &c__21, &ncoeff, taux1, tjacap);
	    mmjacan_(orcont, &ndeg, tjacap, taux1);

/*        RECOPIE  DES COEFS RESULTANT DE LA CONVERSION DANS LA TA
BLE */
/*        DES RESULTAT */

	    i__3 = ncoeff;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		tcbnew[d__ + (i__ + e * tcbnew_dim2) * tcbnew_dim1] = taux1[
			i__ - 1];
	    }

	}
    }

    goto L9999;

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

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

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

L9999:

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

