MINICERN/mathlib/gen/f/comhes.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:33  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE COMHES(NM,N,LOW,IGH,AR,AI,INT)
  11       INTEGER I,J,M,N,LA,NM,IGH,KP1,LOW,MM1,MP1
  12       REAL AR(NM,N),AI(NM,N)
  13       REAL XR,XI,YR,YI
  14       INTEGER INT(IGH)
  15       COMPLEX X,Y
  16       REAL T1(2),T2(2)
  17       EQUIVALENCE (X,T1(1),XR),(T1(2),XI),(Y,T2(1),YR),(T2(2),YI)
  18       LA = IGH - 1
  19       KP1 = LOW + 1
  20       IF (LA .LT. KP1) GO TO 200
  21       DO 180 M = KP1, LA
  22          MM1 = M - 1
  23          XR = 0.0
  24          XI = 0.0
  25          I = M
  26          DO 100 J = M, IGH
  27             IF (ABS(AR(J,MM1)) + ABS(AI(J,MM1))
  28      X         .LE. ABS(XR) + ABS(XI)) GO TO 100
  29             XR = AR(J,MM1)
  30             XI = AI(J,MM1)
  31             I = J
  32   100    CONTINUE
  33          INT(M) = I
  34          IF (I .EQ. M) GO TO 130
  35          DO 110 J = MM1, N
  36             YR = AR(I,J)
  37             AR(I,J) = AR(M,J)
  38             AR(M,J) = YR
  39             YI = AI(I,J)
  40             AI(I,J) = AI(M,J)
  41             AI(M,J) = YI
  42   110    CONTINUE
  43          DO 120 J = 1, IGH
  44             YR = AR(J,I)
  45             AR(J,I) = AR(J,M)
  46             AR(J,M) = YR
  47             YI = AI(J,I)
  48             AI(J,I) = AI(J,M)
  49             AI(J,M) = YI
  50   120    CONTINUE
  51   130    IF (XR .EQ. 0.0 .AND. XI .EQ. 0.0) GO TO 180
  52          MP1 = M + 1
  53          DO 160 I = MP1, IGH
  54             YR = AR(I,MM1)
  55             YI = AI(I,MM1)
  56             IF (YR .EQ. 0.0 .AND. YI .EQ. 0.0) GO TO 160
  57             Y = Y / X
  58             AR(I,MM1) = YR
  59             AI(I,MM1) = YI
  60             DO 140 J = M, N
  61                AR(I,J) = AR(I,J) - YR * AR(M,J) + YI * AI(M,J)
  62                AI(I,J) = AI(I,J) - YR * AI(M,J) - YI * AR(M,J)
  63   140       CONTINUE
  64             DO 150 J = 1, IGH
  65                AR(J,M) = AR(J,M) + YR * AR(J,I) - YI * AI(J,I)
  66                AI(J,M) = AI(J,M) + YR * AI(J,I) + YI * AR(J,I)
  67   150       CONTINUE
  68   160    CONTINUE
  69   180 CONTINUE
  70   200 RETURN
  71       END