1 REAL FUNCTION CLANHS( NORM, N, A, LDA, WORK ) 2* 3* -- LAPACK auxiliary routine (version 3.0) -- 4* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 5* Courant Institute, Argonne National Lab, and Rice University 6* October 31, 1992 7* 8* .. Scalar Arguments .. 9 CHARACTER NORM 10 INTEGER LDA, N 11* .. 12* .. Array Arguments .. 13 REAL WORK( * ) 14 COMPLEX A( LDA, * ) 15* .. 16* 17* Purpose 18* ======= 19* 20* CLANHS returns the value of the one norm, or the Frobenius norm, or 21* the infinity norm, or the element of largest absolute value of a 22* Hessenberg matrix A. 23* 24* Description 25* =========== 26* 27* CLANHS returns the value 28* 29* CLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm' 30* ( 31* ( norm1(A), NORM = '1', 'O' or 'o' 32* ( 33* ( normI(A), NORM = 'I' or 'i' 34* ( 35* ( normF(A), NORM = 'F', 'f', 'E' or 'e' 36* 37* where norm1 denotes the one norm of a matrix (maximum column sum), 38* normI denotes the infinity norm of a matrix (maximum row sum) and 39* normF denotes the Frobenius norm of a matrix (square root of sum of 40* squares). Note that max(abs(A(i,j))) is not a matrix norm. 41* 42* Arguments 43* ========= 44* 45* NORM (input) CHARACTER*1 46* Specifies the value to be returned in CLANHS as described 47* above. 48* 49* N (input) INTEGER 50* The order of the matrix A. N >= 0. When N = 0, CLANHS is 51* set to zero. 52* 53* A (input) COMPLEX array, dimension (LDA,N) 54* The n by n upper Hessenberg matrix A; the part of A below the 55* first sub-diagonal is not referenced. 56* 57* LDA (input) INTEGER 58* The leading dimension of the array A. LDA >= max(N,1). 59* 60* WORK (workspace) REAL array, dimension (LWORK), 61* where LWORK >= N when NORM = 'I'; otherwise, WORK is not 62* referenced. 63* 64* ===================================================================== 65* 66* .. Parameters .. 67 REAL ONE, ZERO 68 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 69* .. 70* .. Local Scalars .. 71 INTEGER I, J 72 REAL SCALE, SUM, VALUE 73* .. 74* .. External Functions .. 75 LOGICAL LSAME 76 EXTERNAL LSAME 77* .. 78* .. External Subroutines .. 79 EXTERNAL CLASSQ 80* .. 81* .. Intrinsic Functions .. 82 INTRINSIC ABS, MAX, MIN, SQRT 83* .. 84* .. Executable Statements .. 85* 86 IF( N.EQ.0 ) THEN 87 VALUE = ZERO 88 ELSE IF( LSAME( NORM, 'M' ) ) THEN 89* 90* Find max(abs(A(i,j))). 91* 92 VALUE = ZERO 93 DO 20 J = 1, N 94 DO 10 I = 1, MIN( N, J+1 ) 95 VALUE = MAX( VALUE, ABS( A( I, J ) ) ) 96 10 CONTINUE 97 20 CONTINUE 98 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 99* 100* Find norm1(A). 101* 102 VALUE = ZERO 103 DO 40 J = 1, N 104 SUM = ZERO 105 DO 30 I = 1, MIN( N, J+1 ) 106 SUM = SUM + ABS( A( I, J ) ) 107 30 CONTINUE 108 VALUE = MAX( VALUE, SUM ) 109 40 CONTINUE 110 ELSE IF( LSAME( NORM, 'I' ) ) THEN 111* 112* Find normI(A). 113* 114 DO 50 I = 1, N 115 WORK( I ) = ZERO 116 50 CONTINUE 117 DO 70 J = 1, N 118 DO 60 I = 1, MIN( N, J+1 ) 119 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 120 60 CONTINUE 121 70 CONTINUE 122 VALUE = ZERO 123 DO 80 I = 1, N 124 VALUE = MAX( VALUE, WORK( I ) ) 125 80 CONTINUE 126 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 127* 128* Find normF(A). 129* 130 SCALE = ZERO 131 SUM = ONE 132 DO 90 J = 1, N 133 CALL CLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM ) 134 90 CONTINUE 135 VALUE = SCALE*SQRT( SUM ) 136 END IF 137* 138 CLANHS = VALUE 139 RETURN 140* 141* End of CLANHS 142* 143 END 144