ilaenv.c
Go to the documentation of this file.
00001 /* ilaenv.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 #include "string.h"
00016 
00017 /* Table of constant values */
00018 
00019 static integer c__1 = 1;
00020 static real c_b163 = 0.f;
00021 static real c_b164 = 1.f;
00022 static integer c__0 = 0;
00023 
00024 integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1, 
00025         integer *n2, integer *n3, integer *n4)
00026 {
00027     /* System generated locals */
00028     integer ret_val;
00029 
00030     /* Builtin functions */
00031     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00032     integer s_cmp(char *, char *, ftnlen, ftnlen);
00033 
00034     /* Local variables */
00035     integer i__;
00036     char c1[1], c2[2], c3[3], c4[2];
00037     integer ic, nb, iz, nx;
00038     logical cname;
00039     integer nbmin;
00040     logical sname;
00041     extern integer ieeeck_(integer *, real *, real *);
00042     char subnam[6];
00043     extern integer iparmq_(integer *, char *, char *, integer *, integer *, 
00044             integer *, integer *);
00045 
00046     ftnlen name_len, opts_len;
00047 
00048     name_len = strlen (name__);
00049     opts_len = strlen (opts);
00050 
00051 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00052 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00053 /*     January 2007 */
00054 
00055 /*     .. Scalar Arguments .. */
00056 /*     .. */
00057 
00058 /*  Purpose */
00059 /*  ======= */
00060 
00061 /*  ILAENV is called from the LAPACK routines to choose problem-dependent */
00062 /*  parameters for the local environment.  See ISPEC for a description of */
00063 /*  the parameters. */
00064 
00065 /*  ILAENV returns an INTEGER */
00066 /*  if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC */
00067 /*  if ILAENV < 0:  if ILAENV = -k, the k-th argument had an illegal value. */
00068 
00069 /*  This version provides a set of parameters which should give good, */
00070 /*  but not optimal, performance on many of the currently available */
00071 /*  computers.  Users are encouraged to modify this subroutine to set */
00072 /*  the tuning parameters for their particular machine using the option */
00073 /*  and problem size information in the arguments. */
00074 
00075 /*  This routine will not function correctly if it is converted to all */
00076 /*  lower case.  Converting it to all upper case is allowed. */
00077 
00078 /*  Arguments */
00079 /*  ========= */
00080 
00081 /*  ISPEC   (input) INTEGER */
00082 /*          Specifies the parameter to be returned as the value of */
00083 /*          ILAENV. */
00084 /*          = 1: the optimal blocksize; if this value is 1, an unblocked */
00085 /*               algorithm will give the best performance. */
00086 /*          = 2: the minimum block size for which the block routine */
00087 /*               should be used; if the usable block size is less than */
00088 /*               this value, an unblocked routine should be used. */
00089 /*          = 3: the crossover point (in a block routine, for N less */
00090 /*               than this value, an unblocked routine should be used) */
00091 /*          = 4: the number of shifts, used in the nonsymmetric */
00092 /*               eigenvalue routines (DEPRECATED) */
00093 /*          = 5: the minimum column dimension for blocking to be used; */
00094 /*               rectangular blocks must have dimension at least k by m, */
00095 /*               where k is given by ILAENV(2,...) and m by ILAENV(5,...) */
00096 /*          = 6: the crossover point for the SVD (when reducing an m by n */
00097 /*               matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds */
00098 /*               this value, a QR factorization is used first to reduce */
00099 /*               the matrix to a triangular form.) */
00100 /*          = 7: the number of processors */
00101 /*          = 8: the crossover point for the multishift QR method */
00102 /*               for nonsymmetric eigenvalue problems (DEPRECATED) */
00103 /*          = 9: maximum size of the subproblems at the bottom of the */
00104 /*               computation tree in the divide-and-conquer algorithm */
00105 /*               (used by xGELSD and xGESDD) */
00106 /*          =10: ieee NaN arithmetic can be trusted not to trap */
00107 /*          =11: infinity arithmetic can be trusted not to trap */
00108 /*          12 <= ISPEC <= 16: */
00109 /*               xHSEQR or one of its subroutines, */
00110 /*               see IPARMQ for detailed explanation */
00111 
00112 /*  NAME    (input) CHARACTER*(*) */
00113 /*          The name of the calling subroutine, in either upper case or */
00114 /*          lower case. */
00115 
00116 /*  OPTS    (input) CHARACTER*(*) */
00117 /*          The character options to the subroutine NAME, concatenated */
00118 /*          into a single character string.  For example, UPLO = 'U', */
00119 /*          TRANS = 'T', and DIAG = 'N' for a triangular routine would */
00120 /*          be specified as OPTS = 'UTN'. */
00121 
00122 /*  N1      (input) INTEGER */
00123 /*  N2      (input) INTEGER */
00124 /*  N3      (input) INTEGER */
00125 /*  N4      (input) INTEGER */
00126 /*          Problem dimensions for the subroutine NAME; these may not all */
00127 /*          be required. */
00128 
00129 /*  Further Details */
00130 /*  =============== */
00131 
00132 /*  The following conventions have been used when calling ILAENV from the */
00133 /*  LAPACK routines: */
00134 /*  1)  OPTS is a concatenation of all of the character options to */
00135 /*      subroutine NAME, in the same order that they appear in the */
00136 /*      argument list for NAME, even if they are not used in determining */
00137 /*      the value of the parameter specified by ISPEC. */
00138 /*  2)  The problem dimensions N1, N2, N3, N4 are specified in the order */
00139 /*      that they appear in the argument list for NAME.  N1 is used */
00140 /*      first, N2 second, and so on, and unused problem dimensions are */
00141 /*      passed a value of -1. */
00142 /*  3)  The parameter value returned by ILAENV is checked for validity in */
00143 /*      the calling subroutine.  For example, ILAENV is used to retrieve */
00144 /*      the optimal blocksize for STRTRI as follows: */
00145 
00146 /*      NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) */
00147 /*      IF( NB.LE.1 ) NB = MAX( 1, N ) */
00148 
00149 /*  ===================================================================== */
00150 
00151 /*     .. Local Scalars .. */
00152 /*     .. */
00153 /*     .. Intrinsic Functions .. */
00154 /*     .. */
00155 /*     .. External Functions .. */
00156 /*     .. */
00157 /*     .. Executable Statements .. */
00158 
00159     switch (*ispec) {
00160         case 1:  goto L10;
00161         case 2:  goto L10;
00162         case 3:  goto L10;
00163         case 4:  goto L80;
00164         case 5:  goto L90;
00165         case 6:  goto L100;
00166         case 7:  goto L110;
00167         case 8:  goto L120;
00168         case 9:  goto L130;
00169         case 10:  goto L140;
00170         case 11:  goto L150;
00171         case 12:  goto L160;
00172         case 13:  goto L160;
00173         case 14:  goto L160;
00174         case 15:  goto L160;
00175         case 16:  goto L160;
00176     }
00177 
00178 /*     Invalid value for ISPEC */
00179 
00180     ret_val = -1;
00181     return ret_val;
00182 
00183 L10:
00184 
00185 /*     Convert NAME to upper case if the first character is lower case. */
00186 
00187     ret_val = 1;
00188     s_copy(subnam, name__, (ftnlen)1, name_len);
00189     ic = *(unsigned char *)subnam;
00190     iz = 'Z';
00191     if (iz == 90 || iz == 122) {
00192 
00193 /*        ASCII character set */
00194 
00195         if (ic >= 97 && ic <= 122) {
00196             *(unsigned char *)subnam = (char) (ic - 32);
00197             for (i__ = 2; i__ <= 6; ++i__) {
00198                 ic = *(unsigned char *)&subnam[i__ - 1];
00199                 if (ic >= 97 && ic <= 122) {
00200                     *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
00201                 }
00202 /* L20: */
00203             }
00204         }
00205 
00206     } else if (iz == 233 || iz == 169) {
00207 
00208 /*        EBCDIC character set */
00209 
00210         if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 && 
00211                 ic <= 169) {
00212             *(unsigned char *)subnam = (char) (ic + 64);
00213             for (i__ = 2; i__ <= 6; ++i__) {
00214                 ic = *(unsigned char *)&subnam[i__ - 1];
00215                 if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 
00216                         162 && ic <= 169) {
00217                     *(unsigned char *)&subnam[i__ - 1] = (char) (ic + 64);
00218                 }
00219 /* L30: */
00220             }
00221         }
00222 
00223     } else if (iz == 218 || iz == 250) {
00224 
00225 /*        Prime machines:  ASCII+128 */
00226 
00227         if (ic >= 225 && ic <= 250) {
00228             *(unsigned char *)subnam = (char) (ic - 32);
00229             for (i__ = 2; i__ <= 6; ++i__) {
00230                 ic = *(unsigned char *)&subnam[i__ - 1];
00231                 if (ic >= 225 && ic <= 250) {
00232                     *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
00233                 }
00234 /* L40: */
00235             }
00236         }
00237     }
00238 
00239     *(unsigned char *)c1 = *(unsigned char *)subnam;
00240     sname = *(unsigned char *)c1 == 'S' || *(unsigned char *)c1 == 'D';
00241     cname = *(unsigned char *)c1 == 'C' || *(unsigned char *)c1 == 'Z';
00242     if (! (cname || sname)) {
00243         return ret_val;
00244     }
00245     s_copy(c2, subnam + 1, (ftnlen)1, (ftnlen)2);
00246     s_copy(c3, subnam + 3, (ftnlen)1, (ftnlen)3);
00247     s_copy(c4, c3 + 1, (ftnlen)1, (ftnlen)2);
00248 
00249     switch (*ispec) {
00250         case 1:  goto L50;
00251         case 2:  goto L60;
00252         case 3:  goto L70;
00253     }
00254 
00255 L50:
00256 
00257 /*     ISPEC = 1:  block size */
00258 
00259 /*     In these examples, separate code is provided for setting NB for */
00260 /*     real and complex.  We assume that NB will take the same value in */
00261 /*     single or double precision. */
00262 
00263     nb = 1;
00264 
00265     if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
00266         if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00267             if (sname) {
00268                 nb = 64;
00269             } else {
00270                 nb = 64;
00271             }
00272         } else if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, 
00273                 "RQF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)
00274                 1, (ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3) 
00275                 == 0) {
00276             if (sname) {
00277                 nb = 32;
00278             } else {
00279                 nb = 32;
00280             }
00281         } else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
00282             if (sname) {
00283                 nb = 32;
00284             } else {
00285                 nb = 32;
00286             }
00287         } else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
00288             if (sname) {
00289                 nb = 32;
00290             } else {
00291                 nb = 32;
00292             }
00293         } else if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
00294             if (sname) {
00295                 nb = 64;
00296             } else {
00297                 nb = 64;
00298             }
00299         }
00300     } else if (s_cmp(c2, "PO", (ftnlen)1, (ftnlen)2) == 0) {
00301         if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00302             if (sname) {
00303                 nb = 64;
00304             } else {
00305                 nb = 64;
00306             }
00307         }
00308     } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
00309         if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00310             if (sname) {
00311                 nb = 64;
00312             } else {
00313                 nb = 64;
00314             }
00315         } else if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00316             nb = 32;
00317         } else if (sname && s_cmp(c3, "GST", (ftnlen)1, (ftnlen)3) == 0) {
00318             nb = 64;
00319         }
00320     } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
00321         if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00322             nb = 64;
00323         } else if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00324             nb = 32;
00325         } else if (s_cmp(c3, "GST", (ftnlen)1, (ftnlen)3) == 0) {
00326             nb = 64;
00327         }
00328     } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
00329         if (*(unsigned char *)c3 == 'G') {
00330             if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
00331                     (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00332                     ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00333                      0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00334                     c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00335                     ftnlen)1, (ftnlen)2) == 0) {
00336                 nb = 32;
00337             }
00338         } else if (*(unsigned char *)c3 == 'M') {
00339             if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
00340                     (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00341                     ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00342                      0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00343                     c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00344                     ftnlen)1, (ftnlen)2) == 0) {
00345                 nb = 32;
00346             }
00347         }
00348     } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
00349         if (*(unsigned char *)c3 == 'G') {
00350             if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
00351                     (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00352                     ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00353                      0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00354                     c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00355                     ftnlen)1, (ftnlen)2) == 0) {
00356                 nb = 32;
00357             }
00358         } else if (*(unsigned char *)c3 == 'M') {
00359             if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
00360                     (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00361                     ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00362                      0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00363                     c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00364                     ftnlen)1, (ftnlen)2) == 0) {
00365                 nb = 32;
00366             }
00367         }
00368     } else if (s_cmp(c2, "GB", (ftnlen)1, (ftnlen)2) == 0) {
00369         if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00370             if (sname) {
00371                 if (*n4 <= 64) {
00372                     nb = 1;
00373                 } else {
00374                     nb = 32;
00375                 }
00376             } else {
00377                 if (*n4 <= 64) {
00378                     nb = 1;
00379                 } else {
00380                     nb = 32;
00381                 }
00382             }
00383         }
00384     } else if (s_cmp(c2, "PB", (ftnlen)1, (ftnlen)2) == 0) {
00385         if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00386             if (sname) {
00387                 if (*n2 <= 64) {
00388                     nb = 1;
00389                 } else {
00390                     nb = 32;
00391                 }
00392             } else {
00393                 if (*n2 <= 64) {
00394                     nb = 1;
00395                 } else {
00396                     nb = 32;
00397                 }
00398             }
00399         }
00400     } else if (s_cmp(c2, "TR", (ftnlen)1, (ftnlen)2) == 0) {
00401         if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
00402             if (sname) {
00403                 nb = 64;
00404             } else {
00405                 nb = 64;
00406             }
00407         }
00408     } else if (s_cmp(c2, "LA", (ftnlen)1, (ftnlen)2) == 0) {
00409         if (s_cmp(c3, "UUM", (ftnlen)1, (ftnlen)3) == 0) {
00410             if (sname) {
00411                 nb = 64;
00412             } else {
00413                 nb = 64;
00414             }
00415         }
00416     } else if (sname && s_cmp(c2, "ST", (ftnlen)1, (ftnlen)2) == 0) {
00417         if (s_cmp(c3, "EBZ", (ftnlen)1, (ftnlen)3) == 0) {
00418             nb = 1;
00419         }
00420     }
00421     ret_val = nb;
00422     return ret_val;
00423 
00424 L60:
00425 
00426 /*     ISPEC = 2:  minimum block size */
00427 
00428     nbmin = 2;
00429     if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
00430         if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
00431                 ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)1, (
00432                 ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3) == 0)
00433                  {
00434             if (sname) {
00435                 nbmin = 2;
00436             } else {
00437                 nbmin = 2;
00438             }
00439         } else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
00440             if (sname) {
00441                 nbmin = 2;
00442             } else {
00443                 nbmin = 2;
00444             }
00445         } else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
00446             if (sname) {
00447                 nbmin = 2;
00448             } else {
00449                 nbmin = 2;
00450             }
00451         } else if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
00452             if (sname) {
00453                 nbmin = 2;
00454             } else {
00455                 nbmin = 2;
00456             }
00457         }
00458     } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
00459         if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00460             if (sname) {
00461                 nbmin = 8;
00462             } else {
00463                 nbmin = 8;
00464             }
00465         } else if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00466             nbmin = 2;
00467         }
00468     } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
00469         if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00470             nbmin = 2;
00471         }
00472     } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
00473         if (*(unsigned char *)c3 == 'G') {
00474             if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
00475                     (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00476                     ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00477                      0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00478                     c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00479                     ftnlen)1, (ftnlen)2) == 0) {
00480                 nbmin = 2;
00481             }
00482         } else if (*(unsigned char *)c3 == 'M') {
00483             if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
00484                     (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00485                     ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00486                      0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00487                     c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00488                     ftnlen)1, (ftnlen)2) == 0) {
00489                 nbmin = 2;
00490             }
00491         }
00492     } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
00493         if (*(unsigned char *)c3 == 'G') {
00494             if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
00495                     (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00496                     ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00497                      0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00498                     c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00499                     ftnlen)1, (ftnlen)2) == 0) {
00500                 nbmin = 2;
00501             }
00502         } else if (*(unsigned char *)c3 == 'M') {
00503             if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
00504                     (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00505                     ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00506                      0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00507                     c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00508                     ftnlen)1, (ftnlen)2) == 0) {
00509                 nbmin = 2;
00510             }
00511         }
00512     }
00513     ret_val = nbmin;
00514     return ret_val;
00515 
00516 L70:
00517 
00518 /*     ISPEC = 3:  crossover point */
00519 
00520     nx = 0;
00521     if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
00522         if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
00523                 ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)1, (
00524                 ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3) == 0)
00525                  {
00526             if (sname) {
00527                 nx = 128;
00528             } else {
00529                 nx = 128;
00530             }
00531         } else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
00532             if (sname) {
00533                 nx = 128;
00534             } else {
00535                 nx = 128;
00536             }
00537         } else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
00538             if (sname) {
00539                 nx = 128;
00540             } else {
00541                 nx = 128;
00542             }
00543         }
00544     } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
00545         if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00546             nx = 32;
00547         }
00548     } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
00549         if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00550             nx = 32;
00551         }
00552     } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
00553         if (*(unsigned char *)c3 == 'G') {
00554             if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
00555                     (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00556                     ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00557                      0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00558                     c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00559                     ftnlen)1, (ftnlen)2) == 0) {
00560                 nx = 128;
00561             }
00562         }
00563     } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
00564         if (*(unsigned char *)c3 == 'G') {
00565             if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
00566                     (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00567                     ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00568                      0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00569                     c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00570                     ftnlen)1, (ftnlen)2) == 0) {
00571                 nx = 128;
00572             }
00573         }
00574     }
00575     ret_val = nx;
00576     return ret_val;
00577 
00578 L80:
00579 
00580 /*     ISPEC = 4:  number of shifts (used by xHSEQR) */
00581 
00582     ret_val = 6;
00583     return ret_val;
00584 
00585 L90:
00586 
00587 /*     ISPEC = 5:  minimum column dimension (not used) */
00588 
00589     ret_val = 2;
00590     return ret_val;
00591 
00592 L100:
00593 
00594 /*     ISPEC = 6:  crossover point for SVD (used by xGELSS and xGESVD) */
00595 
00596     ret_val = (integer) ((real) min(*n1,*n2) * 1.6f);
00597     return ret_val;
00598 
00599 L110:
00600 
00601 /*     ISPEC = 7:  number of processors (not used) */
00602 
00603     ret_val = 1;
00604     return ret_val;
00605 
00606 L120:
00607 
00608 /*     ISPEC = 8:  crossover point for multishift (used by xHSEQR) */
00609 
00610     ret_val = 50;
00611     return ret_val;
00612 
00613 L130:
00614 
00615 /*     ISPEC = 9:  maximum size of the subproblems at the bottom of the */
00616 /*                 computation tree in the divide-and-conquer algorithm */
00617 /*                 (used by xGELSD and xGESDD) */
00618 
00619     ret_val = 25;
00620     return ret_val;
00621 
00622 L140:
00623 
00624 /*     ISPEC = 10: ieee NaN arithmetic can be trusted not to trap */
00625 
00626 /*     ILAENV = 0 */
00627     ret_val = 1;
00628     if (ret_val == 1) {
00629         ret_val = ieeeck_(&c__1, &c_b163, &c_b164);
00630     }
00631     return ret_val;
00632 
00633 L150:
00634 
00635 /*     ISPEC = 11: infinity arithmetic can be trusted not to trap */
00636 
00637 /*     ILAENV = 0 */
00638     ret_val = 1;
00639     if (ret_val == 1) {
00640         ret_val = ieeeck_(&c__0, &c_b163, &c_b164);
00641     }
00642     return ret_val;
00643 
00644 L160:
00645 
00646 /*     12 <= ISPEC <= 16: xHSEQR or one of its subroutines. */
00647 
00648     ret_val = iparmq_(ispec, name__, opts, n1, n2, n3, n4)
00649             ;
00650     return ret_val;
00651 
00652 /*     End of ILAENV */
00653 
00654 } /* ilaenv_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:50