![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b TSTIEE 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Authors: 00009 * ======== 00010 * 00011 *> \author Univ. of Tennessee 00012 *> \author Univ. of California Berkeley 00013 *> \author Univ. of Colorado Denver 00014 *> \author NAG Ltd. 00015 * 00016 *> \date November 2011 00017 * 00018 *> \ingroup auxOTHERauxiliary 00019 * 00020 * ===================================================================== 00021 PROGRAM TSTIEE 00022 * 00023 * -- LAPACK test routine (version 3.4.0) -- 00024 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00025 * November 2006 00026 * 00027 * .. External Functions .. 00028 INTEGER ILAENV 00029 EXTERNAL ILAENV 00030 * .. 00031 * .. Local Scalars .. 00032 INTEGER IEEEOK 00033 * .. 00034 * .. Executable Statements .. 00035 * 00036 WRITE( 6, FMT = * ) 00037 $ 'We are about to check whether infinity arithmetic' 00038 WRITE( 6, FMT = * )'can be trusted. If this test hangs, set' 00039 WRITE( 6, FMT = * ) 00040 $ 'ILAENV = 0 for ISPEC = 10 in LAPACK/SRC/ilaenv.f' 00041 * 00042 IEEEOK = ILAENV( 10, 'ILAENV', 'N', 1, 2, 3, 4 ) 00043 WRITE( 6, FMT = * ) 00044 * 00045 IF( IEEEOK.EQ.0 ) THEN 00046 WRITE( 6, FMT = * ) 00047 $ 'Infinity arithmetic did not perform per the ieee spec' 00048 ELSE 00049 WRITE( 6, FMT = * ) 00050 $ 'Infinity arithmetic performed as per the ieee spec.' 00051 WRITE( 6, FMT = * ) 00052 $ 'However, this is not an exhaustive test and does not' 00053 WRITE( 6, FMT = * ) 00054 $ 'guarantee that infinity arithmetic meets the', 00055 $ ' ieee spec.' 00056 END IF 00057 * 00058 WRITE( 6, FMT = * ) 00059 WRITE( 6, FMT = * ) 00060 $ 'We are about to check whether NaN arithmetic' 00061 WRITE( 6, FMT = * )'can be trusted. If this test hangs, set' 00062 WRITE( 6, FMT = * ) 00063 $ 'ILAENV = 0 for ISPEC = 11 in LAPACK/SRC/ilaenv.f' 00064 IEEEOK = ILAENV( 11, 'ILAENV', 'N', 1, 2, 3, 4 ) 00065 * 00066 WRITE( 6, FMT = * ) 00067 IF( IEEEOK.EQ.0 ) THEN 00068 WRITE( 6, FMT = * ) 00069 $ 'NaN arithmetic did not perform per the ieee spec' 00070 ELSE 00071 WRITE( 6, FMT = * )'NaN arithmetic performed as per the ieee', 00072 $ ' spec.' 00073 WRITE( 6, FMT = * ) 00074 $ 'However, this is not an exhaustive test and does not' 00075 WRITE( 6, FMT = * )'guarantee that NaN arithmetic meets the', 00076 $ ' ieee spec.' 00077 END IF 00078 WRITE( 6, FMT = * ) 00079 * 00080 END 00081 INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, 00082 $ N4 ) 00083 * 00084 * -- LAPACK auxiliary routine (version 3.4.0) -- 00085 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00086 * November 2006 00087 * 00088 * .. Scalar Arguments .. 00089 CHARACTER*( * ) NAME, OPTS 00090 INTEGER ISPEC, N1, N2, N3, N4 00091 * .. 00092 * 00093 * Purpose 00094 * ======= 00095 * 00096 * ILAENV is called from the LAPACK routines to choose problem-dependent 00097 * parameters for the local environment. See ISPEC for a description of 00098 * the parameters. 00099 * 00100 * This version provides a set of parameters which should give good, 00101 * but not optimal, performance on many of the currently available 00102 * computers. Users are encouraged to modify this subroutine to set 00103 * the tuning parameters for their particular machine using the option 00104 * and problem size information in the arguments. 00105 * 00106 * This routine will not function correctly if it is converted to all 00107 * lower case. Converting it to all upper case is allowed. 00108 * 00109 * Arguments: 00110 * ========== 00111 * 00112 * ISPEC (input) INTEGER 00113 * Specifies the parameter to be returned as the value of 00114 * ILAENV. 00115 * = 1: the optimal blocksize; if this value is 1, an unblocked 00116 * algorithm will give the best performance. 00117 * = 2: the minimum block size for which the block routine 00118 * should be used; if the usable block size is less than 00119 * this value, an unblocked routine should be used. 00120 * = 3: the crossover point (in a block routine, for N less 00121 * than this value, an unblocked routine should be used) 00122 * = 4: the number of shifts, used in the nonsymmetric 00123 * eigenvalue routines 00124 * = 5: the minimum column dimension for blocking to be used; 00125 * rectangular blocks must have dimension at least k by m, 00126 * where k is given by ILAENV(2,...) and m by ILAENV(5,...) 00127 * = 6: the crossover point for the SVD (when reducing an m by n 00128 * matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds 00129 * this value, a QR factorization is used first to reduce 00130 * the matrix to a triangular form.) 00131 * = 7: the number of processors 00132 * = 8: the crossover point for the multishift QR and QZ methods 00133 * for nonsymmetric eigenvalue problems. 00134 * = 9: maximum size of the subproblems at the bottom of the 00135 * computation tree in the divide-and-conquer algorithm 00136 * (used by xGELSD and xGESDD) 00137 * =10: ieee NaN arithmetic can be trusted not to trap 00138 * =11: infinity arithmetic can be trusted not to trap 00139 * 00140 * NAME (input) CHARACTER*(*) 00141 * The name of the calling subroutine, in either upper case or 00142 * lower case. 00143 * 00144 * OPTS (input) CHARACTER*(*) 00145 * The character options to the subroutine NAME, concatenated 00146 * into a single character string. For example, UPLO = 'U', 00147 * TRANS = 'T', and DIAG = 'N' for a triangular routine would 00148 * be specified as OPTS = 'UTN'. 00149 * 00150 * N1 (input) INTEGER 00151 * N2 (input) INTEGER 00152 * N3 (input) INTEGER 00153 * N4 (input) INTEGER 00154 * Problem dimensions for the subroutine NAME; these may not all 00155 * be required. 00156 * 00157 * (ILAENV) (output) INTEGER 00158 * >= 0: the value of the parameter specified by ISPEC 00159 * < 0: if ILAENV = -k, the k-th argument had an illegal value. 00160 * 00161 * Further Details 00162 * =============== 00163 * 00164 * The following conventions have been used when calling ILAENV from the 00165 * LAPACK routines: 00166 * 1) OPTS is a concatenation of all of the character options to 00167 * subroutine NAME, in the same order that they appear in the 00168 * argument list for NAME, even if they are not used in determining 00169 * the value of the parameter specified by ISPEC. 00170 * 2) The problem dimensions N1, N2, N3, N4 are specified in the order 00171 * that they appear in the argument list for NAME. N1 is used 00172 * first, N2 second, and so on, and unused problem dimensions are 00173 * passed a value of -1. 00174 * 3) The parameter value returned by ILAENV is checked for validity in 00175 * the calling subroutine. For example, ILAENV is used to retrieve 00176 * the optimal blocksize for STRTRI as follows: 00177 * 00178 * NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) 00179 * IF( NB.LE.1 ) NB = MAX( 1, N ) 00180 * 00181 * ===================================================================== 00182 * 00183 * .. Local Scalars .. 00184 LOGICAL CNAME, SNAME 00185 CHARACTER*1 C1 00186 CHARACTER*2 C2, C4 00187 CHARACTER*3 C3 00188 CHARACTER*6 SUBNAM 00189 INTEGER I, IC, IZ, NB, NBMIN, NX 00190 * .. 00191 * .. Intrinsic Functions .. 00192 INTRINSIC CHAR, ICHAR, INT, MIN, REAL 00193 * .. 00194 * .. External Functions .. 00195 INTEGER IEEECK 00196 EXTERNAL IEEECK 00197 * .. 00198 * .. Executable Statements .. 00199 * 00200 GO TO ( 100, 100, 100, 400, 500, 600, 700, 800, 900, 1000, 00201 $ 1100 ) ISPEC 00202 * 00203 * Invalid value for ISPEC 00204 * 00205 ILAENV = -1 00206 RETURN 00207 * 00208 100 CONTINUE 00209 * 00210 * Convert NAME to upper case if the first character is lower case. 00211 * 00212 ILAENV = 1 00213 SUBNAM = NAME 00214 IC = ICHAR( SUBNAM( 1:1 ) ) 00215 IZ = ICHAR( 'Z' ) 00216 IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN 00217 * 00218 * ASCII character set 00219 * 00220 IF( IC.GE.97 .AND. IC.LE.122 ) THEN 00221 SUBNAM( 1:1 ) = CHAR( IC-32 ) 00222 DO 10 I = 2, 6 00223 IC = ICHAR( SUBNAM( I:I ) ) 00224 IF( IC.GE.97 .AND. IC.LE.122 ) 00225 $ SUBNAM( I:I ) = CHAR( IC-32 ) 00226 10 CONTINUE 00227 END IF 00228 * 00229 ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN 00230 * 00231 * EBCDIC character set 00232 * 00233 IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR. 00234 $ ( IC.GE.145 .AND. IC.LE.153 ) .OR. 00235 $ ( IC.GE.162 .AND. IC.LE.169 ) ) THEN 00236 SUBNAM( 1:1 ) = CHAR( IC+64 ) 00237 DO 20 I = 2, 6 00238 IC = ICHAR( SUBNAM( I:I ) ) 00239 IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR. 00240 $ ( IC.GE.145 .AND. IC.LE.153 ) .OR. 00241 $ ( IC.GE.162 .AND. IC.LE.169 ) ) 00242 $ SUBNAM( I:I ) = CHAR( IC+64 ) 00243 20 CONTINUE 00244 END IF 00245 * 00246 ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN 00247 * 00248 * Prime machines: ASCII+128 00249 * 00250 IF( IC.GE.225 .AND. IC.LE.250 ) THEN 00251 SUBNAM( 1:1 ) = CHAR( IC-32 ) 00252 DO 30 I = 2, 6 00253 IC = ICHAR( SUBNAM( I:I ) ) 00254 IF( IC.GE.225 .AND. IC.LE.250 ) 00255 $ SUBNAM( I:I ) = CHAR( IC-32 ) 00256 30 CONTINUE 00257 END IF 00258 END IF 00259 * 00260 C1 = SUBNAM( 1:1 ) 00261 SNAME = C1.EQ.'S' .OR. C1.EQ.'D' 00262 CNAME = C1.EQ.'C' .OR. C1.EQ.'Z' 00263 IF( .NOT.( CNAME .OR. SNAME ) ) 00264 $ RETURN 00265 C2 = SUBNAM( 2:3 ) 00266 C3 = SUBNAM( 4:6 ) 00267 C4 = C3( 2:3 ) 00268 * 00269 GO TO ( 110, 200, 300 ) ISPEC 00270 * 00271 110 CONTINUE 00272 * 00273 * ISPEC = 1: block size 00274 * 00275 * In these examples, separate code is provided for setting NB for 00276 * real and complex. We assume that NB will take the same value in 00277 * single or double precision. 00278 * 00279 NB = 1 00280 * 00281 IF( C2.EQ.'GE' ) THEN 00282 IF( C3.EQ.'TRF' ) THEN 00283 IF( SNAME ) THEN 00284 NB = 64 00285 ELSE 00286 NB = 64 00287 END IF 00288 ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. 00289 $ C3.EQ.'QLF' ) THEN 00290 IF( SNAME ) THEN 00291 NB = 32 00292 ELSE 00293 NB = 32 00294 END IF 00295 ELSE IF( C3.EQ.'HRD' ) THEN 00296 IF( SNAME ) THEN 00297 NB = 32 00298 ELSE 00299 NB = 32 00300 END IF 00301 ELSE IF( C3.EQ.'BRD' ) THEN 00302 IF( SNAME ) THEN 00303 NB = 32 00304 ELSE 00305 NB = 32 00306 END IF 00307 ELSE IF( C3.EQ.'TRI' ) THEN 00308 IF( SNAME ) THEN 00309 NB = 64 00310 ELSE 00311 NB = 64 00312 END IF 00313 END IF 00314 ELSE IF( C2.EQ.'PO' ) THEN 00315 IF( C3.EQ.'TRF' ) THEN 00316 IF( SNAME ) THEN 00317 NB = 64 00318 ELSE 00319 NB = 64 00320 END IF 00321 END IF 00322 ELSE IF( C2.EQ.'SY' ) THEN 00323 IF( C3.EQ.'TRF' ) THEN 00324 IF( SNAME ) THEN 00325 NB = 64 00326 ELSE 00327 NB = 64 00328 END IF 00329 ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN 00330 NB = 32 00331 ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN 00332 NB = 64 00333 END IF 00334 ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN 00335 IF( C3.EQ.'TRF' ) THEN 00336 NB = 64 00337 ELSE IF( C3.EQ.'TRD' ) THEN 00338 NB = 32 00339 ELSE IF( C3.EQ.'GST' ) THEN 00340 NB = 64 00341 END IF 00342 ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN 00343 IF( C3( 1:1 ).EQ.'G' ) THEN 00344 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. 00345 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. 00346 $ C4.EQ.'BR' ) THEN 00347 NB = 32 00348 END IF 00349 ELSE IF( C3( 1:1 ).EQ.'M' ) THEN 00350 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. 00351 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. 00352 $ C4.EQ.'BR' ) THEN 00353 NB = 32 00354 END IF 00355 END IF 00356 ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN 00357 IF( C3( 1:1 ).EQ.'G' ) THEN 00358 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. 00359 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. 00360 $ C4.EQ.'BR' ) THEN 00361 NB = 32 00362 END IF 00363 ELSE IF( C3( 1:1 ).EQ.'M' ) THEN 00364 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. 00365 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. 00366 $ C4.EQ.'BR' ) THEN 00367 NB = 32 00368 END IF 00369 END IF 00370 ELSE IF( C2.EQ.'GB' ) THEN 00371 IF( C3.EQ.'TRF' ) THEN 00372 IF( SNAME ) THEN 00373 IF( N4.LE.64 ) THEN 00374 NB = 1 00375 ELSE 00376 NB = 32 00377 END IF 00378 ELSE 00379 IF( N4.LE.64 ) THEN 00380 NB = 1 00381 ELSE 00382 NB = 32 00383 END IF 00384 END IF 00385 END IF 00386 ELSE IF( C2.EQ.'PB' ) THEN 00387 IF( C3.EQ.'TRF' ) THEN 00388 IF( SNAME ) THEN 00389 IF( N2.LE.64 ) THEN 00390 NB = 1 00391 ELSE 00392 NB = 32 00393 END IF 00394 ELSE 00395 IF( N2.LE.64 ) THEN 00396 NB = 1 00397 ELSE 00398 NB = 32 00399 END IF 00400 END IF 00401 END IF 00402 ELSE IF( C2.EQ.'TR' ) THEN 00403 IF( C3.EQ.'TRI' ) THEN 00404 IF( SNAME ) THEN 00405 NB = 64 00406 ELSE 00407 NB = 64 00408 END IF 00409 END IF 00410 ELSE IF( C2.EQ.'LA' ) THEN 00411 IF( C3.EQ.'UUM' ) THEN 00412 IF( SNAME ) THEN 00413 NB = 64 00414 ELSE 00415 NB = 64 00416 END IF 00417 END IF 00418 ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN 00419 IF( C3.EQ.'EBZ' ) THEN 00420 NB = 1 00421 END IF 00422 END IF 00423 ILAENV = NB 00424 RETURN 00425 * 00426 200 CONTINUE 00427 * 00428 * ISPEC = 2: minimum block size 00429 * 00430 NBMIN = 2 00431 IF( C2.EQ.'GE' ) THEN 00432 IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. 00433 $ C3.EQ.'QLF' ) THEN 00434 IF( SNAME ) THEN 00435 NBMIN = 2 00436 ELSE 00437 NBMIN = 2 00438 END IF 00439 ELSE IF( C3.EQ.'HRD' ) THEN 00440 IF( SNAME ) THEN 00441 NBMIN = 2 00442 ELSE 00443 NBMIN = 2 00444 END IF 00445 ELSE IF( C3.EQ.'BRD' ) THEN 00446 IF( SNAME ) THEN 00447 NBMIN = 2 00448 ELSE 00449 NBMIN = 2 00450 END IF 00451 ELSE IF( C3.EQ.'TRI' ) THEN 00452 IF( SNAME ) THEN 00453 NBMIN = 2 00454 ELSE 00455 NBMIN = 2 00456 END IF 00457 END IF 00458 ELSE IF( C2.EQ.'SY' ) THEN 00459 IF( C3.EQ.'TRF' ) THEN 00460 IF( SNAME ) THEN 00461 NBMIN = 8 00462 ELSE 00463 NBMIN = 8 00464 END IF 00465 ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN 00466 NBMIN = 2 00467 END IF 00468 ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN 00469 IF( C3.EQ.'TRD' ) THEN 00470 NBMIN = 2 00471 END IF 00472 ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN 00473 IF( C3( 1:1 ).EQ.'G' ) THEN 00474 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. 00475 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. 00476 $ C4.EQ.'BR' ) THEN 00477 NBMIN = 2 00478 END IF 00479 ELSE IF( C3( 1:1 ).EQ.'M' ) THEN 00480 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. 00481 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. 00482 $ C4.EQ.'BR' ) THEN 00483 NBMIN = 2 00484 END IF 00485 END IF 00486 ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN 00487 IF( C3( 1:1 ).EQ.'G' ) THEN 00488 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. 00489 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. 00490 $ C4.EQ.'BR' ) THEN 00491 NBMIN = 2 00492 END IF 00493 ELSE IF( C3( 1:1 ).EQ.'M' ) THEN 00494 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. 00495 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. 00496 $ C4.EQ.'BR' ) THEN 00497 NBMIN = 2 00498 END IF 00499 END IF 00500 END IF 00501 ILAENV = NBMIN 00502 RETURN 00503 * 00504 300 CONTINUE 00505 * 00506 * ISPEC = 3: crossover point 00507 * 00508 NX = 0 00509 IF( C2.EQ.'GE' ) THEN 00510 IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. 00511 $ C3.EQ.'QLF' ) THEN 00512 IF( SNAME ) THEN 00513 NX = 128 00514 ELSE 00515 NX = 128 00516 END IF 00517 ELSE IF( C3.EQ.'HRD' ) THEN 00518 IF( SNAME ) THEN 00519 NX = 128 00520 ELSE 00521 NX = 128 00522 END IF 00523 ELSE IF( C3.EQ.'BRD' ) THEN 00524 IF( SNAME ) THEN 00525 NX = 128 00526 ELSE 00527 NX = 128 00528 END IF 00529 END IF 00530 ELSE IF( C2.EQ.'SY' ) THEN 00531 IF( SNAME .AND. C3.EQ.'TRD' ) THEN 00532 NX = 32 00533 END IF 00534 ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN 00535 IF( C3.EQ.'TRD' ) THEN 00536 NX = 32 00537 END IF 00538 ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN 00539 IF( C3( 1:1 ).EQ.'G' ) THEN 00540 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. 00541 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. 00542 $ C4.EQ.'BR' ) THEN 00543 NX = 128 00544 END IF 00545 END IF 00546 ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN 00547 IF( C3( 1:1 ).EQ.'G' ) THEN 00548 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. 00549 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. 00550 $ C4.EQ.'BR' ) THEN 00551 NX = 128 00552 END IF 00553 END IF 00554 END IF 00555 ILAENV = NX 00556 RETURN 00557 * 00558 400 CONTINUE 00559 * 00560 * ISPEC = 4: number of shifts (used by xHSEQR) 00561 * 00562 ILAENV = 6 00563 RETURN 00564 * 00565 500 CONTINUE 00566 * 00567 * ISPEC = 5: minimum column dimension (not used) 00568 * 00569 ILAENV = 2 00570 RETURN 00571 * 00572 600 CONTINUE 00573 * 00574 * ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) 00575 * 00576 ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 ) 00577 RETURN 00578 * 00579 700 CONTINUE 00580 * 00581 * ISPEC = 7: number of processors (not used) 00582 * 00583 ILAENV = 1 00584 RETURN 00585 * 00586 800 CONTINUE 00587 * 00588 * ISPEC = 8: crossover point for multishift (used by xHSEQR) 00589 * 00590 ILAENV = 50 00591 RETURN 00592 * 00593 900 CONTINUE 00594 * 00595 * ISPEC = 9: maximum size of the subproblems at the bottom of the 00596 * computation tree in the divide-and-conquer algorithm 00597 * (used by xGELSD and xGESDD) 00598 * 00599 ILAENV = 25 00600 RETURN 00601 * 00602 1000 CONTINUE 00603 * 00604 * ISPEC = 10: ieee NaN arithmetic can be trusted not to trap 00605 * 00606 ILAENV = 1 00607 IF (ILAENV .EQ. 1) THEN 00608 ILAENV = IEEECK( 0, 0.0, 1.0 ) 00609 ENDIF 00610 RETURN 00611 * 00612 1100 CONTINUE 00613 * 00614 * ISPEC = 11: infinity arithmetic can be trusted not to trap 00615 * 00616 ILAENV = 1 00617 IF (ILAENV .EQ. 1) THEN 00618 ILAENV = IEEECK( 1, 0.0, 1.0 ) 00619 ENDIF 00620 RETURN 00621 * 00622 * End of ILAENV 00623 * 00624 END 00625 INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) 00626 * 00627 * -- LAPACK auxiliary routine (version 3.4.0) -- 00628 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00629 * November 2006 00630 * 00631 * .. Scalar Arguments .. 00632 INTEGER ISPEC 00633 REAL ZERO, ONE 00634 * .. 00635 * 00636 * Purpose 00637 * ======= 00638 * 00639 * IEEECK is called from the ILAENV to verify that Inifinity and 00640 * possibly NaN arithmetic is safe (i.e. will not trap). 00641 * 00642 * Arguments: 00643 * ========== 00644 * 00645 * ISPEC (input) INTEGER 00646 * Specifies whether to test just for inifinity arithmetic 00647 * or whether to test for infinity and NaN arithmetic. 00648 * = 0: Verify infinity arithmetic only. 00649 * = 1: Verify infinity and NaN arithmetic. 00650 * 00651 * ZERO (input) REAL 00652 * Must contain the value 0.0 00653 * This is passed to prevent the compiler from optimizing 00654 * away this code. 00655 * 00656 * ONE (input) REAL 00657 * Must contain the value 1.0 00658 * This is passed to prevent the compiler from optimizing 00659 * away this code. 00660 * 00661 * RETURN VALUE: INTEGER 00662 * = 0: Arithmetic failed to produce the correct answers 00663 * = 1: Arithmetic produced the correct answers 00664 * 00665 * .. Local Scalars .. 00666 REAL POSINF, NEGINF, NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGZRO, 00667 $ NEWZRO 00668 * .. 00669 * .. Executable Statements .. 00670 IEEECK = 1 00671 00672 POSINF = ONE /ZERO 00673 IF ( POSINF .LE. ONE ) THEN 00674 IEEECK = 0 00675 RETURN 00676 ENDIF 00677 00678 NEGINF = -ONE / ZERO 00679 IF ( NEGINF .GE. ZERO ) THEN 00680 IEEECK = 0 00681 RETURN 00682 ENDIF 00683 00684 NEGZRO = ONE / ( NEGINF + ONE ) 00685 IF ( NEGZRO .NE. ZERO ) THEN 00686 IEEECK = 0 00687 RETURN 00688 ENDIF 00689 00690 NEGINF = ONE / NEGZRO 00691 IF ( NEGINF .GE. ZERO ) THEN 00692 IEEECK = 0 00693 RETURN 00694 ENDIF 00695 00696 NEWZRO = NEGZRO + ZERO 00697 IF ( NEWZRO .NE. ZERO ) THEN 00698 IEEECK = 0 00699 RETURN 00700 ENDIF 00701 00702 POSINF = ONE / NEWZRO 00703 IF ( POSINF .LE. ONE ) THEN 00704 IEEECK = 0 00705 RETURN 00706 ENDIF 00707 00708 NEGINF = NEGINF * POSINF 00709 IF ( NEGINF .GE. ZERO ) THEN 00710 IEEECK = 0 00711 RETURN 00712 ENDIF 00713 00714 POSINF = POSINF * POSINF 00715 IF ( POSINF .LE. ONE ) THEN 00716 IEEECK = 0 00717 RETURN 00718 ENDIF 00719 00720 00721 00722 * 00723 * Return if we were only asked to check infinity arithmetic 00724 * 00725 IF (ISPEC .EQ. 0 ) RETURN 00726 00727 NAN1 = POSINF + NEGINF 00728 00729 NAN2 = POSINF / NEGINF 00730 00731 NAN3 = POSINF / POSINF 00732 00733 NAN4 = POSINF * ZERO 00734 00735 NAN5 = NEGINF * NEGZRO 00736 00737 NAN6 = NAN5 * 0.0 00738 00739 IF ( NAN1 .EQ. NAN1 ) THEN 00740 IEEECK = 0 00741 RETURN 00742 ENDIF 00743 00744 IF ( NAN2 .EQ. NAN2 ) THEN 00745 IEEECK = 0 00746 RETURN 00747 ENDIF 00748 00749 IF ( NAN3 .EQ. NAN3 ) THEN 00750 IEEECK = 0 00751 RETURN 00752 ENDIF 00753 00754 IF ( NAN4 .EQ. NAN4 ) THEN 00755 IEEECK = 0 00756 RETURN 00757 ENDIF 00758 00759 IF ( NAN5 .EQ. NAN5 ) THEN 00760 IEEECK = 0 00761 RETURN 00762 ENDIF 00763 00764 IF ( NAN6 .EQ. NAN6 ) THEN 00765 IEEECK = 0 00766 RETURN 00767 ENDIF 00768 00769 RETURN 00770 END