|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, 00002 $ WORK ) 00003 * 00004 * -- LAPACK auxiliary routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER DIAG, NORM, UPLO 00011 INTEGER LDA, M, N 00012 * .. 00013 * .. Array Arguments .. 00014 REAL WORK( * ) 00015 COMPLEX A( LDA, * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * CLANTR returns the value of the one norm, or the Frobenius norm, or 00022 * the infinity norm, or the element of largest absolute value of a 00023 * trapezoidal or triangular matrix A. 00024 * 00025 * Description 00026 * =========== 00027 * 00028 * CLANTR returns the value 00029 * 00030 * CLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm' 00031 * ( 00032 * ( norm1(A), NORM = '1', 'O' or 'o' 00033 * ( 00034 * ( normI(A), NORM = 'I' or 'i' 00035 * ( 00036 * ( normF(A), NORM = 'F', 'f', 'E' or 'e' 00037 * 00038 * where norm1 denotes the one norm of a matrix (maximum column sum), 00039 * normI denotes the infinity norm of a matrix (maximum row sum) and 00040 * normF denotes the Frobenius norm of a matrix (square root of sum of 00041 * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 00042 * 00043 * Arguments 00044 * ========= 00045 * 00046 * NORM (input) CHARACTER*1 00047 * Specifies the value to be returned in CLANTR as described 00048 * above. 00049 * 00050 * UPLO (input) CHARACTER*1 00051 * Specifies whether the matrix A is upper or lower trapezoidal. 00052 * = 'U': Upper trapezoidal 00053 * = 'L': Lower trapezoidal 00054 * Note that A is triangular instead of trapezoidal if M = N. 00055 * 00056 * DIAG (input) CHARACTER*1 00057 * Specifies whether or not the matrix A has unit diagonal. 00058 * = 'N': Non-unit diagonal 00059 * = 'U': Unit diagonal 00060 * 00061 * M (input) INTEGER 00062 * The number of rows of the matrix A. M >= 0, and if 00063 * UPLO = 'U', M <= N. When M = 0, CLANTR is set to zero. 00064 * 00065 * N (input) INTEGER 00066 * The number of columns of the matrix A. N >= 0, and if 00067 * UPLO = 'L', N <= M. When N = 0, CLANTR is set to zero. 00068 * 00069 * A (input) COMPLEX array, dimension (LDA,N) 00070 * The trapezoidal matrix A (A is triangular if M = N). 00071 * If UPLO = 'U', the leading m by n upper trapezoidal part of 00072 * the array A contains the upper trapezoidal matrix, and the 00073 * strictly lower triangular part of A is not referenced. 00074 * If UPLO = 'L', the leading m by n lower trapezoidal part of 00075 * the array A contains the lower trapezoidal matrix, and the 00076 * strictly upper triangular part of A is not referenced. Note 00077 * that when DIAG = 'U', the diagonal elements of A are not 00078 * referenced and are assumed to be one. 00079 * 00080 * LDA (input) INTEGER 00081 * The leading dimension of the array A. LDA >= max(M,1). 00082 * 00083 * WORK (workspace) REAL array, dimension (MAX(1,LWORK)), 00084 * where LWORK >= M when NORM = 'I'; otherwise, WORK is not 00085 * referenced. 00086 * 00087 * ===================================================================== 00088 * 00089 * .. Parameters .. 00090 REAL ONE, ZERO 00091 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00092 * .. 00093 * .. Local Scalars .. 00094 LOGICAL UDIAG 00095 INTEGER I, J 00096 REAL SCALE, SUM, VALUE 00097 * .. 00098 * .. External Functions .. 00099 LOGICAL LSAME 00100 EXTERNAL LSAME 00101 * .. 00102 * .. External Subroutines .. 00103 EXTERNAL CLASSQ 00104 * .. 00105 * .. Intrinsic Functions .. 00106 INTRINSIC ABS, MAX, MIN, SQRT 00107 * .. 00108 * .. Executable Statements .. 00109 * 00110 IF( MIN( M, N ).EQ.0 ) THEN 00111 VALUE = ZERO 00112 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00113 * 00114 * Find max(abs(A(i,j))). 00115 * 00116 IF( LSAME( DIAG, 'U' ) ) THEN 00117 VALUE = ONE 00118 IF( LSAME( UPLO, 'U' ) ) THEN 00119 DO 20 J = 1, N 00120 DO 10 I = 1, MIN( M, J-1 ) 00121 VALUE = MAX( VALUE, ABS( A( I, J ) ) ) 00122 10 CONTINUE 00123 20 CONTINUE 00124 ELSE 00125 DO 40 J = 1, N 00126 DO 30 I = J + 1, M 00127 VALUE = MAX( VALUE, ABS( A( I, J ) ) ) 00128 30 CONTINUE 00129 40 CONTINUE 00130 END IF 00131 ELSE 00132 VALUE = ZERO 00133 IF( LSAME( UPLO, 'U' ) ) THEN 00134 DO 60 J = 1, N 00135 DO 50 I = 1, MIN( M, J ) 00136 VALUE = MAX( VALUE, ABS( A( I, J ) ) ) 00137 50 CONTINUE 00138 60 CONTINUE 00139 ELSE 00140 DO 80 J = 1, N 00141 DO 70 I = J, M 00142 VALUE = MAX( VALUE, ABS( A( I, J ) ) ) 00143 70 CONTINUE 00144 80 CONTINUE 00145 END IF 00146 END IF 00147 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 00148 * 00149 * Find norm1(A). 00150 * 00151 VALUE = ZERO 00152 UDIAG = LSAME( DIAG, 'U' ) 00153 IF( LSAME( UPLO, 'U' ) ) THEN 00154 DO 110 J = 1, N 00155 IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN 00156 SUM = ONE 00157 DO 90 I = 1, J - 1 00158 SUM = SUM + ABS( A( I, J ) ) 00159 90 CONTINUE 00160 ELSE 00161 SUM = ZERO 00162 DO 100 I = 1, MIN( M, J ) 00163 SUM = SUM + ABS( A( I, J ) ) 00164 100 CONTINUE 00165 END IF 00166 VALUE = MAX( VALUE, SUM ) 00167 110 CONTINUE 00168 ELSE 00169 DO 140 J = 1, N 00170 IF( UDIAG ) THEN 00171 SUM = ONE 00172 DO 120 I = J + 1, M 00173 SUM = SUM + ABS( A( I, J ) ) 00174 120 CONTINUE 00175 ELSE 00176 SUM = ZERO 00177 DO 130 I = J, M 00178 SUM = SUM + ABS( A( I, J ) ) 00179 130 CONTINUE 00180 END IF 00181 VALUE = MAX( VALUE, SUM ) 00182 140 CONTINUE 00183 END IF 00184 ELSE IF( LSAME( NORM, 'I' ) ) THEN 00185 * 00186 * Find normI(A). 00187 * 00188 IF( LSAME( UPLO, 'U' ) ) THEN 00189 IF( LSAME( DIAG, 'U' ) ) THEN 00190 DO 150 I = 1, M 00191 WORK( I ) = ONE 00192 150 CONTINUE 00193 DO 170 J = 1, N 00194 DO 160 I = 1, MIN( M, J-1 ) 00195 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 00196 160 CONTINUE 00197 170 CONTINUE 00198 ELSE 00199 DO 180 I = 1, M 00200 WORK( I ) = ZERO 00201 180 CONTINUE 00202 DO 200 J = 1, N 00203 DO 190 I = 1, MIN( M, J ) 00204 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 00205 190 CONTINUE 00206 200 CONTINUE 00207 END IF 00208 ELSE 00209 IF( LSAME( DIAG, 'U' ) ) THEN 00210 DO 210 I = 1, N 00211 WORK( I ) = ONE 00212 210 CONTINUE 00213 DO 220 I = N + 1, M 00214 WORK( I ) = ZERO 00215 220 CONTINUE 00216 DO 240 J = 1, N 00217 DO 230 I = J + 1, M 00218 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 00219 230 CONTINUE 00220 240 CONTINUE 00221 ELSE 00222 DO 250 I = 1, M 00223 WORK( I ) = ZERO 00224 250 CONTINUE 00225 DO 270 J = 1, N 00226 DO 260 I = J, M 00227 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 00228 260 CONTINUE 00229 270 CONTINUE 00230 END IF 00231 END IF 00232 VALUE = ZERO 00233 DO 280 I = 1, M 00234 VALUE = MAX( VALUE, WORK( I ) ) 00235 280 CONTINUE 00236 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00237 * 00238 * Find normF(A). 00239 * 00240 IF( LSAME( UPLO, 'U' ) ) THEN 00241 IF( LSAME( DIAG, 'U' ) ) THEN 00242 SCALE = ONE 00243 SUM = MIN( M, N ) 00244 DO 290 J = 2, N 00245 CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) 00246 290 CONTINUE 00247 ELSE 00248 SCALE = ZERO 00249 SUM = ONE 00250 DO 300 J = 1, N 00251 CALL CLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) 00252 300 CONTINUE 00253 END IF 00254 ELSE 00255 IF( LSAME( DIAG, 'U' ) ) THEN 00256 SCALE = ONE 00257 SUM = MIN( M, N ) 00258 DO 310 J = 1, N 00259 CALL CLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, 00260 $ SUM ) 00261 310 CONTINUE 00262 ELSE 00263 SCALE = ZERO 00264 SUM = ONE 00265 DO 320 J = 1, N 00266 CALL CLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM ) 00267 320 CONTINUE 00268 END IF 00269 END IF 00270 VALUE = SCALE*SQRT( SUM ) 00271 END IF 00272 * 00273 CLANTR = VALUE 00274 RETURN 00275 * 00276 * End of CLANTR 00277 * 00278 END
1.7.3 
