001:       INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     November 2006
006: *     
007: *     .. Scalar Arguments ..
008:       INTEGER            IHI, ILO, ISPEC, LWORK, N
009:       CHARACTER          NAME*( * ), OPTS*( * )
010: *
011: *  Purpose
012: *  =======
013: *
014: *       This program sets problem and machine dependent parameters
015: *       useful for xHSEQR and its subroutines. It is called whenever 
016: *       ILAENV is called with 12 <= ISPEC <= 16
017: *
018: *  Arguments
019: *  =========
020: *
021: *       ISPEC  (input) integer scalar
022: *              ISPEC specifies which tunable parameter IPARMQ should
023: *              return.
024: *
025: *              ISPEC=12: (INMIN)  Matrices of order nmin or less
026: *                        are sent directly to xLAHQR, the implicit
027: *                        double shift QR algorithm.  NMIN must be
028: *                        at least 11.
029: *
030: *              ISPEC=13: (INWIN)  Size of the deflation window.
031: *                        This is best set greater than or equal to
032: *                        the number of simultaneous shifts NS.
033: *                        Larger matrices benefit from larger deflation
034: *                        windows.
035: *
036: *              ISPEC=14: (INIBL) Determines when to stop nibbling and
037: *                        invest in an (expensive) multi-shift QR sweep.
038: *                        If the aggressive early deflation subroutine
039: *                        finds LD converged eigenvalues from an order
040: *                        NW deflation window and LD.GT.(NW*NIBBLE)/100,
041: *                        then the next QR sweep is skipped and early
042: *                        deflation is applied immediately to the
043: *                        remaining active diagonal block.  Setting
044: *                        IPARMQ(ISPEC=14) = 0 causes TTQRE to skip a
045: *                        multi-shift QR sweep whenever early deflation
046: *                        finds a converged eigenvalue.  Setting
047: *                        IPARMQ(ISPEC=14) greater than or equal to 100
048: *                        prevents TTQRE from skipping a multi-shift
049: *                        QR sweep.
050: *
051: *              ISPEC=15: (NSHFTS) The number of simultaneous shifts in
052: *                        a multi-shift QR iteration.
053: *
054: *              ISPEC=16: (IACC22) IPARMQ is set to 0, 1 or 2 with the
055: *                        following meanings.
056: *                        0:  During the multi-shift QR sweep,
057: *                            xLAQR5 does not accumulate reflections and
058: *                            does not use matrix-matrix multiply to
059: *                            update the far-from-diagonal matrix
060: *                            entries.
061: *                        1:  During the multi-shift QR sweep,
062: *                            xLAQR5 and/or xLAQRaccumulates reflections and uses
063: *                            matrix-matrix multiply to update the
064: *                            far-from-diagonal matrix entries.
065: *                        2:  During the multi-shift QR sweep.
066: *                            xLAQR5 accumulates reflections and takes
067: *                            advantage of 2-by-2 block structure during
068: *                            matrix-matrix multiplies.
069: *                        (If xTRMM is slower than xGEMM, then
070: *                        IPARMQ(ISPEC=16)=1 may be more efficient than
071: *                        IPARMQ(ISPEC=16)=2 despite the greater level of
072: *                        arithmetic work implied by the latter choice.)
073: *
074: *       NAME    (input) character string
075: *               Name of the calling subroutine
076: *
077: *       OPTS    (input) character string
078: *               This is a concatenation of the string arguments to
079: *               TTQRE.
080: *
081: *       N       (input) integer scalar
082: *               N is the order of the Hessenberg matrix H.
083: *
084: *       ILO     (input) INTEGER
085: *       IHI     (input) INTEGER
086: *               It is assumed that H is already upper triangular
087: *               in rows and columns 1:ILO-1 and IHI+1:N.
088: *
089: *       LWORK   (input) integer scalar
090: *               The amount of workspace available.
091: *
092: *  Further Details
093: *  ===============
094: *
095: *       Little is known about how best to choose these parameters.
096: *       It is possible to use different values of the parameters
097: *       for each of CHSEQR, DHSEQR, SHSEQR and ZHSEQR.
098: *
099: *       It is probably best to choose different parameters for
100: *       different matrices and different parameters at different
101: *       times during the iteration, but this has not been
102: *       implemented --- yet.
103: *
104: *
105: *       The best choices of most of the parameters depend
106: *       in an ill-understood way on the relative execution
107: *       rate of xLAQR3 and xLAQR5 and on the nature of each
108: *       particular eigenvalue problem.  Experiment may be the
109: *       only practical way to determine which choices are most
110: *       effective.
111: *
112: *       Following is a list of default values supplied by IPARMQ.
113: *       These defaults may be adjusted in order to attain better
114: *       performance in any particular computational environment.
115: *
116: *       IPARMQ(ISPEC=12) The xLAHQR vs xLAQR0 crossover point.
117: *                        Default: 75. (Must be at least 11.)
118: *
119: *       IPARMQ(ISPEC=13) Recommended deflation window size.
120: *                        This depends on ILO, IHI and NS, the
121: *                        number of simultaneous shifts returned
122: *                        by IPARMQ(ISPEC=15).  The default for
123: *                        (IHI-ILO+1).LE.500 is NS.  The default
124: *                        for (IHI-ILO+1).GT.500 is 3*NS/2.
125: *
126: *       IPARMQ(ISPEC=14) Nibble crossover point.  Default: 14.
127: *
128: *       IPARMQ(ISPEC=15) Number of simultaneous shifts, NS.
129: *                        a multi-shift QR iteration.
130: *
131: *                        If IHI-ILO+1 is ...
132: *
133: *                        greater than      ...but less    ... the
134: *                        or equal to ...      than        default is
135: *
136: *                                0               30       NS =   2+
137: *                               30               60       NS =   4+
138: *                               60              150       NS =  10
139: *                              150              590       NS =  **
140: *                              590             3000       NS =  64
141: *                             3000             6000       NS = 128
142: *                             6000             infinity   NS = 256
143: *
144: *                    (+)  By default matrices of this order are
145: *                         passed to the implicit double shift routine
146: *                         xLAHQR.  See IPARMQ(ISPEC=12) above.   These
147: *                         values of NS are used only in case of a rare
148: *                         xLAHQR failure.
149: *
150: *                    (**) The asterisks (**) indicate an ad-hoc
151: *                         function increasing from 10 to 64.
152: *
153: *       IPARMQ(ISPEC=16) Select structured matrix multiply.
154: *                        (See ISPEC=16 above for details.)
155: *                        Default: 3.
156: *
157: *     ================================================================
158: *     .. Parameters ..
159:       INTEGER            INMIN, INWIN, INIBL, ISHFTS, IACC22
160:       PARAMETER          ( INMIN = 12, INWIN = 13, INIBL = 14,
161:      $                   ISHFTS = 15, IACC22 = 16 )
162:       INTEGER            NMIN, K22MIN, KACMIN, NIBBLE, KNWSWP
163:       PARAMETER          ( NMIN = 75, K22MIN = 14, KACMIN = 14,
164:      $                   NIBBLE = 14, KNWSWP = 500 )
165:       REAL               TWO
166:       PARAMETER          ( TWO = 2.0 )
167: *     ..
168: *     .. Local Scalars ..
169:       INTEGER            NH, NS
170: *     ..
171: *     .. Intrinsic Functions ..
172:       INTRINSIC          LOG, MAX, MOD, NINT, REAL
173: *     ..
174: *     .. Executable Statements ..
175:       IF( ( ISPEC.EQ.ISHFTS ) .OR. ( ISPEC.EQ.INWIN ) .OR.
176:      $    ( ISPEC.EQ.IACC22 ) ) THEN
177: *
178: *        ==== Set the number simultaneous shifts ====
179: *
180:          NH = IHI - ILO + 1
181:          NS = 2
182:          IF( NH.GE.30 )
183:      $      NS = 4
184:          IF( NH.GE.60 )
185:      $      NS = 10
186:          IF( NH.GE.150 )
187:      $      NS = MAX( 10, NH / NINT( LOG( REAL( NH ) ) / LOG( TWO ) ) )
188:          IF( NH.GE.590 )
189:      $      NS = 64
190:          IF( NH.GE.3000 )
191:      $      NS = 128
192:          IF( NH.GE.6000 )
193:      $      NS = 256
194:          NS = MAX( 2, NS-MOD( NS, 2 ) )
195:       END IF
196: *
197:       IF( ISPEC.EQ.INMIN ) THEN
198: *
199: *
200: *        ===== Matrices of order smaller than NMIN get sent
201: *        .     to xLAHQR, the classic double shift algorithm.
202: *        .     This must be at least 11. ====
203: *
204:          IPARMQ = NMIN
205: *
206:       ELSE IF( ISPEC.EQ.INIBL ) THEN
207: *
208: *        ==== INIBL: skip a multi-shift qr iteration and
209: *        .    whenever aggressive early deflation finds
210: *        .    at least (NIBBLE*(window size)/100) deflations. ====
211: *
212:          IPARMQ = NIBBLE
213: *
214:       ELSE IF( ISPEC.EQ.ISHFTS ) THEN
215: *
216: *        ==== NSHFTS: The number of simultaneous shifts =====
217: *
218:          IPARMQ = NS
219: *
220:       ELSE IF( ISPEC.EQ.INWIN ) THEN
221: *
222: *        ==== NW: deflation window size.  ====
223: *
224:          IF( NH.LE.KNWSWP ) THEN
225:             IPARMQ = NS
226:          ELSE
227:             IPARMQ = 3*NS / 2
228:          END IF
229: *
230:       ELSE IF( ISPEC.EQ.IACC22 ) THEN
231: *
232: *        ==== IACC22: Whether to accumulate reflections
233: *        .     before updating the far-from-diagonal elements
234: *        .     and whether to use 2-by-2 block structure while
235: *        .     doing it.  A small amount of work could be saved
236: *        .     by making this choice dependent also upon the
237: *        .     NH=IHI-ILO+1.
238: *
239:          IPARMQ = 0
240:          IF( NS.GE.KACMIN )
241:      $      IPARMQ = 1
242:          IF( NS.GE.K22MIN )
243:      $      IPARMQ = 2
244: *
245:       ELSE
246: *        ===== invalid value of ispec =====
247:          IPARMQ = -1
248: *
249:       END IF
250: *
251: *     ==== End of IPARMQ ====
252: *
253:       END
254: