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