LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
integer function ilaenv ( integer  ISPEC,
character*( * )  NAME,
character*( * )  OPTS,
integer  N1,
integer  N2,
integer  N3,
integer  N4 
)

ILAENV

Download ILAENV + dependencies [TGZ] [ZIP] [TXT]

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.

 ILAENV returns an INTEGER
 if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC
 if ILAENV < 0:  if ILAENV = -k, the k-th argument had an illegal value.

 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.
Parameters
[in]ISPEC
          ISPEC is 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 (DEPRECATED)
          = 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 method
               for nonsymmetric eigenvalue problems (DEPRECATED)
          = 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
          12 <= ISPEC <= 16:
               xHSEQR or related subroutines,
               see IPARMQ for detailed explanation
[in]NAME
          NAME is CHARACTER*(*)
          The name of the calling subroutine, in either upper case or
          lower case.
[in]OPTS
          OPTS is 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'.
[in]N1
          N1 is INTEGER
[in]N2
          N2 is INTEGER
[in]N3
          N3 is INTEGER
[in]N4
          N4 is INTEGER
          Problem dimensions for the subroutine NAME; these may not all
          be required.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016
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 )
Purpose:
 ILAENV returns problem-dependent parameters for the local
 environment.  See ISPEC for a description of the parameters.

 In this version, the problem-dependent parameters are contained in
 the integer array IPARMS in the common block CLAENV and the value
 with index ISPEC is copied to ILAENV.  This version of ILAENV is
 to be used in conjunction with XLAENV in TESTING and TIMING.
Parameters
[in]ISPEC
          ISPEC is 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
          =10: ieee NaN arithmetic can be trusted not to trap
          =11: infinity arithmetic can be trusted not to trap
          12 <= ISPEC <= 16:
               xHSEQR or one of its subroutines,
               see IPARMQ for detailed explanation

          Other specifications (up to 100) can be added later.
[in]NAME
          NAME is CHARACTER*(*)
          The name of the calling subroutine.
[in]OPTS
          OPTS is 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'.
[in]N1
          N1 is INTEGER
[in]N2
          N2 is INTEGER
[in]N3
          N3 is INTEGER
[in]N4
          N4 is INTEGER

          Problem dimensions for the subroutine NAME; these may not all
          be required.
Returns
ILAENV
          ILAENV is INTEGER
          >= 0: the value of the parameter specified by ISPEC
          < 0:  if ILAENV = -k, the k-th argument had an illegal value.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016
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 )

Definition at line 164 of file ilaenv.f.

