/* MRSLSS.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 */ 
#ifdef WNT
__declspec( dllexport ) 
#endif
int mmrslss_(mxcoef, dimens, smatri, sposit, posuiv, mscnmbr,
	 soluti, iercod)

integer *mxcoef, *dimens;
doublereal *smatri;
integer *sposit, *posuiv;
doublereal *mscnmbr, *soluti;
integer *iercod;
{
    /* System generated locals */
    integer i__1, i__2;

    /* Local variables */
    static logical ldbg;
    static integer i__, j;
    static doublereal somme;
    static integer pointe, ptcour;
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), 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 : */
/*     ----------                     T */
/*       Resoud le systeme lineaire SS x = b ou S est une matrice */
/*       triangulaire inferieure donnee sous forme profil */

/*     MOTS CLES : */
/*     ----------- */
/*     RESERVE, MATRICE_PROFILE, RESOLUTION, CHOLESKI */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*     MXCOEF  : Nombre maximal de coefficient non nuls dans la matrice */
/*     DIMENS  : Dimension de la matrice */
/*     SMATRI(MXCOEF) : Valeurs des coefficients de la matrice */
/*     SPOSIT(2,DIMENS): */
/*       SPOSIT(1,*) : Distance diagonnal-extrimite de la ligne */
/*       SPOSIT(2,*) : Position des termes diagonnaux dans AMATRI */
/*     POSUIV(MXCOEF): premiere ligne inferieure non hors profil */
/*     MSCNMBR(DIMENS): Vecteur second membre de l'equation */

/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*     SOLUTI(NDIMEN) : Vecteur resultat */
/*     IERCOD   : Code d'erreur 0  : ok */

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


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


/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*       T */
/*     SS  est la decomposition de choleski d'une matrice symetrique */
/*     definie postive, qui peut s'obtenir par la routine MMCHOLE. */

/*     Pour une matrice pleine on peut utiliser MRSLMSC */

/*     NIVEAU DE DEBUG = 4 */

/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     14-02-1994: PMN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */



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

    /* Parameter adjustments */
    --posuiv;
    --smatri;
    --soluti;
    --mscnmbr;
    sposit -= 3;

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

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

/* ----- Resolution de Sw = b */

    i__1 = *dimens;
    for (i__ = 1; i__ <= i__1; ++i__) {

	pointe = sposit[(i__ << 1) + 2];
	somme = 0.;
	i__2 = i__ - 1;
	for (j = i__ - sposit[(i__ << 1) + 1]; j <= i__2; ++j) {
	    somme += smatri[pointe - (i__ - j)] * soluti[j];
	}

	soluti[i__] = (mscnmbr[i__] - somme) / smatri[pointe];
    }
/*                     T */
/* ----- Resolution de S u = w */

    for (i__ = *dimens; i__ >= 1; --i__) {

	pointe = sposit[(i__ << 1) + 2];
	j = posuiv[pointe];
	somme = 0.;
	while(j > 0) {
	    ptcour = sposit[(j << 1) + 2] - (j - i__);
	    somme += smatri[ptcour] * soluti[j];
	    j = posuiv[ptcour];
	}

	soluti[i__] = (soluti[i__] - somme) / smatri[pointe];
    }

    goto L9999;

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


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

L9999:

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

