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

/* Subroutine */ int mmtabas_(npoint, npcont, ndimen, ndecop, ordher, ncoefs, 
	tcontr, tpospt, tasemh, tasemg, hdecal, hdimen, gdimen, iercod)
integer *npoint, *npcont, *ndimen, *ndecop, *ordher, *ncoefs, *tcontr, *
	tpospt, *tasemh, *tasemg, *hdecal, *hdimen, *gdimen, *iercod;
{
    /* System generated locals */
    integer tasemh_dim1, tasemh_offset, tasemg_dim1, tasemg_offset, i__1, 
	    i__2;

    /* Local variables */
    static logical ldbg;
    static integer e, i__, j, k, gdecal, indglo;
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mgsomsg_();
    static integer aux1, aux2, aux3, aux4;



/* < */
/* **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 : */
/*     ---------- */
/*       CONSTRUCTION DES TABLES D'ASSEMBLAGE TASEMH(POUR LA MATRICE */
/*       HESSIENNE) , TASEMG (POUR LA MATRICE DES  CONTRAINTES) */


/*     MOTS CLES : */
/*     ----------- */
/*      RESERVE, LISSAGE, TABLE, ASSEMBLAGE */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*       NPOINT: NOMBRE DE POINTS */
/*       NPCONT: NOMBRE DE POINTS CONTRAINTS */
/*       NDIMEN: DIMENSION DE L'ESPACE */
/*       NDECOP: NOMBRE DE DECOUPES */
/*       ORDHER: ORDRE D'HERMITE */
/*       NCOEFS: DEGRE+1 DE LA COURBE POLYNOMIALE */
/*       TCONTR: TABLE DONNANT LE TYPE ET LES INDICES DES POINTS */
/*               CONTRAINTS */
/*               TCONTR(1,I): CONTIENT L'INDICE DU POINT CONTRAINT */
/*               TCONTR(2,I)= 0 SI C'EST UNE CONTRAINTE DE PASSAGE(G0) */
/*                            1 ........................DE PASSAGE ET */
/*                                                      DE TANGENCE (G1) 
*/
/*                            2 ....................... DE PASSAGE, */
/*                                                      C1, */
/*                                                      DE COURBURE (G2) 
*/


/*       TPOSPT: TABLE DONNANT LA POSITION DES POINTS PAR RAPPORT */
/*               A L'ELEMENT DE DECOUPE */
/*               SI   U(e-1) <=TPARAM(I)< U(e) ALORS TPOSPT(I)=e */



/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*       TASEMH(E,I): CONTIENT L'INDICE GLOBAL PERMETTANT D'ASSEMBLER */
/*                    LA MATRICE HESSIENNE POUR LA PREMIERE COMPOSANTE */
/*                   E: EST LE NUMERO DE L'ELEMENT */
/*                   SI I<=2*ORDHER+2 ALORS I EST L'INDICE LOCAL */
/*                   DU DEGRE DE LIBERTE ASSOCIE AUX ELEMENTS DE LA */
/*                   BASE HERMITE */

/*                   SI  2*ORDHER+2 <I<=NCOEFS ALORS I EST L'INDICE LOCAL 
*/
/*                   DU DEGRE DE LIBERTE ASSOCIE AUX ELEMENTS DE LA */
/*                   BASE JACOBI */

/*       TASEMG(K,I,J): CONTIENT L'INDICE GLOBAL PERMETTANT D'ASEMBLER */
/*                      LA MATRICE DES CONTRAINTES */
/*                     K=1,NDIMEN */
/*                     I=0 ..... CONTRAINTE DE PASSAGE */
/*                     I=1 ................... TANGENCE */
/*                     I=2 ................... COURBURE */
/*                     I=3 ................... C1 */
/*                     J=1,NPCONT */
/*       HDECAL : DECALAGE PERMETTANT DE CALCULER LES INDICES GLOBAUX */
/*                POUR L'ASSEMBLAGE DE LA MATRICE HESSIENNE POUR LES */
/*                AUTRES COMPOSANTES */
/*       HDIMEN : NOMBRE DE LIGNE(OU COLONNE) DE LA MATRICE HESSIENNE */
/*       GDIMEN : NOMBRE DE LIGNE DE LA MATRICE */
/*                DES CONTRAINTES */

/*       IERCOD: CODE D'ERREUR */
/*               0 SI OK */
/*               >0 SI ERREUR */
/*     COMMONS UTILISES : */
/*     ------------------ */


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


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


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



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

    /* Parameter adjustments */
    --tpospt;
    tasemg_dim1 = *ndimen;
    tasemg_offset = (tasemg_dim1 << 2) + 1;
    tasemg -= tasemg_offset;
    tasemh_dim1 = *ndecop;
    tasemh_offset = tasemh_dim1 + 1;
    tasemh -= tasemh_offset;
    tcontr -= 3;

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

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

    if (*ndimen < 2 || *ndimen > 3) {
	goto L9101;
    }


/*     INITIALISATION DE ASSEMG ET DES VARIABLES AUXILIAIRES */


    i__1 = *ndimen;
    for (i__ = 1; i__ <= i__1; ++i__) {
	for (j = 0; j <= 3; ++j) {
	    i__2 = *npcont;
	    for (k = 1; k <= i__2; ++k) {
		tasemg[i__ + (j + (k << 2)) * tasemg_dim1] = -1;
	    }
	}
    }
    aux1 = *ordher + 1;
    aux2 = aux1 + 1;
    aux3 = aux1 << 1;
    aux4 = aux3 + 1;


/*    REMPLISSAGE  TASEMH */

/*    POUR UNE COMPOSANTE */

    indglo = 0;
    i__1 = *ndecop;
    for (e = 1; e <= i__1; ++e) {

/*       REMPLIR TASEMH */


	if (e == 1) {
	    i__2 = aux1;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		++indglo;
		tasemh[e + i__ * tasemh_dim1] = indglo;
	    }
	} else {
	    i__2 = aux1;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		tasemh[e + i__ * tasemh_dim1] = tasemh[e - 1 + (i__ + aux1) * 
			tasemh_dim1];
	    }
	}
	i__2 = *ncoefs;
	for (i__ = aux4; i__ <= i__2; ++i__) {
	    ++indglo;
	    tasemh[e + i__ * tasemh_dim1] = indglo;
	}
	i__2 = aux3;
	for (i__ = aux2; i__ <= i__2; ++i__) {
	    ++indglo;
	    tasemh[e + i__ * tasemh_dim1] = indglo;
	}
    }
    *hdecal = indglo;


