/* MRSLW.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 mmrslw_(normax, nordre, ndimen, epspiv, abmatr, xmatri, 
	iercod)
integer *normax, *nordre, *ndimen;
doublereal *epspiv, *abmatr, *xmatri;
integer *iercod;
{
    /* System generated locals */
    integer abmatr_dim1, abmatr_offset, xmatri_dim1, xmatri_offset, i__1, 
	    i__2, i__3;
    doublereal d__1;

    /* Local variables */
    static integer kpiv;
    static doublereal pivot;
    static integer ii, jj, kk;
    static doublereal akj;
    extern /* Subroutine */ int maermsg_();



/* < */
/* **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 d' un systeme lineaire A.x = B de N equations a N */
/*  inconnues par la methode de Gauss (pivot partiel) ou : */
/*          A est une matrice NORDRE * NORDRE, */
/*          B est une matrice NORDRE (lignes) * NDIMEN (colonnes), */
/*          x est une matrice NORDRE (lignes) * NDIMEN (colonnes). */
/*  Dans ce programme, A et B sont stockes dans la matrice ABMATR dont */
/*  les lignes et les colonnes ont ete inversees. ABMATR(k,j) est le */
/*  terme A(j,k) si k <= NORDRE, B(j,k-NORDRE) sinon (cf. exemple). */

/*     MOTS CLES : */
/*     ----------- */
/* TOUS, MATH_ACCES::EQUATION&, MATRICE&, RESOLUTION, GAUSS, &SOLUTION */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*   NORMAX : Taille maximale du premier indice de XMATRI. Cet argument */
/*            ne sert que pour la declaration de dimension de XMATRI et */
/*            doit etre superieur ou egal a NORDRE. */
/*   NORDRE :  Ordre de la matrice i.e. nombre d'equations et */
/*             d'inconnues du systeme lineaire a resoudre. */
/*   NDIMEN : Nombre de second membre. */
/*   EPSPIV : Valeur minimale d'un pivot. Si au cours du calcul la */
/*            valeur absolue du pivot est inferieure a EPSPIV, le */
/*            systeme d'equations est declare singulier. EPSPIV doit */
/*            etre un "petit" reel. */

/*   ABMATR(NORDRE+NDIMEN,NORDRE) : Matrice auxiliaire contenant la */
/*                                  matrice A et la matrice B. */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*   XMATRI : Matrice contenant les NORDRE*NDIMEN solutions. */
/*   IERCOD=0 indique que toutes les solutions sont calculees. */
/*   IERCOD=1 indique que la matrice est de rang inferieur a NORDRE */
/*            (le systeme est singulier). */

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

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

/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*     ATTENTION : les indices de ligne et de colonne sont inverses */
/*                 par rapport aux indices habituels. */
/*                 Le systeme : */
/*                        a1*x + b1*y = c1 */
/*                        a2*x + b2*y = c2 */
/*                 doit etre represente par la matrice ABMATR : */

/*                 ABMATR(1,1) = a1  ABMATR(1,2) = a2 */
/*                 ABMATR(2,1) = b1  ABMATR(2,2) = b2 */
/*                 ABMATR(3,1) = c1  ABMATR(3,2) = c2 */

/*     Pour resoudre ce systeme, il faut poser: */

/*                 NORDRE = 2 (il y a 2 equations a 2 inconnues), */
/*                 NDIMEN = 1 (il y a un seul second membre), */
/*                 NORMAX peut etre pris quelconque >= NORDRE. */

/*     Pour utiliser cette routine, il est conseille de se */
/*     servir de l'une des interfaces : MMRSLWI ou de MMMRSLWD. */

/*     HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*    24-11-1995 : JPI ; annulation des modifs concernant la factorisation
*/
/*                        de 1/PIVOT (Pb numerique) */
/*     08-09-1995 : JMF ; performances */
/*     06-04-1990 : RBD ; Ajout commentaires et Implicit none. */
/*     22-02-1988 : JJM ; Appel MFNDEB -> MNFNDEB */
/*     22-02-1988 : JJM ; Appel GERMSG -> MAERMSG */
/*     21-09-1987 : creation de la matrice unique ABMATR et des */
/*                  interfaces MMRSLWI et MMMRSLWD (RBD). */
/*     01-07-1987 : Cree par R. Beraud. */
/* > */
/* ********************************************************************** 
*/

