annotate ext/clapack/src/ilaenv.c @ 202:45330e0d2819 clapack-included

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