1*> \brief \b XLAENV
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE XLAENV( ISPEC, NVALUE )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            ISPEC, NVALUE
15*       ..
16*
17*
18*> \par Purpose:
19*  =============
20*>
21*> \verbatim
22*>
23*> XLAENV sets certain machine- and problem-dependent quantities
24*> which will later be retrieved by ILAENV.
25*> \endverbatim
26*
27*  Arguments:
28*  ==========
29*
30*> \param[in] ISPEC
31*> \verbatim
32*>          ISPEC is INTEGER
33*>          Specifies the parameter to be set in the COMMON array IPARMS.
34*>          = 1: the optimal blocksize; if this value is 1, an unblocked
35*>               algorithm will give the best performance.
36*>          = 2: the minimum block size for which the block routine
37*>               should be used; if the usable block size is less than
38*>               this value, an unblocked routine should be used.
39*>          = 3: the crossover point (in a block routine, for N less
40*>               than this value, an unblocked routine should be used)
41*>          = 4: the number of shifts, used in the nonsymmetric
42*>               eigenvalue routines
43*>          = 5: the minimum column dimension for blocking to be used;
44*>               rectangular blocks must have dimension at least k by m,
45*>               where k is given by ILAENV(2,...) and m by ILAENV(5,...)
46*>          = 6: the crossover point for the SVD (when reducing an m by n
47*>               matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
48*>               this value, a QR factorization is used first to reduce
49*>               the matrix to a triangular form)
50*>          = 7: the number of processors
51*>          = 8: another crossover point, for the multishift QR and QZ
52*>               methods for nonsymmetric eigenvalue problems.
53*>          = 9: maximum size of the subproblems at the bottom of the
54*>               computation tree in the divide-and-conquer algorithm
55*>               (used by xGELSD and xGESDD)
56*>          =10: ieee NaN arithmetic can be trusted not to trap
57*>          =11: infinity arithmetic can be trusted not to trap
58*> \endverbatim
59*>
60*> \param[in] NVALUE
61*> \verbatim
62*>          NVALUE is INTEGER
63*>          The value of the parameter specified by ISPEC.
64*> \endverbatim
65*
66*  Authors:
67*  ========
68*
69*> \author Univ. of Tennessee
70*> \author Univ. of California Berkeley
71*> \author Univ. of Colorado Denver
72*> \author NAG Ltd.
73*
74*> \date December 2016
75*
76*> \ingroup aux_lin
77*
78*  =====================================================================
79      SUBROUTINE XLAENV( ISPEC, NVALUE )
80*
81*  -- LAPACK test routine (version 3.7.0) --
82*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
83*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
84*     December 2016
85*
86*     .. Scalar Arguments ..
87      INTEGER            ISPEC, NVALUE
88*     ..
89*
90*  =====================================================================
91*
92*     .. Arrays in Common ..
93      INTEGER            IPARMS( 100 )
94*     ..
95*     .. Common blocks ..
96      COMMON             / CLAENV / IPARMS
97*     ..
98*     .. Save statement ..
99      SAVE               / CLAENV /
100*     ..
101*     .. Executable Statements ..
102*
103      IF( ISPEC.GE.1 .AND. ISPEC.LE.9 ) THEN
104         IPARMS( ISPEC ) = NVALUE
105      END IF
106*
107      RETURN
108*
109*     End of XLAENV
110*
111      END
112