C C ________________________________________________________ C | | C | FACTOR A SYMMETRIC MATRIX WITH PARTIAL PIVOTING | C | | C | INPUT: | C | | C | A --ARRAY PACKED WITH ELEMENTS CONTAINED IN | C | EACH ROW OF COEFFICIENT MATRIX ON DIAG. | C | AND TO RIGHT(LENGTH AT LEAST 7+(N+7)N/2)| C | | C | N --MATRIX DIMENSION | C | | C | OUTPUT: | C | | C | A --FACTORED MATRIX | C | | C | BUILTIN FUNCTIONS: ABS | C | PACKAGE SUBROUTINES: PFACT | C |________________________________________________________| C SUBROUTINE IFACT(A,N) REAL A(1),R,S,T,U,V,W INTEGER B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q M = (N+N*N)/2 L = M + N I = M C ------------------------ C |*** COMPUTE 1-NORM ***| C ------------------------ 10 I = I + 1 A(I) = 0. IF ( I .LT. L ) GOTO 10 I = -L J = M K = M R = 0. S = 0. 20 I = I + L - K K = K + 1 J = K S = ABS(A(I+J)) 30 IF ( J .EQ. L ) GOTO 40 J = J + 1 T = ABS(A(I+J)) S = S + T A(J) = A(J) + T GOTO 30 40 S = S + A(K) IF ( R .LT. S ) R = S IF ( K .LT. L ) GOTO 20 J = M + 3 C ----------------------------------- C |*** SHIFT MATRIX DOWN 3 SLOTS ***| C ----------------------------------- 50 A(J) = A(J-3) J = J - 1 IF ( J .GT. 3 ) GOTO 50 A(1) = 1237 A(2) = N A(3) = R IF ( N .GT. 1 ) GOTO 60 A(9) = A(4) A(4) = 1235 A(5) = 1 A(6) = ABS(A(9)) IF ( A(9) .NE. 0. ) RETURN A(1) = -1237 A(4) = -1235 RETURN 60 IF ( N .EQ. 2 ) GOTO 250 E = 7 + (N*(N+5))/2 H = N K = 4 70 G = H - 1 D = N - G IF ( H .GT. 2 ) GOTO 80 C = 0 GOTO 150 80 L = K + G I = K + 1 P = I C ------------------------- C |*** DETERMINE PIVOT ***| C ------------------------- DO 90 J = I,L 90 IF ( ABS(A(J)) .GT. ABS(A(P)) ) P = J S = A(P) A(E+D) = D + P - K C = P - I IF ( S .EQ. 0. ) GOTO 150 IF ( C .EQ. 0 ) GOTO 130 A(P) = A(I) A(I) = S I = K + H + 1 L = I + C - 2 P = L + G IF ( I .GT. L ) GOTO 110 C ---------------------------------- C |*** PERMUTE ROWS AND COLUMNS ***| C ---------------------------------- O = G + I - 2 DO 100 J = I,L T = A(J) A(J) = A(P) A(P) = T 100 P = P + O - J 110 J = K + H T = A(J) A(J) = A(P) A(P) = T I = L + 2 L = K + G + G IF ( I .GT. L ) GOTO 130 O = (C*(G+G-C-1))/2 DO 120 J = I,L T = A(J) P = J + O A(J) = A(P) 120 A(P) = T 130 I = K + 2 L = K + G C ----------------------------- C |*** COMPUTE MULTIPLIERS ***| C ----------------------------- DO 140 J = I,L 140 A(J) = A(J)/S C ----------------------------------- C |*** EVALUATE DIAGONAL ELEMENT ***| C ----------------------------------- 150 Q = K + G + G P = K + H + 1 IF ( D .GT. 1 ) GOTO 160 W = A(K+H) O = -G GOTO 210 160 M = N - 1 V = A(K+H) T = 0. S = A(5) I = 4 J = 4 + D + C U = A(J) L = N IF ( H .EQ. 2 ) GOTO 230 170 I = I + L R = A(J) B = J - C O = B - P + 1 A(J) = A(B) A(B) = R J = J + M R = A(I+1) IF ( I .EQ. K ) GOTO 190 W = S*T + U*A(I) + A(J)*R DO 180 F = P,Q 180 A(F) = A(F) - W*A(F+O) V = V - U*W S = R T = U U = A(J) L = M M = M - 1 GOTO 170 190 W = S*T + U*A(I) + R DO 200 F = P,Q 200 A(F) = A(F) - W*A(F+O) W = V - U*W A(K+H) = W - U*R O = O + H 210 DO 220 F = P,Q 220 A(F) = A(F) - W*A(F+O) K = K + H H = H - 1 GOTO 70 230 I = I + L J = J + M R = A(I+1) IF ( I .EQ. K ) GOTO 240 W = S*T + U*A(I) + A(J)*R V = V - U*W S = R T = U U = A(J) L = M M = M - 1 GOTO 230 240 W = S*T + U*A(I) + R V = V - U*W A(K+H) = V - U*R C --------------------------- C |*** REARRANGE STORAGE ***| C --------------------------- 250 I = 4 K = 4 H = N M = 5 + (N*(N+1))/2 260 A(M) = A(K) A(M+1) = A(K+1) IF ( H .EQ. 2 ) GOTO 280 O = K - I + 2 L = I - 3 + H DO 270 J = I,L 270 A(J) = A(J+O) I = L + 1 K = K + H H = H - 1 M = M + 2 GOTO 260 280 M = M + 2 A(M) = A(K+2) A(M+1) = 0. I = 6 + (N*(N+1))/2 L = I + N + N - 2 K = I - N - N - 1 M = K DO 290 J = I,L,2 A(K) = A(J) A(K+1) = A(J-1) A(K+2) = A(J) 290 K = K + 3 C --------------------------------------- C |*** FACTOR THE TRIDIAGONAL MATRIX ***| C --------------------------------------- CALL PFACT(A(M),3,N) IF ( A(M) .LT. 0. ) A(1) = -1237 RETURN END