C
C      ________________________________________________________
C     |                                                        |
C     |                 BALANCE A REAL MATRIX                  |
C     |                                                        |
C     |    INPUT:                                              |
C     |                                                        |
C     |         A     --REAL ARRAY CONTAINING MATRIX           |
C     |                                                        |
C     |         LA    --LEADING (ROW) DIMENSION OF ARRAY A     |
C     |                                                        |
C     |         N     --DIMENSION OF MATRIX STORED IN A        |
C     |                                                        |
C     |         W     --WORK ARRAY (LENGTH AT LEAST 2N)        |
C     |                                                        |
C     |    OUTPUT:                                             |
C     |                                                        |
C     |         A     --BALANCED ARRAY                         |
C     |                 (NEW A = D TIMES OLD A TIMES D SUP -1) |
C     |                                                        |
C     |         D     --ARRAY STORING DIAGONAL OF D MATRIX     |
C     |                                                        |
C     |   BUILTIN FUNCTIONS: ABS,ALOG                          |
C     |________________________________________________________|
C
      SUBROUTINE BAL(A,LA,N,D,W)
      INTEGER I,J,K,L,LA,M,N
      REAL A(LA,1),D(1),W(1),B,C,Q,R,S,T
C     ------------------------------
C     |*** COMPUTE MACHINE BASE ***|
C     ------------------------------
      T = 1.
10    T = T + T
      IF ( (1.+T)-T .EQ. 1. ) GOTO 10
      B = 0.
20    B = B + 1
      IF ( T+B .EQ. T ) GOTO 20
      IF ( T+2.*B .GT. T+B ) GOTO 30
      B = B + B
30    Q = ALOG(B)
      Q = .5/Q
      DO 40 I = 1,N
           D(I) = 1.
           W(I) = 1.
40         W(I+N) = 0.
C     --------------------------
C     |*** COMPUTE ROW SUMS ***|
C     --------------------------
      M = N + 1
      L = N + N
      DO 50 J = 1,N
           DO 50 I = M,L
50              W(I) = W(I) + ABS(A(I-N,J))
C     ------------------------------------------------------
C     |*** BALANCE THE MATRIX USING THE EISPACK ROUTINE ***|
C     ------------------------------------------------------
60    L = 0
      DO  110 J = 1,N
           C = 0.
           DO 70 I = 1,N
                S = A(I,J)*W(I)
                A(I,J) = S
70              C = C + ABS(S)
           IF ( C .EQ. 0. ) GOTO 110
           R = W(J+N)
           IF ( R .LE. 0. ) GOTO 110
           S = .5 + Q*ALOG(C/R)
           IF ( S .LT. 0. ) GOTO 80
           I = S
           IF ( I .EQ. S ) I = I - 1
           GOTO 90
80         I = S - 1
90         T = B**I
           S = 1./T
           W(J) = 1.
           IF ( T*R+S*C .GT. .95*(R+C) ) GOTO 110
           L = 1
           W(J) = T
           D(J) = D(J)*S
           DO 100 I = 1,N
                R = A(I,J)
                C = R*S
                K = I + N
                W(K) = (W(K)-ABS(R)) + ABS(C)
100             A(I,J) = C
           W(J+N) = T*W(J+N)
110   CONTINUE
      IF ( L .EQ. 1 ) GOTO 60
      DO 120 J = 1,N
           DO 120 I = 1,N
120             A(I,J) = A(I,J)*W(I)
      RETURN
      END