MINICERN/mathlib/gen/f/elmhes.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 ELMHES(NM,N,LOW,IGH,A,INT)
  11       INTEGER I,J,M,N,LA,NM,IGH,KP1,LOW,MM1,MP1
  12       REAL A(NM,N)
  13       REAL X,Y
  14       INTEGER INT(IGH)
  15       LA = IGH - 1
  16       KP1 = LOW + 1
  17       IF (LA .LT. KP1) GO TO 200
  18       DO 180 M = KP1, LA
  19          MM1 = M - 1
  20          X = 0.0
  21          I = M
  22          DO 100 J = M, IGH
  23             IF (ABS(A(J,MM1)) .LE. ABS(X)) GO TO 100
  24             X = A(J,MM1)
  25             I = J
  26   100    CONTINUE
  27          INT(M) = I
  28          IF (I .EQ. M) GO TO 130
  29          DO 110 J = MM1, N
  30             Y = A(I,J)
  31             A(I,J) = A(M,J)
  32             A(M,J) = Y
  33   110    CONTINUE
  34          DO 120 J = 1, IGH
  35             Y = A(J,I)
  36             A(J,I) = A(J,M)
  37             A(J,M) = Y
  38   120    CONTINUE
  39   130    IF (X .EQ. 0.0) GO TO 180
  40          MP1 = M + 1
  41          DO 160 I = MP1, IGH
  42             Y = A(I,MM1)
  43             IF (Y .EQ. 0.0) GO TO 160
  44             Y = Y / X
  45             A(I,MM1) = Y
  46             DO 140 J = M, N
  47   140       A(I,J) = A(I,J) - Y * A(M,J)
  48             DO 150 J = 1, IGH
  49   150       A(J,M) = A(J,M) + Y * A(J,I)
  50   160    CONTINUE
  51   180 CONTINUE
  52   200 RETURN
  53       END