1*> \brief \b ILAENV
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
12*                        N4 )
13*
14*       .. Scalar Arguments ..
15*       CHARACTER*( * )    NAME, OPTS
16*       INTEGER            ISPEC, N1, N2, N3, N4
17*       ..
18*
19*
20*> \par Purpose:
21*  =============
22*>
23*> \verbatim
24*>
25*> ILAENV returns problem-dependent parameters for the local
26*> environment.  See ISPEC for a description of the parameters.
27*>
28*> In this version, the problem-dependent parameters are contained in
29*> the integer array IPARMS in the common block CLAENV and the value
30*> with index ISPEC is copied to ILAENV.  This version of ILAENV is
31*> to be used in conjunction with XLAENV in TESTING and TIMING.
32*> \endverbatim
33*
34*  Arguments:
35*  ==========
36*
37*> \param[in] ISPEC
38*> \verbatim
39*>          ISPEC is INTEGER
40*>          Specifies the parameter to be returned as the value of
41*>          ILAENV.
42*>          = 1: the optimal blocksize; if this value is 1, an unblocked
43*>               algorithm will give the best performance.
44*>          = 2: the minimum block size for which the block routine
45*>               should be used; if the usable block size is less than
46*>               this value, an unblocked routine should be used.
47*>          = 3: the crossover point (in a block routine, for N less
48*>               than this value, an unblocked routine should be used)
49*>          = 4: the number of shifts, used in the nonsymmetric
50*>               eigenvalue routines
51*>          = 5: the minimum column dimension for blocking to be used;
52*>               rectangular blocks must have dimension at least k by m,
53*>               where k is given by ILAENV(2,...) and m by ILAENV(5,...)
54*>          = 6: the crossover point for the SVD (when reducing an m by n
55*>               matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
56*>               this value, a QR factorization is used first to reduce
57*>               the matrix to a triangular form.)
58*>          = 7: the number of processors
59*>          = 8: the crossover point for the multishift QR and QZ methods
60*>               for nonsymmetric eigenvalue problems.
61*>          = 9: maximum size of the subproblems at the bottom of the
62*>               computation tree in the divide-and-conquer algorithm
63*>          =10: ieee NaN arithmetic can be trusted not to trap
64*>          =11: infinity arithmetic can be trusted not to trap
65*>
66*>          Other specifications (up to 100) can be added later.
67*> \endverbatim
68*>
69*> \param[in] NAME
70*> \verbatim
71*>          NAME is CHARACTER*(*)
72*>          The name of the calling subroutine.
73*> \endverbatim
74*>
75*> \param[in] OPTS
76*> \verbatim
77*>          OPTS is CHARACTER*(*)
78*>          The character options to the subroutine NAME, concatenated
79*>          into a single character string.  For example, UPLO = 'U',
80*>          TRANS = 'T', and DIAG = 'N' for a triangular routine would
81*>          be specified as OPTS = 'UTN'.
82*> \endverbatim
83*>
84*> \param[in] N1
85*> \verbatim
86*>          N1 is INTEGER
87*> \endverbatim
88*>
89*> \param[in] N2
90*> \verbatim
91*>          N2 is INTEGER
92*> \endverbatim
93*>
94*> \param[in] N3
95*> \verbatim
96*>          N3 is INTEGER
97*> \endverbatim
98*>
99*> \param[in] N4
100*> \verbatim
101*>          N4 is INTEGER
102*>
103*>          Problem dimensions for the subroutine NAME; these may not all
104*>          be required.
105*> \endverbatim
106*>
107*> \return ILAENV
108*> \verbatim
109*>          ILAENV is INTEGER
110*>          >= 0: the value of the parameter specified by ISPEC
111*>          < 0:  if ILAENV = -k, the k-th argument had an illegal value.
112*> \endverbatim
113*
114*  Authors:
115*  ========
116*
117*> \author Univ. of Tennessee
118*> \author Univ. of California Berkeley
119*> \author Univ. of Colorado Denver
120*> \author NAG Ltd.
121*
122*> \date November 2017
123*
124*> \ingroup aux_lin
125*
126*> \par Further Details:
127*  =====================
128*>
129*> \verbatim
130*>
131*>  The following conventions have been used when calling ILAENV from the
132*>  LAPACK routines:
133*>  1)  OPTS is a concatenation of all of the character options to
134*>      subroutine NAME, in the same order that they appear in the
135*>      argument list for NAME, even if they are not used in determining
136*>      the value of the parameter specified by ISPEC.
137*>  2)  The problem dimensions N1, N2, N3, N4 are specified in the order
138*>      that they appear in the argument list for NAME.  N1 is used
139*>      first, N2 second, and so on, and unused problem dimensions are
140*>      passed a value of -1.
141*>  3)  The parameter value returned by ILAENV is checked for validity in
142*>      the calling subroutine.  For example, ILAENV is used to retrieve
143*>      the optimal blocksize for STRTRI as follows:
144*>
145*>      NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
146*>      IF( NB.LE.1 ) NB = MAX( 1, N )
147*> \endverbatim
148*>
149*  =====================================================================
150      INTEGER          FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
151     $                 N4 )
152*
153*  -- LAPACK test routine (version 3.8.0) --
154*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
155*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
156*     November 2017
157*
158*     .. Scalar Arguments ..
159      CHARACTER*( * )    NAME, OPTS
160      INTEGER            ISPEC, N1, N2, N3, N4
161*     ..
162*
163*  =====================================================================
164*
165*     .. Intrinsic Functions ..
166      INTRINSIC          INT, MIN, REAL
167*     ..
168*     .. External Functions ..
169      INTEGER            IEEECK
170      EXTERNAL           IEEECK
171*     ..
172*     .. Arrays in Common ..
173      INTEGER            IPARMS( 100 )
174*     ..
175*     .. Common blocks ..
176      COMMON             / CLAENV / IPARMS
177*     ..
178*     .. Save statement ..
179      SAVE               / CLAENV /
180*     ..
181*     .. Executable Statements ..
182*
183      IF( ISPEC.GE.1 .AND. ISPEC.LE.5 ) THEN
184*
185*        Return a value from the common block.
186*
187         IF ( NAME(2:6).EQ.'GEQR ' ) THEN
188            IF (N3.EQ.2) THEN
189               ILAENV = IPARMS ( 2 )
190            ELSE
191               ILAENV = IPARMS ( 1 )
192            END IF
193         ELSE IF ( NAME(2:6).EQ.'GELQ ' ) THEN
194            IF (N3.EQ.2) THEN
195               ILAENV = IPARMS ( 2 )
196            ELSE
197               ILAENV = IPARMS ( 1 )
198            END IF
199         ELSE
200            ILAENV = IPARMS( ISPEC )
201         END IF
202*
203      ELSE IF( ISPEC.EQ.6 ) THEN
204*
205*        Compute SVD crossover point.
206*
207         ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
208*
209      ELSE IF( ISPEC.GE.7 .AND. ISPEC.LE.9 ) THEN
210*
211*        Return a value from the common block.
212*
213         ILAENV = IPARMS( ISPEC )
214*
215      ELSE IF( ISPEC.EQ.10 ) THEN
216*
217*        IEEE NaN arithmetic can be trusted not to trap
218*
219C        ILAENV = 0
220         ILAENV = 1
221         IF( ILAENV.EQ.1 ) THEN
222            ILAENV = IEEECK( 1, 0.0, 1.0 )
223         END IF
224*
225      ELSE IF( ISPEC.EQ.11 ) THEN
226*
227*        Infinity arithmetic can be trusted not to trap
228*
229C        ILAENV = 0
230         ILAENV = 1
231         IF( ILAENV.EQ.1 ) THEN
232            ILAENV = IEEECK( 0, 0.0, 1.0 )
233         END IF
234*
235      ELSE
236*
237*        Invalid value for ISPEC
238*
239         ILAENV = -1
240      END IF
241*
242      RETURN
243*
244*     End of ILAENV
245*
246      END
247      INTEGER FUNCTION ILAENV2STAGE( ISPEC, NAME, OPTS, N1, N2,
248     $                               N3, N4 )
249*     .. Scalar Arguments ..
250      CHARACTER*( * )    NAME, OPTS
251      INTEGER            ISPEC, N1, N2, N3, N4
252*     ..
253*
254*  =====================================================================
255*
256*     .. Local variables ..
257      INTEGER            IISPEC
258*     .. External Functions ..
259      INTEGER            IPARAM2STAGE
260      EXTERNAL           IPARAM2STAGE
261*     ..
262*     .. Arrays in Common ..
263      INTEGER            IPARMS( 100 )
264*     ..
265*     .. Common blocks ..
266      COMMON             / CLAENV / IPARMS
267*     ..
268*     .. Save statement ..
269      SAVE               / CLAENV /
270*     ..
271*     .. Executable Statements ..
272*
273      IF(( ISPEC.GE.1 ) .AND. (ISPEC.LE.5)) THEN
274*
275*     1 <= ISPEC <= 5: 2stage eigenvalues SVD routines.
276*
277         IF( ISPEC.EQ.1 ) THEN
278             ILAENV2STAGE = IPARMS( 1 )
279         ELSE
280             IISPEC = 16 + ISPEC
281             ILAENV2STAGE = IPARAM2STAGE( IISPEC, NAME, OPTS,
282     $                                    N1, N2, N3, N4 )
283         ENDIF
284*
285      ELSE
286*
287*        Invalid value for ISPEC
288*
289         ILAENV2STAGE = -1
290      END IF
291*
292      RETURN
293      END
294