MINICERN/mathlib/gen/f/cbabk2.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 CBABK2(NM,N,LOW,IGH,SCALE,M,ZR,ZI)
  11       INTEGER I,J,K,M,N,II,NM,IGH,LOW
  12       REAL SCALE(N),ZR(NM,M),ZI(NM,M)
  13       REAL S
  14       IF (IGH .EQ. LOW) GO TO 120
  15       DO 110 I = LOW, IGH
  16          S = SCALE(I)
  17          DO 100 J = 1, M
  18             ZR(I,J) = ZR(I,J) * S
  19             ZI(I,J) = ZI(I,J) * S
  20   100    CONTINUE
  21   110 CONTINUE
  22   120 DO 140 II = 1, N
  23          I = II
  24          IF (I .GE. LOW .AND. I .LE. IGH) GO TO 140
  25          IF (I .LT. LOW) I = LOW - II
  26          K = SCALE(I)
  27          IF (K .EQ. I) GO TO 140
  28          DO 130 J = 1, M
  29             S = ZR(I,J)
  30             ZR(I,J) = ZR(K,J)
  31             ZR(K,J) = S
  32             S = ZI(I,J)
  33             ZI(I,J) = ZI(K,J)
  34             ZI(K,J) = S
  35   130    CONTINUE
  36   140 CONTINUE
  37       RETURN
  38       END