MINICERN/mathlib/gen/f/combak.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 COMBAK(NM,LOW,IGH,AR,AI,INT,M,ZR,ZI)
  11       INTEGER I,J,M,LA,MM,MP,NM,IGH,KP1,LOW,MP1
  12       REAL AR(NM,IGH),AI(NM,IGH),ZR(NM,M),ZI(NM,M)
  13       REAL XR,XI
  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             XR = AR(I,MP-1)
  23             XI = AI(I,MP-1)
  24             IF (XR .EQ. 0.0 .AND. XI .EQ. 0.0) GO TO 110
  25             DO 100 J = 1, M
  26                ZR(I,J) = ZR(I,J) + XR * ZR(MP,J) - XI * ZI(MP,J)
  27                ZI(I,J) = ZI(I,J) + XR * ZI(MP,J) + XI * ZR(MP,J)
  28   100       CONTINUE
  29   110    CONTINUE
  30          I = INT(MP)
  31          IF (I .EQ. MP) GO TO 140
  32          DO 130 J = 1, M
  33             XR = ZR(I,J)
  34             ZR(I,J) = ZR(MP,J)
  35             ZR(MP,J) = XR
  36             XI = ZI(I,J)
  37             ZI(I,J) = ZI(MP,J)
  38             ZI(MP,J) = XI
  39   130    CONTINUE
  40   140 CONTINUE
  41   200 RETURN
  42       END