annotate ext/clapack/src/ilaenv.c @ 209:ccd2019190bf msvc

Some MSVC fixes, including (temporarily, probably) renaming the FFT source file to avoid getting it mixed up with the Vamp SDK one in our object dir
author Chris Cannam
date Thu, 01 Feb 2018 16:34:08 +0000
parents 9ddc8982ad2d
children
rev   line source
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_ */