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