164 *
165 * -- LAPACK auxiliary routine (version 3.7.0) --
166 * -- LAPACK is a software package provided by Univ. of Tennessee, --
167 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
168 * December 2016
169 *
170 * .. Scalar Arguments ..
171  CHARACTER*( * ) name, opts
172  INTEGER ispec, n1, n2, n3, n4
173 * ..
174 *
175 * =====================================================================
176 *
177 * .. Local Scalars ..
178  INTEGER i, ic, iz, nb, nbmin, nx
179  LOGICAL cname, sname
180  CHARACTER c1*1, c2*2, c4*2, c3*3, subnam*6
181 * ..
182 * .. Intrinsic Functions ..
183  INTRINSIC char, ichar, int, min, real
184 * ..
185 * .. External Functions ..
186  INTEGER ieeeck, iparmq, iparam2stage
187  EXTERNAL ieeeck, iparmq, iparam2stage
188 * ..
189 * .. Executable Statements ..
190 *
191  GO TO ( 10, 10, 10, 80, 90, 100, 110, 120,
192  $ 130, 140, 150, 160, 160, 160, 160, 160,
193  $ 170, 170, 170, 170, 170 )ispec
194 *
195 * Invalid value for ISPEC
196 *
197  ilaenv = -1
198  RETURN
199 *
200  10 CONTINUE
201 *
202 * Convert NAME to upper case if the first character is lower case.
203 *
204  ilaenv = 1
205  subnam = name
206  ic = ichar( subnam( 1: 1 ) )
207  iz = ichar( 'Z' )
208  IF( iz.EQ.90 .OR. iz.EQ.122 ) THEN
209 *
210 * ASCII character set
211 *
212  IF( ic.GE.97 .AND. ic.LE.122 ) THEN
213  subnam( 1: 1 ) = char( ic-32 )
214  DO 20 i = 2, 6
215  ic = ichar( subnam( i: i ) )
216  IF( ic.GE.97 .AND. ic.LE.122 )
217  $ subnam( i: i ) = char( ic-32 )
218  20 CONTINUE
219  END IF
220 *
221  ELSE IF( iz.EQ.233 .OR. iz.EQ.169 ) THEN
222 *
223 * EBCDIC character set
224 *
225  IF( ( ic.GE.129 .AND. ic.LE.137 ) .OR.
226  $ ( ic.GE.145 .AND. ic.LE.153 ) .OR.
227  $ ( ic.GE.162 .AND. ic.LE.169 ) ) THEN
228  subnam( 1: 1 ) = char( ic+64 )
229  DO 30 i = 2, 6
230  ic = ichar( subnam( i: i ) )
231  IF( ( ic.GE.129 .AND. ic.LE.137 ) .OR.
232  $ ( ic.GE.145 .AND. ic.LE.153 ) .OR.
233  $ ( ic.GE.162 .AND. ic.LE.169 ) )subnam( i:
234  $ i ) = char( ic+64 )
235  30 CONTINUE
236  END IF
237 *
238  ELSE IF( iz.EQ.218 .OR. iz.EQ.250 ) THEN
239 *
240 * Prime machines: ASCII+128
241 *
242  IF( ic.GE.225 .AND. ic.LE.250 ) THEN
243  subnam( 1: 1 ) = char( ic-32 )
244  DO 40 i = 2, 6
245  ic = ichar( subnam( i: i ) )
246  IF( ic.GE.225 .AND. ic.LE.250 )
247  $ subnam( i: i ) = char( ic-32 )
248  40 CONTINUE
249  END IF
250  END IF
251 *
252  c1 = subnam( 1: 1 )
253  sname = c1.EQ.'S' .OR. c1.EQ.'D'
254  cname = c1.EQ.'C' .OR. c1.EQ.'Z'
255  IF( .NOT.( cname .OR. sname ) )
256  $ RETURN
257  c2 = subnam( 2: 3 )
258  c3 = subnam( 4: 6 )
259  c4 = c3( 2: 3 )
260 *
261  GO TO ( 50, 60, 70 )ispec
262 *
263  50 CONTINUE
264 *
265 * ISPEC = 1: block size
266 *
267 * In these examples, separate code is provided for setting NB for
268 * real and complex. We assume that NB will take the same value in
269 * single or double precision.
270 *
271  nb = 1
272 *
273  IF( c2.EQ.'GE' ) THEN
274  IF( c3.EQ.'TRF' ) THEN
275  IF( sname ) THEN
276  nb = 64
277  ELSE
278  nb = 64
279  END IF
280  ELSE IF( c3.EQ.'QRF' .OR. c3.EQ.'RQF' .OR. c3.EQ.'LQF' .OR.
281  $ c3.EQ.'QLF' ) THEN
282  IF( sname ) THEN
283  nb = 32
284  ELSE
285  nb = 32
286  END IF
287  ELSE IF( c3.EQ.'QR ') THEN
288  IF( n3 .EQ. 1) THEN
289  IF( sname ) THEN
290 * M*N
291  IF ((n1*n2.LE.131072).OR.(n1.LE.8192)) THEN
292  nb = n1
293  ELSE
294  nb = 32768/n2
295  END IF
296  ELSE
297  IF ((n1*n2.LE.131072).OR.(n1.LE.8192)) THEN
298  nb = n1
299  ELSE
300  nb = 32768/n2
301  END IF
302  END IF
303  ELSE
304  IF( sname ) THEN
305  nb = 1
306  ELSE
307  nb = 1
308  END IF
309  END IF
310  ELSE IF( c3.EQ.'LQ ') THEN
311  IF( n3 .EQ. 2) THEN
312  IF( sname ) THEN
313 * M*N
314  IF ((n1*n2.LE.131072).OR.(n1.LE.8192)) THEN
315  nb = n1
316  ELSE
317  nb = 32768/n2
318  END IF
319  ELSE
320  IF ((n1*n2.LE.131072).OR.(n1.LE.8192)) THEN
321  nb = n1
322  ELSE
323  nb = 32768/n2
324  END IF
325  END IF
326  ELSE
327  IF( sname ) THEN
328  nb = 1
329  ELSE
330  nb = 1
331  END IF
332  END IF
333  ELSE IF( c3.EQ.'HRD' ) THEN
334  IF( sname ) THEN
335  nb = 32
336  ELSE
337  nb = 32
338  END IF
339  ELSE IF( c3.EQ.'BRD' ) THEN
340  IF( sname ) THEN
341  nb = 32
342  ELSE
343  nb = 32
344  END IF
345  ELSE IF( c3.EQ.'TRI' ) THEN
346  IF( sname ) THEN
347  nb = 64
348  ELSE
349  nb = 64
350  END IF
351  END IF
352  ELSE IF( c2.EQ.'PO' ) THEN
353  IF( c3.EQ.'TRF' ) THEN
354  IF( sname ) THEN
355  nb = 64
356  ELSE
357  nb = 64
358  END IF
359  END IF
360  ELSE IF( c2.EQ.'SY' ) THEN
361  IF( c3.EQ.'TRF' ) THEN
362  IF( sname ) THEN
363  nb = 64
364  ELSE
365  nb = 64
366  END IF
367  ELSE IF( sname .AND. c3.EQ.'TRD' ) THEN
368  nb = 32
369  ELSE IF( sname .AND. c3.EQ.'GST' ) THEN
370  nb = 64
371  END IF
372  ELSE IF( cname .AND. c2.EQ.'HE' ) THEN
373  IF( c3.EQ.'TRF' ) THEN
374  nb = 64
375  ELSE IF( c3.EQ.'TRD' ) THEN
376  nb = 32
377  ELSE IF( c3.EQ.'GST' ) THEN
378  nb = 64
379  END IF
380  ELSE IF( sname .AND. c2.EQ.'OR' ) THEN
381  IF( c3( 1: 1 ).EQ.'G' ) THEN
382  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
383  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
384  $ THEN
385  nb = 32
386  END IF
387  ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
388  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
389  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
390  $ THEN
391  nb = 32
392  END IF
393  END IF
394  ELSE IF( cname .AND. c2.EQ.'UN' ) THEN
395  IF( c3( 1: 1 ).EQ.'G' ) THEN
396  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
397  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
398  $ THEN
399  nb = 32
400  END IF
401  ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
402  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
403  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
404  $ THEN
405  nb = 32
406  END IF
407  END IF
408  ELSE IF( c2.EQ.'GB' ) THEN
409  IF( c3.EQ.'TRF' ) THEN
410  IF( sname ) THEN
411  IF( n4.LE.64 ) THEN
412  nb = 1
413  ELSE
414  nb = 32
415  END IF
416  ELSE
417  IF( n4.LE.64 ) THEN
418  nb = 1
419  ELSE
420  nb = 32
421  END IF
422  END IF
423  END IF
424  ELSE IF( c2.EQ.'PB' ) THEN
425  IF( c3.EQ.'TRF' ) THEN
426  IF( sname ) THEN
427  IF( n2.LE.64 ) THEN
428  nb = 1
429  ELSE
430  nb = 32
431  END IF
432  ELSE
433  IF( n2.LE.64 ) THEN
434  nb = 1
435  ELSE
436  nb = 32
437  END IF
438  END IF
439  END IF
440  ELSE IF( c2.EQ.'TR' ) THEN
441  IF( c3.EQ.'TRI' ) THEN
442  IF( sname ) THEN
443  nb = 64
444  ELSE
445  nb = 64
446  END IF
447  ELSE IF ( c3.EQ.'EVC' ) THEN
448  IF( sname ) THEN
449  nb = 64
450  ELSE
451  nb = 64
452  END IF
453  END IF
454  ELSE IF( c2.EQ.'LA' ) THEN
455  IF( c3.EQ.'UUM' ) THEN
456  IF( sname ) THEN
457  nb = 64
458  ELSE
459  nb = 64
460  END IF
461  END IF
462  ELSE IF( sname .AND. c2.EQ.'ST' ) THEN
463  IF( c3.EQ.'EBZ' ) THEN
464  nb = 1
465  END IF
466  ELSE IF( c2.EQ.'GG' ) THEN
467  nb = 32
468  IF( c3.EQ.'HD3' ) THEN
469  IF( sname ) THEN
470  nb = 32
471  ELSE
472  nb = 32
473  END IF
474  END IF
475  END IF
476  ilaenv = nb
477  RETURN
478 *
479  60 CONTINUE
480 *
481 * ISPEC = 2: minimum block size
482 *
483  nbmin = 2
484  IF( c2.EQ.'GE' ) THEN
485  IF( c3.EQ.'QRF' .OR. c3.EQ.'RQF' .OR. c3.EQ.'LQF' .OR. c3.EQ.
486  $ 'QLF' ) THEN
487  IF( sname ) THEN
488  nbmin = 2
489  ELSE
490  nbmin = 2
491  END IF
492  ELSE IF( c3.EQ.'HRD' ) THEN
493  IF( sname ) THEN
494  nbmin = 2
495  ELSE
496  nbmin = 2
497  END IF
498  ELSE IF( c3.EQ.'BRD' ) THEN
499  IF( sname ) THEN
500  nbmin = 2
501  ELSE
502  nbmin = 2
503  END IF
504  ELSE IF( c3.EQ.'TRI' ) THEN
505  IF( sname ) THEN
506  nbmin = 2
507  ELSE
508  nbmin = 2
509  END IF
510  END IF
511  ELSE IF( c2.EQ.'SY' ) THEN
512  IF( c3.EQ.'TRF' ) THEN
513  IF( sname ) THEN
514  nbmin = 8
515  ELSE
516  nbmin = 8
517  END IF
518  ELSE IF( sname .AND. c3.EQ.'TRD' ) THEN
519  nbmin = 2
520  END IF
521  ELSE IF( cname .AND. c2.EQ.'HE' ) THEN
522  IF( c3.EQ.'TRD' ) THEN
523  nbmin = 2
524  END IF
525  ELSE IF( sname .AND. c2.EQ.'OR' ) THEN
526  IF( c3( 1: 1 ).EQ.'G' ) THEN
527  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
528  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
529  $ THEN
530  nbmin = 2
531  END IF
532  ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
533  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
534  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
535  $ THEN
536  nbmin = 2
537  END IF
538  END IF
539  ELSE IF( cname .AND. c2.EQ.'UN' ) THEN
540  IF( c3( 1: 1 ).EQ.'G' ) THEN
541  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
542  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
543  $ THEN
544  nbmin = 2
545  END IF
546  ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
547  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
548  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
549  $ THEN
550  nbmin = 2
551  END IF
552  END IF
553  ELSE IF( c2.EQ.'GG' ) THEN
554  nbmin = 2
555  IF( c3.EQ.'HD3' ) THEN
556  nbmin = 2
557  END IF
558  END IF
559  ilaenv = nbmin
560  RETURN
561 *
562  70 CONTINUE
563 *
564 * ISPEC = 3: crossover point
565 *
566  nx = 0
567  IF( c2.EQ.'GE' ) THEN
568  IF( c3.EQ.'QRF' .OR. c3.EQ.'RQF' .OR. c3.EQ.'LQF' .OR. c3.EQ.
569  $ 'QLF' ) THEN
570  IF( sname ) THEN
571  nx = 128
572  ELSE
573  nx = 128
574  END IF
575  ELSE IF( c3.EQ.'HRD' ) THEN
576  IF( sname ) THEN
577  nx = 128
578  ELSE
579  nx = 128
580  END IF
581  ELSE IF( c3.EQ.'BRD' ) THEN
582  IF( sname ) THEN
583  nx = 128
584  ELSE
585  nx = 128
586  END IF
587  END IF
588  ELSE IF( c2.EQ.'SY' ) THEN
589  IF( sname .AND. c3.EQ.'TRD' ) THEN
590  nx = 32
591  END IF
592  ELSE IF( cname .AND. c2.EQ.'HE' ) THEN
593  IF( c3.EQ.'TRD' ) THEN
594  nx = 32
595  END IF
596  ELSE IF( sname .AND. c2.EQ.'OR' ) THEN
597  IF( c3( 1: 1 ).EQ.'G' ) THEN
598  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
599  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
600  $ THEN
601  nx = 128
602  END IF
603  END IF
604  ELSE IF( cname .AND. c2.EQ.'UN' ) THEN
605  IF( c3( 1: 1 ).EQ.'G' ) THEN
606  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
607  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
608  $ THEN
609  nx = 128
610  END IF
611  END IF
612  ELSE IF( c2.EQ.'GG' ) THEN
613  nx = 128
614  IF( c3.EQ.'HD3' ) THEN
615  nx = 128
616  END IF
617  END IF
618  ilaenv = nx
619  RETURN
620 *
621  80 CONTINUE
622 *
623 * ISPEC = 4: number of shifts (used by xHSEQR)
624 *
625  ilaenv = 6
626  RETURN
627 *
628  90 CONTINUE
629 *
630 * ISPEC = 5: minimum column dimension (not used)
631 *
632  ilaenv = 2
633  RETURN
634 *
635  100 CONTINUE
636 *
637 * ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD)
638 *
639  ilaenv = int( REAL( MIN( N1, N2 ) )*1.6e0 )
640  RETURN
641 *
642  110 CONTINUE
643 *
644 * ISPEC = 7: number of processors (not used)
645 *
646  ilaenv = 1
647  RETURN
648 *
649  120 CONTINUE
650 *
651 * ISPEC = 8: crossover point for multishift (used by xHSEQR)
652 *
653  ilaenv = 50
654  RETURN
655 *
656  130 CONTINUE
657 *
658 * ISPEC = 9: maximum size of the subproblems at the bottom of the
659 * computation tree in the divide-and-conquer algorithm
660 * (used by xGELSD and xGESDD)
661 *
662  ilaenv = 25
663  RETURN
664 *
665  140 CONTINUE
666 *
667 * ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
668 *
669 * ILAENV = 0
670  ilaenv = 1
671  IF( ilaenv.EQ.1 ) THEN
672  ilaenv = ieeeck( 1, 0.0, 1.0 )
673  END IF
674  RETURN
675 *
676  150 CONTINUE
677 *
678 * ISPEC = 11: infinity arithmetic can be trusted not to trap
679 *
680 * ILAENV = 0
681  ilaenv = 1
682  IF( ilaenv.EQ.1 ) THEN
683  ilaenv = ieeeck( 0, 0.0, 1.0 )
684  END IF
685  RETURN
686 *
687  160 CONTINUE
688 *
689 * 12 <= ISPEC <= 16: xHSEQR or related subroutines.
690 *
691  ilaenv = iparmq( ispec, name, opts, n1, n2, n3, n4 )
692  RETURN
693 *
694  170 CONTINUE
695 *
696 * 17 <= ISPEC <= 21: 2stage eigenvalues and SVD or related subroutines.
697 *
698  ilaenv = iparam2stage( ispec, name, opts, n1, n2, n3, n4 )
699  RETURN
700 *
701 * End of ILAENV
702 *
integer function ieeeck(ISPEC, ZERO, ONE)
Definition: tstiee.f:626
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: tstiee.f:83
integer function iparmq(ISPEC, NAME, OPTS, N, ILO, IHI, LWORK)
IPARMQ
Definition: iparmq.f:224

Here is the call graph for this function: