/* MRESOL.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 <MathBase.h>
#else 
#define  __MathBase_API
#endif
/* Table of constant values */

static integer c__100 = 100;

/* Subroutine */ __MathBase_API int mmresol_(hdimen, gdimen, hnstoc, gnstoc, mnstoc, matsyh, 
	matsyg, vecsyh, vecsyg, hposit, hposui, gposit, mmposui, mposit, 
	vecsol, iercod)
integer *hdimen, *gdimen, *hnstoc, *gnstoc, *mnstoc;
doublereal *matsyh, *matsyg, *vecsyh, *vecsyg;
integer *hposit, *hposui, *gposit, *mmposui, *mposit;
doublereal *vecsol;
integer *iercod;
{
    /* System generated locals */
    integer i__1, i__2;

    /* Local variables */
    static logical ldbg;
    static doublereal mcho[100];
    static integer jmin, jmax, i__, j, k, l;
    static long int iofv1, iofv2, iofv3, iofv4;
    static doublereal v1[100], v2[100], v3[100], v4[100];
    static integer deblig, dimhch;
    static doublereal hchole[100];
    static long int iofmch, iofmam, iofhch;
    static doublereal matsym[100];
    extern /* Subroutine */ int macrar8_(), macrdr8_();
    static integer ier;
    extern integer mnfndeb_();
    static integer aux;
    extern /* Subroutine */ int mmchole_(), maermsg_(), mmatvec_(), mgenmsg_()
	    , mswrdbg_(), mmtmave_(), mgsomsg_(), mvriraz_(), mmrslss_();



/* < */
/* **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 : */
/*     ---------- */
/*       RESOLUTION DU SYSTEME */
/*       H  t(G)   V     B */
/*                    = */
/*       G    0    L     C */

/*     MOTS CLES : */
/*     ----------- */
/*      RESERVE, RESOLUTION, SYSTEME, LAGRANGIEN */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*      HDIMEN: NOMBRE DE LIGNE(OU COLONNE) DE LA MATRICE HESSIENNE */
/*      GDIMEN: NOMBRE DE LIGNE DE LA MATRICE DES CONTRAINTES */
/*      HNSTOC: NOMBRES DE TERMES DANS LE PROFIL DE LA MATRICE HESSIENNE 
*/
/*      GNSTOC: NOMBRES DE TERMES DANS LE PROFIL DE LA MATRICE DES */
/*              CONTRAINTES */
/*      MNSTOC: NOMBRES DE TERMES DANS LE PROFIL DE LA MATRICE */
/*              M= G H t(G) */
/*              ou H EST LA MATRICE HESSIENNE ET G LA MATRICE DES */
/*              CONTRAINTES */
/*      MATSYH: PARTIE TRIANGULAIRE INFERIEUR DE LA MATRICE */
/*              HESSIENNE SOUS FORME DE PROFIL */
/*      MATSYG: MATRICE DES CONTRAINTES SOUS FORME DE PROFIL */
/*      VECSYH: VECTEUR DU SECOND MEMBRE ASSOCIE A MATSYH */
/*      VECSYG: VECTEUR DU SECOND MEMBRE ASSOCIE A MATSYG */
/*      HPOSIT: TABLE DE POSITIONNEMENT DE LA MATRICE HESSIENNE */
/*              HPOSIT(1,I) CONTIENT LE NOMBRE DE TERMES -1 */
/*              QUI SONT DANS LE PROFIL A LA LIGNE I */
/*              HPOSIT(2,I) CONTIENT L'INDICE DE STOCKAGE DU TERME */
/*              DIAGNALE DE LA MATRICE A LA LIGNE I */
/*      HPOSUI: TABLE PERMETTANT DE BALAYER EN COLONNE LA MATRICE */
/*              HESSIENNE SOUS FORME DE PROFIL */
/*             HPOSUI(K) CONTIENT LE NUMERO DE LIGNE IMIN SUIVANT  LA LIGN
E*/
/*              COURANT I OU H(I,J)=MATSYH(K) TEL QUE IL EXISTE DANS LA */
/*              MEME COLONNE J UN TERME DANS LE PROFIL DE LA LIGNE IMIN */
/*              SI UN TEL TERME N'EXISTE PAS IMIN=-1 */
/*      GPOSIT: TABLE DE POSITIONNEMENT DE LA MATRICE DES CONTRAINTES */
/*              GPOSIT(1,I) CONTIENT LE NOMBRE DE TERMES DE LA LIGNE I */
/*                          QUI SONT DANS LE PROFIL */
/*              GPOSIT(2,I) CONTIENT L'INDICE DE STOKAGE DU DERNIER TERME 
*/
/*                          DE LA LIGNE I QUI EST DANS LE PROFIL */
/*              GPOSIT(3,I) CONTIENT LE NUMERO DE COLONNE CORRESPONDANT */
/*                          AU PREMIER TERME DE LA LIGNE I QUI EST DANS */
/*                          LE PROFIL */
/*      MMPOSUI, MPOSIT: MEME STRUCTURE QUE HPOSUI, MAIS POUR LA MATRICE 
*/
/*              M=G H t(G) */


/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*       VECSOL: VECTEUR SOLUTION V DU SYSTEME */
/*       IERCOD: CODE D'ERREUR */

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


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


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


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










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

    /* Parameter adjustments */
    --vecsol;
    hposit -= 3;
    --vecsyh;
    --hposui;
    --matsyh;
    --matsyg;
    --vecsyg;
    gposit -= 4;
    --mmposui;
    mposit -= 3;

    /* Function Body */
    ldbg = mnfndeb_() >= 2;
    if (ldbg) {
	mgenmsg_("MMRESOL", 7L);
    }
    *iercod = 0;
    iofhch = 0;
    iofv1 = 0;
    iofv2 = 0;
    iofv3 = 0;
    iofv4 = 0;
    iofmam = 0;
    iofmch = 0;

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

/*     Allocation dynamique */

    macrar8_(hdimen, &c__100, v1, &iofv1, &ier);
    if (ier > 0) {
	goto L9102;
    }
    dimhch = hposit[(*hdimen << 1) + 2];
    macrar8_(&dimhch, &c__100, hchole, &iofhch, &ier);
    if (ier > 0) {
	goto L9102;
    }

/*   RESOL DU SYST 1     H V1 = b */
/*     ou H=MATSYH  et b=VECSYH */

    mmchole_(hnstoc, hdimen, &matsyh[1], &hposit[3], &hposui[1], &hchole[
	    iofhch], &ier);
    if (ier > 0) {
	goto L9101;
    }
    mmrslss_(hnstoc, hdimen, &hchole[iofhch], &hposit[3], &hposui[1], &vecsyh[
	    1], &v1[iofv1], &ier);
    if (ier > 0) {
	goto L9102;
    }

/*     CAS OU IL Y A DES CONTRAINTES */

    if (*gdimen > 0) {

/*    CALCUL LE VECTEUR DU SECOND MEMBRE V2=G H(-1) b -c = G v1-c */
/*    DU SYSTEME D'INCONNU LE VECTEUR MULTIP DE LAGRANGE */
/*    ou G=MATSYG */
/*       c=VECSYG */

	macrar8_(gdimen, &c__100, v2, &iofv2, &ier);
	if (ier > 0) {
	    goto L9102;
	}
	macrar8_(hdimen, &c__100, v3, &iofv3, &ier);
	if (ier > 0) {
	    goto L9102;
	}
	macrar8_(gdimen, &c__100, v4, &iofv4, &ier);
	if (ier > 0) {
	    goto L9102;
	}
	macrar8_(mnstoc, &c__100, matsym, &iofmam, &ier);
	if (ier > 0) {
	    goto L9102;
	}

	deblig = 1;
	mmatvec_(gdimen, hdimen, &gposit[4], gnstoc, &matsyg[1], &v1[iofv1], &
		deblig, &v2[iofv2], &ier);
	if (ier > 0) {
	    goto L9101;
	}
	i__1 = *gdimen;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    v2[i__ + iofv2 - 1] -= vecsyg[i__];
	}

/*     CALCUL de la matrice M= G H(-1) t(G) */
/*     RESOL DU SYST 2 : H qi = gi */
/*             ou gi est un vecteur colonne de t(G) */
/*                qi=v3 */
/*            puis calcul G qi */
/*            puis construire M sous forme de profil */



	i__1 = *gdimen;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    mvriraz_(hdimen, &v1[iofv1]);
	    mvriraz_(hdimen, &v3[iofv3]);
	    mvriraz_(gdimen, &v4[iofv4]);
	    jmin = gposit[i__ * 3 + 3];
	    jmax = gposit[i__ * 3 + 1] + gposit[i__ * 3 + 3] - 1;
	    aux = gposit[i__ * 3 + 2] - gposit[i__ * 3 + 1] - jmin + 1;
	    i__2 = jmax;
	    for (j = jmin; j <= i__2; ++j) {
		k = j + aux;
		v1[j + iofv1 - 1] = matsyg[k];
	    }
	    mmrslss_(hnstoc, hdimen, &hchole[iofhch], &hposit[3], &hposui[1], 
		    &v1[iofv1], &v3[iofv3], &ier);
	    if (ier > 0) {
		goto L9101;
	    }

	    deblig = i__;
	    mmatvec_(gdimen, hdimen, &gposit[4], gnstoc, &matsyg[1], &v3[
		    iofv3], &deblig, &v4[iofv4], &ier);
	    if (ier > 0) {
		goto L9101;
	    }

	    k = mposit[(i__ << 1) + 2];
	    matsym[k + iofmam - 1] = v4[i__ + iofv4 - 1];
	    while(mmposui[k] > 0) {
		l = mmposui[k];
		k = mposit[(l << 1) + 2] - l + i__;
		matsym[k + iofmam - 1] = v4[l + iofv4 - 1];
	    }
	}


/*    RESOL SYST 3  M L = V2 */
/*     AVEC L=V4 */


	mvriraz_(gdimen, &v4[iofv4]);
	macrar8_(mnstoc, &c__100, mcho, &iofmch, &ier);
	if (ier > 0) {
	    goto L9102;
	}
	mmchole_(mnstoc, gdimen, &matsym[iofmam], &mposit[3], &mmposui[1], &
		mcho[iofmch], &ier);
	if (ier > 0) {
	    goto L9101;
	}
	mmrslss_(mnstoc, gdimen, &mcho[iofmch], &mposit[3], &mmposui[1], &v2[
		iofv2], &v4[iofv4], &ier);
	if (ier > 0) {
	    goto L9102;
	}


/*    CALCUL LE VECTEUR DU SECOND MEMBRE DU SYSTEME  Hx = b - t(G) L 
*/
/*                                                      = V1 */

	mvriraz_(hdimen, &v1[iofv1]);
	mmtmave_(gdimen, hdimen, &gposit[4], gnstoc, &matsyg[1], &v4[iofv4], &
		v1[iofv1], &ier);
	if (ier > 0) {
	    goto L9101;
	}
	i__1 = *hdimen;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    v1[i__ + iofv1 - 1] = vecsyh[i__] - v1[i__ + iofv1 - 1];
	}

/*    RESOL SYST 4   Hx = b - t(G) L */


	mmrslss_(hnstoc, hdimen, &hchole[iofhch], &hposit[3], &hposui[1], &v1[
		iofv1], &vecsol[1], &ier);
	if (ier > 0) {
	    goto L9102;
	}
    } else {
	i__1 = *hdimen;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    vecsol[i__] = v1[i__ + iofv1 - 1];
	}
    }

    goto L9999;

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


L9101:
    *iercod = 1;
    goto L9999;

L9102:
    mswrdbg_("MMRESOL : PROBLEME AVEC DIMMAT", 30L);
    *iercod = 2;

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

L9999:

/* ___ DESALLOCATION, ... */
    macrdr8_(hdimen, &c__100, v1, &iofv1, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(&dimhch, &c__100, hchole, &iofhch, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(gdimen, &c__100, v2, &iofv2, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(hdimen, &c__100, v3, &iofv3, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(gdimen, &c__100, v4, &iofv4, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(mnstoc, &c__100, matsym, &iofmam, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(mnstoc, &c__100, mcho, &iofmch, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }

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

