C C ________________________________________________________ C | | C | BALANCE A COMPLEX MATRIX | C | | C | INPUT: | C | | C | A --COMPLEX ARRAY CONTAINING MATRIX | C | | C | LA --LEADING (ROW) DIMENSION OF ARRAY A | C | | C | N --DIMENSION OF MATRIX STORED IN A | C | | C | W --WORK ARRAY (AT LEAST 2N REAL ELEMENTS) | C | | C | OUTPUT: | C | | C | A --BALANCED ARRAY | C | (NEW A = D TIMES OLD A TIMES D SUP -1) | C | | C | D --REAL ARRAY STORING DIAGONAL OF D MATRIX| C | | C | BUILTIN FUNCTIONS: ALOG | C | PACKAGE FUNCTIONS: MAG | C |________________________________________________________| C SUBROUTINE CBAL(A,LA,N,D,W) INTEGER I,J,K,L,LA,M,N REAL D(1),W(1),B,C,Q,R,S,T,MAG COMPLEX A(LA,1),Y,Z C ------------------------------ C |*** COMPUTE MACHINE BASE ***| C ------------------------------ T = 1. 10 T = T + T IF ( (1.+T)-T .EQ. 1. ) GOTO 10 B = 0. 20 B = B + 1 IF ( T+B .EQ. T ) GOTO 20 IF ( T+2.*B .GT. T+B ) GOTO 30 B = B + B 30 Q = ALOG(B) Q = .5/Q DO 40 I = 1,N D(I) = 1. W(I) = 1. 40 W(I+N) = 0. C -------------------------- C |*** COMPUTE ROW SUMS ***| C -------------------------- M = N + 1 L = N + N DO 50 J = 1,N DO 50 I = M,L 50 W(I) = W(I) + MAG(A(I-N,J)) C ------------------------------------------------------ C |*** BALANCE THE MATRIX USING THE EISPACK ROUTINE ***| C ------------------------------------------------------ 60 L = 0 DO 110 J = 1,N C = 0. DO 70 I = 1,N Z = A(I,J)*W(I) A(I,J) = Z 70 C = C + MAG(Z) IF ( C .EQ. 0. ) GOTO 110 R = W(J+N) IF ( R .LE. 0. ) GOTO 110 S = .5 + Q*ALOG(C/R) IF ( S .LT. 0. ) GOTO 80 I = S IF ( I .EQ. S ) I = I - 1 GOTO 90 80 I = S - 1 90 T = B**I S = 1./T W(J) = 1. IF ( T*R+S*C .GT. .95*(R+C) ) GOTO 110 L = 1 W(J) = T D(J) = D(J)*S DO 100 I = 1,N Z = A(I,J) Y = Z*S K = I + N W(K) = (W(K)-MAG(Z)) + MAG(Y) 100 A(I,J) = Y W(J+N) = T*W(J+N) 110 CONTINUE IF ( L .EQ. 1 ) GOTO 60 DO 120 J = 1,N DO 120 I = 1,N 120 A(I,J) = A(I,J)*W(I) RETURN END