annotate ext/clapack/src/ilaenv.c @ 210:cf62f73766e9 msvc

Add a MSVC build project. This is hard to use, because it depends on a BLAS library
author Chris Cannam
date Mon, 05 Feb 2018 17:36:47 +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_ */