MINICERN/mathlib/gen/f/balbak.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:32  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE BALBAK(NM,N,LOW,IGH,SCALE,M,Z)
  11       INTEGER I,J,K,M,N,II,NM,IGH,LOW
  12       REAL SCALE(N),Z(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   100    Z(I,J) = Z(I,J) * S
  19   110 CONTINUE
  20   120 DO 140 II = 1, N
  21          I = II
  22          IF (I .GE. LOW .AND. I .LE. IGH) GO TO 140
  23          IF (I .LT. LOW) I = LOW - II
  24          K = SCALE(I)
  25          IF (K .EQ. I) GO TO 140
  26          DO 130 J = 1, M
  27             S = Z(I,J)
  28             Z(I,J) = Z(K,J)
  29             Z(K,J) = S
  30   130    CONTINUE
  31   140 CONTINUE
  32       RETURN
  33       END