/* MA2AC3.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 <ApproxF2var.h>
#endif 
/* Subroutine */ int mma2ac3_(ndimen, mxujac, mxvjac, iordru, nclimv, ncfiu1, 
	crbiu1, ncfiu2, crbiu2, uhermt, patjac)
const integer *ndimen, *mxujac, *mxvjac, *iordru, *nclimv, *ncfiu1;
const doublereal *crbiu1;
const integer *ncfiu2;
const doublereal *crbiu2, *uhermt;
doublereal *patjac;
{
    /* System generated locals */
    integer crbiu1_dim1, crbiu1_dim2, crbiu1_offset, crbiu2_dim1, crbiu2_dim2,
	     crbiu2_offset, patjac_dim1, patjac_dim2, patjac_offset, 
	    uhermt_dim1, uhermt_offset, i__1, i__2, i__3, i__4;

    /* Local variables */
    static logical ldbg;
    static integer ndgu1, ndgu2, ii, jj, nd, kk;
    extern integer mnfndeb_();
    extern /* Subroutine */ int mgenmsg_();
    static doublereal bid1, bid2;
    extern /* Subroutine */ int 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 : */
/*     ---------- */
/*     Ajout des polynomes de contraintes */

/*     MOTS CLES : */
/*     ----------- */
/*     FONCTION,APPROXIMATION,COEFFICIENT,POLYNOME */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*   NDIMEN: Dimension de l'espace. */
/*   MXUJAC: Degre maxi du polynome d' approximation en U. La */
/*           representation dans la base orthogonale part du degre */
/*           0 au degre MXUJAC-2*(IORDRU+1). La base polynomiale est */
/*           la base de Jacobi d' ordre -1 (Legendre), 0, 1 ou 2 */
/*   MXVJAC: Degre maxi du polynome d' approximation en V. La */
/*           representation dans la base orthogonale part du degre */
/*           0 au degre MXVJAC-2*(IORDRU+1). La base polynomiale est */
/*           la base de Jacobi d' ordre -1 (Legendre), 0, 1 ou 2 */
/*   IORDRU: Ordre de la base de Jacobi (-1,0,1 ou 2) en V. Correspond */
/*           a pas de contraintes, contraintes C0, C1 ou C2. */
/*   NCLIMV: Nbre LIMITE de coeff. en v de la solution P(u,v). */
/*   NCFIU1: Nbre de Coeff. des courbes stockees dans CRBIU1. */
/*   CRBIU1: Table des coeffs de l'approximation de l'iso-U0 et ses */
/*           derivees jusqu'a l'ordre IORDRU. */
/*   NCFIU2: Nbre de Coeff. des courbes stockees dans CRBIU2. */
/*   CRBIU2: Table des coeffs de l'approximation de l'iso-U1 et ses */
/*           derivees jusqu'a l'ordre IORDRU. */
/*   UHERMT: Table des coeff. des polynomes d'Hermite d'ordre IORDRU. */
/*   PATJAC: Table des coefficients du polynome P(u,v) d' approximation */
/*           de F(u,v) SANS prise en compte des contraintes. */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*   PATJAC: Table des coefficients du polynome P(u,v) d' approximation */
/*           de F(u,v) AVEC prise en compte des contraintes. */

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

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

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

/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     06-02-1991: RBD; Creation d'apres MA2CA3. */
/* > */
/* ********************************************************************** 
*/
/*   Le nom de la routine */

/* --------------------------- Initialisations -------------------------- 
*/

    /* Parameter adjustments */
    patjac_dim1 = *mxujac + 1;
    patjac_dim2 = *mxvjac + 1;
    patjac_offset = patjac_dim1 * patjac_dim2;
    patjac -= patjac_offset;
    uhermt_dim1 = (*iordru << 1) + 2;
    uhermt_offset = uhermt_dim1;
    uhermt -= uhermt_offset;
    --ncfiu2;
    --ncfiu1;
    crbiu2_dim1 = *nclimv;
    crbiu2_dim2 = *ndimen;
    crbiu2_offset = crbiu2_dim1 * (crbiu2_dim2 + 1);
    crbiu2 -= crbiu2_offset;
    crbiu1_dim1 = *nclimv;
    crbiu1_dim2 = *ndimen;
    crbiu1_offset = crbiu1_dim1 * (crbiu1_dim2 + 1);
    crbiu1 -= crbiu1_offset;

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

/* ------------ AJOUT des coeff en u des courbes, en v d'Hermite -------- 
*/

    i__1 = *iordru + 1;
    for (ii = 1; ii <= i__1; ++ii) {
	ndgu1 = ncfiu1[ii] - 1;
	ndgu2 = ncfiu2[ii] - 1;
	i__2 = *ndimen;
	for (nd = 1; nd <= i__2; ++nd) {
	    i__3 = ndgu1;
	    for (jj = 0; jj <= i__3; ++jj) {
		bid1 = crbiu1[jj + (nd + ii * crbiu1_dim2) * crbiu1_dim1];
		i__4 = (*iordru << 1) + 1;
		for (kk = 0; kk <= i__4; ++kk) {
		    patjac[kk + (jj + nd * patjac_dim2) * patjac_dim1] += 
			    bid1 * uhermt[kk + ((ii << 1) - 1) * uhermt_dim1];
/* L400: */
		}
/* L300: */
	    }
	    i__3 = ndgu2;
	    for (jj = 0; jj <= i__3; ++jj) {
		bid2 = crbiu2[jj + (nd + ii * crbiu2_dim2) * crbiu2_dim1];
		i__4 = (*iordru << 1) + 1;
		for (kk = 0; kk <= i__4; ++kk) {
		    patjac[kk + (jj + nd * patjac_dim2) * patjac_dim1] += 
			    bid2 * uhermt[kk + (ii << 1) * uhermt_dim1];
/* L600: */
		}
/* L500: */
	    }

/* L200: */
	}
/* L100: */
    }

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

    if (ldbg) {
	mgsomsg_("MMA2AC3", 7L);
    }
    return 0;
} /* mma2ac3_ */

