C ________________________________________________________ C | | C | SOLVE THE TRANSPOSE OF A FACTORED TRIDIAGONAL SYSTEM | C | | C | INPUT: | C | | C | L,D,U --TFACT'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 TTRANS(X,L,D,U,B) REAL B(1),D(1),L(1),U(1),X(1),S,T INTEGER I,J,K,M,N T = D(1) IF ( ABS(T) .EQ. 1234 ) GOTO 10 IF ( ABS(T) .EQ. 1238 ) GOTO 10 WRITE(6,*) 'ERROR: MUST FACTOR WITH TFACT BEFORE SOLVING' STOP 10 N = D(2) IF ( N .GT. 1 ) GOTO 30 IF ( T .LT. 0. ) GOTO 20 X(1) = B(1)/D(4) RETURN 20 X(1) = 1. RETURN 30 IF ( T .LT. 0. ) GOTO 90 J = 1 X(1) = B(1)/D(4) IF ( T .EQ. 1238 ) GOTO 50 C ------------------------------ C |*** FORWARD SUBSTITUTION ***| C ------------------------------ DO 40 K = 2,N X(K) = (B(K) - X(J)*U(J))/D(K+3) 40 J = K GOTO 70 50 S = D(4) DO 60 K = 2,N T = D(K+3) X(K) = (B(K)-X(J)*U(J)*S)/T S = T 60 J = K C --------------------------- C |*** BACK SUBSTITUTION ***| C --------------------------- 70 M = N - 1 DO 80 J = 1,M K = N - J 80 X(K) = X(K) - X(K+1)*L(K) RETURN C ----------------------------- C |*** COMPUTE NULL VECTOR ***| C ----------------------------- 90 DO 100 I = 1,N IF ( D(I+3) .EQ. 0. ) J = I 100 X(I) = 0. X(J) = 1. IF ( J .EQ. N ) GOTO 70 M = J + 1 IF ( T .EQ. 1238 ) GOTO 120 DO 110 K = M,N X(K) = -X(J)*U(J)/D(K+3) 110 J = K GOTO 70 120 S = D(M+2) DO 130 K = M,N T = D(K+3) X(K) = -X(J)*U(J)*S/T S = T 130 J = K GOTO 70 END