00001
00002
00003
00004
00005 INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
00006 $ N4 )
00007
00008
00009
00010
00011
00012
00013
00014 CHARACTER*( * ) NAME, OPTS
00015 INTEGER ISPEC, N1, N2, N3, N4
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109 LOGICAL CNAME, SNAME
00110 CHARACTER*1 C1
00111 CHARACTER*2 C2, C4
00112 CHARACTER*3 C3
00113 CHARACTER*6 SUBNAM
00114 INTEGER I, IC, IZ, NB, NBMIN, NX
00115
00116
00117 INTRINSIC CHAR, ICHAR, INT, MIN, REAL
00118
00119
00120 INTEGER IEEECK
00121 EXTERNAL IEEECK
00122
00123
00124
00125 GO TO ( 100, 100, 100, 400, 500, 600, 700, 800, 900, 1000,
00126 $ 1100 ) ISPEC
00127
00128
00129
00130 ILAENV = -1
00131 RETURN
00132
00133 100 CONTINUE
00134
00135
00136
00137 ILAENV = 1
00138 SUBNAM = NAME
00139 IC = ICHAR( SUBNAM( 1:1 ) )
00140 IZ = ICHAR( 'Z' )
00141 IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN
00142
00143
00144
00145 IF( IC.GE.97 .AND. IC.LE.122 ) THEN
00146 SUBNAM( 1:1 ) = CHAR( IC-32 )
00147 DO 10 I = 2, 6
00148 IC = ICHAR( SUBNAM( I:I ) )
00149 IF( IC.GE.97 .AND. IC.LE.122 )
00150 $ SUBNAM( I:I ) = CHAR( IC-32 )
00151 10 CONTINUE
00152 END IF
00153
00154 ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN
00155
00156
00157
00158 IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
00159 $ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
00160 $ ( IC.GE.162 .AND. IC.LE.169 ) ) THEN
00161 SUBNAM( 1:1 ) = CHAR( IC+64 )
00162 DO 20 I = 2, 6
00163 IC = ICHAR( SUBNAM( I:I ) )
00164 IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
00165 $ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
00166 $ ( IC.GE.162 .AND. IC.LE.169 ) )
00167 $ SUBNAM( I:I ) = CHAR( IC+64 )
00168 20 CONTINUE
00169 END IF
00170
00171 ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN
00172
00173
00174
00175 IF( IC.GE.225 .AND. IC.LE.250 ) THEN
00176 SUBNAM( 1:1 ) = CHAR( IC-32 )
00177 DO 30 I = 2, 6
00178 IC = ICHAR( SUBNAM( I:I ) )
00179 IF( IC.GE.225 .AND. IC.LE.250 )
00180 $ SUBNAM( I:I ) = CHAR( IC-32 )
00181 30 CONTINUE
00182 END IF
00183 END IF
00184
00185 C1 = SUBNAM( 1:1 )
00186 SNAME = C1.EQ.'S' .OR. C1.EQ.'D'
00187 CNAME = C1.EQ.'C' .OR. C1.EQ.'Z'
00188 IF( .NOT.( CNAME .OR. SNAME ) )
00189 $ RETURN
00190 C2 = SUBNAM( 2:3 )
00191 C3 = SUBNAM( 4:6 )
00192 C4 = C3( 2:3 )
00193
00194 GO TO ( 110, 200, 300 ) ISPEC
00195
00196 110 CONTINUE
00197
00198
00199
00200
00201
00202
00203
00204 NB = 1
00205
00206 IF( C2.EQ.'GE' ) THEN
00207 IF( C3.EQ.'TRF' ) THEN
00208 IF( SNAME ) THEN
00209 NB = 64
00210 ELSE
00211 NB = 64
00212 END IF
00213 ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
00214 $ C3.EQ.'QLF' ) THEN
00215 IF( SNAME ) THEN
00216 NB = 32
00217 ELSE
00218 NB = 32
00219 END IF
00220 ELSE IF( C3.EQ.'HRD' ) THEN
00221 IF( SNAME ) THEN
00222 NB = 32
00223 ELSE
00224 NB = 32
00225 END IF
00226 ELSE IF( C3.EQ.'BRD' ) THEN
00227 IF( SNAME ) THEN
00228 NB = 32
00229 ELSE
00230 NB = 32
00231 END IF
00232 ELSE IF( C3.EQ.'TRI' ) THEN
00233 IF( SNAME ) THEN
00234 NB = 64
00235 ELSE
00236 NB = 64
00237 END IF
00238 END IF
00239 ELSE IF( C2.EQ.'PO' ) THEN
00240 IF( C3.EQ.'TRF' ) THEN
00241 IF( SNAME ) THEN
00242 NB = 64
00243 ELSE
00244 NB = 64
00245 END IF
00246 END IF
00247 ELSE IF( C2.EQ.'SY' ) THEN
00248 IF( C3.EQ.'TRF' ) THEN
00249 IF( SNAME ) THEN
00250 NB = 64
00251 ELSE
00252 NB = 64
00253 END IF
00254 ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
00255 NB = 32
00256 ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN
00257 NB = 64
00258 END IF
00259 ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
00260 IF( C3.EQ.'TRF' ) THEN
00261 NB = 64
00262 ELSE IF( C3.EQ.'TRD' ) THEN
00263 NB = 32
00264 ELSE IF( C3.EQ.'GST' ) THEN
00265 NB = 64
00266 END IF
00267 ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
00268 IF( C3( 1:1 ).EQ.'G' ) THEN
00269 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
00270 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
00271 $ C4.EQ.'BR' ) THEN
00272 NB = 32
00273 END IF
00274 ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
00275 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
00276 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
00277 $ C4.EQ.'BR' ) THEN
00278 NB = 32
00279 END IF
00280 END IF
00281 ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
00282 IF( C3( 1:1 ).EQ.'G' ) THEN
00283 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
00284 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
00285 $ C4.EQ.'BR' ) THEN
00286 NB = 32
00287 END IF
00288 ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
00289 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
00290 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
00291 $ C4.EQ.'BR' ) THEN
00292 NB = 32
00293 END IF
00294 END IF
00295 ELSE IF( C2.EQ.'GB' ) THEN
00296 IF( C3.EQ.'TRF' ) THEN
00297 IF( SNAME ) THEN
00298 IF( N4.LE.64 ) THEN
00299 NB = 1
00300 ELSE
00301 NB = 32
00302 END IF
00303 ELSE
00304 IF( N4.LE.64 ) THEN
00305 NB = 1
00306 ELSE
00307 NB = 32
00308 END IF
00309 END IF
00310 END IF
00311 ELSE IF( C2.EQ.'PB' ) THEN
00312 IF( C3.EQ.'TRF' ) THEN
00313 IF( SNAME ) THEN
00314 IF( N2.LE.64 ) THEN
00315 NB = 1
00316 ELSE
00317 NB = 32
00318 END IF
00319 ELSE
00320 IF( N2.LE.64 ) THEN
00321 NB = 1
00322 ELSE
00323 NB = 32
00324 END IF
00325 END IF
00326 END IF
00327 ELSE IF( C2.EQ.'TR' ) THEN
00328 IF( C3.EQ.'TRI' ) THEN
00329 IF( SNAME ) THEN
00330 NB = 64
00331 ELSE
00332 NB = 64
00333 END IF
00334 END IF
00335 ELSE IF( C2.EQ.'LA' ) THEN
00336 IF( C3.EQ.'UUM' ) THEN
00337 IF( SNAME ) THEN
00338 NB = 64
00339 ELSE
00340 NB = 64
00341 END IF
00342 END IF
00343 ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN
00344 IF( C3.EQ.'EBZ' ) THEN
00345 NB = 1
00346 END IF
00347 END IF
00348 ILAENV = NB
00349 RETURN
00350
00351 200 CONTINUE
00352
00353
00354
00355 NBMIN = 2
00356 IF( C2.EQ.'GE' ) THEN
00357 IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
00358 $ C3.EQ.'QLF' ) THEN
00359 IF( SNAME ) THEN
00360 NBMIN = 2
00361 ELSE
00362 NBMIN = 2
00363 END IF
00364 ELSE IF( C3.EQ.'HRD' ) THEN
00365 IF( SNAME ) THEN
00366 NBMIN = 2
00367 ELSE
00368 NBMIN = 2
00369 END IF
00370 ELSE IF( C3.EQ.'BRD' ) THEN
00371 IF( SNAME ) THEN
00372 NBMIN = 2
00373 ELSE
00374 NBMIN = 2
00375 END IF
00376 ELSE IF( C3.EQ.'TRI' ) THEN
00377 IF( SNAME ) THEN
00378 NBMIN = 2
00379 ELSE
00380 NBMIN = 2
00381 END IF
00382 END IF
00383 ELSE IF( C2.EQ.'SY' ) THEN
00384 IF( C3.EQ.'TRF' ) THEN
00385 IF( SNAME ) THEN
00386 NBMIN = 8
00387 ELSE
00388 NBMIN = 8
00389 END IF
00390 ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
00391 NBMIN = 2
00392 END IF
00393 ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
00394 IF( C3.EQ.'TRD' ) THEN
00395 NBMIN = 2
00396 END IF
00397 ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
00398 IF( C3( 1:1 ).EQ.'G' ) THEN
00399 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
00400 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
00401 $ C4.EQ.'BR' ) THEN
00402 NBMIN = 2
00403 END IF
00404 ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
00405 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
00406 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
00407 $ C4.EQ.'BR' ) THEN
00408 NBMIN = 2
00409 END IF
00410 END IF
00411 ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
00412 IF( C3( 1:1 ).EQ.'G' ) THEN
00413 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
00414 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
00415 $ C4.EQ.'BR' ) THEN
00416 NBMIN = 2
00417 END IF
00418 ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
00419 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
00420 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
00421 $ C4.EQ.'BR' ) THEN
00422 NBMIN = 2
00423 END IF
00424 END IF
00425 END IF
00426 ILAENV = NBMIN
00427 RETURN
00428
00429 300 CONTINUE
00430
00431
00432
00433 NX = 0
00434 IF( C2.EQ.'GE' ) THEN
00435 IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
00436 $ C3.EQ.'QLF' ) THEN
00437 IF( SNAME ) THEN
00438 NX = 128
00439 ELSE
00440 NX = 128
00441 END IF
00442 ELSE IF( C3.EQ.'HRD' ) THEN
00443 IF( SNAME ) THEN
00444 NX = 128
00445 ELSE
00446 NX = 128
00447 END IF
00448 ELSE IF( C3.EQ.'BRD' ) THEN
00449 IF( SNAME ) THEN
00450 NX = 128
00451 ELSE
00452 NX = 128
00453 END IF
00454 END IF
00455 ELSE IF( C2.EQ.'SY' ) THEN
00456 IF( SNAME .AND. C3.EQ.'TRD' ) THEN
00457 NX = 32
00458 END IF
00459 ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
00460 IF( C3.EQ.'TRD' ) THEN
00461 NX = 32
00462 END IF
00463 ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
00464 IF( C3( 1:1 ).EQ.'G' ) THEN
00465 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
00466 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
00467 $ C4.EQ.'BR' ) THEN
00468 NX = 128
00469 END IF
00470 END IF
00471 ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
00472 IF( C3( 1:1 ).EQ.'G' ) THEN
00473 IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
00474 $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
00475 $ C4.EQ.'BR' ) THEN
00476 NX = 128
00477 END IF
00478 END IF
00479 END IF
00480 ILAENV = NX
00481 RETURN
00482
00483 400 CONTINUE
00484
00485
00486
00487 ILAENV = 6
00488 RETURN
00489
00490 500 CONTINUE
00491
00492
00493
00494 ILAENV = 2
00495 RETURN
00496
00497 600 CONTINUE
00498
00499
00500
00501 ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
00502 RETURN
00503
00504 700 CONTINUE
00505
00506
00507
00508 ILAENV = 1
00509 RETURN
00510
00511 800 CONTINUE
00512
00513
00514
00515 ILAENV = 50
00516 RETURN
00517
00518 900 CONTINUE
00519
00520
00521
00522
00523
00524 ILAENV = 25
00525 RETURN
00526
00527 1000 CONTINUE
00528
00529
00530
00531 ILAENV = 1
00532 IF (ILAENV .EQ. 1) THEN
00533 ILAENV = IEEECK( 0, 0.0, 1.0 )
00534 ENDIF
00535 RETURN
00536
00537 1100 CONTINUE
00538
00539
00540
00541 ILAENV = 1
00542 IF (ILAENV .EQ. 1) THEN
00543 ILAENV = IEEECK( 1, 0.0, 1.0 )
00544 ENDIF
00545 RETURN
00546
00547
00548
00549 END
00550 INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
00551
00552
00553
00554
00555
00556
00557
00558 INTEGER ISPEC
00559 REAL ZERO, ONE
00560
00561
00562
00563
00564
00565
00566
00567
00568
00569
00570
00571
00572
00573
00574
00575
00576
00577
00578
00579
00580
00581
00582
00583
00584
00585
00586
00587
00588
00589
00590
00591
00592 REAL POSINF, NEGINF, NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGZRO,
00593 $ NEWZRO
00594
00595
00596 IEEECK = 1
00597
00598 POSINF = ONE /ZERO
00599 IF ( POSINF .LE. ONE ) THEN
00600 IEEECK = 0
00601 RETURN
00602 ENDIF
00603
00604 NEGINF = -ONE / ZERO
00605 IF ( NEGINF .GE. ZERO ) THEN
00606 IEEECK = 0
00607 RETURN
00608 ENDIF
00609
00610 NEGZRO = ONE / ( NEGINF + ONE )
00611 IF ( NEGZRO .NE. ZERO ) THEN
00612 IEEECK = 0
00613 RETURN
00614 ENDIF
00615
00616 NEGINF = ONE / NEGZRO
00617 IF ( NEGINF .GE. ZERO ) THEN
00618 IEEECK = 0
00619 RETURN
00620 ENDIF
00621
00622 NEWZRO = NEGZRO + ZERO
00623 IF ( NEWZRO .NE. ZERO ) THEN
00624 IEEECK = 0
00625 RETURN
00626 ENDIF
00627
00628 POSINF = ONE / NEWZRO
00629 IF ( POSINF .LE. ONE ) THEN
00630 IEEECK = 0
00631 RETURN
00632 ENDIF
00633
00634 NEGINF = NEGINF * POSINF
00635 IF ( NEGINF .GE. ZERO ) THEN
00636 IEEECK = 0
00637 RETURN
00638 ENDIF
00639
00640 POSINF = POSINF * POSINF
00641 IF ( POSINF .LE. ONE ) THEN
00642 IEEECK = 0
00643 RETURN
00644 ENDIF
00645
00646
00647
00648
00649
00650
00651 IF (ISPEC .EQ. 0 ) RETURN
00652
00653 NAN1 = POSINF + NEGINF
00654
00655 NAN2 = POSINF / NEGINF
00656
00657 NAN3 = POSINF / POSINF
00658
00659 NAN4 = POSINF * ZERO
00660
00661 NAN5 = NEGINF * NEGZRO
00662
00663 NAN6 = NAN5 * 0.0
00664
00665 IF ( NAN1 .EQ. NAN1 ) THEN
00666 IEEECK = 0
00667 RETURN
00668 ENDIF
00669
00670 IF ( NAN2 .EQ. NAN2 ) THEN
00671 IEEECK = 0
00672 RETURN
00673 ENDIF
00674
00675 IF ( NAN3 .EQ. NAN3 ) THEN
00676 IEEECK = 0
00677 RETURN
00678 ENDIF
00679
00680 IF ( NAN4 .EQ. NAN4 ) THEN
00681 IEEECK = 0
00682 RETURN
00683 ENDIF
00684
00685 IF ( NAN5 .EQ. NAN5 ) THEN
00686 IEEECK = 0
00687 RETURN
00688 ENDIF
00689
00690 IF ( NAN6 .EQ. NAN6 ) THEN
00691 IEEECK = 0
00692 RETURN
00693 ENDIF
00694
00695 RETURN
00696 END