![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLANTB 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CLANTB + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clantb.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clantb.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clantb.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, 00022 * LDAB, WORK ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER DIAG, NORM, UPLO 00026 * INTEGER K, LDAB, N 00027 * .. 00028 * .. Array Arguments .. 00029 * REAL WORK( * ) 00030 * COMPLEX AB( LDAB, * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> CLANTB returns the value of the one norm, or the Frobenius norm, or 00040 *> the infinity norm, or the element of largest absolute value of an 00041 *> n by n triangular band matrix A, with ( k + 1 ) diagonals. 00042 *> \endverbatim 00043 *> 00044 *> \return CLANTB 00045 *> \verbatim 00046 *> 00047 *> CLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm' 00048 *> ( 00049 *> ( norm1(A), NORM = '1', 'O' or 'o' 00050 *> ( 00051 *> ( normI(A), NORM = 'I' or 'i' 00052 *> ( 00053 *> ( normF(A), NORM = 'F', 'f', 'E' or 'e' 00054 *> 00055 *> where norm1 denotes the one norm of a matrix (maximum column sum), 00056 *> normI denotes the infinity norm of a matrix (maximum row sum) and 00057 *> normF denotes the Frobenius norm of a matrix (square root of sum of 00058 *> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 00059 *> \endverbatim 00060 * 00061 * Arguments: 00062 * ========== 00063 * 00064 *> \param[in] NORM 00065 *> \verbatim 00066 *> NORM is CHARACTER*1 00067 *> Specifies the value to be returned in CLANTB as described 00068 *> above. 00069 *> \endverbatim 00070 *> 00071 *> \param[in] UPLO 00072 *> \verbatim 00073 *> UPLO is CHARACTER*1 00074 *> Specifies whether the matrix A is upper or lower triangular. 00075 *> = 'U': Upper triangular 00076 *> = 'L': Lower triangular 00077 *> \endverbatim 00078 *> 00079 *> \param[in] DIAG 00080 *> \verbatim 00081 *> DIAG is CHARACTER*1 00082 *> Specifies whether or not the matrix A is unit triangular. 00083 *> = 'N': Non-unit triangular 00084 *> = 'U': Unit triangular 00085 *> \endverbatim 00086 *> 00087 *> \param[in] N 00088 *> \verbatim 00089 *> N is INTEGER 00090 *> The order of the matrix A. N >= 0. When N = 0, CLANTB is 00091 *> set to zero. 00092 *> \endverbatim 00093 *> 00094 *> \param[in] K 00095 *> \verbatim 00096 *> K is INTEGER 00097 *> The number of super-diagonals of the matrix A if UPLO = 'U', 00098 *> or the number of sub-diagonals of the matrix A if UPLO = 'L'. 00099 *> K >= 0. 00100 *> \endverbatim 00101 *> 00102 *> \param[in] AB 00103 *> \verbatim 00104 *> AB is COMPLEX array, dimension (LDAB,N) 00105 *> The upper or lower triangular band matrix A, stored in the 00106 *> first k+1 rows of AB. The j-th column of A is stored 00107 *> in the j-th column of the array AB as follows: 00108 *> if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j; 00109 *> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k). 00110 *> Note that when DIAG = 'U', the elements of the array AB 00111 *> corresponding to the diagonal elements of the matrix A are 00112 *> not referenced, but are assumed to be one. 00113 *> \endverbatim 00114 *> 00115 *> \param[in] LDAB 00116 *> \verbatim 00117 *> LDAB is INTEGER 00118 *> The leading dimension of the array AB. LDAB >= K+1. 00119 *> \endverbatim 00120 *> 00121 *> \param[out] WORK 00122 *> \verbatim 00123 *> WORK is REAL array, dimension (MAX(1,LWORK)), 00124 *> where LWORK >= N when NORM = 'I'; otherwise, WORK is not 00125 *> referenced. 00126 *> \endverbatim 00127 * 00128 * Authors: 00129 * ======== 00130 * 00131 *> \author Univ. of Tennessee 00132 *> \author Univ. of California Berkeley 00133 *> \author Univ. of Colorado Denver 00134 *> \author NAG Ltd. 00135 * 00136 *> \date November 2011 00137 * 00138 *> \ingroup complexOTHERauxiliary 00139 * 00140 * ===================================================================== 00141 REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, 00142 $ LDAB, WORK ) 00143 * 00144 * -- LAPACK auxiliary routine (version 3.4.0) -- 00145 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00146 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00147 * November 2011 00148 * 00149 * .. Scalar Arguments .. 00150 CHARACTER DIAG, NORM, UPLO 00151 INTEGER K, LDAB, N 00152 * .. 00153 * .. Array Arguments .. 00154 REAL WORK( * ) 00155 COMPLEX AB( LDAB, * ) 00156 * .. 00157 * 00158 * ===================================================================== 00159 * 00160 * .. Parameters .. 00161 REAL ONE, ZERO 00162 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00163 * .. 00164 * .. Local Scalars .. 00165 LOGICAL UDIAG 00166 INTEGER I, J, L 00167 REAL SCALE, SUM, VALUE 00168 * .. 00169 * .. External Functions .. 00170 LOGICAL LSAME 00171 EXTERNAL LSAME 00172 * .. 00173 * .. External Subroutines .. 00174 EXTERNAL CLASSQ 00175 * .. 00176 * .. Intrinsic Functions .. 00177 INTRINSIC ABS, MAX, MIN, SQRT 00178 * .. 00179 * .. Executable Statements .. 00180 * 00181 IF( N.EQ.0 ) THEN 00182 VALUE = ZERO 00183 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00184 * 00185 * Find max(abs(A(i,j))). 00186 * 00187 IF( LSAME( DIAG, 'U' ) ) THEN 00188 VALUE = ONE 00189 IF( LSAME( UPLO, 'U' ) ) THEN 00190 DO 20 J = 1, N 00191 DO 10 I = MAX( K+2-J, 1 ), K 00192 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00193 10 CONTINUE 00194 20 CONTINUE 00195 ELSE 00196 DO 40 J = 1, N 00197 DO 30 I = 2, MIN( N+1-J, K+1 ) 00198 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00199 30 CONTINUE 00200 40 CONTINUE 00201 END IF 00202 ELSE 00203 VALUE = ZERO 00204 IF( LSAME( UPLO, 'U' ) ) THEN 00205 DO 60 J = 1, N 00206 DO 50 I = MAX( K+2-J, 1 ), K + 1 00207 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00208 50 CONTINUE 00209 60 CONTINUE 00210 ELSE 00211 DO 80 J = 1, N 00212 DO 70 I = 1, MIN( N+1-J, K+1 ) 00213 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00214 70 CONTINUE 00215 80 CONTINUE 00216 END IF 00217 END IF 00218 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 00219 * 00220 * Find norm1(A). 00221 * 00222 VALUE = ZERO 00223 UDIAG = LSAME( DIAG, 'U' ) 00224 IF( LSAME( UPLO, 'U' ) ) THEN 00225 DO 110 J = 1, N 00226 IF( UDIAG ) THEN 00227 SUM = ONE 00228 DO 90 I = MAX( K+2-J, 1 ), K 00229 SUM = SUM + ABS( AB( I, J ) ) 00230 90 CONTINUE 00231 ELSE 00232 SUM = ZERO 00233 DO 100 I = MAX( K+2-J, 1 ), K + 1 00234 SUM = SUM + ABS( AB( I, J ) ) 00235 100 CONTINUE 00236 END IF 00237 VALUE = MAX( VALUE, SUM ) 00238 110 CONTINUE 00239 ELSE 00240 DO 140 J = 1, N 00241 IF( UDIAG ) THEN 00242 SUM = ONE 00243 DO 120 I = 2, MIN( N+1-J, K+1 ) 00244 SUM = SUM + ABS( AB( I, J ) ) 00245 120 CONTINUE 00246 ELSE 00247 SUM = ZERO 00248 DO 130 I = 1, MIN( N+1-J, K+1 ) 00249 SUM = SUM + ABS( AB( I, J ) ) 00250 130 CONTINUE 00251 END IF 00252 VALUE = MAX( VALUE, SUM ) 00253 140 CONTINUE 00254 END IF 00255 ELSE IF( LSAME( NORM, 'I' ) ) THEN 00256 * 00257 * Find normI(A). 00258 * 00259 VALUE = ZERO 00260 IF( LSAME( UPLO, 'U' ) ) THEN 00261 IF( LSAME( DIAG, 'U' ) ) THEN 00262 DO 150 I = 1, N 00263 WORK( I ) = ONE 00264 150 CONTINUE 00265 DO 170 J = 1, N 00266 L = K + 1 - J 00267 DO 160 I = MAX( 1, J-K ), J - 1 00268 WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 00269 160 CONTINUE 00270 170 CONTINUE 00271 ELSE 00272 DO 180 I = 1, N 00273 WORK( I ) = ZERO 00274 180 CONTINUE 00275 DO 200 J = 1, N 00276 L = K + 1 - J 00277 DO 190 I = MAX( 1, J-K ), J 00278 WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 00279 190 CONTINUE 00280 200 CONTINUE 00281 END IF 00282 ELSE 00283 IF( LSAME( DIAG, 'U' ) ) THEN 00284 DO 210 I = 1, N 00285 WORK( I ) = ONE 00286 210 CONTINUE 00287 DO 230 J = 1, N 00288 L = 1 - J 00289 DO 220 I = J + 1, MIN( N, J+K ) 00290 WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 00291 220 CONTINUE 00292 230 CONTINUE 00293 ELSE 00294 DO 240 I = 1, N 00295 WORK( I ) = ZERO 00296 240 CONTINUE 00297 DO 260 J = 1, N 00298 L = 1 - J 00299 DO 250 I = J, MIN( N, J+K ) 00300 WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) ) 00301 250 CONTINUE 00302 260 CONTINUE 00303 END IF 00304 END IF 00305 DO 270 I = 1, N 00306 VALUE = MAX( VALUE, WORK( I ) ) 00307 270 CONTINUE 00308 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00309 * 00310 * Find normF(A). 00311 * 00312 IF( LSAME( UPLO, 'U' ) ) THEN 00313 IF( LSAME( DIAG, 'U' ) ) THEN 00314 SCALE = ONE 00315 SUM = N 00316 IF( K.GT.0 ) THEN 00317 DO 280 J = 2, N 00318 CALL CLASSQ( MIN( J-1, K ), 00319 $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE, 00320 $ SUM ) 00321 280 CONTINUE 00322 END IF 00323 ELSE 00324 SCALE = ZERO 00325 SUM = ONE 00326 DO 290 J = 1, N 00327 CALL CLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), 00328 $ 1, SCALE, SUM ) 00329 290 CONTINUE 00330 END IF 00331 ELSE 00332 IF( LSAME( DIAG, 'U' ) ) THEN 00333 SCALE = ONE 00334 SUM = N 00335 IF( K.GT.0 ) THEN 00336 DO 300 J = 1, N - 1 00337 CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, 00338 $ SUM ) 00339 300 CONTINUE 00340 END IF 00341 ELSE 00342 SCALE = ZERO 00343 SUM = ONE 00344 DO 310 J = 1, N 00345 CALL CLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, 00346 $ SUM ) 00347 310 CONTINUE 00348 END IF 00349 END IF 00350 VALUE = SCALE*SQRT( SUM ) 00351 END IF 00352 * 00353 CLANTB = VALUE 00354 RETURN 00355 * 00356 * End of CLANTB 00357 * 00358 END