/* MTPOSI.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 mmtposi_(ndimen, npoint, nptcnt, ndecop, ordher, hdimen, 
	gdimen, ncoefs, tasemh, tasemg, tpospt, typcnt, hdecal, hposit, 
	gposit, mposit, hnstoc, mnstoc, gnstoc, iercod)
integer *ndimen, *npoint, *nptcnt, *ndecop, *ordher, *hdimen, *gdimen, *
	ncoefs, *tasemh, *tasemg, *tpospt, *typcnt, *hdecal, *hposit, *gposit,
	 *mposit, *hnstoc, *mnstoc, *gnstoc, *iercod;
{
    /* System generated locals */
    integer tasemh_dim1, tasemh_offset, tasemg_dim1, tasemg_offset, i__1, 
	    i__2, i__3;

    /* Local variables */
    static logical ldbg;
    static integer d__, e, decal, i__, k, l, lb, bid, ncc, ncp;
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_();
    static integer ncc1;
    extern /* Subroutine */ int 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 : */
/*     ---------- */
/*       REMPLISSAGE DES TABLES DE POSITIONNEMENT PERMETTANT LE STOCKAGE 
*/
/*       DES MATRICES SOUS FORME DE PROFIL */


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

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*       NDIMEN: DIMENSION DE L'ESPACE */
/*       NPOINT : NOMBRE DE POINTS */
/*       NPTCNT: NOMBRE DE POINTS CONTRAINTS */
/*       NDECOP: NOMBRE DE DECOUPE */
/*       ORDHER: ORDRE D'HERMITE (0..2) */
/*       DIMMAT: NOMBRE DE LIGNE DE LA MATRICE CARRE */
/*       NCOEFS: DEGRE+1 DE LA COURBE  POLYNOMIALE */
/*       TASEMH:TABLE D'ASSEMBLAGE DE LA MATRICE HESSIENNE */
/*       TASEMG: TABLED'ASSEMBLAGE DE LA MATRICE DES CONTRAINTES */
/*       TPOSPT: TABLE DONNANT LA POSITION SUR LE MAILLAGE DES */
/*               POINTS */
/*       TYPCNT: TABLE DONNANT L'INDICE ET LE TYPE DE */
/*               CONTRAINTES DES POINTS */
/*       HDECAL: DECALAGE PERMETTANT LE CALCUL LES INDICES GLOABUX */
/*               DE LA MATRICE HESSIENNE */


/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*       HPOSIT:HPOSIT(1,I) CONTIENT LE NOMBRE DE TERMES DANS LE PROFIL -1
 */
/*                          DE LA LIGNE I DE LA PARTIE TRIANGULAIRE */
/*                          INFERIEUR DE LA MATRICE HESSIENNE */
/*              HPOSIT(2,I) CONTIENT L'INDICE DE STOCKAGE DU TERME H(I,I) 
*/
/*                          DE LA MATRICE HESSIENNE */
/*       GPOSIT(3,GDIMEN): */
/*              GPOSIT(1,I) DONNE LE NOMBRE DE TERMES DANS LE PROFIL */
/*                           DE LA LIGNE I DE LA MATRICE (!NON SYMETRIQUE)
 */
/*                           DES CONTRAINTES */
/*               GPOSIT(2,I) CONTIENT L'INDICE DE STOCKAGE DU TERME G(I,I)
 */
/*                           DE LA MATRICE DES CONTRAINTES */
/*               GPOSIT(3,I) CONTIENT L'INDICE COLONNE DU PREMIER TERME */
/*                           DANS LE PROFIL DE LA MATRICE DES CONTRAINTES 
*/
/*                           A LA LIGNE I */
/*       MPOSIT(2,GDIMEN): */
/*              MPOSIT(1,I) CONTIENT LE NOMBRE DE TERMES DANS LE PROFIL -1
 */
/*                          DE LA LIGNE I DE LA PARTIE TRIANGULAIRE */
/*                          INFERIEUR DE LA MATRICE M= G H t(G) */
/*                          OU H EST LA MATRICE HESSIENNE */
/*                             G  ............. DES CONTRAINTES */
/*              MPOSIT(2,I)  HPOSIT(2,I) CONTIENT L'INDICE DE STOCKAGE DU 
*/
/*                           TERME H(I,I) */
/*                           DE LA MATRICE M */
/*       HNSTOC=NOMBRE D'INDICES DE STOCKAGE DE LA MATRICE HESSIENNE */
/*       GNSTOC=NOMBRE D'INDICES DE STOCKAGE DE LA MATRICE DES CONTRAINTES
 */