/*   Le nom de la routine */

/*      INTEGER IBB,MNFNDEB */

/*      IBB=MNFNDEB() */
/*      IF (IBB.GE.2) CALL MGENMSG(NOMPR) */
    /* Parameter adjustments */
    xmatri_dim1 = *normax;
    xmatri_offset = xmatri_dim1 + 1;
    xmatri -= xmatri_offset;
    abmatr_dim1 = *nordre + *ndimen;
    abmatr_offset = abmatr_dim1 + 1;
    abmatr -= abmatr_offset;

    /* Function Body */
    *iercod = 0;

/* ********************************************************************* 
*/
/*                  Triangulation de la matrice ABMATR. */
/* ********************************************************************* 
*/

    i__1 = *nordre;
    for (kk = 1; kk <= i__1; ++kk) {

/* ---------- Recherche du pivot maxi sur la colonne KK. ------------
--- */

	pivot = *epspiv;
	kpiv = 0;
	i__2 = *nordre;
	for (jj = kk; jj <= i__2; ++jj) {
	    akj = (d__1 = abmatr[kk + jj * abmatr_dim1], abs(d__1));
	    if (akj > pivot) {
		pivot = akj;
		kpiv = jj;
	    }
/* L100: */
	}
	if (kpiv == 0) {
	    goto L9900;
	}

/* --------- Permutation de la ligne KPIV et avec la ligne KK. ------
--- */

	if (kpiv != kk) {
	    i__2 = *nordre + *ndimen;
	    for (jj = kk; jj <= i__2; ++jj) {
		akj = abmatr[jj + kk * abmatr_dim1];
		abmatr[jj + kk * abmatr_dim1] = abmatr[jj + kpiv * 
			abmatr_dim1];
		abmatr[jj + kpiv * abmatr_dim1] = akj;
/* L200: */
	    }
	}

/* -------------------- Elimination et triangularisation. -----------
--- */

	pivot = -abmatr[kk + kk * abmatr_dim1];
	i__2 = *nordre;
	for (ii = kk + 1; ii <= i__2; ++ii) {
	    akj = abmatr[kk + ii * abmatr_dim1] / pivot;
	    i__3 = *nordre + *ndimen;
	    for (jj = kk + 1; jj <= i__3; ++jj) {
		abmatr[jj + ii * abmatr_dim1] += akj * abmatr[jj + kk * 
			abmatr_dim1];
/* L400: */
	    }
/* L300: */
	}


/* L1000: */
    }

/* ********************************************************************* 
*/
/*          Resolution du systeme d'equations triangulaires. */
/*   La matrice ABMATR(NORDRE+JJ,II), contient les second membres du */
/*             systeme pour 1<=j<=NDIMEN et 1<=i<=NORDRE. */
/* ********************************************************************* 
*/


/* ---------------- Calcul des solutions en remontant. ----------------- 
*/

    for (kk = *nordre; kk >= 1; --kk) {
	pivot = abmatr[kk + kk * abmatr_dim1];
	i__1 = *ndimen;
	for (ii = 1; ii <= i__1; ++ii) {
	    akj = abmatr[ii + *nordre + kk * abmatr_dim1];
	    i__2 = *nordre;
	    for (jj = kk + 1; jj <= i__2; ++jj) {
		akj -= abmatr[jj + kk * abmatr_dim1] * xmatri[jj + ii * 
			xmatri_dim1];
/* L800: */
	    }
	    xmatri[kk + ii * xmatri_dim1] = akj / pivot;
/* L700: */
	}
/* L600: */
    }
    goto L9999;

/* ------Si la valeur absolue de l' un des pivot est plus petit -------- 
*/
/* ------------ que EPSPIV: recuperation du code d' erreur. ------------ 
*/

L9900:
    *iercod = 1;



L9999:
    if (*iercod > 0) {
	maermsg_("MMRSLW ", iercod, 7L);
    }
/*      IF (IBB.GE.2) CALL MGSOMSG(NOMPR) */
 return 0 ;
} /* mmrslw_ */

