771 lines
21 KiB
Fortran
771 lines
21 KiB
Fortran
*> \brief \b TSTIEE
|
|
*
|
|
* =========== DOCUMENTATION ===========
|
|
*
|
|
* Online html documentation available at
|
|
* http://www.netlib.org/lapack/explore-html/
|
|
*
|
|
* Authors:
|
|
* ========
|
|
*
|
|
*> \author Univ. of Tennessee
|
|
*> \author Univ. of California Berkeley
|
|
*> \author Univ. of Colorado Denver
|
|
*> \author NAG Ltd.
|
|
*
|
|
*> \date November 2011
|
|
*
|
|
*> \ingroup auxOTHERauxiliary
|
|
*
|
|
* =====================================================================
|
|
PROGRAM TSTIEE
|
|
*
|
|
* -- LAPACK test routine (version 3.4.0) --
|
|
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
|
|
* November 2006
|
|
*
|
|
* .. External Functions ..
|
|
INTEGER ILAENV
|
|
EXTERNAL ILAENV
|
|
* ..
|
|
* .. Local Scalars ..
|
|
INTEGER IEEEOK
|
|
* ..
|
|
* .. Executable Statements ..
|
|
*
|
|
WRITE( 6, FMT = * )
|
|
$ 'We are about to check whether infinity arithmetic'
|
|
WRITE( 6, FMT = * )'can be trusted. If this test hangs, set'
|
|
WRITE( 6, FMT = * )
|
|
$ 'ILAENV = 0 for ISPEC = 10 in LAPACK/SRC/ilaenv.f'
|
|
*
|
|
IEEEOK = ILAENV( 10, 'ILAENV', 'N', 1, 2, 3, 4 )
|
|
WRITE( 6, FMT = * )
|
|
*
|
|
IF( IEEEOK.EQ.0 ) THEN
|
|
WRITE( 6, FMT = * )
|
|
$ 'Infinity arithmetic did not perform per the ieee spec'
|
|
ELSE
|
|
WRITE( 6, FMT = * )
|
|
$ 'Infinity arithmetic performed as per the ieee spec.'
|
|
WRITE( 6, FMT = * )
|
|
$ 'However, this is not an exhaustive test and does not'
|
|
WRITE( 6, FMT = * )
|
|
$ 'guarantee that infinity arithmetic meets the',
|
|
$ ' ieee spec.'
|
|
END IF
|
|
*
|
|
WRITE( 6, FMT = * )
|
|
WRITE( 6, FMT = * )
|
|
$ 'We are about to check whether NaN arithmetic'
|
|
WRITE( 6, FMT = * )'can be trusted. If this test hangs, set'
|
|
WRITE( 6, FMT = * )
|
|
$ 'ILAENV = 0 for ISPEC = 11 in LAPACK/SRC/ilaenv.f'
|
|
IEEEOK = ILAENV( 11, 'ILAENV', 'N', 1, 2, 3, 4 )
|
|
*
|
|
WRITE( 6, FMT = * )
|
|
IF( IEEEOK.EQ.0 ) THEN
|
|
WRITE( 6, FMT = * )
|
|
$ 'NaN arithmetic did not perform per the ieee spec'
|
|
ELSE
|
|
WRITE( 6, FMT = * )'NaN arithmetic performed as per the ieee',
|
|
$ ' spec.'
|
|
WRITE( 6, FMT = * )
|
|
$ 'However, this is not an exhaustive test and does not'
|
|
WRITE( 6, FMT = * )'guarantee that NaN arithmetic meets the',
|
|
$ ' ieee spec.'
|
|
END IF
|
|
WRITE( 6, FMT = * )
|
|
*
|
|
END
|
|
INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
|
|
$ N4 )
|
|
*
|
|
* -- LAPACK auxiliary routine (version 3.4.0) --
|
|
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
|
|
* November 2006
|
|
*
|
|
* .. Scalar Arguments ..
|
|
CHARACTER*( * ) NAME, OPTS
|
|
INTEGER ISPEC, N1, N2, N3, N4
|
|
* ..
|
|
*
|
|
* Purpose
|
|
* =======
|
|
*
|
|
* ILAENV is called from the LAPACK routines to choose problem-dependent
|
|
* parameters for the local environment. See ISPEC for a description of
|
|
* the parameters.
|
|
*
|
|
* This version provides a set of parameters which should give good,
|
|
* but not optimal, performance on many of the currently available
|
|
* computers. Users are encouraged to modify this subroutine to set
|
|
* the tuning parameters for their particular machine using the option
|
|
* and problem size information in the arguments.
|
|
*
|
|
* This routine will not function correctly if it is converted to all
|
|
* lower case. Converting it to all upper case is allowed.
|
|
*
|
|
* Arguments:
|
|
* ==========
|
|
*
|
|
* ISPEC (input) INTEGER
|
|
* Specifies the parameter to be returned as the value of
|
|
* ILAENV.
|
|
* = 1: the optimal blocksize; if this value is 1, an unblocked
|
|
* algorithm will give the best performance.
|
|
* = 2: the minimum block size for which the block routine
|
|
* should be used; if the usable block size is less than
|
|
* this value, an unblocked routine should be used.
|
|
* = 3: the crossover point (in a block routine, for N less
|
|
* than this value, an unblocked routine should be used)
|
|
* = 4: the number of shifts, used in the nonsymmetric
|
|
* eigenvalue routines
|
|
* = 5: the minimum column dimension for blocking to be used;
|
|
* rectangular blocks must have dimension at least k by m,
|
|
* where k is given by ILAENV(2,...) and m by ILAENV(5,...)
|
|
* = 6: the crossover point for the SVD (when reducing an m by n
|
|
* matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
|
|
* this value, a QR factorization is used first to reduce
|
|
* the matrix to a triangular form.)
|
|
* = 7: the number of processors
|
|
* = 8: the crossover point for the multishift QR and QZ methods
|
|
* for nonsymmetric eigenvalue problems.
|
|
* = 9: maximum size of the subproblems at the bottom of the
|
|
* computation tree in the divide-and-conquer algorithm
|
|
* (used by xGELSD and xGESDD)
|
|
* =10: ieee NaN arithmetic can be trusted not to trap
|
|
* =11: infinity arithmetic can be trusted not to trap
|
|
*
|
|
* NAME (input) CHARACTER*(*)
|
|
* The name of the calling subroutine, in either upper case or
|
|
* lower case.
|
|
*
|
|
* OPTS (input) CHARACTER*(*)
|
|
* The character options to the subroutine NAME, concatenated
|
|
* into a single character string. For example, UPLO = 'U',
|
|
* TRANS = 'T', and DIAG = 'N' for a triangular routine would
|
|
* be specified as OPTS = 'UTN'.
|
|
*
|
|
* N1 (input) INTEGER
|
|
* N2 (input) INTEGER
|
|
* N3 (input) INTEGER
|
|
* N4 (input) INTEGER
|
|
* Problem dimensions for the subroutine NAME; these may not all
|
|
* be required.
|
|
*
|
|
* (ILAENV) (output) INTEGER
|
|
* >= 0: the value of the parameter specified by ISPEC
|
|
* < 0: if ILAENV = -k, the k-th argument had an illegal value.
|
|
*
|
|
* Further Details
|
|
* ===============
|
|
*
|
|
* The following conventions have been used when calling ILAENV from the
|
|
* LAPACK routines:
|
|
* 1) OPTS is a concatenation of all of the character options to
|
|
* subroutine NAME, in the same order that they appear in the
|
|
* argument list for NAME, even if they are not used in determining
|
|
* the value of the parameter specified by ISPEC.
|
|
* 2) The problem dimensions N1, N2, N3, N4 are specified in the order
|
|
* that they appear in the argument list for NAME. N1 is used
|
|
* first, N2 second, and so on, and unused problem dimensions are
|
|
* passed a value of -1.
|
|
* 3) The parameter value returned by ILAENV is checked for validity in
|
|
* the calling subroutine. For example, ILAENV is used to retrieve
|
|
* the optimal blocksize for STRTRI as follows:
|
|
*
|
|
* NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
|
|
* IF( NB.LE.1 ) NB = MAX( 1, N )
|
|
*
|
|
* =====================================================================
|
|
*
|
|
* .. Local Scalars ..
|
|
LOGICAL CNAME, SNAME
|
|
CHARACTER*1 C1
|
|
CHARACTER*2 C2, C4
|
|
CHARACTER*3 C3
|
|
CHARACTER*6 SUBNAM
|
|
INTEGER I, IC, IZ, NB, NBMIN, NX
|
|
* ..
|
|
* .. Intrinsic Functions ..
|
|
INTRINSIC CHAR, ICHAR, INT, MIN, REAL
|
|
* ..
|
|
* .. External Functions ..
|
|
INTEGER IEEECK
|
|
EXTERNAL IEEECK
|
|
* ..
|
|
* .. Executable Statements ..
|
|
*
|
|
GO TO ( 100, 100, 100, 400, 500, 600, 700, 800, 900, 1000,
|
|
$ 1100 ) ISPEC
|
|
*
|
|
* Invalid value for ISPEC
|
|
*
|
|
ILAENV = -1
|
|
RETURN
|
|
*
|
|
100 CONTINUE
|
|
*
|
|
* Convert NAME to upper case if the first character is lower case.
|
|
*
|
|
ILAENV = 1
|
|
SUBNAM = NAME
|
|
IC = ICHAR( SUBNAM( 1:1 ) )
|
|
IZ = ICHAR( 'Z' )
|
|
IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN
|
|
*
|
|
* ASCII character set
|
|
*
|
|
IF( IC.GE.97 .AND. IC.LE.122 ) THEN
|
|
SUBNAM( 1:1 ) = CHAR( IC-32 )
|
|
DO 10 I = 2, 6
|
|
IC = ICHAR( SUBNAM( I:I ) )
|
|
IF( IC.GE.97 .AND. IC.LE.122 )
|
|
$ SUBNAM( I:I ) = CHAR( IC-32 )
|
|
10 CONTINUE
|
|
END IF
|
|
*
|
|
ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN
|
|
*
|
|
* EBCDIC character set
|
|
*
|
|
IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
|
|
$ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
|
|
$ ( IC.GE.162 .AND. IC.LE.169 ) ) THEN
|
|
SUBNAM( 1:1 ) = CHAR( IC+64 )
|
|
DO 20 I = 2, 6
|
|
IC = ICHAR( SUBNAM( I:I ) )
|
|
IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
|
|
$ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
|
|
$ ( IC.GE.162 .AND. IC.LE.169 ) )
|
|
$ SUBNAM( I:I ) = CHAR( IC+64 )
|
|
20 CONTINUE
|
|
END IF
|
|
*
|
|
ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN
|
|
*
|
|
* Prime machines: ASCII+128
|
|
*
|
|
IF( IC.GE.225 .AND. IC.LE.250 ) THEN
|
|
SUBNAM( 1:1 ) = CHAR( IC-32 )
|
|
DO 30 I = 2, 6
|
|
IC = ICHAR( SUBNAM( I:I ) )
|
|
IF( IC.GE.225 .AND. IC.LE.250 )
|
|
$ SUBNAM( I:I ) = CHAR( IC-32 )
|
|
30 CONTINUE
|
|
END IF
|
|
END IF
|
|
*
|
|
C1 = SUBNAM( 1:1 )
|
|
SNAME = C1.EQ.'S' .OR. C1.EQ.'D'
|
|
CNAME = C1.EQ.'C' .OR. C1.EQ.'Z'
|
|
IF( .NOT.( CNAME .OR. SNAME ) )
|
|
$ RETURN
|
|
C2 = SUBNAM( 2:3 )
|
|
C3 = SUBNAM( 4:6 )
|
|
C4 = C3( 2:3 )
|
|
*
|
|
GO TO ( 110, 200, 300 ) ISPEC
|
|
*
|
|
110 CONTINUE
|
|
*
|
|
* ISPEC = 1: block size
|
|
*
|
|
* In these examples, separate code is provided for setting NB for
|
|
* real and complex. We assume that NB will take the same value in
|
|
* single or double precision.
|
|
*
|
|
NB = 1
|
|
*
|
|
IF( C2.EQ.'GE' ) THEN
|
|
IF( C3.EQ.'TRF' ) THEN
|
|
IF( SNAME ) THEN
|
|
NB = 64
|
|
ELSE
|
|
NB = 64
|
|
END IF
|
|
ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
|
|
$ C3.EQ.'QLF' ) THEN
|
|
IF( SNAME ) THEN
|
|
NB = 32
|
|
ELSE
|
|
NB = 32
|
|
END IF
|
|
ELSE IF( C3.EQ.'HRD' ) THEN
|
|
IF( SNAME ) THEN
|
|
NB = 32
|
|
ELSE
|
|
NB = 32
|
|
END IF
|
|
ELSE IF( C3.EQ.'BRD' ) THEN
|
|
IF( SNAME ) THEN
|
|
NB = 32
|
|
ELSE
|
|
NB = 32
|
|
END IF
|
|
ELSE IF( C3.EQ.'TRI' ) THEN
|
|
IF( SNAME ) THEN
|
|
NB = 64
|
|
ELSE
|
|
NB = 64
|
|
END IF
|
|
END IF
|
|
ELSE IF( C2.EQ.'PO' ) THEN
|
|
IF( C3.EQ.'TRF' ) THEN
|
|
IF( SNAME ) THEN
|
|
NB = 64
|
|
ELSE
|
|
NB = 64
|
|
END IF
|
|
END IF
|
|
ELSE IF( C2.EQ.'SY' ) THEN
|
|
IF( C3.EQ.'TRF' ) THEN
|
|
IF( SNAME ) THEN
|
|
NB = 64
|
|
ELSE
|
|
NB = 64
|
|
END IF
|
|
ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
|
|
NB = 32
|
|
ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN
|
|
NB = 64
|
|
END IF
|
|
ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
|
|
IF( C3.EQ.'TRF' ) THEN
|
|
NB = 64
|
|
ELSE IF( C3.EQ.'TRD' ) THEN
|
|
NB = 32
|
|
ELSE IF( C3.EQ.'GST' ) THEN
|
|
NB = 64
|
|
END IF
|
|
ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
|
|
IF( C3( 1:1 ).EQ.'G' ) THEN
|
|
IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
|
|
$ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
|
|
$ C4.EQ.'BR' ) THEN
|
|
NB = 32
|
|
END IF
|
|
ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
|
|
IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
|
|
$ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
|
|
$ C4.EQ.'BR' ) THEN
|
|
NB = 32
|
|
END IF
|
|
END IF
|
|
ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
|
|
IF( C3( 1:1 ).EQ.'G' ) THEN
|
|
IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
|
|
$ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
|
|
$ C4.EQ.'BR' ) THEN
|
|
NB = 32
|
|
END IF
|
|
ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
|
|
IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
|
|
$ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
|
|
$ C4.EQ.'BR' ) THEN
|
|
NB = 32
|
|
END IF
|
|
END IF
|
|
ELSE IF( C2.EQ.'GB' ) THEN
|
|
IF( C3.EQ.'TRF' ) THEN
|
|
IF( SNAME ) THEN
|
|
IF( N4.LE.64 ) THEN
|
|
NB = 1
|
|
ELSE
|
|
NB = 32
|
|
END IF
|
|
ELSE
|
|
IF( N4.LE.64 ) THEN
|
|
NB = 1
|
|
ELSE
|
|
NB = 32
|
|
END IF
|
|
END IF
|
|
END IF
|
|
ELSE IF( C2.EQ.'PB' ) THEN
|
|
IF( C3.EQ.'TRF' ) THEN
|
|
IF( SNAME ) THEN
|
|
IF( N2.LE.64 ) THEN
|
|
NB = 1
|
|
ELSE
|
|
NB = 32
|
|
END IF
|
|
ELSE
|
|
IF( N2.LE.64 ) THEN
|
|
NB = 1
|
|
ELSE
|
|
NB = 32
|
|
END IF
|
|
END IF
|
|
END IF
|
|
ELSE IF( C2.EQ.'TR' ) THEN
|
|
IF( C3.EQ.'TRI' ) THEN
|
|
IF( SNAME ) THEN
|
|
NB = 64
|
|
ELSE
|
|
NB = 64
|
|
END IF
|
|
END IF
|
|
ELSE IF( C2.EQ.'LA' ) THEN
|
|
IF( C3.EQ.'UUM' ) THEN
|
|
IF( SNAME ) THEN
|
|
NB = 64
|
|
ELSE
|
|
NB = 64
|
|
END IF
|
|
END IF
|
|
ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN
|
|
IF( C3.EQ.'EBZ' ) THEN
|
|
NB = 1
|
|
END IF
|
|
END IF
|
|
ILAENV = NB
|
|
RETURN
|
|
*
|
|
200 CONTINUE
|
|
*
|
|
* ISPEC = 2: minimum block size
|
|
*
|
|
NBMIN = 2
|
|
IF( C2.EQ.'GE' ) THEN
|
|
IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
|
|
$ C3.EQ.'QLF' ) THEN
|
|
IF( SNAME ) THEN
|
|
NBMIN = 2
|
|
ELSE
|
|
NBMIN = 2
|
|
END IF
|
|
ELSE IF( C3.EQ.'HRD' ) THEN
|
|
IF( SNAME ) THEN
|
|
NBMIN = 2
|
|
ELSE
|
|
NBMIN = 2
|
|
END IF
|
|
ELSE IF( C3.EQ.'BRD' ) THEN
|
|
IF( SNAME ) THEN
|
|
NBMIN = 2
|
|
ELSE
|
|
NBMIN = 2
|
|
END IF
|
|
ELSE IF( C3.EQ.'TRI' ) THEN
|
|
IF( SNAME ) THEN
|
|
NBMIN = 2
|
|
ELSE
|
|
NBMIN = 2
|
|
END IF
|
|
END IF
|
|
ELSE IF( C2.EQ.'SY' ) THEN
|
|
IF( C3.EQ.'TRF' ) THEN
|
|
IF( SNAME ) THEN
|
|
NBMIN = 8
|
|
ELSE
|
|
NBMIN = 8
|
|
END IF
|
|
ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
|
|
NBMIN = 2
|
|
END IF
|
|
ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
|
|
IF( C3.EQ.'TRD' ) THEN
|
|
NBMIN = 2
|
|
END IF
|
|
ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
|
|
IF( C3( 1:1 ).EQ.'G' ) THEN
|
|
IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
|
|
$ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
|
|
$ C4.EQ.'BR' ) THEN
|
|
NBMIN = 2
|
|
END IF
|
|
ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
|
|
IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
|
|
$ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
|
|
$ C4.EQ.'BR' ) THEN
|
|
NBMIN = 2
|
|
END IF
|
|
END IF
|
|
ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
|
|
IF( C3( 1:1 ).EQ.'G' ) THEN
|
|
IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
|
|
$ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
|
|
$ C4.EQ.'BR' ) THEN
|
|
NBMIN = 2
|
|
END IF
|
|
ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
|
|
IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
|
|
$ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
|
|
$ C4.EQ.'BR' ) THEN
|
|
NBMIN = 2
|
|
END IF
|
|
END IF
|
|
END IF
|
|
ILAENV = NBMIN
|
|
RETURN
|
|
*
|
|
300 CONTINUE
|
|
*
|
|
* ISPEC = 3: crossover point
|
|
*
|
|
NX = 0
|
|
IF( C2.EQ.'GE' ) THEN
|
|
IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
|
|
$ C3.EQ.'QLF' ) THEN
|
|
IF( SNAME ) THEN
|
|
NX = 128
|
|
ELSE
|
|
NX = 128
|
|
END IF
|
|
ELSE IF( C3.EQ.'HRD' ) THEN
|
|
IF( SNAME ) THEN
|
|
NX = 128
|
|
ELSE
|
|
NX = 128
|
|
END IF
|
|
ELSE IF( C3.EQ.'BRD' ) THEN
|
|
IF( SNAME ) THEN
|
|
NX = 128
|
|
ELSE
|
|
NX = 128
|
|
END IF
|
|
END IF
|
|
ELSE IF( C2.EQ.'SY' ) THEN
|
|
IF( SNAME .AND. C3.EQ.'TRD' ) THEN
|
|
NX = 32
|
|
END IF
|
|
ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
|
|
IF( C3.EQ.'TRD' ) THEN
|
|
NX = 32
|
|
END IF
|
|
ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
|
|
IF( C3( 1:1 ).EQ.'G' ) THEN
|
|
IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
|
|
$ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
|
|
$ C4.EQ.'BR' ) THEN
|
|
NX = 128
|
|
END IF
|
|
END IF
|
|
ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
|
|
IF( C3( 1:1 ).EQ.'G' ) THEN
|
|
IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
|
|
$ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
|
|
$ C4.EQ.'BR' ) THEN
|
|
NX = 128
|
|
END IF
|
|
END IF
|
|
END IF
|
|
ILAENV = NX
|
|
RETURN
|
|
*
|
|
400 CONTINUE
|
|
*
|
|
* ISPEC = 4: number of shifts (used by xHSEQR)
|
|
*
|
|
ILAENV = 6
|
|
RETURN
|
|
*
|
|
500 CONTINUE
|
|
*
|
|
* ISPEC = 5: minimum column dimension (not used)
|
|
*
|
|
ILAENV = 2
|
|
RETURN
|
|
*
|
|
600 CONTINUE
|
|
*
|
|
* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD)
|
|
*
|
|
ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
|
|
RETURN
|
|
*
|
|
700 CONTINUE
|
|
*
|
|
* ISPEC = 7: number of processors (not used)
|
|
*
|
|
ILAENV = 1
|
|
RETURN
|
|
*
|
|
800 CONTINUE
|
|
*
|
|
* ISPEC = 8: crossover point for multishift (used by xHSEQR)
|
|
*
|
|
ILAENV = 50
|
|
RETURN
|
|
*
|
|
900 CONTINUE
|
|
*
|
|
* ISPEC = 9: maximum size of the subproblems at the bottom of the
|
|
* computation tree in the divide-and-conquer algorithm
|
|
* (used by xGELSD and xGESDD)
|
|
*
|
|
ILAENV = 25
|
|
RETURN
|
|
*
|
|
1000 CONTINUE
|
|
*
|
|
* ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
|
|
*
|
|
ILAENV = 1
|
|
IF (ILAENV .EQ. 1) THEN
|
|
ILAENV = IEEECK( 0, 0.0, 1.0 )
|
|
ENDIF
|
|
RETURN
|
|
*
|
|
1100 CONTINUE
|
|
*
|
|
* ISPEC = 11: infinity arithmetic can be trusted not to trap
|
|
*
|
|
ILAENV = 1
|
|
IF (ILAENV .EQ. 1) THEN
|
|
ILAENV = IEEECK( 1, 0.0, 1.0 )
|
|
ENDIF
|
|
RETURN
|
|
*
|
|
* End of ILAENV
|
|
*
|
|
END
|
|
INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
|
|
*
|
|
* -- LAPACK auxiliary routine (version 3.4.0) --
|
|
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
|
|
* November 2006
|
|
*
|
|
* .. Scalar Arguments ..
|
|
INTEGER ISPEC
|
|
REAL ZERO, ONE
|
|
* ..
|
|
*
|
|
* Purpose
|
|
* =======
|
|
*
|
|
* IEEECK is called from the ILAENV to verify that Inifinity and
|
|
* possibly NaN arithmetic is safe (i.e. will not trap).
|
|
*
|
|
* Arguments:
|
|
* ==========
|
|
*
|
|
* ISPEC (input) INTEGER
|
|
* Specifies whether to test just for inifinity arithmetic
|
|
* or whether to test for infinity and NaN arithmetic.
|
|
* = 0: Verify infinity arithmetic only.
|
|
* = 1: Verify infinity and NaN arithmetic.
|
|
*
|
|
* ZERO (input) REAL
|
|
* Must contain the value 0.0
|
|
* This is passed to prevent the compiler from optimizing
|
|
* away this code.
|
|
*
|
|
* ONE (input) REAL
|
|
* Must contain the value 1.0
|
|
* This is passed to prevent the compiler from optimizing
|
|
* away this code.
|
|
*
|
|
* RETURN VALUE: INTEGER
|
|
* = 0: Arithmetic failed to produce the correct answers
|
|
* = 1: Arithmetic produced the correct answers
|
|
*
|
|
* .. Local Scalars ..
|
|
REAL POSINF, NEGINF, NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGZRO,
|
|
$ NEWZRO
|
|
* ..
|
|
* .. Executable Statements ..
|
|
IEEECK = 1
|
|
|
|
POSINF = ONE /ZERO
|
|
IF ( POSINF .LE. ONE ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
NEGINF = -ONE / ZERO
|
|
IF ( NEGINF .GE. ZERO ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
NEGZRO = ONE / ( NEGINF + ONE )
|
|
IF ( NEGZRO .NE. ZERO ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
NEGINF = ONE / NEGZRO
|
|
IF ( NEGINF .GE. ZERO ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
NEWZRO = NEGZRO + ZERO
|
|
IF ( NEWZRO .NE. ZERO ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
POSINF = ONE / NEWZRO
|
|
IF ( POSINF .LE. ONE ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
NEGINF = NEGINF * POSINF
|
|
IF ( NEGINF .GE. ZERO ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
POSINF = POSINF * POSINF
|
|
IF ( POSINF .LE. ONE ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
|
|
|
|
*
|
|
* Return if we were only asked to check infinity arithmetic
|
|
*
|
|
IF (ISPEC .EQ. 0 ) RETURN
|
|
|
|
NAN1 = POSINF + NEGINF
|
|
|
|
NAN2 = POSINF / NEGINF
|
|
|
|
NAN3 = POSINF / POSINF
|
|
|
|
NAN4 = POSINF * ZERO
|
|
|
|
NAN5 = NEGINF * NEGZRO
|
|
|
|
NAN6 = NAN5 * 0.0
|
|
|
|
IF ( NAN1 .EQ. NAN1 ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF ( NAN2 .EQ. NAN2 ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF ( NAN3 .EQ. NAN3 ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF ( NAN4 .EQ. NAN4 ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF ( NAN5 .EQ. NAN5 ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF ( NAN6 .EQ. NAN6 ) THEN
|
|
IEEECK = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|