1*> \brief \b CLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix. 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download CLANTR + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clantr.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clantr.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clantr.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, 22* WORK ) 23* 24* .. Scalar Arguments .. 25* CHARACTER DIAG, NORM, UPLO 26* INTEGER LDA, M, N 27* .. 28* .. Array Arguments .. 29* REAL WORK( * ) 30* COMPLEX A( LDA, * ) 31* .. 32* 33* 34*> \par Purpose: 35* ============= 36*> 37*> \verbatim 38*> 39*> CLANTR returns the value of the one norm, or the Frobenius norm, or 40*> the infinity norm, or the element of largest absolute value of a 41*> trapezoidal or triangular matrix A. 42*> \endverbatim 43*> 44*> \return CLANTR 45*> \verbatim 46*> 47*> CLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm' 48*> ( 49*> ( norm1(A), NORM = '1', 'O' or 'o' 50*> ( 51*> ( normI(A), NORM = 'I' or 'i' 52*> ( 53*> ( normF(A), NORM = 'F', 'f', 'E' or 'e' 54*> 55*> where norm1 denotes the one norm of a matrix (maximum column sum), 56*> normI denotes the infinity norm of a matrix (maximum row sum) and 57*> normF denotes the Frobenius norm of a matrix (square root of sum of 58*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 59*> \endverbatim 60* 61* Arguments: 62* ========== 63* 64*> \param[in] NORM 65*> \verbatim 66*> NORM is CHARACTER*1 67*> Specifies the value to be returned in CLANTR as described 68*> above. 69*> \endverbatim 70*> 71*> \param[in] UPLO 72*> \verbatim 73*> UPLO is CHARACTER*1 74*> Specifies whether the matrix A is upper or lower trapezoidal. 75*> = 'U': Upper trapezoidal 76*> = 'L': Lower trapezoidal 77*> Note that A is triangular instead of trapezoidal if M = N. 78*> \endverbatim 79*> 80*> \param[in] DIAG 81*> \verbatim 82*> DIAG is CHARACTER*1 83*> Specifies whether or not the matrix A has unit diagonal. 84*> = 'N': Non-unit diagonal 85*> = 'U': Unit diagonal 86*> \endverbatim 87*> 88*> \param[in] M 89*> \verbatim 90*> M is INTEGER 91*> The number of rows of the matrix A. M >= 0, and if 92*> UPLO = 'U', M <= N. When M = 0, CLANTR is set to zero. 93*> \endverbatim 94*> 95*> \param[in] N 96*> \verbatim 97*> N is INTEGER 98*> The number of columns of the matrix A. N >= 0, and if 99*> UPLO = 'L', N <= M. When N = 0, CLANTR is set to zero. 100*> \endverbatim 101*> 102*> \param[in] A 103*> \verbatim 104*> A is COMPLEX array, dimension (LDA,N) 105*> The trapezoidal matrix A (A is triangular if M = N). 106*> If UPLO = 'U', the leading m by n upper trapezoidal part of 107*> the array A contains the upper trapezoidal matrix, and the 108*> strictly lower triangular part of A is not referenced. 109*> If UPLO = 'L', the leading m by n lower trapezoidal part of 110*> the array A contains the lower trapezoidal matrix, and the 111*> strictly upper triangular part of A is not referenced. Note 112*> that when DIAG = 'U', the diagonal elements of A are not 113*> referenced and are assumed to be one. 114*> \endverbatim 115*> 116*> \param[in] LDA 117*> \verbatim 118*> LDA is INTEGER 119*> The leading dimension of the array A. LDA >= max(M,1). 120*> \endverbatim 121*> 122*> \param[out] WORK 123*> \verbatim 124*> WORK is REAL array, dimension (MAX(1,LWORK)), 125*> where LWORK >= M when NORM = 'I'; otherwise, WORK is not 126*> referenced. 127*> \endverbatim 128* 129* Authors: 130* ======== 131* 132*> \author Univ. of Tennessee 133*> \author Univ. of California Berkeley 134*> \author Univ. of Colorado Denver 135*> \author NAG Ltd. 136* 137*> \ingroup complexOTHERauxiliary 138* 139* ===================================================================== 140 REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, 141 $ WORK ) 142* 143* -- LAPACK auxiliary routine -- 144* -- LAPACK is a software package provided by Univ. of Tennessee, -- 145* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 146* 147 IMPLICIT NONE 148* .. Scalar Arguments .. 149 CHARACTER DIAG, NORM, UPLO 150 INTEGER LDA, M, N 151* .. 152* .. Array Arguments .. 153 REAL WORK( * ) 154 COMPLEX A( LDA, * ) 155* .. 156* 157* ===================================================================== 158* 159* .. Parameters .. 160 REAL ONE, ZERO 161 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 162* .. 163* .. Local Scalars .. 164 LOGICAL UDIAG 165 INTEGER I, J 166 REAL SUM, VALUE 167* .. 168* .. Local Arrays .. 169 REAL SSQ( 2 ), COLSSQ( 2 ) 170* .. 171* .. External Functions .. 172 LOGICAL LSAME, SISNAN 173 EXTERNAL LSAME, SISNAN 174* .. 175* .. External Subroutines .. 176 EXTERNAL CLASSQ, SCOMBSSQ 177* .. 178* .. Intrinsic Functions .. 179 INTRINSIC ABS, MIN, SQRT 180* .. 181* .. Executable Statements .. 182* 183 IF( MIN( M, N ).EQ.0 ) THEN 184 VALUE = ZERO 185 ELSE IF( LSAME( NORM, 'M' ) ) THEN 186* 187* Find max(abs(A(i,j))). 188* 189 IF( LSAME( DIAG, 'U' ) ) THEN 190 VALUE = ONE 191 IF( LSAME( UPLO, 'U' ) ) THEN 192 DO 20 J = 1, N 193 DO 10 I = 1, MIN( M, J-1 ) 194 SUM = ABS( A( I, J ) ) 195 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 196 10 CONTINUE 197 20 CONTINUE 198 ELSE 199 DO 40 J = 1, N 200 DO 30 I = J + 1, M 201 SUM = ABS( A( I, J ) ) 202 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 203 30 CONTINUE 204 40 CONTINUE 205 END IF 206 ELSE 207 VALUE = ZERO 208 IF( LSAME( UPLO, 'U' ) ) THEN 209 DO 60 J = 1, N 210 DO 50 I = 1, MIN( M, J ) 211 SUM = ABS( A( I, J ) ) 212 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 213 50 CONTINUE 214 60 CONTINUE 215 ELSE 216 DO 80 J = 1, N 217 DO 70 I = J, M 218 SUM = ABS( A( I, J ) ) 219 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 220 70 CONTINUE 221 80 CONTINUE 222 END IF 223 END IF 224 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 225* 226* Find norm1(A). 227* 228 VALUE = ZERO 229 UDIAG = LSAME( DIAG, 'U' ) 230 IF( LSAME( UPLO, 'U' ) ) THEN 231 DO 110 J = 1, N 232 IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN 233 SUM = ONE 234 DO 90 I = 1, J - 1 235 SUM = SUM + ABS( A( I, J ) ) 236 90 CONTINUE 237 ELSE 238 SUM = ZERO 239 DO 100 I = 1, MIN( M, J ) 240 SUM = SUM + ABS( A( I, J ) ) 241 100 CONTINUE 242 END IF 243 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 244 110 CONTINUE 245 ELSE 246 DO 140 J = 1, N 247 IF( UDIAG ) THEN 248 SUM = ONE 249 DO 120 I = J + 1, M 250 SUM = SUM + ABS( A( I, J ) ) 251 120 CONTINUE 252 ELSE 253 SUM = ZERO 254 DO 130 I = J, M 255 SUM = SUM + ABS( A( I, J ) ) 256 130 CONTINUE 257 END IF 258 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 259 140 CONTINUE 260 END IF 261 ELSE IF( LSAME( NORM, 'I' ) ) THEN 262* 263* Find normI(A). 264* 265 IF( LSAME( UPLO, 'U' ) ) THEN 266 IF( LSAME( DIAG, 'U' ) ) THEN 267 DO 150 I = 1, M 268 WORK( I ) = ONE 269 150 CONTINUE 270 DO 170 J = 1, N 271 DO 160 I = 1, MIN( M, J-1 ) 272 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 273 160 CONTINUE 274 170 CONTINUE 275 ELSE 276 DO 180 I = 1, M 277 WORK( I ) = ZERO 278 180 CONTINUE 279 DO 200 J = 1, N 280 DO 190 I = 1, MIN( M, J ) 281 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 282 190 CONTINUE 283 200 CONTINUE 284 END IF 285 ELSE 286 IF( LSAME( DIAG, 'U' ) ) THEN 287 DO 210 I = 1, MIN( M, N ) 288 WORK( I ) = ONE 289 210 CONTINUE 290 DO 220 I = N + 1, M 291 WORK( I ) = ZERO 292 220 CONTINUE 293 DO 240 J = 1, N 294 DO 230 I = J + 1, M 295 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 296 230 CONTINUE 297 240 CONTINUE 298 ELSE 299 DO 250 I = 1, M 300 WORK( I ) = ZERO 301 250 CONTINUE 302 DO 270 J = 1, N 303 DO 260 I = J, M 304 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 305 260 CONTINUE 306 270 CONTINUE 307 END IF 308 END IF 309 VALUE = ZERO 310 DO 280 I = 1, M 311 SUM = WORK( I ) 312 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 313 280 CONTINUE 314 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 315* 316* Find normF(A). 317* SSQ(1) is scale 318* SSQ(2) is sum-of-squares 319* For better accuracy, sum each column separately. 320* 321 IF( LSAME( UPLO, 'U' ) ) THEN 322 IF( LSAME( DIAG, 'U' ) ) THEN 323 SSQ( 1 ) = ONE 324 SSQ( 2 ) = MIN( M, N ) 325 DO 290 J = 2, N 326 COLSSQ( 1 ) = ZERO 327 COLSSQ( 2 ) = ONE 328 CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, 329 $ COLSSQ( 1 ), COLSSQ( 2 ) ) 330 CALL SCOMBSSQ( SSQ, COLSSQ ) 331 290 CONTINUE 332 ELSE 333 SSQ( 1 ) = ZERO 334 SSQ( 2 ) = ONE 335 DO 300 J = 1, N 336 COLSSQ( 1 ) = ZERO 337 COLSSQ( 2 ) = ONE 338 CALL CLASSQ( MIN( M, J ), A( 1, J ), 1, 339 $ COLSSQ( 1 ), COLSSQ( 2 ) ) 340 CALL SCOMBSSQ( SSQ, COLSSQ ) 341 300 CONTINUE 342 END IF 343 ELSE 344 IF( LSAME( DIAG, 'U' ) ) THEN 345 SSQ( 1 ) = ONE 346 SSQ( 2 ) = MIN( M, N ) 347 DO 310 J = 1, N 348 COLSSQ( 1 ) = ZERO 349 COLSSQ( 2 ) = ONE 350 CALL CLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, 351 $ COLSSQ( 1 ), COLSSQ( 2 ) ) 352 CALL SCOMBSSQ( SSQ, COLSSQ ) 353 310 CONTINUE 354 ELSE 355 SSQ( 1 ) = ZERO 356 SSQ( 2 ) = ONE 357 DO 320 J = 1, N 358 COLSSQ( 1 ) = ZERO 359 COLSSQ( 2 ) = ONE 360 CALL CLASSQ( M-J+1, A( J, J ), 1, 361 $ COLSSQ( 1 ), COLSSQ( 2 ) ) 362 CALL SCOMBSSQ( SSQ, COLSSQ ) 363 320 CONTINUE 364 END IF 365 END IF 366 VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) 367 END IF 368* 369 CLANTR = VALUE 370 RETURN 371* 372* End of CLANTR 373* 374 END 375