C
C      ________________________________________________________
C     |                                                        |
C     |       FACTOR A BAND MATRIX WITH PARTIAL PIVOTING       |
C     |                                                        |
C     |    INPUT:                                              |
C     |                                                        |
C     |         A     --ARRAY CONTAINING MATRIX BANDS          |
C     |                 (LENGTH AT LEAST 5 + (2L+U+2)N)        |
C     |                                                        |
C     |         LA    --LEADING (ROW) DIMENSION OF ARRAY A     |
C     |                                                        |
C     |         N     --MATRIX DIMENSION                       |
C     |                                                        |
C     |         L     --NUMBER OF BANDS BELOW DIAGONAL         |
C     |                                                        |
C     |         U     --NUMBER OF BANDS ABOVE DIAGONAL         |
C     |                                                        |
C     |    OUTPUT:                                             |
C     |                                                        |
C     |         A     --FACTORED MATRIX                        |
C     |                                                        |
C     |    BUILTIN FUNCTIONS: ABS,MIN0                         |
C     |    PACKAGE SUBROUTINES: RPACK                          |
C     |________________________________________________________|
C
      SUBROUTINE BFACT(A,LA,N,L,U)
      REAL A(1),S,T,V
      INTEGER C,D,E,F,G,H,I,J,K,L,LA,M,N,O,P,Q,R,U
      P = 1 + L
      C = P + U
      F = LA*N + C
      K = L
C     -----------------------------------------
C     |*** PUT ZEROS IN LOWER RIGHT CORNER ***|
C     -----------------------------------------
10    IF ( K .EQ. 0 ) GOTO 30
      F = F - LA
      I = F
      J = F - K
      K = K - 1
20    A(I) = 0.
      I = I - 1
      IF ( I .GT. J ) GOTO 20
      GOTO 10
30    F = LA*N
      K = U
C     -----------------------------------------
C     |*** PUT ZEROS IN UPPER RIGHT CORNER ***|
C     -----------------------------------------
40    IF ( K .EQ. 0 ) GOTO 60
      F = F - LA
      I = F
      J = F + K
      K = K - 1
50    I = I + 1
      A(I) = 0.
      IF ( I .LT. J ) GOTO 50
      GOTO 40
60    IF ( C .LT. LA ) CALL RPACK(A,LA,C,N)
      IF ( U .EQ. 0 ) GOTO 100
C     -------------------------------------------------------
C     |*** MAKE COLUMNS OF ARRAY MATCH COLUMNS OF MATRIX ***|
C     -------------------------------------------------------
      Q = C + 1
      D = C - U
      J = N*C
      K = N
70    K = K - 1
      IF ( K .LT. 0 ) GOTO 100
      J = J - D
      I = J - C
      E = J - U
      F = J - MIN0(U,K)
80    IF ( J .EQ. F ) GOTO 90
      A(J) = A(I)
      I = I - Q
      J = J - 1
      GOTO 80
90    IF ( J .EQ. E ) GOTO 70
      A(J) = 0.
      J = J - 1
      GOTO 90
C     -------------------------------------------
C     |*** INSERT BANDS NEEDED FOR ROW SWAPS ***|
C     |          COMPUTE MATRIX 1-NORM          |
C     -------------------------------------------
100   V = 0.
      E = C + P
      K = N
      J = 5 + E*N
      I = C*N - J
110   IF ( J .EQ. 5 ) GOTO 150
      S = 0.
      F = J - C
120   T = A(I+J)
      A(J) = T
      S = S + ABS(T)
      J = J - 1
      IF ( J .GT. F ) GOTO 120
      IF ( V .LT. S ) V = S
      I = I + P
      F = F - L
130   IF ( J .EQ. F ) GOTO 140
      A(J) = 0.
      J = J - 1
      GOTO 130
140   A(J) = K
      K = K - 1
      J = J - 1
      GOTO 110
150   A(1) = 1231
      A(2) = N
      A(3) = V
      A(4) = L
      A(5) = U
      I = 5 - L
      IF ( L .EQ. 0 ) GOTO 230
      C = C + L
      D = L + U
      R = P + U
C     ---------------------------
C     |*** START ELIMINATION ***|
C     ---------------------------
      K = 0
160   K = K + 1
      I = I + E
      IF ( K .EQ. N ) GOTO 260
      M = I + 1
      Q = I
      O = MIN0(L,N-K)
      P = I + O
C     ---------------------------------------
C     |*** FIND PIVOT AND START ROW SWAP ***|
C     ---------------------------------------
      DO 170 J = M,P
170        IF ( ABS(A(J)) .GT. ABS(A(Q)) ) Q = J
      J = I - R
      H = Q - I
      A(J) = K + H
      T = A(Q)
      IF ( T .EQ. 0. ) GOTO 220
      A(Q) = A(I)
      A(I) = T
C     -----------------------------
C     |*** COMPUTE MULTIPLIERS ***|
C     -----------------------------
      DO 180 J = M,P
180        A(J) = A(J)/T
      F = I + C*MIN0(D,N-K)
      G = C - O
190   M = P + G
      P = M + H
      T = A(P)
      A(P) = A(M)
      A(M) = T
      P = M + O
      IF ( T .EQ. 0. ) GOTO 210
      Q = I - M
      M = M + 1
C     ------------------------------
C     |*** ELIMINATE BY COLUMNS ***|
C     ------------------------------
      DO 200 J = M,P
200        A(J) = A(J) - T*A(J+Q)
210   IF ( P .LT. F ) GOTO 190
      GOTO 160
220   A(1) = -1231
      GOTO 160
230   J = 5 + E*N
240   I = I + E
      IF ( A(I) .EQ. 0. ) GOTO 250
      IF ( I .LT. J ) GOTO 240
      RETURN
250   A(1) = -1231
      RETURN
260   IF ( A(I) .EQ. 0. ) GOTO 250
      RETURN
      END