C ________________________________________________________ C | | C | SOLVE A FACTORED UPPER HESSENBERG SYSTEM | C | | C | INPUT: | C | | C | A --EFACT'S OUTPUT | C | | C | B --RIGHT SIDE | C | | C | OUTPUT: | C | | C | X --SOLUTION (CAN BE IDENTIFIED WITH B | C | ALTHOUGH THE RIGHT SIDE IS DESTROYED) | C | | C | BUILTIN FUNCTIONS: ABS | C |________________________________________________________| C SUBROUTINE ESOLVE(X,A,B) REAL A(1),B(1),X(1),T INTEGER I,J,K,L,N T = A(1) IF ( ABS(T) .EQ. 1237 ) GOTO 10 WRITE(6,*) 'ERROR: MUST FACTOR WITH EFACT BEFORE SOLVING' STOP 10 N = A(2) J = 3 + (N*(N-1))/2 K = N L = J + N IF ( T .LT. 0. ) GOTO 80 DO 20 I = 1,N 20 X(I) = B(I) C -------------------------- C |*** BACK ELIMINATION ***| C -------------------------- 30 T = B(K)/A(J+K) 40 X(K) = T IF ( K .EQ. 1 ) GOTO 70 K = K - 1 IF ( T .EQ. 0. ) GOTO 60 DO 50 I = 1,K 50 X(I) = X(I) - T*A(I+J) 60 J = J - K GOTO 30 C ---------------------------------------- C |*** FORWARD ELIMINATION AND PIVOTS ***| C ---------------------------------------- 70 IF ( K .EQ. N ) RETURN J = K K = K + 1 L = L + 2 X(K) = X(K) - A(L-1)*X(J) IF ( A(L) .EQ. 0. ) GOTO 70 T = X(K) X(K) = X(J) X(J) = T GOTO 70 C ----------------------------- C |*** COMPUTE NULL VECTOR ***| C ----------------------------- 80 J = 3 K = 0 90 J = J + K K = K + 1 IF ( A(J+K) .NE. 0. ) GOTO 90 DO 100 I = 1,N 100 X(I) = 0. T = 1. GOTO 40 END