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