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