/*      REMPLIR UNE PARTIE DE TASEMG : CAS DES CONTRAINTES DE PASSAGE */
/*      PUIS DES CONTRAINTES C1 */


    indglo = 0;

    i__1 = *ndecop;
    for (e = 1; e <= i__1; ++e) {
	i__2 = *npcont;
	for (j = 1; j <= i__2; ++j) {
	    if (tpospt[tcontr[(j << 1) + 1]] == e) {
		++indglo;
		tasemg[(j << 2) * tasemg_dim1 + 1] = indglo;
	    }
	}
	i__2 = *npcont;
	for (j = 1; j <= i__2; ++j) {
	    if (tcontr[(j << 1) + 2] >= 1 && tpospt[tcontr[(j << 1) + 1]] == 
		    e) {
		++indglo;
		tasemg[((j << 2) + 3) * tasemg_dim1 + 1] = indglo;
	    }
	}
    }



/*     REMPLISSAGE DE TASEMG (CONTRAINTES PASSAGES ET C1) */
/*                           POUR AUTRES COMPOSANTES */


    gdecal = indglo;

    i__1 = *ndimen;
    for (k = 2; k <= i__1; ++k) {
	i__ = k - 1;
	i__2 = *npcont;
	for (j = 1; j <= i__2; ++j) {
	    tasemg[k + (j << 2) * tasemg_dim1] = tasemg[i__ + (j << 2) * 
		    tasemg_dim1] + gdecal;
	    if (tasemg[i__ + ((j << 2) + 3) * tasemg_dim1] > 0) {
		tasemg[k + ((j << 2) + 3) * tasemg_dim1] = tasemg[i__ + ((j <<
			 2) + 3) * tasemg_dim1] + gdecal;
	    }
	}
    }


/*     REMPLIR TASEMG SUITE : POUR LES CONTRAINTES DE COURBURE */

    indglo = *ndimen * gdecal;

    i__1 = *npcont;
    for (j = 1; j <= i__1; ++j) {
	if (tcontr[(j << 1) + 2] == 2) {
	    i__2 = *ndimen - 1;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		++indglo;
		tasemg[i__ + ((j << 2) + 2) * tasemg_dim1] = indglo;
	    }
	}
    }

/*    CALCUL DE LA DIMMENSION DES  MATRICES DU SYSTEME */

    *hdimen = *hdecal * *ndimen;
    if (*npcont > 0) {
	*gdimen = indglo;
    } else {
	*gdimen = 0;
    }

    goto L9999;

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


L9101:
    *iercod = 1;
    goto L9999;


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

L9999:


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

