C C ________________________________________________________ C | | C | FACTOR AN UPPER HESSENBERG MATRIX WITH PARTIAL PIVOTING| C | | C | INPUT: | C | | C | A --ARRAY CONTAINING MATRIX | C | (LENGTH AT LEAST 1 + N(N+5)/2) | C | | C | N --MATRIX DIMENSION | C | | C | OUTPUT: | C | | C | A --FACTORED MATRIX | C | | C | BUILTIN FUNCTIONS: ABS | C |________________________________________________________| C SUBROUTINE EFACT(A,N) REAL A(1),R,S,T INTEGER G,H,I,J,K,L,M,N G = (N*(N+1))/2 H = G + N + 1 M = 1 L = 2 J = 0 K = 1 R = 0. C --------------------------------------------- C |*** INSERT PIVOT ROW AND COMPUTE 1-NORM ***| C --------------------------------------------- 10 IF ( M .LT. G ) GOTO 20 IF ( M .GT. G ) GOTO 40 L = L - 1 20 S = 0. DO 30 I = M,L T = A(I) S = S + ABS(T) 30 A(I-J) = T IF ( S .GT. R ) R = S J = K K = K + 1 A(H+J) = T M = L + 1 L = M + K GOTO 10 40 G = G + 3 I = G + 1 J = H + 1 K = H + N 50 IF ( I .GT. K ) GOTO 60 A(I) = A(J) I = I + 2 J = J + 1 GOTO 50 60 I = G 70 A(I) = A(I-3) I = I - 1 IF ( I .GT. 3 ) GOTO 70 A(1) = 1237 A(2) = N A(3) = R K = N M = G L = G - N + 1 G = H + N - 1 80 IF ( K .EQ. 1 ) GOTO 140 J = K K = K - 1 S = A(M) T = A(G) IF ( ABS(S) .GE. ABS(T) ) GOTO 100 C -------------------------------------------- C |*** PIVOT AND PERFORM ELIMINATION STEP ***| C -------------------------------------------- A(M) = T T = S/T A(G) = T A(G+1) = 1. G = G - 2 L = L - K M = M - J DO 90 I = L,M H = I + K S = A(I) A(I) = A(H) - T*S 90 A(H) = S GOTO 80 C -------------------------- C |*** ELIMINATION STEP ***| C -------------------------- 100 IF ( S .EQ. 0. ) GOTO 130 T = T/S L = L - K M = M - J IF ( T .EQ. 0. ) GOTO 120 DO 110 I = L,M 110 A(I) = A(I) - T*A(I+K) 120 A(G) = T A(G+1) = 0. G = G - 2 GOTO 80 130 A(1) = -1237 GOTO 120 140 IF ( A(4) .EQ. 0. ) A(1) = -1237 RETURN END