MINICERN/mathlib/gen/f/elmbak.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:34  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE ELMBAK(NM,LOW,IGH,A,INT,M,Z)
  11       INTEGER I,J,M,LA,MM,MP,NM,IGH,KP1,LOW,MP1
  12       REAL A(NM,IGH),Z(NM,M)
  13       REAL X
  14       INTEGER INT(IGH)
  15       LA = IGH - 1
  16       KP1 = LOW + 1
  17       IF (LA .LT. KP1) GO TO 200
  18       DO 140 MM = KP1, LA
  19          MP = LOW + IGH - MM
  20          MP1 = MP + 1
  21          DO 110 I = MP1, IGH
  22             X = A(I,MP-1)
  23             IF (X .EQ. 0.0) GO TO 110
  24             DO 100 J = 1, M
  25   100       Z(I,J) = Z(I,J) + X * Z(MP,J)
  26   110    CONTINUE
  27          I = INT(MP)
  28          IF (I .EQ. MP) GO TO 140
  29          DO 130 J = 1, M
  30             X = Z(I,J)
  31             Z(I,J) = Z(MP,J)
  32             Z(MP,J) = X
  33   130    CONTINUE
  34   140 CONTINUE
  35   200 RETURN
  36       END