LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ilaenv.f
Go to the documentation of this file.
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
integer function ieeeck(ispec, zero, one)
IEEECK
Definition ieeeck.f:82
integer function ilaenv2stage(ispec, name, opts, n1, n2, n3, n4)
ILAENV2STAGE
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
integer function iparam2stage(ispec, name, opts, ni, nbi, ibi, nxi)
IPARAM2STAGE
integer function iparmq(ispec, name, opts, n, ilo, ihi, lwork)
IPARMQ
Definition iparmq.f:230