/*       MNSTOC=NOMBRE D'INDICES DE STOCKAGE DE LA MATRICE M */
/*     COMMONS UTILISES : */
/*     ------------------ */


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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     22-11-95 : PMN; La structure de H est creuse */
/*      9-10-95 : PMN; Elimination du G1 (devient C1) */
/*     22-08-95 : KHN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */



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

    /* Parameter adjustments */
    tasemg_dim1 = *ndimen;
    tasemg_offset = (tasemg_dim1 << 2) + 1;
    tasemg -= tasemg_offset;
    --tpospt;
    hposit -= 3;
    tasemh_dim1 = *ndecop;
    tasemh_offset = tasemh_dim1 + 1;
    tasemh -= tasemh_offset;
    typcnt -= 3;
    gposit -= 4;
    mposit -= 3;

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

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



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

    d__ = 0;
    l = 0;
    aux1 = *ordher + 1;
    aux2 = aux1 << 1;
    aux3 = aux2 + 1;
    aux4 = aux1 + 1;



    i__1 = *ndimen;
    for (k = 1; k <= i__1; ++k) {
	lb = -1;
	decal = *hdecal * (k - 1);

/*     CALCUL DE LA LARGEUR DE BANDE LB ET L'INDICE DE STOCKAGE D */
/*     POUR LE CAS  ELEMENT= 1 ET HERMITES GAUCHES */

	i__2 = aux1;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    l = tasemh[i__ * tasemh_dim1 + 1] + decal;
	    ++lb;
	    hposit[(l << 1) + 1] = lb;
	    d__ = d__ + lb + 1;
	    hposit[(l << 1) + 2] = d__;
	}


	i__2 = *ndecop;
	for (e = 1; e <= i__2; ++e) {

/*       CAS DES POLYS JACOBI */

	    i__3 = *ncoefs;
	    for (i__ = aux3; i__ <= i__3; ++i__) {
		l = tasemh[e + i__ * tasemh_dim1] + decal;
		++lb;
		hposit[(l << 1) + 1] = lb;
		d__ = d__ + lb + 1;
		hposit[(l << 1) + 2] = d__;
	    }

/*        CAS DES HERMITES A DROITE */

	    i__3 = aux2;
	    for (i__ = aux4; i__ <= i__3; ++i__) {
		l = tasemh[e + i__ * tasemh_dim1] + decal;
		++lb;
		hposit[(l << 1) + 1] = lb;
		d__ = d__ + lb + 1;
		hposit[(l << 1) + 2] = d__;
	    }
/*        On reinitialise la largeur de bande avant de passer */
/*        a l'element suivant */
	    lb = *ordher;
	}


    }

/*      REMPLISSAGE DE GPOSIT */
/*      CAS CONTRAINTES DE PASSAGE PUIS C1 */

    d__ = 0;
    ncc1 = 0;
    i__1 = *ndimen;
    for (k = 1; k <= i__1; ++k) {
	decal = (k - 1) * *hdecal;
	i__2 = *ndecop;
	for (e = 1; e <= i__2; ++e) {
	    i__3 = *nptcnt;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		if (tpospt[typcnt[(i__ << 1) + 1]] == e) {
		    l = tasemg[k + (i__ << 2) * tasemg_dim1];
		    gposit[l * 3 + 1] = *ncoefs;
		    d__ += *ncoefs;
		    gposit[l * 3 + 2] = d__;
		    gposit[l * 3 + 3] = tasemh[e + tasemh_dim1] + decal;
		}
	    }

/*      CAS DES CONTRAINTES C1 */

	    i__3 = *nptcnt;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		if (tpospt[typcnt[(i__ << 1) + 1]] == e) {
		    if (tasemg[k + ((i__ << 2) + 3) * tasemg_dim1] > 0) {
			l = tasemg[k + ((i__ << 2) + 3) * tasemg_dim1];
			gposit[l * 3 + 1] = *ncoefs;
			d__ += *ncoefs;
			gposit[l * 3 + 2] = d__;
			gposit[l * 3 + 3] = tasemh[e + tasemh_dim1] + decal;
			++ncc1;
		    }
		}
	    }
	}
    }


/*     CAS DES CONTRAINTES DE COURBURE */

    ncc = 0;


    i__1 = *ndecop;
    for (e = 1; e <= i__1; ++e) {
	i__2 = *nptcnt;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    if (tpospt[typcnt[(i__ << 1) + 1]] == e) {
		if (typcnt[(i__ << 1) + 2] == 2) {
		    lb = tasemh[e + aux2 * tasemh_dim1] + (*ndimen - 1) * *
			    hdecal - tasemh[e + tasemh_dim1] + 1;
		    i__3 = *ndimen - 1;
		    for (k = 1; k <= i__3; ++k) {
			l = tasemg[k + ((i__ << 2) + 2) * tasemg_dim1];
			d__ += lb;
			gposit[l * 3 + 1] = lb;
			gposit[l * 3 + 2] = d__;
			gposit[l * 3 + 3] = tasemh[e + tasemh_dim1];
			++ncc;
		    }
		}
	    }
	}

    }


/*     --- remplissage du profil */

    ncp = *ndimen * *nptcnt;
    bid = (ncp + ncc1) / *ndimen;
    d__ = 0;
    i__1 = *ndimen;
    for (k = 1; k <= i__1; ++k) {
	lb = -1;
	l = (k - 1) * bid;
	i__2 = bid;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    ++lb;
	    d__ = d__ + lb + 1;
	    mposit[((i__ + l) << 1) + 1] = lb;
	    mposit[((i__ + l) << 1) + 2] = d__;
	}
    }
    l = ncp + ncc1 + 1;
    i__1 = ncc + ncp + ncc1;
    for (i__ = l; i__ <= i__1; ++i__) {
	lb = i__ - 1;
	mposit[(i__ << 1) + 1] = lb;
	d__ = d__ + lb + 1;
	mposit[(i__ << 1) + 2] = d__;
    }

/*     Calcul des taille */

    *hnstoc = hposit[(*hdimen << 1) + 2];
    if (*gdimen > 0) {
	*gnstoc = gposit[*gdimen * 3 + 2];
	*mnstoc = mposit[(*gdimen << 1) + 2];
    } else {
	*gnstoc = 0;
	*mnstoc = 0;
    }

    goto L9999;

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


L9101:
    *iercod = 1;
    goto L9999;

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

L9999:

/* ___ DESALLOCATION, ... */

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

