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*> \ingroup aux_lin
123*
124*> \par Further Details:
125*  =====================
126*>
127*> \verbatim
128*>
129*>  The following conventions have been used when calling ILAENV from the
130*>  LAPACK routines:
131*>  1)  OPTS is a concatenation of all of the character options to
132*>      subroutine NAME, in the same order that they appear in the
133*>      argument list for NAME, even if they are not used in determining
134*>      the value of the parameter specified by ISPEC.
135*>  2)  The problem dimensions N1, N2, N3, N4 are specified in the order
136*>      that they appear in the argument list for NAME.  N1 is used
137*>      first, N2 second, and so on, and unused problem dimensions are
138*>      passed a value of -1.
139*>  3)  The parameter value returned by ILAENV is checked for validity in
140*>      the calling subroutine.  For example, ILAENV is used to retrieve
141*>      the optimal blocksize for STRTRI as follows:
142*>
143*>      NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
144*>      IF( NB.LE.1 ) NB = MAX( 1, N )
145*> \endverbatim
146*>
147*  =====================================================================
148      INTEGER          FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
149     $                 N4 )
150*
151*  -- LAPACK test routine --
152*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
153*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
154*
155*     .. Scalar Arguments ..
156      CHARACTER*( * )    NAME, OPTS
157      INTEGER            ISPEC, N1, N2, N3, N4
158*     ..
159*
160*  =====================================================================
161*
162*     .. Intrinsic Functions ..
163      INTRINSIC          INT, MIN, REAL
164*     ..
165*     .. External Functions ..
166      INTEGER            IEEECK
167      EXTERNAL           IEEECK
168*     ..
169*     .. Arrays in Common ..
170      INTEGER            IPARMS( 100 )
171*     ..
172*     .. Common blocks ..
173      COMMON             / CLAENV / IPARMS
174*     ..
175*     .. Save statement ..
176      SAVE               / CLAENV /
177*     ..
178*     .. Executable Statements ..
179*
180      IF( ISPEC.GE.1 .AND. ISPEC.LE.5 ) THEN
181*
182*        Return a value from the common block.
183*
184         IF ( NAME(2:6).EQ.'GEQR ' ) THEN
185            IF (N3.EQ.2) THEN
186               ILAENV = IPARMS ( 2 )
187            ELSE
188               ILAENV = IPARMS ( 1 )
189            END IF
190         ELSE IF ( NAME(2:6).EQ.'GELQ ' ) THEN
191            IF (N3.EQ.2) THEN
192               ILAENV = IPARMS ( 2 )
193            ELSE
194               ILAENV = IPARMS ( 1 )
195            END IF
196         ELSE
197            ILAENV = IPARMS( ISPEC )
198         END IF
199*
200      ELSE IF( ISPEC.EQ.6 ) THEN
201*
202*        Compute SVD crossover point.
203*
204         ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
205*
206      ELSE IF( ISPEC.GE.7 .AND. ISPEC.LE.9 ) THEN
207*
208*        Return a value from the common block.
209*
210         ILAENV = IPARMS( ISPEC )
211*
212      ELSE IF( ISPEC.EQ.10 ) THEN
213*
214*        IEEE NaN arithmetic can be trusted not to trap
215*
216C        ILAENV = 0
217         ILAENV = 1
218         IF( ILAENV.EQ.1 ) THEN
219            ILAENV = IEEECK( 1, 0.0, 1.0 )
220         END IF
221*
222      ELSE IF( ISPEC.EQ.11 ) THEN
223*
224*        Infinity arithmetic can be trusted not to trap
225*
226C        ILAENV = 0
227         ILAENV = 1
228         IF( ILAENV.EQ.1 ) THEN
229            ILAENV = IEEECK( 0, 0.0, 1.0 )
230         END IF
231*
232      ELSE
233*
234*        Invalid value for ISPEC
235*
236         ILAENV = -1
237      END IF
238*
239      RETURN
240*
241*     End of ILAENV
242*
243      END
244      INTEGER FUNCTION ILAENV2STAGE( ISPEC, NAME, OPTS, N1, N2,
245     $                               N3, N4 )
246*     .. Scalar Arguments ..
247      CHARACTER*( * )    NAME, OPTS
248      INTEGER            ISPEC, N1, N2, N3, N4
249*     ..
250*
251*  =====================================================================
252*
253*     .. Local variables ..
254      INTEGER            IISPEC
255*     .. External Functions ..
256      INTEGER            IPARAM2STAGE
257      EXTERNAL           IPARAM2STAGE
258*     ..
259*     .. Arrays in Common ..
260      INTEGER            IPARMS( 100 )
261*     ..
262*     .. Common blocks ..
263      COMMON             / CLAENV / IPARMS
264*     ..
265*     .. Save statement ..
266      SAVE               / CLAENV /
267*     ..
268*     .. Executable Statements ..
269*
270      IF(( ISPEC.GE.1 ) .AND. (ISPEC.LE.5)) THEN
271*
272*     1 <= ISPEC <= 5: 2stage eigenvalues SVD routines.
273*
274         IF( ISPEC.EQ.1 ) THEN
275             ILAENV2STAGE = IPARMS( 1 )
276         ELSE
277             IISPEC = 16 + ISPEC
278             ILAENV2STAGE = IPARAM2STAGE( IISPEC, NAME, OPTS,
279     $                                    N1, N2, N3, N4 )
280         ENDIF
281*
282      ELSE
283*
284*        Invalid value for ISPEC
285*
286         ILAENV2STAGE = -1
287      END IF
288*
289      RETURN
290      END
291