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