C ________________________________________________________ C | | C | ESTIMATE 1-NORM OF A SQUARE MATRIX USING THE METHOD | C | DESCRIBED IN SISSC, 5(1984), PP. 311-316 | C | | C | INPUT: | C | | C | N --MATRIX DIMENSION | C | | C | L --SEARCH DEPTH USED IN ESTIMATING NORM | C | (FOR RANDOMLY GENERATED MATRICES, THE | C | RATIO BETWEEN THE ESTIMATED NORM AND | C | THE TRUE NORM IS ABOUT .97, .993, AND | C | .996 FOR L = 1, 2, AND 3 RESPECTIVELY | C | -- SEE THE SISSC ARTICLE FOR DETAILS) | C | | C | MULT --NAME OF SUBROUTINE TO MULTIPLY MATRIX A| C | BY VECTOR (NAME EXTERNAL IN MAIN PROG.)| C | WHEN MULT(P,M) IS INVOKED, THE INPUT | C | VECTOR STORED IN P IS REPLACED BY THE | C | PRODUCT AP. IF M .GT. 0 THEN EVERY ELE-| C | MENT OF INPUT VECTOR IS ZERO EXCEPT FOR| C | ELEMENT M WHICH IS 1 | C | | C | TMULT --NAME OF SUBROUTINE TO MULTIPLY TRANS- | C | POSE MATRIX BY VECTOR (NAME EXTERNAL IN| C | MAIN PROGRAM). WHEN TMULT(P) IS INVOKED| C | THE INPUT VECTOR STORED IN P IS RE- | C | PLACED BY THE PRODUCT AP | C | | C | W --WORK ARRAY WITH AT LEAST 2N ELEMENTS | C | (2ND N ELEMENTS ONLY USED WHEN L .GT.1)| C | | C | OUTPUT: | C | | C | NORM1 --ESTIMATED 1-NORM OF MATRIX | C | | C | BUILTIN FUNCTIONS: ABS | C |________________________________________________________| C REAL FUNCTION NORM1(N,L,MULT,TMULT,W) REAL W(1),C,D,E INTEGER I,J,K,L,M,N,O,P,Q K = 0 M = 0 O = 0 C = 1./N DO 10 J = 1,N 10 W(J) = C IF ( L .EQ. 1 ) GOTO 50 DO 20 J = 1,N 20 W(J+N) = 0. GOTO 50 30 DO 40 J = 1,N 40 W(J) = 0. W(M) = 1. 50 CALL MULT(W,M) C = 0. DO 70 J = 1,N C = C + ABS(W(J)) IF ( W(J) .LT. 0. ) GOTO 60 W(J) = 1. GOTO 70 60 W(J) = -1. 70 CONTINUE CALL TMULT(W) I = 1 DO 80 J = 1,N 80 IF ( ABS(W(I)) .LT. ABS(W(J)) ) I = J IF ( M .EQ. 0 ) GOTO 90 IF ( D .GE. C ) GOTO 110 IF ( M .EQ. I ) GOTO 100 90 M = I D = C O = O + 1 IF ( L .GT. 1 ) W(I+N) = 1. GOTO 30 100 D = C 110 IF ( O .GE. N ) GOTO 130 120 K = K + 1 IF ( K .LT. L ) GOTO 140 130 NORM1 = D RETURN 140 C = 1./(N-O) DO 150 J = 1,N W(J) = 0. IF ( W(J+N) .GT. 0. ) GOTO 150 W(J) = C 150 CONTINUE M = 0 Q = O GOTO 180 160 DO 170 J = 1,N 170 W(J) = 0. W(M) = 1. 180 CALL MULT(W,M) IF ( M .GT. 0 ) GOTO 210 DO 190 J = 1,N 190 IF ( W(J+N) .EQ. 0. ) GOTO 200 200 M = J P = J 210 C = 0. DO 230 J = 1,N C = C + ABS(W(J)) IF ( W(J) .LT. 0. ) GOTO 220 W(J) = 1. GOTO 230 220 W(J) = -1. 230 CONTINUE CALL TMULT(W) I = M DO 240 J = P,N IF ( W(J+N) .GT. 0. ) GOTO 240 IF ( ABS(W(I)) .LT. ABS(W(J)) ) I = J 240 CONTINUE IF ( O .EQ. Q ) GOTO 250 IF ( E .GE. C ) GOTO 270 IF ( M .EQ. I ) GOTO 260 250 M = I E = C O = O + 1 W(I+N) = 1. IF ( O .GT. N ) GOTO 270 GOTO 160 260 E = C 270 IF ( E .GT. D ) D = E GOTO 110 END