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