|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, 00002 $ LDAB, WORK ) 00003 * 00004 * -- LAPACK auxiliary routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER DIAG, NORM, UPLO 00011 INTEGER K, LDAB, N 00012 * .. 00013 * .. Array Arguments .. 00014 REAL WORK( * ) 00015 COMPLEX AB( LDAB, * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * CLANTB returns the value of the one norm, or the Frobenius norm, or 00022 * the infinity norm, or the element of largest absolute value of an 00023 * n by n triangular band matrix A, with ( k + 1 ) diagonals. 00024 * 00025 * Description 00026 * =========== 00027 * 00028 * CLANTB returns the value 00029 * 00030 * CLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm' 00031 * ( 00032 * ( norm1(A), NORM = '1', 'O' or 'o' 00033 * ( 00034 * ( normI(A), NORM = 'I' or 'i' 00035 * ( 00036 * ( normF(A), NORM = 'F', 'f', 'E' or 'e' 00037 * 00038 * where norm1 denotes the one norm of a matrix (maximum column sum), 00039 * normI denotes the infinity norm of a matrix (maximum row sum) and 00040 * normF denotes the Frobenius norm of a matrix (square root of sum of 00041 * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 00042 * 00043 * Arguments 00044 * ========= 00045 * 00046 * NORM (input) CHARACTER*1 00047 * Specifies the value to be returned in CLANTB as described 00048 * above. 00049 * 00050 * UPLO (input) CHARACTER*1 00051 * Specifies whether the matrix A is upper or lower triangular. 00052 * = 'U': Upper triangular 00053 * = 'L': Lower triangular 00054 * 00055 * DIAG (input) CHARACTER*1 00056 * Specifies whether or not the matrix A is unit triangular. 00057 * = 'N': Non-unit triangular 00058 * = 'U': Unit triangular 00059 * 00060 * N (input) INTEGER 00061 * The order of the matrix A. N >= 0. When N = 0, CLANTB is 00062 * set to zero. 00063 * 00064 * K (input) INTEGER 00065 * The number of super-diagonals of the matrix A if UPLO = 'U', 00066 * or the number of sub-diagonals of the matrix A if UPLO = 'L'. 00067 * K >= 0. 00068 * 00069 * AB (input) COMPLEX array, dimension (LDAB,N) 00070 * The upper or lower triangular band matrix A, stored in the 00071 * first k+1 rows of AB. The j-th column of A is stored 00072 * in the j-th column of the array AB as follows: 00073 * if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j; 00074 * if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k). 00075 * Note that when DIAG = 'U', the elements of the array AB 00076 * corresponding to the diagonal elements of the matrix A are 00077 * not referenced, but are assumed to be one. 00078 * 00079 * LDAB (input) INTEGER 00080 * The leading dimension of the array AB. LDAB >= K+1. 00081 * 00082 * WORK (workspace) REAL array, dimension (MAX(1,LWORK)), 00083 * where LWORK >= N when NORM = 'I'; otherwise, WORK is not 00084 * referenced. 00085 * 00086 * ===================================================================== 00087 * 00088 * .. Parameters .. 00089 REAL ONE, ZERO 00090 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00091 * .. 00092 * .. Local Scalars .. 00093 LOGICAL UDIAG 00094 INTEGER I, J, L 00095 REAL SCALE, SUM, VALUE 00096 * .. 00097 * .. External Functions .. 00098 LOGICAL LSAME 00099 EXTERNAL LSAME 00100 * .. 00101 * .. External Subroutines .. 00102 EXTERNAL CLASSQ 00103 * .. 00104 * .. Intrinsic Functions .. 00105 INTRINSIC ABS, MAX, MIN, SQRT 00106 * .. 00107 * .. Executable Statements .. 00108 * 00109 IF( N.EQ.0 ) THEN 00110 VALUE = ZERO 00111 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00112 * 00113 * Find max(abs(A(i,j))). 00114 * 00115 IF( LSAME( DIAG, 'U' ) ) THEN 00116 VALUE = ONE 00117 IF( LSAME( UPLO, 'U' ) ) THEN 00118 DO 20 J = 1, N 00119 DO 10 I = MAX( K+2-J, 1 ), K 00120 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00121 10 CONTINUE 00122 20 CONTINUE 00123 ELSE 00124 DO 40 J = 1, N 00125 DO 30 I = 2, MIN( N+1-J, K+1 ) 00126 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00127 30 CONTINUE 00128 40 CONTINUE 00129 END IF 00130 ELSE 00131 VALUE = ZERO 00132 IF( LSAME( UPLO, 'U' ) ) THEN 00133 DO 60 J = 1, N 00134 DO 50 I = MAX( K+2-J, 1 ), K + 1 00135 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00136 50 CONTINUE 00137 60 CONTINUE 00138 ELSE 00139 DO 80 J = 1, N 00140 DO 70 I = 1, MIN( N+1-J, K+1 ) 00141 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00142 70 CONTINUE 00143 80 CONTINUE 00144 END IF 00145 END IF 00146 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 00147 * 00148 * Find norm1(A). 00149 * 00150 VALUE = ZERO 00151 UDIAG = LSAME( DIAG, 'U' ) 00152 IF( LSAME( UPLO, 'U' ) ) THEN 00153 DO 110 J = 1, N 00154 IF( UDIAG ) THEN 00155 SUM = ONE 00156 DO 90 I = MAX( K+2-J, 1 ), K 00157 SUM = SUM + ABS( AB( I, J ) ) 00158 90 CONTINUE 00159 ELSE 00160 SUM = ZERO 00161 DO 100 I = MAX( K+2-J, 1 ), K + 1 00162 SUM = SUM + ABS( AB( I, J ) ) 00163 100 CONTINUE 00164 END IF 00165 VALUE = MAX( VALUE, SUM ) 00166 110 CONTINUE 00167 ELSE 00168 DO 140 J = 1, N 00169 IF( UDIAG ) THEN 00170 SUM = ONE 00171 DO 120 I = 2, MIN( N+1-J, K+1 ) 00172 SUM = SUM + ABS( AB( I, J ) ) 00173 120 CONTINUE 00174 ELSE 00175 SUM = ZERO 00176 DO 130 I = 1, MIN( N+1-J, K+1 ) 00177 SUM = SUM + ABS( AB( I, J ) ) 00178 130 CONTINUE 00179 END IF 00180 VALUE = MAX( VALUE, SUM ) 00181 140 CONTINUE 00182 END IF 00183 ELSE IF( LSAME( NORM, 'I' ) ) THEN 00184 * 00185 * Find normI(A). 00186 * 00187 VALUE = ZERO 00188 IF( LSAME( UPLO, 'U' ) ) THEN 00189 IF( LSAME( DIAG, 'U' ) ) THEN 00190 DO 150 I = 1, N 00191 WORK( I ) = ONE 00192 150 CONTINUE 00193 DO 170 J = 1, N 00194 L = K + 1 - J 00195 DO 160 I = MAX( 1, J-K ), J - 1 00196 WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 00197 160 CONTINUE 00198 170 CONTINUE 00199 ELSE 00200 DO 180 I = 1, N 00201 WORK( I ) = ZERO 00202 180 CONTINUE 00203 DO 200 J = 1, N 00204 L = K + 1 - J 00205 DO 190 I = MAX( 1, J-K ), J 00206 WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 00207 190 CONTINUE 00208 200 CONTINUE 00209 END IF 00210 ELSE 00211 IF( LSAME( DIAG, 'U' ) ) THEN 00212 DO 210 I = 1, N 00213 WORK( I ) = ONE 00214 210 CONTINUE 00215 DO 230 J = 1, N 00216 L = 1 - J 00217 DO 220 I = J + 1, MIN( N, J+K ) 00218 WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 00219 220 CONTINUE 00220 230 CONTINUE 00221 ELSE 00222 DO 240 I = 1, N 00223 WORK( I ) = ZERO 00224 240 CONTINUE 00225 DO 260 J = 1, N 00226 L = 1 - J 00227 DO 250 I = J, MIN( N, J+K ) 00228 WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 00229 250 CONTINUE 00230 260 CONTINUE 00231 END IF 00232 END IF 00233 DO 270 I = 1, N 00234 VALUE = MAX( VALUE, WORK( I ) ) 00235 270 CONTINUE 00236 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00237 * 00238 * Find normF(A). 00239 * 00240 IF( LSAME( UPLO, 'U' ) ) THEN 00241 IF( LSAME( DIAG, 'U' ) ) THEN 00242 SCALE = ONE 00243 SUM = N 00244 IF( K.GT.0 ) THEN 00245 DO 280 J = 2, N 00246 CALL CLASSQ( MIN( J-1, K ), 00247 $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE, 00248 $ SUM ) 00249 280 CONTINUE 00250 END IF 00251 ELSE 00252 SCALE = ZERO 00253 SUM = ONE 00254 DO 290 J = 1, N 00255 CALL CLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), 00256 $ 1, SCALE, SUM ) 00257 290 CONTINUE 00258 END IF 00259 ELSE 00260 IF( LSAME( DIAG, 'U' ) ) THEN 00261 SCALE = ONE 00262 SUM = N 00263 IF( K.GT.0 ) THEN 00264 DO 300 J = 1, N - 1 00265 CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, 00266 $ SUM ) 00267 300 CONTINUE 00268 END IF 00269 ELSE 00270 SCALE = ZERO 00271 SUM = ONE 00272 DO 310 J = 1, N 00273 CALL CLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, 00274 $ SUM ) 00275 310 CONTINUE 00276 END IF 00277 END IF 00278 VALUE = SCALE*SQRT( SUM ) 00279 END IF 00280 * 00281 CLANTB = VALUE 00282 RETURN 00283 * 00284 * End of CLANTB 00285 * 00286 END
1.7.3 
