ilaenv.f

来自「基于Blas CLapck的.用过的人知道是干啥的」· F 代码 · 共 605 行 · 第 1/2 页

      INTEGER          FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
     $                 N4 )
*
*  -- LAPACK auxiliary routine (version 3.0) --
*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
*     Courant Institute, Argonne National Lab, and Rice University
*     June 30, 1999
*
*  -- Modified by R. Clint Whaley for ATLAS Fortran77 LAPACK interface,
*     1999
*
*     .. 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, SREAL, DREAL, SCPLX, DCPLX
      CHARACTER*1        C1
      CHARACTER*2        C2, C4
      CHARACTER*3        C3
      CHARACTER*6        SUBNAM
      INTEGER            I, IC, IZ, NB, NBMIN, NX
      INTEGER            MN, ATLNB
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          CHAR, ICHAR, INT, MIN, REAL
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            IEEECK
      EXTERNAL           IEEECK, LSAME
*     ..
*     .. External Subroutines ..
      EXTERNAL ATL_F77WRAP_SGETNB, ATL_F77WRAP_DGETNB,
     $         ATL_F77WRAP_CGETNB, ATL_F77WRAP_ZGETNB
*     ..
*     .. 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
      C1 = NAME(1:1)
      SREAL = LSAME(C1, 'S')
      DREAL = LSAME(C1, 'D')
      SCPLX = LSAME(C1, 'C')
      DCPLX = LSAME(C1, 'Z')
      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
*
*     ATLAS sets default blocking factor to the internal blocking factor of
*     GEMM.  For particular routines, we then examine input parameters to
*     see if we should reduce it (for instance, to ensure that we don't
*     spend too much time in the unblocked level-2 portion of the algorithm).
*     Note that the recursive routines provided by ATLAS
*     (presently, LU & Cholesky) do not need this value.
*
      NB = 60
      IF (SREAL) THEN
         CALL ATL_F77WRAP_SGETNB(NB)
      ELSE IF (DREAL) THEN
         CALL ATL_F77WRAP_DGETNB(NB)
      ELSE IF (SCPLX) THEN
         CALL ATL_F77WRAP_CGETNB(NB)
      ELSE IF (DCPLX) THEN
         CALL ATL_F77WRAP_ZGETNB(NB)
      ENDIF
      ATLNB = NB
*
*     Find minimum dimension of problem: don't want NB bigger than that
*
      MN = N1
      IF (N2 .GT. 0) THEN
         IF (MN .GT. N2) MN = N2
         IF (N3 .GT. 0) THEN
            IF (MN .GT. N3) MN = N3
            IF (N4 .GT. 0) THEN
               IF (MN .GT. N4) MN = N4
            END IF
         END IF
      END IF
*
*     Make sure NB is not close to size of entire dimension, unless smallest
*     dimension is so small you might as well use unblocked code the whole way
*
      IF (MN .LE. 3) THEN
         NB = MN;
      ELSE IF (NB*5 .GT. MN) THEN
         IF (MN .LT. 16) THEN
            IF (MN .LT. 8) THEN
               NB = 2
            ELSE
               NB = 4
            END IF
         ELSE
           NB = (MN / 4)
           IF (NB .GT. 4) THEN
              NB = (NB/4)*4
           ENDIF
         END IF
      END IF
      IF( C2.EQ.'GE' ) THEN
         IF( C3.EQ.'TRF' ) THEN
            NB = NB
*
*        QR requires extra flops for blocking, so restrain total NB
*
         ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
     $            C3.EQ.'QLF' ) THEN
            IF (NB .GT. 80) THEN
               IF( SNAME ) THEN
                  NB = 60
               ELSE
                  NB = 40
               END IF
            END IF
         ELSE IF( C3.EQ.'HRD' ) THEN
            IF (NB .GT. 80) THEN
               IF( SNAME ) THEN
                  NB = 60
               ELSE
                  NB = 40
               END IF
            END IF
         ELSE IF( C3.EQ.'BRD' ) THEN
            IF (NB .GT. 80) THEN
               IF( SNAME ) THEN
                  NB = 60
               ELSE
                  NB = 40
               END IF
            END IF
         ELSE IF( C3.EQ.'TRI' ) THEN
               NB = NB
         END IF
      ELSE IF( C2.EQ.'PO' ) THEN
         IF( C3.EQ.'TRF' ) THEN
            NB = NB
         END IF
      ELSE IF( C2.EQ.'SY' ) THEN
         IF( C3.EQ.'TRF' ) THEN
            NB = NB
         ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
            IF (NB .GT. 80) THEN