C ________________________________________________________ C | | C | SOLVE TRANSPOSE OF 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 ETRANS(X,A,B) REAL A(1),B(1),X(1),T INTEGER I,J,K,L,M,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) K = N I = 3 + (N*(N+5))/2 IF ( T .LT. 0. ) GOTO 80 DO 20 J = 1,N 20 X(J) = B(J) C ---------------------------------------- C |*** FORWARD ELIMINATION AND PIVOTS ***| C ---------------------------------------- 30 IF ( K .LT. 2 ) GOTO 50 J = K K = K - 1 I = I - 2 IF ( A(I) .EQ. 0. ) GOTO 40 T = X(J) X(J) = X(K) X(K) = T 40 X(K) = X(K) - A(I-1)*X(J) GOTO 30 C --------------------------- C |*** BACK SUBSTITUTION ***| C --------------------------- 50 J = 4 T = X(K) 60 X(K) = T/A(J) L = K K = K + 1 IF ( K .GT. N ) RETURN T = X(K) DO 70 I = 1,L 70 T = T - A(I+J)*X(I) J = J + K GOTO 60 C ----------------------------- C |*** COMPUTE NULL VECTOR ***| C ----------------------------- 80 J = I - N - N 90 IF ( A(J) .EQ. 0. ) GOTO 100 J = J - K K = K - 1 GOTO 90 100 DO 110 I = 1,N 110 X(I) = 0. X(K) = 1. L = K GOTO 130 120 X(K) = T/A(J) 130 IF ( K .EQ. N ) RETURN M = K K = K + 1 T = X(K) DO 140 I = L,M 140 T = T - A(I+J)*X(I) J = J + K GOTO 120 END