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