C ________________________________________________________ C | | C | SOLVE TRANSPOSE OF A FACTORED BAND SYSTEM | C | | C | INPUT: | C | | C | A --BFACT'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,MIN0,MAX0 | C |________________________________________________________| C SUBROUTINE BTRANS(X,A,B) REAL A(1),B(1),X(1),T INTEGER I,J,K,L,M,N,O,P,Q T = A(1) IF ( ABS(T) .EQ. 1231 ) GOTO 10 WRITE(6,*) 'ERROR: MUST FACTOR WITH BFACT BEFORE SOLVING' STOP 10 N = A(2) L = A(4) M = A(5) O = L + M - 1 M = 2 + L + O J = 7 + O K = 1 IF ( T .LT. 0. ) GOTO 90 T = 0. IF ( O .GE. 0 ) GOTO 30 C ------------------------ C |*** DIAGONAL MATRIX***| C ------------------------ DO 20 K = 1,N 20 X(K) = B(K)/A(K+K+5) RETURN C --------------------------- C |*** FORE SUBSTITUTION ***| C --------------------------- 30 J = J - M + M*K 40 X(K) = (B(K)-T)/A(J+K) IF ( K .EQ. N ) GOTO 60 T = 0. J = J + M P = MAX0(1,K-O) DO 50 I = P,K 50 T = T + X(I)*A(I+J) K = K + 1 GOTO 40 60 IF ( L .EQ. 0 ) RETURN O = O + 2 C --------------------------- C |*** BACK SUBSTITUTION ***| C --------------------------- 70 IF ( K .EQ. 1 ) RETURN J = J - M Q = K K = K - 1 P = MIN0(N,K+L) T = X(K) DO 80 I = Q,P 80 T = T - X(I)*A(I+J) I = A(J+K-O) X(K) = X(I) X(I) = T GOTO 70 C ----------------------------- C |*** COMPUTE NULL VECTOR ***| C ----------------------------- 90 I = 8 + O + N + M*N Q = N + 1 100 I = I - M - 1 Q = Q - 1 IF ( A(I) .NE. 0. ) GOTO 100 J = J + M*(Q-K) K = Q DO 110 I = 1,N 110 X(I) = 0. X(K) = 1. IF ( O .LT. 0 ) RETURN 120 IF ( K .EQ. N ) GOTO 60 T = 0. J = J + M P = MAX0(Q,K-O) DO 130 I = P,K 130 T = T - X(I)*A(I+J) K = K + 1 X(K) = T/A(J+K) GOTO 120 END