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*>          12 <= ISPEC <= 16:
66*>               xHSEQR or one of its subroutines,
67*>               see IPARMQ for detailed explanation
68*>
69*>          Other specifications (up to 100) can be added later.
70*> \endverbatim
71*>
72*> \param[in] NAME
73*> \verbatim
74*>          NAME is CHARACTER*(*)
75*>          The name of the calling subroutine.
76*> \endverbatim
77*>
78*> \param[in] OPTS
79*> \verbatim
80*>          OPTS is CHARACTER*(*)
81*>          The character options to the subroutine NAME, concatenated
82*>          into a single character string.  For example, UPLO = 'U',
83*>          TRANS = 'T', and DIAG = 'N' for a triangular routine would
84*>          be specified as OPTS = 'UTN'.
85*> \endverbatim
86*>
87*> \param[in] N1
88*> \verbatim
89*>          N1 is INTEGER
90*> \endverbatim
91*>
92*> \param[in] N2
93*> \verbatim
94*>          N2 is INTEGER
95*> \endverbatim
96*>
97*> \param[in] N3
98*> \verbatim
99*>          N3 is INTEGER
100*> \endverbatim
101*>
102*> \param[in] N4
103*> \verbatim
104*>          N4 is INTEGER
105*>
106*>          Problem dimensions for the subroutine NAME; these may not all
107*>          be required.
108*> \endverbatim
109*>
110*> \result ILAENV
111*> \verbatim
112*>          ILAENV is INTEGER
113*>          >= 0: the value of the parameter specified by ISPEC
114*>          < 0:  if ILAENV = -k, the k-th argument had an illegal value.
115*> \endverbatim
116*
117*  Authors:
118*  ========
119*
120*> \author Univ. of Tennessee
121*> \author Univ. of California Berkeley
122*> \author Univ. of Colorado Denver
123*> \author NAG Ltd.
124*
125*> \ingroup OTHERauxiliary
126*
127*> \par Further Details:
128*  =====================
129*>
130*> \verbatim
131*>
132*>  The following conventions have been used when calling ILAENV from the
133*>  LAPACK routines:
134*>  1)  OPTS is a concatenation of all of the character options to
135*>      subroutine NAME, in the same order that they appear in the
136*>      argument list for NAME, even if they are not used in determining
137*>      the value of the parameter specified by ISPEC.
138*>  2)  The problem dimensions N1, N2, N3, N4 are specified in the order
139*>      that they appear in the argument list for NAME.  N1 is used
140*>      first, N2 second, and so on, and unused problem dimensions are
141*>      passed a value of -1.
142*>  3)  The parameter value returned by ILAENV is checked for validity in
143*>      the calling subroutine.  For example, ILAENV is used to retrieve
144*>      the optimal blocksize for STRTRI as follows:
145*>
146*>      NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
147*>      IF( NB.LE.1 ) NB = MAX( 1, N )
148*> \endverbatim
149*>
150*  =====================================================================
151      INTEGER          FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
152     $                 N4 )
153*
154*  -- LAPACK test routine --
155*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
156*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
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, IPARAM2STAGE
170      EXTERNAL           IEEECK, IPARAM2STAGE
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         ILAENV = IPARMS( ISPEC )
188*
189      ELSE IF( ISPEC.EQ.6 ) THEN
190*
191*        Compute SVD crossover point.
192*
193         ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
194*
195      ELSE IF( ISPEC.GE.7 .AND. ISPEC.LE.9 ) THEN
196*
197*        Return a value from the common block.
198*
199         ILAENV = IPARMS( ISPEC )
200*
201      ELSE IF( ISPEC.EQ.10 ) THEN
202*
203*        IEEE NaN arithmetic can be trusted not to trap
204*
205C        ILAENV = 0
206         ILAENV = 1
207         IF( ILAENV.EQ.1 ) THEN
208            ILAENV = IEEECK( 1, 0.0, 1.0 )
209         END IF
210*
211      ELSE IF( ISPEC.EQ.11 ) THEN
212*
213*        Infinity arithmetic can be trusted not to trap
214*
215C        ILAENV = 0
216         ILAENV = 1
217         IF( ILAENV.EQ.1 ) THEN
218            ILAENV = IEEECK( 0, 0.0, 1.0 )
219         END IF
220*
221      ELSE IF(( ISPEC.GE.12 ) .AND. (ISPEC.LE.16)) THEN
222*
223*     12 <= ISPEC <= 16: xHSEQR or one of its subroutines.
224*
225         ILAENV = IPARMS( ISPEC )
226*         WRITE(*,*) 'ISPEC = ',ISPEC,' ILAENV =',ILAENV
227*         ILAENV = IPARMQ( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
228*
229      ELSE IF(( ISPEC.GE.17 ) .AND. (ISPEC.LE.21)) THEN
230*
231*     17 <= ISPEC <= 21: 2stage eigenvalues SVD routines.
232*
233         IF( ISPEC.EQ.17 ) THEN
234             ILAENV = IPARMS( 1 )
235         ELSE
236             ILAENV = IPARAM2STAGE( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
237         ENDIF
238*
239      ELSE
240*
241*        Invalid value for ISPEC
242*
243         ILAENV = -1
244      END IF
245*
246      RETURN
247*
248*     End of ILAENV
249*
250      END
251      INTEGER FUNCTION ILAENV2STAGE( ISPEC, NAME, OPTS, N1, N2,
252     $                               N3, N4 )
253*     .. Scalar Arguments ..
254      CHARACTER*( * )    NAME, OPTS
255      INTEGER            ISPEC, N1, N2, N3, N4
256*     ..
257*
258*  =====================================================================
259*
260*     .. Local variables ..
261      INTEGER            IISPEC
262*     .. External Functions ..
263      INTEGER            IPARAM2STAGE
264      EXTERNAL           IPARAM2STAGE
265*     ..
266*     .. Arrays in Common ..
267      INTEGER            IPARMS( 100 )
268*     ..
269*     .. Common blocks ..
270      COMMON             / CLAENV / IPARMS
271*     ..
272*     .. Save statement ..
273      SAVE               / CLAENV /
274*     ..
275*     .. Executable Statements ..
276*
277      IF(( ISPEC.GE.1 ) .AND. (ISPEC.LE.5)) THEN
278*
279*     1 <= ISPEC <= 5: 2stage eigenvalues SVD routines.
280*
281         IF( ISPEC.EQ.1 ) THEN
282             ILAENV2STAGE = IPARMS( 1 )
283         ELSE
284             IISPEC = 16 + ISPEC
285             ILAENV2STAGE = IPARAM2STAGE( IISPEC, NAME, OPTS,
286     $                                    N1, N2, N3, N4 )
287         ENDIF
288*
289      ELSE
290*
291*        Invalid value for ISPEC
292*
293         ILAENV2STAGE = -1
294      END IF
295*
296      RETURN
297*
298*     End of ILAENV2STAGE
299*
300      END
301      INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK )
302*
303      INTEGER            INMIN, INWIN, INIBL, ISHFTS, IACC22
304      PARAMETER          ( INMIN = 12, INWIN = 13, INIBL = 14,
305     $                   ISHFTS = 15, IACC22 = 16 )
306      INTEGER            NMIN, K22MIN, KACMIN, NIBBLE, KNWSWP
307      PARAMETER          ( NMIN = 11, K22MIN = 14, KACMIN = 14,
308     $                   NIBBLE = 14, KNWSWP = 500 )
309      REAL               TWO
310      PARAMETER          ( TWO = 2.0 )
311*     ..
312*     .. Scalar Arguments ..
313      INTEGER            IHI, ILO, ISPEC, LWORK, N
314      CHARACTER          NAME*( * ), OPTS*( * )
315*     ..
316*     .. Local Scalars ..
317      INTEGER            NH, NS
318*     ..
319*     .. Intrinsic Functions ..
320      INTRINSIC          LOG, MAX, MOD, NINT, REAL
321*     ..
322*     .. Executable Statements ..
323      IF( ( ISPEC.EQ.ISHFTS ) .OR. ( ISPEC.EQ.INWIN ) .OR.
324     $    ( ISPEC.EQ.IACC22 ) ) THEN
325*
326*        ==== Set the number simultaneous shifts ====
327*
328         NH = IHI - ILO + 1
329         NS = 2
330         IF( NH.GE.30 )
331     $      NS = 4
332         IF( NH.GE.60 )
333     $      NS = 10
334         IF( NH.GE.150 )
335     $      NS = MAX( 10, NH / NINT( LOG( REAL( NH ) ) / LOG( TWO ) ) )
336         IF( NH.GE.590 )
337     $      NS = 64
338         IF( NH.GE.3000 )
339     $      NS = 128
340         IF( NH.GE.6000 )
341     $      NS = 256
342         NS = MAX( 2, NS-MOD( NS, 2 ) )
343      END IF
344*
345      IF( ISPEC.EQ.INMIN ) THEN
346*
347*
348*        ===== Matrices of order smaller than NMIN get sent
349*        .     to LAHQR, the classic double shift algorithm.
350*        .     This must be at least 11. ====
351*
352         IPARMQ = NMIN
353*
354      ELSE IF( ISPEC.EQ.INIBL ) THEN
355*
356*        ==== INIBL: skip a multi-shift qr iteration and
357*        .    whenever aggressive early deflation finds
358*        .    at least (NIBBLE*(window size)/100) deflations. ====
359*
360         IPARMQ = NIBBLE
361*
362      ELSE IF( ISPEC.EQ.ISHFTS ) THEN
363*
364*        ==== NSHFTS: The number of simultaneous shifts =====
365*
366         IPARMQ = NS
367*
368      ELSE IF( ISPEC.EQ.INWIN ) THEN
369*
370*        ==== NW: deflation window size.  ====
371*
372         IF( NH.LE.KNWSWP ) THEN
373            IPARMQ = NS
374         ELSE
375            IPARMQ = 3*NS / 2
376         END IF
377*
378      ELSE IF( ISPEC.EQ.IACC22 ) THEN
379*
380*        ==== IACC22: Whether to accumulate reflections
381*        .     before updating the far-from-diagonal elements
382*        .     and whether to use 2-by-2 block structure while
383*        .     doing it.  A small amount of work could be saved
384*        .     by making this choice dependent also upon the
385*        .     NH=IHI-ILO+1.
386*
387         IPARMQ = 0
388         IF( NS.GE.KACMIN )
389     $      IPARMQ = 1
390         IF( NS.GE.K22MIN )
391     $      IPARMQ = 2
392*
393      ELSE
394*        ===== invalid value of ispec =====
395         IPARMQ = -1
396*
397      END IF
398*
399*     ==== End of IPARMQ ====
400*
401      END
402