|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, 00002 $ CNDNUM, DIST ) 00003 * 00004 * -- LAPACK test routine (version 3.1) -- 00005 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER DIST, TYPE 00010 CHARACTER*3 PATH 00011 INTEGER IMAT, KL, KU, M, MODE, N 00012 REAL ANORM, CNDNUM 00013 * .. 00014 * 00015 * Purpose 00016 * ======= 00017 * 00018 * SLATB4 sets parameters for the matrix generator based on the type of 00019 * matrix to be generated. 00020 * 00021 * Arguments 00022 * ========= 00023 * 00024 * PATH (input) CHARACTER*3 00025 * The LAPACK path name. 00026 * 00027 * IMAT (input) INTEGER 00028 * An integer key describing which matrix to generate for this 00029 * path. 00030 * 00031 * M (input) INTEGER 00032 * The number of rows in the matrix to be generated. 00033 * 00034 * N (input) INTEGER 00035 * The number of columns in the matrix to be generated. 00036 * 00037 * TYPE (output) CHARACTER*1 00038 * The type of the matrix to be generated: 00039 * = 'S': symmetric matrix 00040 * = 'P': symmetric positive (semi)definite matrix 00041 * = 'N': nonsymmetric matrix 00042 * 00043 * KL (output) INTEGER 00044 * The lower band width of the matrix to be generated. 00045 * 00046 * KU (output) INTEGER 00047 * The upper band width of the matrix to be generated. 00048 * 00049 * ANORM (output) REAL 00050 * The desired norm of the matrix to be generated. The diagonal 00051 * matrix of singular values or eigenvalues is scaled by this 00052 * value. 00053 * 00054 * MODE (output) INTEGER 00055 * A key indicating how to choose the vector of eigenvalues. 00056 * 00057 * CNDNUM (output) REAL 00058 * The desired condition number. 00059 * 00060 * DIST (output) CHARACTER*1 00061 * The type of distribution to be used by the random number 00062 * generator. 00063 * 00064 * ===================================================================== 00065 * 00066 * .. Parameters .. 00067 REAL SHRINK, TENTH 00068 PARAMETER ( SHRINK = 0.25E0, TENTH = 0.1E+0 ) 00069 REAL ONE 00070 PARAMETER ( ONE = 1.0E+0 ) 00071 REAL TWO 00072 PARAMETER ( TWO = 2.0E+0 ) 00073 * .. 00074 * .. Local Scalars .. 00075 LOGICAL FIRST 00076 CHARACTER*2 C2 00077 INTEGER MAT 00078 REAL BADC1, BADC2, EPS, LARGE, SMALL 00079 * .. 00080 * .. External Functions .. 00081 LOGICAL LSAMEN 00082 REAL SLAMCH 00083 EXTERNAL LSAMEN, SLAMCH 00084 * .. 00085 * .. Intrinsic Functions .. 00086 INTRINSIC ABS, MAX, SQRT 00087 * .. 00088 * .. External Subroutines .. 00089 EXTERNAL SLABAD 00090 * .. 00091 * .. Save statement .. 00092 SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST 00093 * .. 00094 * .. Data statements .. 00095 DATA FIRST / .TRUE. / 00096 * .. 00097 * .. Executable Statements .. 00098 * 00099 * Set some constants for use in the subroutine. 00100 * 00101 IF( FIRST ) THEN 00102 FIRST = .FALSE. 00103 EPS = SLAMCH( 'Precision' ) 00104 BADC2 = TENTH / EPS 00105 BADC1 = SQRT( BADC2 ) 00106 SMALL = SLAMCH( 'Safe minimum' ) 00107 LARGE = ONE / SMALL 00108 * 00109 * If it looks like we're on a Cray, take the square root of 00110 * SMALL and LARGE to avoid overflow and underflow problems. 00111 * 00112 CALL SLABAD( SMALL, LARGE ) 00113 SMALL = SHRINK*( SMALL / EPS ) 00114 LARGE = ONE / SMALL 00115 END IF 00116 * 00117 C2 = PATH( 2: 3 ) 00118 * 00119 * Set some parameters we don't plan to change. 00120 * 00121 DIST = 'S' 00122 MODE = 3 00123 * 00124 IF( LSAMEN( 2, C2, 'QR' ) .OR. LSAMEN( 2, C2, 'LQ' ) .OR. 00125 $ LSAMEN( 2, C2, 'QL' ) .OR. LSAMEN( 2, C2, 'RQ' ) ) THEN 00126 * 00127 * xQR, xLQ, xQL, xRQ: Set parameters to generate a general 00128 * M x N matrix. 00129 * 00130 * Set TYPE, the type of matrix to be generated. 00131 * 00132 TYPE = 'N' 00133 * 00134 * Set the lower and upper bandwidths. 00135 * 00136 IF( IMAT.EQ.1 ) THEN 00137 KL = 0 00138 KU = 0 00139 ELSE IF( IMAT.EQ.2 ) THEN 00140 KL = 0 00141 KU = MAX( N-1, 0 ) 00142 ELSE IF( IMAT.EQ.3 ) THEN 00143 KL = MAX( M-1, 0 ) 00144 KU = 0 00145 ELSE 00146 KL = MAX( M-1, 0 ) 00147 KU = MAX( N-1, 0 ) 00148 END IF 00149 * 00150 * Set the condition number and norm. 00151 * 00152 IF( IMAT.EQ.5 ) THEN 00153 CNDNUM = BADC1 00154 ELSE IF( IMAT.EQ.6 ) THEN 00155 CNDNUM = BADC2 00156 ELSE 00157 CNDNUM = TWO 00158 END IF 00159 * 00160 IF( IMAT.EQ.7 ) THEN 00161 ANORM = SMALL 00162 ELSE IF( IMAT.EQ.8 ) THEN 00163 ANORM = LARGE 00164 ELSE 00165 ANORM = ONE 00166 END IF 00167 * 00168 ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN 00169 * 00170 * xGE: Set parameters to generate a general M x N matrix. 00171 * 00172 * Set TYPE, the type of matrix to be generated. 00173 * 00174 TYPE = 'N' 00175 * 00176 * Set the lower and upper bandwidths. 00177 * 00178 IF( IMAT.EQ.1 ) THEN 00179 KL = 0 00180 KU = 0 00181 ELSE IF( IMAT.EQ.2 ) THEN 00182 KL = 0 00183 KU = MAX( N-1, 0 ) 00184 ELSE IF( IMAT.EQ.3 ) THEN 00185 KL = MAX( M-1, 0 ) 00186 KU = 0 00187 ELSE 00188 KL = MAX( M-1, 0 ) 00189 KU = MAX( N-1, 0 ) 00190 END IF 00191 * 00192 * Set the condition number and norm. 00193 * 00194 IF( IMAT.EQ.8 ) THEN 00195 CNDNUM = BADC1 00196 ELSE IF( IMAT.EQ.9 ) THEN 00197 CNDNUM = BADC2 00198 ELSE 00199 CNDNUM = TWO 00200 END IF 00201 * 00202 IF( IMAT.EQ.10 ) THEN 00203 ANORM = SMALL 00204 ELSE IF( IMAT.EQ.11 ) THEN 00205 ANORM = LARGE 00206 ELSE 00207 ANORM = ONE 00208 END IF 00209 * 00210 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 00211 * 00212 * xGB: Set parameters to generate a general banded matrix. 00213 * 00214 * Set TYPE, the type of matrix to be generated. 00215 * 00216 TYPE = 'N' 00217 * 00218 * Set the condition number and norm. 00219 * 00220 IF( IMAT.EQ.5 ) THEN 00221 CNDNUM = BADC1 00222 ELSE IF( IMAT.EQ.6 ) THEN 00223 CNDNUM = TENTH*BADC2 00224 ELSE 00225 CNDNUM = TWO 00226 END IF 00227 * 00228 IF( IMAT.EQ.7 ) THEN 00229 ANORM = SMALL 00230 ELSE IF( IMAT.EQ.8 ) THEN 00231 ANORM = LARGE 00232 ELSE 00233 ANORM = ONE 00234 END IF 00235 * 00236 ELSE IF( LSAMEN( 2, C2, 'GT' ) ) THEN 00237 * 00238 * xGT: Set parameters to generate a general tridiagonal matrix. 00239 * 00240 * Set TYPE, the type of matrix to be generated. 00241 * 00242 TYPE = 'N' 00243 * 00244 * Set the lower and upper bandwidths. 00245 * 00246 IF( IMAT.EQ.1 ) THEN 00247 KL = 0 00248 ELSE 00249 KL = 1 00250 END IF 00251 KU = KL 00252 * 00253 * Set the condition number and norm. 00254 * 00255 IF( IMAT.EQ.3 ) THEN 00256 CNDNUM = BADC1 00257 ELSE IF( IMAT.EQ.4 ) THEN 00258 CNDNUM = BADC2 00259 ELSE 00260 CNDNUM = TWO 00261 END IF 00262 * 00263 IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN 00264 ANORM = SMALL 00265 ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN 00266 ANORM = LARGE 00267 ELSE 00268 ANORM = ONE 00269 END IF 00270 * 00271 ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'PP' ) .OR. 00272 $ LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 2, C2, 'SP' ) ) THEN 00273 * 00274 * xPO, xPP, xSY, xSP: Set parameters to generate a 00275 * symmetric matrix. 00276 * 00277 * Set TYPE, the type of matrix to be generated. 00278 * 00279 TYPE = C2( 1: 1 ) 00280 * 00281 * Set the lower and upper bandwidths. 00282 * 00283 IF( IMAT.EQ.1 ) THEN 00284 KL = 0 00285 ELSE 00286 KL = MAX( N-1, 0 ) 00287 END IF 00288 KU = KL 00289 * 00290 * Set the condition number and norm. 00291 * 00292 IF( IMAT.EQ.6 ) THEN 00293 CNDNUM = BADC1 00294 ELSE IF( IMAT.EQ.7 ) THEN 00295 CNDNUM = BADC2 00296 ELSE 00297 CNDNUM = TWO 00298 END IF 00299 * 00300 IF( IMAT.EQ.8 ) THEN 00301 ANORM = SMALL 00302 ELSE IF( IMAT.EQ.9 ) THEN 00303 ANORM = LARGE 00304 ELSE 00305 ANORM = ONE 00306 END IF 00307 * 00308 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN 00309 * 00310 * xPB: Set parameters to generate a symmetric band matrix. 00311 * 00312 * Set TYPE, the type of matrix to be generated. 00313 * 00314 TYPE = 'P' 00315 * 00316 * Set the norm and condition number. 00317 * 00318 IF( IMAT.EQ.5 ) THEN 00319 CNDNUM = BADC1 00320 ELSE IF( IMAT.EQ.6 ) THEN 00321 CNDNUM = BADC2 00322 ELSE 00323 CNDNUM = TWO 00324 END IF 00325 * 00326 IF( IMAT.EQ.7 ) THEN 00327 ANORM = SMALL 00328 ELSE IF( IMAT.EQ.8 ) THEN 00329 ANORM = LARGE 00330 ELSE 00331 ANORM = ONE 00332 END IF 00333 * 00334 ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN 00335 * 00336 * xPT: Set parameters to generate a symmetric positive definite 00337 * tridiagonal matrix. 00338 * 00339 TYPE = 'P' 00340 IF( IMAT.EQ.1 ) THEN 00341 KL = 0 00342 ELSE 00343 KL = 1 00344 END IF 00345 KU = KL 00346 * 00347 * Set the condition number and norm. 00348 * 00349 IF( IMAT.EQ.3 ) THEN 00350 CNDNUM = BADC1 00351 ELSE IF( IMAT.EQ.4 ) THEN 00352 CNDNUM = BADC2 00353 ELSE 00354 CNDNUM = TWO 00355 END IF 00356 * 00357 IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN 00358 ANORM = SMALL 00359 ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN 00360 ANORM = LARGE 00361 ELSE 00362 ANORM = ONE 00363 END IF 00364 * 00365 ELSE IF( LSAMEN( 2, C2, 'TR' ) .OR. LSAMEN( 2, C2, 'TP' ) ) THEN 00366 * 00367 * xTR, xTP: Set parameters to generate a triangular matrix 00368 * 00369 * Set TYPE, the type of matrix to be generated. 00370 * 00371 TYPE = 'N' 00372 * 00373 * Set the lower and upper bandwidths. 00374 * 00375 MAT = ABS( IMAT ) 00376 IF( MAT.EQ.1 .OR. MAT.EQ.7 ) THEN 00377 KL = 0 00378 KU = 0 00379 ELSE IF( IMAT.LT.0 ) THEN 00380 KL = MAX( N-1, 0 ) 00381 KU = 0 00382 ELSE 00383 KL = 0 00384 KU = MAX( N-1, 0 ) 00385 END IF 00386 * 00387 * Set the condition number and norm. 00388 * 00389 IF( MAT.EQ.3 .OR. MAT.EQ.9 ) THEN 00390 CNDNUM = BADC1 00391 ELSE IF( MAT.EQ.4 ) THEN 00392 CNDNUM = BADC2 00393 ELSE IF( MAT.EQ.10 ) THEN 00394 CNDNUM = BADC2 00395 ELSE 00396 CNDNUM = TWO 00397 END IF 00398 * 00399 IF( MAT.EQ.5 ) THEN 00400 ANORM = SMALL 00401 ELSE IF( MAT.EQ.6 ) THEN 00402 ANORM = LARGE 00403 ELSE 00404 ANORM = ONE 00405 END IF 00406 * 00407 ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN 00408 * 00409 * xTB: Set parameters to generate a triangular band matrix. 00410 * 00411 * Set TYPE, the type of matrix to be generated. 00412 * 00413 TYPE = 'N' 00414 * 00415 * Set the norm and condition number. 00416 * 00417 IF( IMAT.EQ.2 .OR. IMAT.EQ.8 ) THEN 00418 CNDNUM = BADC1 00419 ELSE IF( IMAT.EQ.3 .OR. IMAT.EQ.9 ) THEN 00420 CNDNUM = BADC2 00421 ELSE 00422 CNDNUM = TWO 00423 END IF 00424 * 00425 IF( IMAT.EQ.4 ) THEN 00426 ANORM = SMALL 00427 ELSE IF( IMAT.EQ.5 ) THEN 00428 ANORM = LARGE 00429 ELSE 00430 ANORM = ONE 00431 END IF 00432 END IF 00433 IF( N.LE.1 ) 00434 $ CNDNUM = ONE 00435 * 00436 RETURN 00437 * 00438 * End of SLATB4 00439 * 00440 END
1.7.3 
