LAPACK: INSTALL/tstiee.f Source File

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