001: REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, 002: $ LDAB, WORK ) 003: * 004: * -- LAPACK auxiliary routine (version 3.2) -- 005: * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 006: * November 2006 007: * 008: * .. Scalar Arguments .. 009: CHARACTER DIAG, NORM, UPLO 010: INTEGER K, LDAB, N 011: * .. 012: * .. Array Arguments .. 013: REAL WORK( * ) 014: COMPLEX AB( LDAB, * ) 015: * .. 016: * 017: * Purpose 018: * ======= 019: * 020: * CLANTB returns the value of the one norm, or the Frobenius norm, or 021: * the infinity norm, or the element of largest absolute value of an 022: * n by n triangular band matrix A, with ( k + 1 ) diagonals. 023: * 024: * Description 025: * =========== 026: * 027: * CLANTB returns the value 028: * 029: * CLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm' 030: * ( 031: * ( norm1(A), NORM = '1', 'O' or 'o' 032: * ( 033: * ( normI(A), NORM = 'I' or 'i' 034: * ( 035: * ( normF(A), NORM = 'F', 'f', 'E' or 'e' 036: * 037: * where norm1 denotes the one norm of a matrix (maximum column sum), 038: * normI denotes the infinity norm of a matrix (maximum row sum) and 039: * normF denotes the Frobenius norm of a matrix (square root of sum of 040: * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 041: * 042: * Arguments 043: * ========= 044: * 045: * NORM (input) CHARACTER*1 046: * Specifies the value to be returned in CLANTB as described 047: * above. 048: * 049: * UPLO (input) CHARACTER*1 050: * Specifies whether the matrix A is upper or lower triangular. 051: * = 'U': Upper triangular 052: * = 'L': Lower triangular 053: * 054: * DIAG (input) CHARACTER*1 055: * Specifies whether or not the matrix A is unit triangular. 056: * = 'N': Non-unit triangular 057: * = 'U': Unit triangular 058: * 059: * N (input) INTEGER 060: * The order of the matrix A. N >= 0. When N = 0, CLANTB is 061: * set to zero. 062: * 063: * K (input) INTEGER 064: * The number of super-diagonals of the matrix A if UPLO = 'U', 065: * or the number of sub-diagonals of the matrix A if UPLO = 'L'. 066: * K >= 0. 067: * 068: * AB (input) COMPLEX array, dimension (LDAB,N) 069: * The upper or lower triangular band matrix A, stored in the 070: * first k+1 rows of AB. The j-th column of A is stored 071: * in the j-th column of the array AB as follows: 072: * if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j; 073: * if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k). 074: * Note that when DIAG = 'U', the elements of the array AB 075: * corresponding to the diagonal elements of the matrix A are 076: * not referenced, but are assumed to be one. 077: * 078: * LDAB (input) INTEGER 079: * The leading dimension of the array AB. LDAB >= K+1. 080: * 081: * WORK (workspace) REAL array, dimension (MAX(1,LWORK)), 082: * where LWORK >= N when NORM = 'I'; otherwise, WORK is not 083: * referenced. 084: * 085: * ===================================================================== 086: * 087: * .. Parameters .. 088: REAL ONE, ZERO 089: PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 090: * .. 091: * .. Local Scalars .. 092: LOGICAL UDIAG 093: INTEGER I, J, L 094: REAL SCALE, SUM, VALUE 095: * .. 096: * .. External Functions .. 097: LOGICAL LSAME 098: EXTERNAL LSAME 099: * .. 100: * .. External Subroutines .. 101: EXTERNAL CLASSQ 102: * .. 103: * .. Intrinsic Functions .. 104: INTRINSIC ABS, MAX, MIN, SQRT 105: * .. 106: * .. Executable Statements .. 107: * 108: IF( N.EQ.0 ) THEN 109: VALUE = ZERO 110: ELSE IF( LSAME( NORM, 'M' ) ) THEN 111: * 112: * Find max(abs(A(i,j))). 113: * 114: IF( LSAME( DIAG, 'U' ) ) THEN 115: VALUE = ONE 116: IF( LSAME( UPLO, 'U' ) ) THEN 117: DO 20 J = 1, N 118: DO 10 I = MAX( K+2-J, 1 ), K 119: VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 120: 10 CONTINUE 121: 20 CONTINUE 122: ELSE 123: DO 40 J = 1, N 124: DO 30 I = 2, MIN( N+1-J, K+1 ) 125: VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 126: 30 CONTINUE 127: 40 CONTINUE 128: END IF 129: ELSE 130: VALUE = ZERO 131: IF( LSAME( UPLO, 'U' ) ) THEN 132: DO 60 J = 1, N 133: DO 50 I = MAX( K+2-J, 1 ), K + 1 134: VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 135: 50 CONTINUE 136: 60 CONTINUE 137: ELSE 138: DO 80 J = 1, N 139: DO 70 I = 1, MIN( N+1-J, K+1 ) 140: VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 141: 70 CONTINUE 142: 80 CONTINUE 143: END IF 144: END IF 145: ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 146: * 147: * Find norm1(A). 148: * 149: VALUE = ZERO 150: UDIAG = LSAME( DIAG, 'U' ) 151: IF( LSAME( UPLO, 'U' ) ) THEN 152: DO 110 J = 1, N 153: IF( UDIAG ) THEN 154: SUM = ONE 155: DO 90 I = MAX( K+2-J, 1 ), K 156: SUM = SUM + ABS( AB( I, J ) ) 157: 90 CONTINUE 158: ELSE 159: SUM = ZERO 160: DO 100 I = MAX( K+2-J, 1 ), K + 1 161: SUM = SUM + ABS( AB( I, J ) ) 162: 100 CONTINUE 163: END IF 164: VALUE = MAX( VALUE, SUM ) 165: 110 CONTINUE 166: ELSE 167: DO 140 J = 1, N 168: IF( UDIAG ) THEN 169: SUM = ONE 170: DO 120 I = 2, MIN( N+1-J, K+1 ) 171: SUM = SUM + ABS( AB( I, J ) ) 172: 120 CONTINUE 173: ELSE 174: SUM = ZERO 175: DO 130 I = 1, MIN( N+1-J, K+1 ) 176: SUM = SUM + ABS( AB( I, J ) ) 177: 130 CONTINUE 178: END IF 179: VALUE = MAX( VALUE, SUM ) 180: 140 CONTINUE 181: END IF 182: ELSE IF( LSAME( NORM, 'I' ) ) THEN 183: * 184: * Find normI(A). 185: * 186: VALUE = ZERO 187: IF( LSAME( UPLO, 'U' ) ) THEN 188: IF( LSAME( DIAG, 'U' ) ) THEN 189: DO 150 I = 1, N 190: WORK( I ) = ONE 191: 150 CONTINUE 192: DO 170 J = 1, N 193: L = K + 1 - J 194: DO 160 I = MAX( 1, J-K ), J - 1 195: WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 196: 160 CONTINUE 197: 170 CONTINUE 198: ELSE 199: DO 180 I = 1, N 200: WORK( I ) = ZERO 201: 180 CONTINUE 202: DO 200 J = 1, N 203: L = K + 1 - J 204: DO 190 I = MAX( 1, J-K ), J 205: WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 206: 190 CONTINUE 207: 200 CONTINUE 208: END IF 209: ELSE 210: IF( LSAME( DIAG, 'U' ) ) THEN 211: DO 210 I = 1, N 212: WORK( I ) = ONE 213: 210 CONTINUE 214: DO 230 J = 1, N 215: L = 1 - J 216: DO 220 I = J + 1, MIN( N, J+K ) 217: WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 218: 220 CONTINUE 219: 230 CONTINUE 220: ELSE 221: DO 240 I = 1, N 222: WORK( I ) = ZERO 223: 240 CONTINUE 224: DO 260 J = 1, N 225: L = 1 - J 226: DO 250 I = J, MIN( N, J+K ) 227: WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 228: 250 CONTINUE 229: 260 CONTINUE 230: END IF 231: END IF 232: DO 270 I = 1, N 233: VALUE = MAX( VALUE, WORK( I ) ) 234: 270 CONTINUE 235: ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 236: * 237: * Find normF(A). 238: * 239: IF( LSAME( UPLO, 'U' ) ) THEN 240: IF( LSAME( DIAG, 'U' ) ) THEN 241: SCALE = ONE 242: SUM = N 243: IF( K.GT.0 ) THEN 244: DO 280 J = 2, N 245: CALL CLASSQ( MIN( J-1, K ), 246: $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE, 247: $ SUM ) 248: 280 CONTINUE 249: END IF 250: ELSE 251: SCALE = ZERO 252: SUM = ONE 253: DO 290 J = 1, N 254: CALL CLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), 255: $ 1, SCALE, SUM ) 256: 290 CONTINUE 257: END IF 258: ELSE 259: IF( LSAME( DIAG, 'U' ) ) THEN 260: SCALE = ONE 261: SUM = N 262: IF( K.GT.0 ) THEN 263: DO 300 J = 1, N - 1 264: CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, 265: $ SUM ) 266: 300 CONTINUE 267: END IF 268: ELSE 269: SCALE = ZERO 270: SUM = ONE 271: DO 310 J = 1, N 272: CALL CLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, 273: $ SUM ) 274: 310 CONTINUE 275: END IF 276: END IF 277: VALUE = SCALE*SQRT( SUM ) 278: END IF 279: * 280: CLANTB = VALUE 281: RETURN 282: * 283: * End of CLANTB 284: * 285: END 286: