Chris@202: #include "f2c.h"
Chris@202: #include "string.h"
Chris@202: 
Chris@202: /* Table of constant values */
Chris@202: 
Chris@203: static integer c__0 = 0;
Chris@202: static real c_b163 = 0.f;
Chris@202: static real c_b164 = 1.f;
Chris@203: static integer c__1 = 1;
Chris@202: 
Chris@202: integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1, 
Chris@202: 	integer *n2, integer *n3, integer *n4)
Chris@202: {
Chris@202:     /* System generated locals */
Chris@202:     integer ret_val;
Chris@202: 
Chris@202:     /* Builtin functions */
Chris@202:     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
Chris@202:     integer s_cmp(char *, char *, ftnlen, ftnlen);
Chris@202: 
Chris@202:     /* Local variables */
Chris@203:     static integer i__;
Chris@203:     static char c1[1], c2[2], c3[3], c4[2];
Chris@203:     static integer ic, nb, iz, nx;
Chris@203:     static logical cname;
Chris@203:     static integer nbmin;
Chris@203:     static logical sname;
Chris@202:     extern integer ieeeck_(integer *, real *, real *);
Chris@203:     static char subnam[6];
Chris@202:     extern integer iparmq_(integer *, char *, char *, integer *, integer *, 
Chris@202: 	    integer *, integer *);
Chris@202: 
Chris@202:     ftnlen name_len, opts_len;
Chris@202: 
Chris@202:     name_len = strlen (name__);
Chris@202:     opts_len = strlen (opts);
Chris@202: 
Chris@203: 
Chris@203: /*  -- LAPACK auxiliary routine (version 3.1.1) -- */
Chris@202: /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
Chris@202: /*     January 2007 */
Chris@202: 
Chris@202: /*     .. Scalar Arguments .. */
Chris@202: /*     .. */
Chris@202: 
Chris@202: /*  Purpose */
Chris@202: /*  ======= */
Chris@202: 
Chris@202: /*  ILAENV is called from the LAPACK routines to choose problem-dependent */
Chris@202: /*  parameters for the local environment.  See ISPEC for a description of */
Chris@202: /*  the parameters. */
Chris@202: 
Chris@202: /*  ILAENV returns an INTEGER */
Chris@202: /*  if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC */
Chris@202: /*  if ILAENV < 0:  if ILAENV = -k, the k-th argument had an illegal value. */
Chris@202: 
Chris@202: /*  This version provides a set of parameters which should give good, */
Chris@202: /*  but not optimal, performance on many of the currently available */
Chris@202: /*  computers.  Users are encouraged to modify this subroutine to set */
Chris@202: /*  the tuning parameters for their particular machine using the option */
Chris@202: /*  and problem size information in the arguments. */
Chris@202: 
Chris@202: /*  This routine will not function correctly if it is converted to all */
Chris@202: /*  lower case.  Converting it to all upper case is allowed. */
Chris@202: 
Chris@202: /*  Arguments */
Chris@202: /*  ========= */
Chris@202: 
Chris@202: /*  ISPEC   (input) INTEGER */
Chris@202: /*          Specifies the parameter to be returned as the value of */
Chris@202: /*          ILAENV. */
Chris@202: /*          = 1: the optimal blocksize; if this value is 1, an unblocked */
Chris@202: /*               algorithm will give the best performance. */
Chris@202: /*          = 2: the minimum block size for which the block routine */
Chris@202: /*               should be used; if the usable block size is less than */
Chris@202: /*               this value, an unblocked routine should be used. */
Chris@202: /*          = 3: the crossover point (in a block routine, for N less */
Chris@202: /*               than this value, an unblocked routine should be used) */
Chris@202: /*          = 4: the number of shifts, used in the nonsymmetric */
Chris@202: /*               eigenvalue routines (DEPRECATED) */
Chris@202: /*          = 5: the minimum column dimension for blocking to be used; */
Chris@202: /*               rectangular blocks must have dimension at least k by m, */
Chris@202: /*               where k is given by ILAENV(2,...) and m by ILAENV(5,...) */
Chris@202: /*          = 6: the crossover point for the SVD (when reducing an m by n */
Chris@202: /*               matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds */
Chris@202: /*               this value, a QR factorization is used first to reduce */
Chris@202: /*               the matrix to a triangular form.) */
Chris@202: /*          = 7: the number of processors */
Chris@202: /*          = 8: the crossover point for the multishift QR method */
Chris@202: /*               for nonsymmetric eigenvalue problems (DEPRECATED) */
Chris@202: /*          = 9: maximum size of the subproblems at the bottom of the */
Chris@202: /*               computation tree in the divide-and-conquer algorithm */
Chris@202: /*               (used by xGELSD and xGESDD) */
Chris@202: /*          =10: ieee NaN arithmetic can be trusted not to trap */
Chris@202: /*          =11: infinity arithmetic can be trusted not to trap */
Chris@202: /*          12 <= ISPEC <= 16: */
Chris@202: /*               xHSEQR or one of its subroutines, */
Chris@202: /*               see IPARMQ for detailed explanation */
Chris@202: 
Chris@202: /*  NAME    (input) CHARACTER*(*) */
Chris@202: /*          The name of the calling subroutine, in either upper case or */
Chris@202: /*          lower case. */
Chris@202: 
Chris@202: /*  OPTS    (input) CHARACTER*(*) */
Chris@202: /*          The character options to the subroutine NAME, concatenated */
Chris@202: /*          into a single character string.  For example, UPLO = 'U', */
Chris@202: /*          TRANS = 'T', and DIAG = 'N' for a triangular routine would */
Chris@202: /*          be specified as OPTS = 'UTN'. */
Chris@202: 
Chris@202: /*  N1      (input) INTEGER */
Chris@202: /*  N2      (input) INTEGER */
Chris@202: /*  N3      (input) INTEGER */
Chris@202: /*  N4      (input) INTEGER */
Chris@202: /*          Problem dimensions for the subroutine NAME; these may not all */
Chris@202: /*          be required. */
Chris@202: 
Chris@202: /*  Further Details */
Chris@202: /*  =============== */
Chris@202: 
Chris@202: /*  The following conventions have been used when calling ILAENV from the */
Chris@202: /*  LAPACK routines: */
Chris@202: /*  1)  OPTS is a concatenation of all of the character options to */
Chris@202: /*      subroutine NAME, in the same order that they appear in the */
Chris@202: /*      argument list for NAME, even if they are not used in determining */
Chris@202: /*      the value of the parameter specified by ISPEC. */
Chris@202: /*  2)  The problem dimensions N1, N2, N3, N4 are specified in the order */
Chris@202: /*      that they appear in the argument list for NAME.  N1 is used */
Chris@202: /*      first, N2 second, and so on, and unused problem dimensions are */
Chris@202: /*      passed a value of -1. */
Chris@202: /*  3)  The parameter value returned by ILAENV is checked for validity in */
Chris@202: /*      the calling subroutine.  For example, ILAENV is used to retrieve */
Chris@202: /*      the optimal blocksize for STRTRI as follows: */
Chris@202: 
Chris@202: /*      NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) */
Chris@202: /*      IF( NB.LE.1 ) NB = MAX( 1, N ) */
Chris@202: 
Chris@202: /*  ===================================================================== */
Chris@202: 
Chris@202: /*     .. Local Scalars .. */
Chris@202: /*     .. */
Chris@202: /*     .. Intrinsic Functions .. */
Chris@202: /*     .. */
Chris@202: /*     .. External Functions .. */
Chris@202: /*     .. */
Chris@202: /*     .. Executable Statements .. */
Chris@202: 
Chris@202:     switch (*ispec) {
Chris@202: 	case 1:  goto L10;
Chris@202: 	case 2:  goto L10;
Chris@202: 	case 3:  goto L10;
Chris@202: 	case 4:  goto L80;
Chris@202: 	case 5:  goto L90;
Chris@202: 	case 6:  goto L100;
Chris@202: 	case 7:  goto L110;
Chris@202: 	case 8:  goto L120;
Chris@202: 	case 9:  goto L130;
Chris@202: 	case 10:  goto L140;
Chris@202: 	case 11:  goto L150;
Chris@202: 	case 12:  goto L160;
Chris@202: 	case 13:  goto L160;
Chris@202: 	case 14:  goto L160;
Chris@202: 	case 15:  goto L160;
Chris@202: 	case 16:  goto L160;
Chris@202:     }
Chris@202: 
Chris@202: /*     Invalid value for ISPEC */
Chris@202: 
Chris@202:     ret_val = -1;
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L10:
Chris@202: 
Chris@202: /*     Convert NAME to upper case if the first character is lower case. */
Chris@202: 
Chris@202:     ret_val = 1;
Chris@202:     s_copy(subnam, name__, (ftnlen)6, name_len);
Chris@202:     ic = *(unsigned char *)subnam;
Chris@202:     iz = 'Z';
Chris@202:     if (iz == 90 || iz == 122) {
Chris@202: 
Chris@202: /*        ASCII character set */
Chris@202: 
Chris@202: 	if (ic >= 97 && ic <= 122) {
Chris@202: 	    *(unsigned char *)subnam = (char) (ic - 32);
Chris@202: 	    for (i__ = 2; i__ <= 6; ++i__) {
Chris@202: 		ic = *(unsigned char *)&subnam[i__ - 1];
Chris@202: 		if (ic >= 97 && ic <= 122) {
Chris@202: 		    *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
Chris@202: 		}
Chris@202: /* L20: */
Chris@202: 	    }
Chris@202: 	}
Chris@202: 
Chris@202:     } else if (iz == 233 || iz == 169) {
Chris@202: 
Chris@202: /*        EBCDIC character set */
Chris@202: 
Chris@202: 	if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 && 
Chris@202: 		ic <= 169) {
Chris@202: 	    *(unsigned char *)subnam = (char) (ic + 64);
Chris@202: 	    for (i__ = 2; i__ <= 6; ++i__) {
Chris@202: 		ic = *(unsigned char *)&subnam[i__ - 1];
Chris@202: 		if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 
Chris@202: 			162 && ic <= 169) {
Chris@202: 		    *(unsigned char *)&subnam[i__ - 1] = (char) (ic + 64);
Chris@202: 		}
Chris@202: /* L30: */
Chris@202: 	    }
Chris@202: 	}
Chris@202: 
Chris@202:     } else if (iz == 218 || iz == 250) {
Chris@202: 
Chris@202: /*        Prime machines:  ASCII+128 */
Chris@202: 
Chris@202: 	if (ic >= 225 && ic <= 250) {
Chris@202: 	    *(unsigned char *)subnam = (char) (ic - 32);
Chris@202: 	    for (i__ = 2; i__ <= 6; ++i__) {
Chris@202: 		ic = *(unsigned char *)&subnam[i__ - 1];
Chris@202: 		if (ic >= 225 && ic <= 250) {
Chris@202: 		    *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
Chris@202: 		}
Chris@202: /* L40: */
Chris@202: 	    }
Chris@202: 	}
Chris@202:     }
Chris@202: 
Chris@202:     *(unsigned char *)c1 = *(unsigned char *)subnam;
Chris@202:     sname = *(unsigned char *)c1 == 'S' || *(unsigned char *)c1 == 'D';
Chris@202:     cname = *(unsigned char *)c1 == 'C' || *(unsigned char *)c1 == 'Z';
Chris@202:     if (! (cname || sname)) {
Chris@202: 	return ret_val;
Chris@202:     }
Chris@203:     s_copy(c2, subnam + 1, (ftnlen)2, (ftnlen)2);
Chris@203:     s_copy(c3, subnam + 3, (ftnlen)3, (ftnlen)3);
Chris@203:     s_copy(c4, c3 + 1, (ftnlen)2, (ftnlen)2);
Chris@202: 
Chris@202:     switch (*ispec) {
Chris@202: 	case 1:  goto L50;
Chris@202: 	case 2:  goto L60;
Chris@202: 	case 3:  goto L70;
Chris@202:     }
Chris@202: 
Chris@202: L50:
Chris@202: 
Chris@202: /*     ISPEC = 1:  block size */
Chris@202: 
Chris@202: /*     In these examples, separate code is provided for setting NB for */
Chris@202: /*     real and complex.  We assume that NB will take the same value in */
Chris@202: /*     single or double precision. */
Chris@202: 
Chris@202:     nb = 1;
Chris@202: 
Chris@203:     if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nb = 64;
Chris@202: 	    } else {
Chris@202: 		nb = 64;
Chris@202: 	    }
Chris@203: 	} else if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, 
Chris@203: 		"RQF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)
Chris@203: 		3, (ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) 
Chris@202: 		== 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nb = 32;
Chris@202: 	    } else {
Chris@202: 		nb = 32;
Chris@202: 	    }
Chris@203: 	} else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nb = 32;
Chris@202: 	    } else {
Chris@202: 		nb = 32;
Chris@202: 	    }
Chris@203: 	} else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nb = 32;
Chris@202: 	    } else {
Chris@202: 		nb = 32;
Chris@202: 	    }
Chris@203: 	} else if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nb = 64;
Chris@202: 	    } else {
Chris@202: 		nb = 64;
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (s_cmp(c2, "PO", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nb = 64;
Chris@202: 	    } else {
Chris@202: 		nb = 64;
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nb = 64;
Chris@202: 	    } else {
Chris@202: 		nb = 64;
Chris@202: 	    }
Chris@203: 	} else if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    nb = 32;
Chris@203: 	} else if (sname && s_cmp(c3, "GST", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    nb = 64;
Chris@202: 	}
Chris@203:     } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    nb = 64;
Chris@203: 	} else if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    nb = 32;
Chris@203: 	} else if (s_cmp(c3, "GST", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    nb = 64;
Chris@202: 	}
Chris@203:     } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 	if (*(unsigned char *)c3 == 'G') {
Chris@203: 	    if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
Chris@203: 		    (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
Chris@203: 		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
Chris@203: 		     0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
Chris@203: 		    c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
Chris@203: 		    ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 		nb = 32;
Chris@202: 	    }
Chris@202: 	} else if (*(unsigned char *)c3 == 'M') {
Chris@203: 	    if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
Chris@203: 		    (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
Chris@203: 		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
Chris@203: 		     0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
Chris@203: 		    c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
Chris@203: 		    ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 		nb = 32;
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 	if (*(unsigned char *)c3 == 'G') {
Chris@203: 	    if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
Chris@203: 		    (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
Chris@203: 		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
Chris@203: 		     0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
Chris@203: 		    c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
Chris@203: 		    ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 		nb = 32;
Chris@202: 	    }
Chris@202: 	} else if (*(unsigned char *)c3 == 'M') {
Chris@203: 	    if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
Chris@203: 		    (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
Chris@203: 		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
Chris@203: 		     0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
Chris@203: 		    c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
Chris@203: 		    ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 		nb = 32;
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (s_cmp(c2, "GB", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		if (*n4 <= 64) {
Chris@202: 		    nb = 1;
Chris@202: 		} else {
Chris@202: 		    nb = 32;
Chris@202: 		}
Chris@202: 	    } else {
Chris@202: 		if (*n4 <= 64) {
Chris@202: 		    nb = 1;
Chris@202: 		} else {
Chris@202: 		    nb = 32;
Chris@202: 		}
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (s_cmp(c2, "PB", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		if (*n2 <= 64) {
Chris@202: 		    nb = 1;
Chris@202: 		} else {
Chris@202: 		    nb = 32;
Chris@202: 		}
Chris@202: 	    } else {
Chris@202: 		if (*n2 <= 64) {
Chris@202: 		    nb = 1;
Chris@202: 		} else {
Chris@202: 		    nb = 32;
Chris@202: 		}
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (s_cmp(c2, "TR", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nb = 64;
Chris@202: 	    } else {
Chris@202: 		nb = 64;
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (s_cmp(c2, "LA", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "UUM", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nb = 64;
Chris@202: 	    } else {
Chris@202: 		nb = 64;
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (sname && s_cmp(c2, "ST", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "EBZ", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    nb = 1;
Chris@202: 	}
Chris@202:     }
Chris@202:     ret_val = nb;
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L60:
Chris@202: 
Chris@202: /*     ISPEC = 2:  minimum block size */
Chris@202: 
Chris@202:     nbmin = 2;
Chris@203:     if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
Chris@203: 		ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)3, (
Chris@203: 		ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0)
Chris@202: 		 {
Chris@202: 	    if (sname) {
Chris@202: 		nbmin = 2;
Chris@202: 	    } else {
Chris@202: 		nbmin = 2;
Chris@202: 	    }
Chris@203: 	} else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nbmin = 2;
Chris@202: 	    } else {
Chris@202: 		nbmin = 2;
Chris@202: 	    }
Chris@203: 	} else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nbmin = 2;
Chris@202: 	    } else {
Chris@202: 		nbmin = 2;
Chris@202: 	    }
Chris@203: 	} else if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nbmin = 2;
Chris@202: 	    } else {
Chris@202: 		nbmin = 2;
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nbmin = 8;
Chris@202: 	    } else {
Chris@202: 		nbmin = 8;
Chris@202: 	    }
Chris@203: 	} else if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    nbmin = 2;
Chris@202: 	}
Chris@203:     } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    nbmin = 2;
Chris@202: 	}
Chris@203:     } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 	if (*(unsigned char *)c3 == 'G') {
Chris@203: 	    if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
Chris@203: 		    (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
Chris@203: 		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
Chris@203: 		     0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
Chris@203: 		    c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
Chris@203: 		    ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 		nbmin = 2;
Chris@202: 	    }
Chris@202: 	} else if (*(unsigned char *)c3 == 'M') {
Chris@203: 	    if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
Chris@203: 		    (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
Chris@203: 		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
Chris@203: 		     0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
Chris@203: 		    c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
Chris@203: 		    ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 		nbmin = 2;
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 	if (*(unsigned char *)c3 == 'G') {
Chris@203: 	    if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
Chris@203: 		    (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
Chris@203: 		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
Chris@203: 		     0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
Chris@203: 		    c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
Chris@203: 		    ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 		nbmin = 2;
Chris@202: 	    }
Chris@202: 	} else if (*(unsigned char *)c3 == 'M') {
Chris@203: 	    if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
Chris@203: 		    (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
Chris@203: 		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
Chris@203: 		     0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
Chris@203: 		    c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
Chris@203: 		    ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 		nbmin = 2;
Chris@202: 	    }
Chris@202: 	}
Chris@202:     }
Chris@202:     ret_val = nbmin;
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L70:
Chris@202: 
Chris@202: /*     ISPEC = 3:  crossover point */
Chris@202: 
Chris@202:     nx = 0;
Chris@203:     if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
Chris@203: 		ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)3, (
Chris@203: 		ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0)
Chris@202: 		 {
Chris@202: 	    if (sname) {
Chris@202: 		nx = 128;
Chris@202: 	    } else {
Chris@202: 		nx = 128;
Chris@202: 	    }
Chris@203: 	} else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nx = 128;
Chris@202: 	    } else {
Chris@202: 		nx = 128;
Chris@202: 	    }
Chris@203: 	} else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    if (sname) {
Chris@202: 		nx = 128;
Chris@202: 	    } else {
Chris@202: 		nx = 128;
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    nx = 32;
Chris@202: 	}
Chris@203:     } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) {
Chris@203: 	if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
Chris@202: 	    nx = 32;
Chris@202: 	}
Chris@203:     } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 	if (*(unsigned char *)c3 == 'G') {
Chris@203: 	    if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
Chris@203: 		    (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
Chris@203: 		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
Chris@203: 		     0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
Chris@203: 		    c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
Chris@203: 		    ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 		nx = 128;
Chris@202: 	    }
Chris@202: 	}
Chris@203:     } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 	if (*(unsigned char *)c3 == 'G') {
Chris@203: 	    if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
Chris@203: 		    (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
Chris@203: 		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
Chris@203: 		     0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
Chris@203: 		    c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
Chris@203: 		    ftnlen)2, (ftnlen)2) == 0) {
Chris@202: 		nx = 128;
Chris@202: 	    }
Chris@202: 	}
Chris@202:     }
Chris@202:     ret_val = nx;
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L80:
Chris@202: 
Chris@202: /*     ISPEC = 4:  number of shifts (used by xHSEQR) */
Chris@202: 
Chris@202:     ret_val = 6;
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L90:
Chris@202: 
Chris@202: /*     ISPEC = 5:  minimum column dimension (not used) */
Chris@202: 
Chris@202:     ret_val = 2;
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L100:
Chris@202: 
Chris@202: /*     ISPEC = 6:  crossover point for SVD (used by xGELSS and xGESVD) */
Chris@202: 
Chris@202:     ret_val = (integer) ((real) min(*n1,*n2) * 1.6f);
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L110:
Chris@202: 
Chris@202: /*     ISPEC = 7:  number of processors (not used) */
Chris@202: 
Chris@202:     ret_val = 1;
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L120:
Chris@202: 
Chris@202: /*     ISPEC = 8:  crossover point for multishift (used by xHSEQR) */
Chris@202: 
Chris@202:     ret_val = 50;
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L130:
Chris@202: 
Chris@202: /*     ISPEC = 9:  maximum size of the subproblems at the bottom of the */
Chris@202: /*                 computation tree in the divide-and-conquer algorithm */
Chris@202: /*                 (used by xGELSD and xGESDD) */
Chris@202: 
Chris@202:     ret_val = 25;
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L140:
Chris@202: 
Chris@202: /*     ISPEC = 10: ieee NaN arithmetic can be trusted not to trap */
Chris@202: 
Chris@202: /*     ILAENV = 0 */
Chris@202:     ret_val = 1;
Chris@202:     if (ret_val == 1) {
Chris@203: 	ret_val = ieeeck_(&c__0, &c_b163, &c_b164);
Chris@202:     }
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L150:
Chris@202: 
Chris@202: /*     ISPEC = 11: infinity arithmetic can be trusted not to trap */
Chris@202: 
Chris@202: /*     ILAENV = 0 */
Chris@202:     ret_val = 1;
Chris@202:     if (ret_val == 1) {
Chris@203: 	ret_val = ieeeck_(&c__1, &c_b163, &c_b164);
Chris@202:     }
Chris@202:     return ret_val;
Chris@202: 
Chris@202: L160:
Chris@202: 
Chris@202: /*     12 <= ISPEC <= 16: xHSEQR or one of its subroutines. */
Chris@202: 
Chris@202:     ret_val = iparmq_(ispec, name__, opts, n1, n2, n3, n4)
Chris@202: 	    ;
Chris@202:     return ret_val;
Chris@202: 
Chris@202: /*     End of ILAENV */
Chris@202: 
Chris@202: } /* ilaenv_ */