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

/* Table of constant values */

static integer c__2 = 2;

/* Subroutine */ int mmpojac_(tparam, iordre, ncoeff, nderiv, valjac, iercod)
doublereal *tparam;
integer *iordre, *ncoeff, *nderiv;
doublereal *valjac;
integer *iercod;
{
    /* Initialized data */

    static integer nbcof = -1;

    /* System generated locals */
    integer valjac_dim1, i__1, i__2;

    /* Builtin functions */
    integer pow__ii();
    double sqrt();

    /* Local variables */
    static doublereal cofa, cofb, denom, tnorm[100];
    static integer ii, jj, kk1, kk2;
    extern /* Subroutine */ int maermsg_();
    static doublereal 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 : */
/*     ---------- */
/*       Positionnement sur les polynomes de Jacobi et leurs derives */
/*       successives par un algorithme de recurence */

/*     MOTS CLES : */
/*     ----------- */
/*      RESERVE, POSITIONEMENT, JACOBI */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*       TPARAM : Parametre pour lequel on se positionne. */
/*       IORDRE : Ordre d'hermite-?? (-1,0,1, ou 2) */
/*       NCOEFF : Nombre de coeeficients des polynomes (Nb de valeur a */
/*                calculer) */
/*       NDERIV : Nombre de derive a calculer (0<= N <=3) */
/*              0 -> Positionement simple sur les fonctions de jacobi */
/*              N -> Positionement sur les fonctions de jacobi et leurs */
/*              derive d'ordre 1 a N. */

/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*     VALJAC (NCOEFF, 0:NDERIV) : les valeur calculee */
/*           i */
/*          d    vj(t)  = VALJAC(J, I) */
/*          -- i */
/*          dt */

/*    IERCOD : Code d'erreur */
/*      0 : Ok */
/*      1 : Incoherance des arguments d'entre */

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


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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     19-07-1995: PMN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */


/*     varaibles statiques */



    /* Parameter adjustments */
    valjac_dim1 = *ncoeff;
    --valjac;

    /* Function Body */

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

    *iercod = 0;

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

    if (*nderiv > 3) {
	goto L9101;
    }
    if (*ncoeff > 100) {
	goto L9101;
    }

/*  --- Calcul des normes */

/*      IF (NCOEFF.GT.NBCOF) THEN */
    i__1 = *ncoeff;
    for (ii = 1; ii <= i__1; ++ii) {
	kk1 = ii - 1;
	aux2 = 1.;
	i__2 = *iordre;
	for (jj = 1; jj <= i__2; ++jj) {
	    aux2 = aux2 * (doublereal) (kk1 + *iordre + jj) / (doublereal) (
		    kk1 + jj);
	}
	i__2 = (*iordre << 1) + 1;
	tnorm[ii - 1] = sqrt(aux2 * (kk1 * 2. + (*iordre << 1) + 1) / pow__ii(&
		c__2, &i__2));
    }

    nbcof = *ncoeff;

/*      END IF */

/*  --- Positionements triviaux ----- */

    valjac[1] = 1.;
    aux1 = (doublereal) (*iordre + 1);
    valjac[2] = aux1 * *tparam;

    if (*nderiv >= 1) {
	valjac[valjac_dim1 + 1] = 0.;
	valjac[valjac_dim1 + 2] = aux1;

	if (*nderiv >= 2) {
	    valjac[(valjac_dim1 << 1) + 1] = 0.;
	    valjac[(valjac_dim1 << 1) + 2] = 0.;

	    if (*nderiv >= 3) {
		valjac[valjac_dim1 * 3 + 1] = 0.;
		valjac[valjac_dim1 * 3 + 2] = 0.;
	    }
	}
    }

/*  --- Positionement par reccurence */

    i__1 = *ncoeff;
    for (ii = 3; ii <= i__1; ++ii) {

	kk1 = ii - 1;
	kk2 = ii - 2;
	aux1 = (doublereal) (*iordre + kk2);
	aux2 = aux1 * 2;
	cofa = aux2 * (aux2 + 1) * (aux2 + 2);
	cofb = (aux2 + 2) * -2. * aux1 * aux1;
	denom = kk1 * 2. * (kk2 + (*iordre << 1) + 1) * aux2;
	denom = 1. / denom;

/*        --> Pi(t) */
	valjac[ii] = (cofa * *tparam * valjac[kk1] + cofb * valjac[kk2]) * 
		denom;
/*        --> P'i(t) */
	if (*nderiv >= 1) {
	    valjac[ii + valjac_dim1] = (cofa * *tparam * valjac[kk1 + 
		    valjac_dim1] + cofa * valjac[kk1] + cofb * valjac[kk2 + 
		    valjac_dim1]) * denom;
/*        --> P''i(t) */
	    if (*nderiv >= 2) {
		valjac[ii + (valjac_dim1 << 1)] = (cofa * *tparam * valjac[
			kk1 + (valjac_dim1 << 1)] + cofa * 2 * valjac[kk1 + 
			valjac_dim1] + cofb * valjac[kk2 + (valjac_dim1 << 1)]
			) * denom;
	    }
/*        --> P'i(t) */
	    if (*nderiv >= 3) {
		valjac[ii + valjac_dim1 * 3] = (cofa * *tparam * valjac[kk1 + 
			valjac_dim1 * 3] + cofa * 3 * valjac[kk1 + (
			valjac_dim1 << 1)] + cofb * valjac[kk2 + valjac_dim1 *
			 3]) * denom;
	    }
	}
    }

/*    ---> Normalisation */

    i__1 = *ncoeff;
    for (ii = 1; ii <= i__1; ++ii) {
	i__2 = *nderiv;
	for (jj = 0; jj <= i__2; ++jj) {
	    valjac[ii + jj * valjac_dim1] = tnorm[ii - 1] * valjac[ii + jj * 
		    valjac_dim1];
	}
    }

    goto L9999;

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

L9101:
    *iercod = 1;
    goto L9999;


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

L9999:

    if (*iercod > 0) {
	maermsg_("MMPOJAC", iercod, 7L);
    }
 return 0 ;
} /* mmpojac_ */

