Chris@202
|
1 #include "f2c.h"
|
Chris@202
|
2 #include "string.h"
|
Chris@202
|
3
|
Chris@202
|
4 /* Table of constant values */
|
Chris@202
|
5
|
Chris@203
|
6 static integer c__0 = 0;
|
Chris@202
|
7 static real c_b163 = 0.f;
|
Chris@202
|
8 static real c_b164 = 1.f;
|
Chris@203
|
9 static integer c__1 = 1;
|
Chris@202
|
10
|
Chris@202
|
11 integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1,
|
Chris@202
|
12 integer *n2, integer *n3, integer *n4)
|
Chris@202
|
13 {
|
Chris@202
|
14 /* System generated locals */
|
Chris@202
|
15 integer ret_val;
|
Chris@202
|
16
|
Chris@202
|
17 /* Builtin functions */
|
Chris@202
|
18 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
|
Chris@202
|
19 integer s_cmp(char *, char *, ftnlen, ftnlen);
|
Chris@202
|
20
|
Chris@202
|
21 /* Local variables */
|
Chris@203
|
22 static integer i__;
|
Chris@203
|
23 static char c1[1], c2[2], c3[3], c4[2];
|
Chris@203
|
24 static integer ic, nb, iz, nx;
|
Chris@203
|
25 static logical cname;
|
Chris@203
|
26 static integer nbmin;
|
Chris@203
|
27 static logical sname;
|
Chris@202
|
28 extern integer ieeeck_(integer *, real *, real *);
|
Chris@203
|
29 static char subnam[6];
|
Chris@202
|
30 extern integer iparmq_(integer *, char *, char *, integer *, integer *,
|
Chris@202
|
31 integer *, integer *);
|
Chris@202
|
32
|
Chris@202
|
33 ftnlen name_len, opts_len;
|
Chris@202
|
34
|
Chris@202
|
35 name_len = strlen (name__);
|
Chris@202
|
36 opts_len = strlen (opts);
|
Chris@202
|
37
|
Chris@203
|
38
|
Chris@203
|
39 /* -- LAPACK auxiliary routine (version 3.1.1) -- */
|
Chris@202
|
40 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
|
Chris@202
|
41 /* January 2007 */
|
Chris@202
|
42
|
Chris@202
|
43 /* .. Scalar Arguments .. */
|
Chris@202
|
44 /* .. */
|
Chris@202
|
45
|
Chris@202
|
46 /* Purpose */
|
Chris@202
|
47 /* ======= */
|
Chris@202
|
48
|
Chris@202
|
49 /* ILAENV is called from the LAPACK routines to choose problem-dependent */
|
Chris@202
|
50 /* parameters for the local environment. See ISPEC for a description of */
|
Chris@202
|
51 /* the parameters. */
|
Chris@202
|
52
|
Chris@202
|
53 /* ILAENV returns an INTEGER */
|
Chris@202
|
54 /* if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC */
|
Chris@202
|
55 /* if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal value. */
|
Chris@202
|
56
|
Chris@202
|
57 /* This version provides a set of parameters which should give good, */
|
Chris@202
|
58 /* but not optimal, performance on many of the currently available */
|
Chris@202
|
59 /* computers. Users are encouraged to modify this subroutine to set */
|
Chris@202
|
60 /* the tuning parameters for their particular machine using the option */
|
Chris@202
|
61 /* and problem size information in the arguments. */
|
Chris@202
|
62
|
Chris@202
|
63 /* This routine will not function correctly if it is converted to all */
|
Chris@202
|
64 /* lower case. Converting it to all upper case is allowed. */
|
Chris@202
|
65
|
Chris@202
|
66 /* Arguments */
|
Chris@202
|
67 /* ========= */
|
Chris@202
|
68
|
Chris@202
|
69 /* ISPEC (input) INTEGER */
|
Chris@202
|
70 /* Specifies the parameter to be returned as the value of */
|
Chris@202
|
71 /* ILAENV. */
|
Chris@202
|
72 /* = 1: the optimal blocksize; if this value is 1, an unblocked */
|
Chris@202
|
73 /* algorithm will give the best performance. */
|
Chris@202
|
74 /* = 2: the minimum block size for which the block routine */
|
Chris@202
|
75 /* should be used; if the usable block size is less than */
|
Chris@202
|
76 /* this value, an unblocked routine should be used. */
|
Chris@202
|
77 /* = 3: the crossover point (in a block routine, for N less */
|
Chris@202
|
78 /* than this value, an unblocked routine should be used) */
|
Chris@202
|
79 /* = 4: the number of shifts, used in the nonsymmetric */
|
Chris@202
|
80 /* eigenvalue routines (DEPRECATED) */
|
Chris@202
|
81 /* = 5: the minimum column dimension for blocking to be used; */
|
Chris@202
|
82 /* rectangular blocks must have dimension at least k by m, */
|
Chris@202
|
83 /* where k is given by ILAENV(2,...) and m by ILAENV(5,...) */
|
Chris@202
|
84 /* = 6: the crossover point for the SVD (when reducing an m by n */
|
Chris@202
|
85 /* matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds */
|
Chris@202
|
86 /* this value, a QR factorization is used first to reduce */
|
Chris@202
|
87 /* the matrix to a triangular form.) */
|
Chris@202
|
88 /* = 7: the number of processors */
|
Chris@202
|
89 /* = 8: the crossover point for the multishift QR method */
|
Chris@202
|
90 /* for nonsymmetric eigenvalue problems (DEPRECATED) */
|
Chris@202
|
91 /* = 9: maximum size of the subproblems at the bottom of the */
|
Chris@202
|
92 /* computation tree in the divide-and-conquer algorithm */
|
Chris@202
|
93 /* (used by xGELSD and xGESDD) */
|
Chris@202
|
94 /* =10: ieee NaN arithmetic can be trusted not to trap */
|
Chris@202
|
95 /* =11: infinity arithmetic can be trusted not to trap */
|
Chris@202
|
96 /* 12 <= ISPEC <= 16: */
|
Chris@202
|
97 /* xHSEQR or one of its subroutines, */
|
Chris@202
|
98 /* see IPARMQ for detailed explanation */
|
Chris@202
|
99
|
Chris@202
|
100 /* NAME (input) CHARACTER*(*) */
|
Chris@202
|
101 /* The name of the calling subroutine, in either upper case or */
|
Chris@202
|
102 /* lower case. */
|
Chris@202
|
103
|
Chris@202
|
104 /* OPTS (input) CHARACTER*(*) */
|
Chris@202
|
105 /* The character options to the subroutine NAME, concatenated */
|
Chris@202
|
106 /* into a single character string. For example, UPLO = 'U', */
|
Chris@202
|
107 /* TRANS = 'T', and DIAG = 'N' for a triangular routine would */
|
Chris@202
|
108 /* be specified as OPTS = 'UTN'. */
|
Chris@202
|
109
|
Chris@202
|
110 /* N1 (input) INTEGER */
|
Chris@202
|
111 /* N2 (input) INTEGER */
|
Chris@202
|
112 /* N3 (input) INTEGER */
|
Chris@202
|
113 /* N4 (input) INTEGER */
|
Chris@202
|
114 /* Problem dimensions for the subroutine NAME; these may not all */
|
Chris@202
|
115 /* be required. */
|
Chris@202
|
116
|
Chris@202
|
117 /* Further Details */
|
Chris@202
|
118 /* =============== */
|
Chris@202
|
119
|
Chris@202
|
120 /* The following conventions have been used when calling ILAENV from the */
|
Chris@202
|
121 /* LAPACK routines: */
|
Chris@202
|
122 /* 1) OPTS is a concatenation of all of the character options to */
|
Chris@202
|
123 /* subroutine NAME, in the same order that they appear in the */
|
Chris@202
|
124 /* argument list for NAME, even if they are not used in determining */
|
Chris@202
|
125 /* the value of the parameter specified by ISPEC. */
|
Chris@202
|
126 /* 2) The problem dimensions N1, N2, N3, N4 are specified in the order */
|
Chris@202
|
127 /* that they appear in the argument list for NAME. N1 is used */
|
Chris@202
|
128 /* first, N2 second, and so on, and unused problem dimensions are */
|
Chris@202
|
129 /* passed a value of -1. */
|
Chris@202
|
130 /* 3) The parameter value returned by ILAENV is checked for validity in */
|
Chris@202
|
131 /* the calling subroutine. For example, ILAENV is used to retrieve */
|
Chris@202
|
132 /* the optimal blocksize for STRTRI as follows: */
|
Chris@202
|
133
|
Chris@202
|
134 /* NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) */
|
Chris@202
|
135 /* IF( NB.LE.1 ) NB = MAX( 1, N ) */
|
Chris@202
|
136
|
Chris@202
|
137 /* ===================================================================== */
|
Chris@202
|
138
|
Chris@202
|
139 /* .. Local Scalars .. */
|
Chris@202
|
140 /* .. */
|
Chris@202
|
141 /* .. Intrinsic Functions .. */
|
Chris@202
|
142 /* .. */
|
Chris@202
|
143 /* .. External Functions .. */
|
Chris@202
|
144 /* .. */
|
Chris@202
|
145 /* .. Executable Statements .. */
|
Chris@202
|
146
|
Chris@202
|
147 switch (*ispec) {
|
Chris@202
|
148 case 1: goto L10;
|
Chris@202
|
149 case 2: goto L10;
|
Chris@202
|
150 case 3: goto L10;
|
Chris@202
|
151 case 4: goto L80;
|
Chris@202
|
152 case 5: goto L90;
|
Chris@202
|
153 case 6: goto L100;
|
Chris@202
|
154 case 7: goto L110;
|
Chris@202
|
155 case 8: goto L120;
|
Chris@202
|
156 case 9: goto L130;
|
Chris@202
|
157 case 10: goto L140;
|
Chris@202
|
158 case 11: goto L150;
|
Chris@202
|
159 case 12: goto L160;
|
Chris@202
|
160 case 13: goto L160;
|
Chris@202
|
161 case 14: goto L160;
|
Chris@202
|
162 case 15: goto L160;
|
Chris@202
|
163 case 16: goto L160;
|
Chris@202
|
164 }
|
Chris@202
|
165
|
Chris@202
|
166 /* Invalid value for ISPEC */
|
Chris@202
|
167
|
Chris@202
|
168 ret_val = -1;
|
Chris@202
|
169 return ret_val;
|
Chris@202
|
170
|
Chris@202
|
171 L10:
|
Chris@202
|
172
|
Chris@202
|
173 /* Convert NAME to upper case if the first character is lower case. */
|
Chris@202
|
174
|
Chris@202
|
175 ret_val = 1;
|
Chris@202
|
176 s_copy(subnam, name__, (ftnlen)6, name_len);
|
Chris@202
|
177 ic = *(unsigned char *)subnam;
|
Chris@202
|
178 iz = 'Z';
|
Chris@202
|
179 if (iz == 90 || iz == 122) {
|
Chris@202
|
180
|
Chris@202
|
181 /* ASCII character set */
|
Chris@202
|
182
|
Chris@202
|
183 if (ic >= 97 && ic <= 122) {
|
Chris@202
|
184 *(unsigned char *)subnam = (char) (ic - 32);
|
Chris@202
|
185 for (i__ = 2; i__ <= 6; ++i__) {
|
Chris@202
|
186 ic = *(unsigned char *)&subnam[i__ - 1];
|
Chris@202
|
187 if (ic >= 97 && ic <= 122) {
|
Chris@202
|
188 *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
|
Chris@202
|
189 }
|
Chris@202
|
190 /* L20: */
|
Chris@202
|
191 }
|
Chris@202
|
192 }
|
Chris@202
|
193
|
Chris@202
|
194 } else if (iz == 233 || iz == 169) {
|
Chris@202
|
195
|
Chris@202
|
196 /* EBCDIC character set */
|
Chris@202
|
197
|
Chris@202
|
198 if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 &&
|
Chris@202
|
199 ic <= 169) {
|
Chris@202
|
200 *(unsigned char *)subnam = (char) (ic + 64);
|
Chris@202
|
201 for (i__ = 2; i__ <= 6; ++i__) {
|
Chris@202
|
202 ic = *(unsigned char *)&subnam[i__ - 1];
|
Chris@202
|
203 if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >=
|
Chris@202
|
204 162 && ic <= 169) {
|
Chris@202
|
205 *(unsigned char *)&subnam[i__ - 1] = (char) (ic + 64);
|
Chris@202
|
206 }
|
Chris@202
|
207 /* L30: */
|
Chris@202
|
208 }
|
Chris@202
|
209 }
|
Chris@202
|
210
|
Chris@202
|
211 } else if (iz == 218 || iz == 250) {
|
Chris@202
|
212
|
Chris@202
|
213 /* Prime machines: ASCII+128 */
|
Chris@202
|
214
|
Chris@202
|
215 if (ic >= 225 && ic <= 250) {
|
Chris@202
|
216 *(unsigned char *)subnam = (char) (ic - 32);
|
Chris@202
|
217 for (i__ = 2; i__ <= 6; ++i__) {
|
Chris@202
|
218 ic = *(unsigned char *)&subnam[i__ - 1];
|
Chris@202
|
219 if (ic >= 225 && ic <= 250) {
|
Chris@202
|
220 *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
|
Chris@202
|
221 }
|
Chris@202
|
222 /* L40: */
|
Chris@202
|
223 }
|
Chris@202
|
224 }
|
Chris@202
|
225 }
|
Chris@202
|
226
|
Chris@202
|
227 *(unsigned char *)c1 = *(unsigned char *)subnam;
|
Chris@202
|
228 sname = *(unsigned char *)c1 == 'S' || *(unsigned char *)c1 == 'D';
|
Chris@202
|
229 cname = *(unsigned char *)c1 == 'C' || *(unsigned char *)c1 == 'Z';
|
Chris@202
|
230 if (! (cname || sname)) {
|
Chris@202
|
231 return ret_val;
|
Chris@202
|
232 }
|
Chris@203
|
233 s_copy(c2, subnam + 1, (ftnlen)2, (ftnlen)2);
|
Chris@203
|
234 s_copy(c3, subnam + 3, (ftnlen)3, (ftnlen)3);
|
Chris@203
|
235 s_copy(c4, c3 + 1, (ftnlen)2, (ftnlen)2);
|
Chris@202
|
236
|
Chris@202
|
237 switch (*ispec) {
|
Chris@202
|
238 case 1: goto L50;
|
Chris@202
|
239 case 2: goto L60;
|
Chris@202
|
240 case 3: goto L70;
|
Chris@202
|
241 }
|
Chris@202
|
242
|
Chris@202
|
243 L50:
|
Chris@202
|
244
|
Chris@202
|
245 /* ISPEC = 1: block size */
|
Chris@202
|
246
|
Chris@202
|
247 /* In these examples, separate code is provided for setting NB for */
|
Chris@202
|
248 /* real and complex. We assume that NB will take the same value in */
|
Chris@202
|
249 /* single or double precision. */
|
Chris@202
|
250
|
Chris@202
|
251 nb = 1;
|
Chris@202
|
252
|
Chris@203
|
253 if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
254 if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
255 if (sname) {
|
Chris@202
|
256 nb = 64;
|
Chris@202
|
257 } else {
|
Chris@202
|
258 nb = 64;
|
Chris@202
|
259 }
|
Chris@203
|
260 } else if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
|
Chris@203
|
261 "RQF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)
|
Chris@203
|
262 3, (ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3)
|
Chris@202
|
263 == 0) {
|
Chris@202
|
264 if (sname) {
|
Chris@202
|
265 nb = 32;
|
Chris@202
|
266 } else {
|
Chris@202
|
267 nb = 32;
|
Chris@202
|
268 }
|
Chris@203
|
269 } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
270 if (sname) {
|
Chris@202
|
271 nb = 32;
|
Chris@202
|
272 } else {
|
Chris@202
|
273 nb = 32;
|
Chris@202
|
274 }
|
Chris@203
|
275 } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
276 if (sname) {
|
Chris@202
|
277 nb = 32;
|
Chris@202
|
278 } else {
|
Chris@202
|
279 nb = 32;
|
Chris@202
|
280 }
|
Chris@203
|
281 } else if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
282 if (sname) {
|
Chris@202
|
283 nb = 64;
|
Chris@202
|
284 } else {
|
Chris@202
|
285 nb = 64;
|
Chris@202
|
286 }
|
Chris@202
|
287 }
|
Chris@203
|
288 } else if (s_cmp(c2, "PO", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
289 if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
290 if (sname) {
|
Chris@202
|
291 nb = 64;
|
Chris@202
|
292 } else {
|
Chris@202
|
293 nb = 64;
|
Chris@202
|
294 }
|
Chris@202
|
295 }
|
Chris@203
|
296 } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
297 if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
298 if (sname) {
|
Chris@202
|
299 nb = 64;
|
Chris@202
|
300 } else {
|
Chris@202
|
301 nb = 64;
|
Chris@202
|
302 }
|
Chris@203
|
303 } else if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
304 nb = 32;
|
Chris@203
|
305 } else if (sname && s_cmp(c3, "GST", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
306 nb = 64;
|
Chris@202
|
307 }
|
Chris@203
|
308 } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
309 if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
310 nb = 64;
|
Chris@203
|
311 } else if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
312 nb = 32;
|
Chris@203
|
313 } else if (s_cmp(c3, "GST", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
314 nb = 64;
|
Chris@202
|
315 }
|
Chris@203
|
316 } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
317 if (*(unsigned char *)c3 == 'G') {
|
Chris@203
|
318 if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
|
Chris@203
|
319 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
|
Chris@203
|
320 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
|
Chris@203
|
321 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
Chris@203
|
322 c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
|
Chris@203
|
323 ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
324 nb = 32;
|
Chris@202
|
325 }
|
Chris@202
|
326 } else if (*(unsigned char *)c3 == 'M') {
|
Chris@203
|
327 if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
|
Chris@203
|
328 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
|
Chris@203
|
329 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
|
Chris@203
|
330 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
Chris@203
|
331 c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
|
Chris@203
|
332 ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
333 nb = 32;
|
Chris@202
|
334 }
|
Chris@202
|
335 }
|
Chris@203
|
336 } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
337 if (*(unsigned char *)c3 == 'G') {
|
Chris@203
|
338 if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
|
Chris@203
|
339 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
|
Chris@203
|
340 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
|
Chris@203
|
341 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
Chris@203
|
342 c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
|
Chris@203
|
343 ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
344 nb = 32;
|
Chris@202
|
345 }
|
Chris@202
|
346 } else if (*(unsigned char *)c3 == 'M') {
|
Chris@203
|
347 if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
|
Chris@203
|
348 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
|
Chris@203
|
349 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
|
Chris@203
|
350 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
Chris@203
|
351 c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
|
Chris@203
|
352 ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
353 nb = 32;
|
Chris@202
|
354 }
|
Chris@202
|
355 }
|
Chris@203
|
356 } else if (s_cmp(c2, "GB", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
357 if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
358 if (sname) {
|
Chris@202
|
359 if (*n4 <= 64) {
|
Chris@202
|
360 nb = 1;
|
Chris@202
|
361 } else {
|
Chris@202
|
362 nb = 32;
|
Chris@202
|
363 }
|
Chris@202
|
364 } else {
|
Chris@202
|
365 if (*n4 <= 64) {
|
Chris@202
|
366 nb = 1;
|
Chris@202
|
367 } else {
|
Chris@202
|
368 nb = 32;
|
Chris@202
|
369 }
|
Chris@202
|
370 }
|
Chris@202
|
371 }
|
Chris@203
|
372 } else if (s_cmp(c2, "PB", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
373 if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
374 if (sname) {
|
Chris@202
|
375 if (*n2 <= 64) {
|
Chris@202
|
376 nb = 1;
|
Chris@202
|
377 } else {
|
Chris@202
|
378 nb = 32;
|
Chris@202
|
379 }
|
Chris@202
|
380 } else {
|
Chris@202
|
381 if (*n2 <= 64) {
|
Chris@202
|
382 nb = 1;
|
Chris@202
|
383 } else {
|
Chris@202
|
384 nb = 32;
|
Chris@202
|
385 }
|
Chris@202
|
386 }
|
Chris@202
|
387 }
|
Chris@203
|
388 } else if (s_cmp(c2, "TR", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
389 if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
390 if (sname) {
|
Chris@202
|
391 nb = 64;
|
Chris@202
|
392 } else {
|
Chris@202
|
393 nb = 64;
|
Chris@202
|
394 }
|
Chris@202
|
395 }
|
Chris@203
|
396 } else if (s_cmp(c2, "LA", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
397 if (s_cmp(c3, "UUM", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
398 if (sname) {
|
Chris@202
|
399 nb = 64;
|
Chris@202
|
400 } else {
|
Chris@202
|
401 nb = 64;
|
Chris@202
|
402 }
|
Chris@202
|
403 }
|
Chris@203
|
404 } else if (sname && s_cmp(c2, "ST", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
405 if (s_cmp(c3, "EBZ", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
406 nb = 1;
|
Chris@202
|
407 }
|
Chris@202
|
408 }
|
Chris@202
|
409 ret_val = nb;
|
Chris@202
|
410 return ret_val;
|
Chris@202
|
411
|
Chris@202
|
412 L60:
|
Chris@202
|
413
|
Chris@202
|
414 /* ISPEC = 2: minimum block size */
|
Chris@202
|
415
|
Chris@202
|
416 nbmin = 2;
|
Chris@203
|
417 if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
418 if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
|
Chris@203
|
419 ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)3, (
|
Chris@203
|
420 ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0)
|
Chris@202
|
421 {
|
Chris@202
|
422 if (sname) {
|
Chris@202
|
423 nbmin = 2;
|
Chris@202
|
424 } else {
|
Chris@202
|
425 nbmin = 2;
|
Chris@202
|
426 }
|
Chris@203
|
427 } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
428 if (sname) {
|
Chris@202
|
429 nbmin = 2;
|
Chris@202
|
430 } else {
|
Chris@202
|
431 nbmin = 2;
|
Chris@202
|
432 }
|
Chris@203
|
433 } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
434 if (sname) {
|
Chris@202
|
435 nbmin = 2;
|
Chris@202
|
436 } else {
|
Chris@202
|
437 nbmin = 2;
|
Chris@202
|
438 }
|
Chris@203
|
439 } else if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
440 if (sname) {
|
Chris@202
|
441 nbmin = 2;
|
Chris@202
|
442 } else {
|
Chris@202
|
443 nbmin = 2;
|
Chris@202
|
444 }
|
Chris@202
|
445 }
|
Chris@203
|
446 } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
447 if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
448 if (sname) {
|
Chris@202
|
449 nbmin = 8;
|
Chris@202
|
450 } else {
|
Chris@202
|
451 nbmin = 8;
|
Chris@202
|
452 }
|
Chris@203
|
453 } else if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
454 nbmin = 2;
|
Chris@202
|
455 }
|
Chris@203
|
456 } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
457 if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
458 nbmin = 2;
|
Chris@202
|
459 }
|
Chris@203
|
460 } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
461 if (*(unsigned char *)c3 == 'G') {
|
Chris@203
|
462 if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
|
Chris@203
|
463 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
|
Chris@203
|
464 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
|
Chris@203
|
465 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
Chris@203
|
466 c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
|
Chris@203
|
467 ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
468 nbmin = 2;
|
Chris@202
|
469 }
|
Chris@202
|
470 } else if (*(unsigned char *)c3 == 'M') {
|
Chris@203
|
471 if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
|
Chris@203
|
472 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
|
Chris@203
|
473 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
|
Chris@203
|
474 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
Chris@203
|
475 c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
|
Chris@203
|
476 ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
477 nbmin = 2;
|
Chris@202
|
478 }
|
Chris@202
|
479 }
|
Chris@203
|
480 } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
481 if (*(unsigned char *)c3 == 'G') {
|
Chris@203
|
482 if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
|
Chris@203
|
483 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
|
Chris@203
|
484 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
|
Chris@203
|
485 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
Chris@203
|
486 c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
|
Chris@203
|
487 ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
488 nbmin = 2;
|
Chris@202
|
489 }
|
Chris@202
|
490 } else if (*(unsigned char *)c3 == 'M') {
|
Chris@203
|
491 if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
|
Chris@203
|
492 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
|
Chris@203
|
493 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
|
Chris@203
|
494 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
Chris@203
|
495 c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
|
Chris@203
|
496 ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
497 nbmin = 2;
|
Chris@202
|
498 }
|
Chris@202
|
499 }
|
Chris@202
|
500 }
|
Chris@202
|
501 ret_val = nbmin;
|
Chris@202
|
502 return ret_val;
|
Chris@202
|
503
|
Chris@202
|
504 L70:
|
Chris@202
|
505
|
Chris@202
|
506 /* ISPEC = 3: crossover point */
|
Chris@202
|
507
|
Chris@202
|
508 nx = 0;
|
Chris@203
|
509 if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
510 if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
|
Chris@203
|
511 ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)3, (
|
Chris@203
|
512 ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0)
|
Chris@202
|
513 {
|
Chris@202
|
514 if (sname) {
|
Chris@202
|
515 nx = 128;
|
Chris@202
|
516 } else {
|
Chris@202
|
517 nx = 128;
|
Chris@202
|
518 }
|
Chris@203
|
519 } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
520 if (sname) {
|
Chris@202
|
521 nx = 128;
|
Chris@202
|
522 } else {
|
Chris@202
|
523 nx = 128;
|
Chris@202
|
524 }
|
Chris@203
|
525 } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
526 if (sname) {
|
Chris@202
|
527 nx = 128;
|
Chris@202
|
528 } else {
|
Chris@202
|
529 nx = 128;
|
Chris@202
|
530 }
|
Chris@202
|
531 }
|
Chris@203
|
532 } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
533 if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
534 nx = 32;
|
Chris@202
|
535 }
|
Chris@203
|
536 } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@203
|
537 if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
Chris@202
|
538 nx = 32;
|
Chris@202
|
539 }
|
Chris@203
|
540 } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
541 if (*(unsigned char *)c3 == 'G') {
|
Chris@203
|
542 if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
|
Chris@203
|
543 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
|
Chris@203
|
544 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
|
Chris@203
|
545 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
Chris@203
|
546 c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
|
Chris@203
|
547 ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
548 nx = 128;
|
Chris@202
|
549 }
|
Chris@202
|
550 }
|
Chris@203
|
551 } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
552 if (*(unsigned char *)c3 == 'G') {
|
Chris@203
|
553 if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
|
Chris@203
|
554 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
|
Chris@203
|
555 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
|
Chris@203
|
556 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
Chris@203
|
557 c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
|
Chris@203
|
558 ftnlen)2, (ftnlen)2) == 0) {
|
Chris@202
|
559 nx = 128;
|
Chris@202
|
560 }
|
Chris@202
|
561 }
|
Chris@202
|
562 }
|
Chris@202
|
563 ret_val = nx;
|
Chris@202
|
564 return ret_val;
|
Chris@202
|
565
|
Chris@202
|
566 L80:
|
Chris@202
|
567
|
Chris@202
|
568 /* ISPEC = 4: number of shifts (used by xHSEQR) */
|
Chris@202
|
569
|
Chris@202
|
570 ret_val = 6;
|
Chris@202
|
571 return ret_val;
|
Chris@202
|
572
|
Chris@202
|
573 L90:
|
Chris@202
|
574
|
Chris@202
|
575 /* ISPEC = 5: minimum column dimension (not used) */
|
Chris@202
|
576
|
Chris@202
|
577 ret_val = 2;
|
Chris@202
|
578 return ret_val;
|
Chris@202
|
579
|
Chris@202
|
580 L100:
|
Chris@202
|
581
|
Chris@202
|
582 /* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) */
|
Chris@202
|
583
|
Chris@202
|
584 ret_val = (integer) ((real) min(*n1,*n2) * 1.6f);
|
Chris@202
|
585 return ret_val;
|
Chris@202
|
586
|
Chris@202
|
587 L110:
|
Chris@202
|
588
|
Chris@202
|
589 /* ISPEC = 7: number of processors (not used) */
|
Chris@202
|
590
|
Chris@202
|
591 ret_val = 1;
|
Chris@202
|
592 return ret_val;
|
Chris@202
|
593
|
Chris@202
|
594 L120:
|
Chris@202
|
595
|
Chris@202
|
596 /* ISPEC = 8: crossover point for multishift (used by xHSEQR) */
|
Chris@202
|
597
|
Chris@202
|
598 ret_val = 50;
|
Chris@202
|
599 return ret_val;
|
Chris@202
|
600
|
Chris@202
|
601 L130:
|
Chris@202
|
602
|
Chris@202
|
603 /* ISPEC = 9: maximum size of the subproblems at the bottom of the */
|
Chris@202
|
604 /* computation tree in the divide-and-conquer algorithm */
|
Chris@202
|
605 /* (used by xGELSD and xGESDD) */
|
Chris@202
|
606
|
Chris@202
|
607 ret_val = 25;
|
Chris@202
|
608 return ret_val;
|
Chris@202
|
609
|
Chris@202
|
610 L140:
|
Chris@202
|
611
|
Chris@202
|
612 /* ISPEC = 10: ieee NaN arithmetic can be trusted not to trap */
|
Chris@202
|
613
|
Chris@202
|
614 /* ILAENV = 0 */
|
Chris@202
|
615 ret_val = 1;
|
Chris@202
|
616 if (ret_val == 1) {
|
Chris@203
|
617 ret_val = ieeeck_(&c__0, &c_b163, &c_b164);
|
Chris@202
|
618 }
|
Chris@202
|
619 return ret_val;
|
Chris@202
|
620
|
Chris@202
|
621 L150:
|
Chris@202
|
622
|
Chris@202
|
623 /* ISPEC = 11: infinity arithmetic can be trusted not to trap */
|
Chris@202
|
624
|
Chris@202
|
625 /* ILAENV = 0 */
|
Chris@202
|
626 ret_val = 1;
|
Chris@202
|
627 if (ret_val == 1) {
|
Chris@203
|
628 ret_val = ieeeck_(&c__1, &c_b163, &c_b164);
|
Chris@202
|
629 }
|
Chris@202
|
630 return ret_val;
|
Chris@202
|
631
|
Chris@202
|
632 L160:
|
Chris@202
|
633
|
Chris@202
|
634 /* 12 <= ISPEC <= 16: xHSEQR or one of its subroutines. */
|
Chris@202
|
635
|
Chris@202
|
636 ret_val = iparmq_(ispec, name__, opts, n1, n2, n3, n4)
|
Chris@202
|
637 ;
|
Chris@202
|
638 return ret_val;
|
Chris@202
|
639
|
Chris@202
|
640 /* End of ILAENV */
|
Chris@202
|
641
|
Chris@202
|
642 } /* ilaenv_ */
|