C C ________________________________________________________ C | | C | FACTOR A SYMMETRIC BAND MATRIX WITHOUT PIVOTING | C | | C | INPUT: | C | | C | A --ARRAY CONTAINING DIAGONAL AND SUBDIAG- | C | ONAL BANDS FROM COEFFICIENT MATRIX | C | (LENGTH AT LEAST 4 + (H+1)N) | C | | C | LA --LEADING (ROW) DIMENSION OF ARRAY A | C | | C | N --DIMENSION OF MATRIX STORED IN A | C | | C | H --HALF BANDWIDTH | C | | C | OUTPUT: | C | | C | A --FACTORED MATRIX | C | | C | BUILTIN FUNCTIONS: ABS,MIN0 | C | PACKAGE SUBROUTINES: RPACK | C |________________________________________________________| C SUBROUTINE HFACT(A,LA,N,H) REAL A(1),Q,R,S,T INTEGER D,E,F,G,H,I,J,K,L,LA,M,N G = H + 1 F = LA*N + G K = H 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 IF ( LA .GT. G ) CALL RPACK(A,LA,G,N) F = 2 - G + G*N A(F+H) = 0. Q = 0. R = Q I = 0 J = 0 L = 0 C ------------------------ C |*** COMPUTE 1-NORM ***| C ------------------------ 40 L = L + 1 IF ( L .GT. N ) GOTO 80 D = J + G J = J + 1 E = J + MIN0(H,N-L) S = Q + ABS(A(J)) K = F 50 IF ( J .EQ. E ) GOTO 60 J = J + 1 T = ABS(A(J)) S = S + T A(K) = A(K+1) + T K = K + 1 GOTO 50 60 Q = A(F) IF ( R .LT. S ) R = S 70 IF ( J .EQ. D ) GOTO 40 J = J + 1 A(J) = 0. GOTO 70 80 J = 4 + G*N 90 A(J) = A(J-4) J = J - 1 IF ( J .GT. 4 ) GOTO 90 A(1) = 1232 A(2) = N A(3) = R A(4) = H I = 5 - G K = 0 C --------------------------- C |*** START ELIMINATION ***| C --------------------------- 100 K = K + 1 I = I + G IF ( K .EQ. N ) GOTO 140 M = MIN0(H,N-K) S = A(I) IF ( S .EQ. 0. ) GOTO 130 D = 0 E = I J = I 110 IF ( M .EQ. 0 ) GOTO 100 J = J + 1 T = A(J)/S D = D - H E = E + G M = M - 1 IF ( T .EQ. 0. ) GOTO 110 F = E + M C --------------------------- C |*** ELIMINATE BY ROWS ***| C --------------------------- DO 120 L = E,F 120 A(L) = A(L) - T*A(D+L) GOTO 110 130 A(1) = -1232 GOTO 100 140 IF ( A(I) .NE. 0. ) RETURN A(1) = -1232 RETURN END