summaryrefslogtreecommitdiff
path: root/media/sphinxbase/src/libsphinxbase/util/slapack_lite.c
diff options
context:
space:
mode:
Diffstat (limited to 'media/sphinxbase/src/libsphinxbase/util/slapack_lite.c')
-rw-r--r--media/sphinxbase/src/libsphinxbase/util/slapack_lite.c1461
1 files changed, 0 insertions, 1461 deletions
diff --git a/media/sphinxbase/src/libsphinxbase/util/slapack_lite.c b/media/sphinxbase/src/libsphinxbase/util/slapack_lite.c
deleted file mode 100644
index 4d4e1af31c..0000000000
--- a/media/sphinxbase/src/libsphinxbase/util/slapack_lite.c
+++ /dev/null
@@ -1,1461 +0,0 @@
-/*
-NOTE: This is generated code. Look in README.python for information on
- remaking this file.
-*/
-#include "sphinxbase/f2c.h"
-
-#ifdef HAVE_CONFIG
-#include "config.h"
-#else
-extern doublereal slamch_(char *);
-#define EPSILON slamch_("Epsilon")
-#define SAFEMINIMUM slamch_("Safe minimum")
-#define PRECISION slamch_("Precision")
-#define BASE slamch_("Base")
-#endif
-
-
-extern doublereal slapy2_(real *, real *);
-
-
-
-/* Table of constant values */
-
-static integer c__0 = 0;
-static real c_b163 = 0.f;
-static real c_b164 = 1.f;
-static integer c__1 = 1;
-static real c_b181 = -1.f;
-static integer c_n1 = -1;
-
-integer ieeeck_(integer *ispec, real *zero, real *one)
-{
- /* System generated locals */
- integer ret_val;
-
- /* Local variables */
- static real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro,
- newzro;
-
-
-/*
- -- LAPACK auxiliary routine (version 3.0) --
- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
- Courant Institute, Argonne National Lab, and Rice University
- June 30, 1998
-
-
- Purpose
- =======
-
- IEEECK is called from the ILAENV to verify that Infinity and
- possibly NaN arithmetic is safe (i.e. will not trap).
-
- Arguments
- =========
-
- ISPEC (input) INTEGER
- Specifies whether to test just for inifinity arithmetic
- or whether to test for infinity and NaN arithmetic.
- = 0: Verify infinity arithmetic only.
- = 1: Verify infinity and NaN arithmetic.
-
- ZERO (input) REAL
- Must contain the value 0.0
- This is passed to prevent the compiler from optimizing
- away this code.
-
- ONE (input) REAL
- Must contain the value 1.0
- This is passed to prevent the compiler from optimizing
- away this code.
-
- RETURN VALUE: INTEGER
- = 0: Arithmetic failed to produce the correct answers
- = 1: Arithmetic produced the correct answers
-*/
-
- ret_val = 1;
-
- posinf = *one / *zero;
- if (posinf <= *one) {
- ret_val = 0;
- return ret_val;
- }
-
- neginf = -(*one) / *zero;
- if (neginf >= *zero) {
- ret_val = 0;
- return ret_val;
- }
-
- negzro = *one / (neginf + *one);
- if (negzro != *zero) {
- ret_val = 0;
- return ret_val;
- }
-
- neginf = *one / negzro;
- if (neginf >= *zero) {
- ret_val = 0;
- return ret_val;
- }
-
- newzro = negzro + *zero;
- if (newzro != *zero) {
- ret_val = 0;
- return ret_val;
- }
-
- posinf = *one / newzro;
- if (posinf <= *one) {
- ret_val = 0;
- return ret_val;
- }
-
- neginf *= posinf;
- if (neginf >= *zero) {
- ret_val = 0;
- return ret_val;
- }
-
- posinf *= posinf;
- if (posinf <= *one) {
- ret_val = 0;
- return ret_val;
- }
-
-
-/* Return if we were only asked to check infinity arithmetic */
-
- if (*ispec == 0) {
- return ret_val;
- }
-
- nan1 = posinf + neginf;
-
- nan2 = posinf / neginf;
-
- nan3 = posinf / posinf;
-
- nan4 = posinf * *zero;
-
- nan5 = neginf * negzro;
-
- nan6 = nan5 * 0.f;
-
- if (nan1 == nan1) {
- ret_val = 0;
- return ret_val;
- }
-
- if (nan2 == nan2) {
- ret_val = 0;
- return ret_val;
- }
-
- if (nan3 == nan3) {
- ret_val = 0;
- return ret_val;
- }
-
- if (nan4 == nan4) {
- ret_val = 0;
- return ret_val;
- }
-
- if (nan5 == nan5) {
- ret_val = 0;
- return ret_val;
- }
-
- if (nan6 == nan6) {
- ret_val = 0;
- return ret_val;
- }
-
- return ret_val;
-} /* ieeeck_ */
-
-integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1,
- integer *n2, integer *n3, integer *n4, ftnlen name_len, ftnlen
- opts_len)
-{
- /* System generated locals */
- integer ret_val;
-
- /* Builtin functions */
- /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
- integer s_cmp(char *, char *, ftnlen, ftnlen);
-
- /* Local variables */
- static integer i__;
- static char c1[1], c2[2], c3[3], c4[2];
- static integer ic, nb, iz, nx;
- static logical cname, sname;
- static integer nbmin;
- extern integer ieeeck_(integer *, real *, real *);
- static char subnam[6];
-
-
-/*
- -- LAPACK auxiliary routine (version 3.0) --
- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
- Courant Institute, Argonne National Lab, and Rice University
- June 30, 1999
-
-
- Purpose
- =======
-
- ILAENV is called from the LAPACK routines to choose problem-dependent
- parameters for the local environment. See ISPEC for a description of
- the parameters.
-
- This version provides a set of parameters which should give good,
- but not optimal, performance on many of the currently available
- computers. Users are encouraged to modify this subroutine to set
- the tuning parameters for their particular machine using the option
- and problem size information in the arguments.
-
- This routine will not function correctly if it is converted to all
- lower case. Converting it to all upper case is allowed.
-
- Arguments
- =========
-
- ISPEC (input) INTEGER
- Specifies the parameter to be returned as the value of
- ILAENV.
- = 1: the optimal blocksize; if this value is 1, an unblocked
- algorithm will give the best performance.
- = 2: the minimum block size for which the block routine
- should be used; if the usable block size is less than
- this value, an unblocked routine should be used.
- = 3: the crossover point (in a block routine, for N less
- than this value, an unblocked routine should be used)
- = 4: the number of shifts, used in the nonsymmetric
- eigenvalue routines
- = 5: the minimum column dimension for blocking to be used;
- rectangular blocks must have dimension at least k by m,
- where k is given by ILAENV(2,...) and m by ILAENV(5,...)
- = 6: the crossover point for the SVD (when reducing an m by n
- matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
- this value, a QR factorization is used first to reduce
- the matrix to a triangular form.)
- = 7: the number of processors
- = 8: the crossover point for the multishift QR and QZ methods
- for nonsymmetric eigenvalue problems.
- = 9: maximum size of the subproblems at the bottom of the
- computation tree in the divide-and-conquer algorithm
- (used by xGELSD and xGESDD)
- =10: ieee NaN arithmetic can be trusted not to trap
- =11: infinity arithmetic can be trusted not to trap
-
- NAME (input) CHARACTER*(*)
- The name of the calling subroutine, in either upper case or
- lower case.
-
- OPTS (input) CHARACTER*(*)
- The character options to the subroutine NAME, concatenated
- into a single character string. For example, UPLO = 'U',
- TRANS = 'T', and DIAG = 'N' for a triangular routine would
- be specified as OPTS = 'UTN'.
-
- N1 (input) INTEGER
- N2 (input) INTEGER
- N3 (input) INTEGER
- N4 (input) INTEGER
- Problem dimensions for the subroutine NAME; these may not all
- be required.
-
- (ILAENV) (output) INTEGER
- >= 0: the value of the parameter specified by ISPEC
- < 0: if ILAENV = -k, the k-th argument had an illegal value.
-
- Further Details
- ===============
-
- The following conventions have been used when calling ILAENV from the
- LAPACK routines:
- 1) OPTS is a concatenation of all of the character options to
- subroutine NAME, in the same order that they appear in the
- argument list for NAME, even if they are not used in determining
- the value of the parameter specified by ISPEC.
- 2) The problem dimensions N1, N2, N3, N4 are specified in the order
- that they appear in the argument list for NAME. N1 is used
- first, N2 second, and so on, and unused problem dimensions are
- passed a value of -1.
- 3) The parameter value returned by ILAENV is checked for validity in
- the calling subroutine. For example, ILAENV is used to retrieve
- the optimal blocksize for STRTRI as follows:
-
- NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
- IF( NB.LE.1 ) NB = MAX( 1, N )
-
- =====================================================================
-*/
-
-
- switch (*ispec) {
- case 1: goto L100;
- case 2: goto L100;
- case 3: goto L100;
- case 4: goto L400;
- case 5: goto L500;
- case 6: goto L600;
- case 7: goto L700;
- case 8: goto L800;
- case 9: goto L900;
- case 10: goto L1000;
- case 11: goto L1100;
- }
-
-/* Invalid value for ISPEC */
-
- ret_val = -1;
- return ret_val;
-
-L100:
-
-/* Convert NAME to upper case if the first character is lower case. */
-
- ret_val = 1;
- s_copy(subnam, name__, (ftnlen)6, name_len);
- ic = *(unsigned char *)subnam;
- iz = 'Z';
- if (iz == 90 || iz == 122) {
-
-/* ASCII character set */
-
- if (ic >= 97 && ic <= 122) {
- *(unsigned char *)subnam = (char) (ic - 32);
- for (i__ = 2; i__ <= 6; ++i__) {
- ic = *(unsigned char *)&subnam[i__ - 1];
- if (ic >= 97 && ic <= 122) {
- *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
- }
-/* L10: */
- }
- }
-
- } else if (iz == 233 || iz == 169) {
-
-/* EBCDIC character set */
-
- if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 &&
- ic <= 169) {
- *(unsigned char *)subnam = (char) (ic + 64);
- for (i__ = 2; i__ <= 6; ++i__) {
- ic = *(unsigned char *)&subnam[i__ - 1];
- if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >=
- 162 && ic <= 169) {
- *(unsigned char *)&subnam[i__ - 1] = (char) (ic + 64);
- }
-/* L20: */
- }
- }
-
- } else if (iz == 218 || iz == 250) {
-
-/* Prime machines: ASCII+128 */
-
- if (ic >= 225 && ic <= 250) {
- *(unsigned char *)subnam = (char) (ic - 32);
- for (i__ = 2; i__ <= 6; ++i__) {
- ic = *(unsigned char *)&subnam[i__ - 1];
- if (ic >= 225 && ic <= 250) {
- *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
- }
-/* L30: */
- }
- }
- }
-
- *(unsigned char *)c1 = *(unsigned char *)subnam;
- sname = *(unsigned char *)c1 == 'S' || *(unsigned char *)c1 == 'D';
- cname = *(unsigned char *)c1 == 'C' || *(unsigned char *)c1 == 'Z';
- if (! (cname || sname)) {
- return ret_val;
- }
- s_copy(c2, subnam + 1, (ftnlen)2, (ftnlen)2);
- s_copy(c3, subnam + 3, (ftnlen)3, (ftnlen)3);
- s_copy(c4, c3 + 1, (ftnlen)2, (ftnlen)2);
-
- switch (*ispec) {
- case 1: goto L110;
- case 2: goto L200;
- case 3: goto L300;
- }
-
-L110:
-
-/*
- ISPEC = 1: block size
-
- In these examples, separate code is provided for setting NB for
- real and complex. We assume that NB will take the same value in
- single or double precision.
-*/
-
- nb = 1;
-
- if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nb = 64;
- } else {
- nb = 64;
- }
- } else if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
- "RQF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)
- 3, (ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3)
- == 0) {
- if (sname) {
- nb = 32;
- } else {
- nb = 32;
- }
- } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nb = 32;
- } else {
- nb = 32;
- }
- } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nb = 32;
- } else {
- nb = 32;
- }
- } else if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nb = 64;
- } else {
- nb = 64;
- }
- }
- } else if (s_cmp(c2, "PO", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nb = 64;
- } else {
- nb = 64;
- }
- }
- } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nb = 64;
- } else {
- nb = 64;
- }
- } else if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
- nb = 32;
- } else if (sname && s_cmp(c3, "GST", (ftnlen)3, (ftnlen)3) == 0) {
- nb = 64;
- }
- } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
- nb = 64;
- } else if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
- nb = 32;
- } else if (s_cmp(c3, "GST", (ftnlen)3, (ftnlen)3) == 0) {
- nb = 64;
- }
- } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) {
- if (*(unsigned char *)c3 == 'G') {
- if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
- (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
- ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
- 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
- c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
- ftnlen)2, (ftnlen)2) == 0) {
- nb = 32;
- }
- } else if (*(unsigned char *)c3 == 'M') {
- if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
- (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
- ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
- 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
- c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
- ftnlen)2, (ftnlen)2) == 0) {
- nb = 32;
- }
- }
- } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) {
- if (*(unsigned char *)c3 == 'G') {
- if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
- (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
- ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
- 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
- c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
- ftnlen)2, (ftnlen)2) == 0) {
- nb = 32;
- }
- } else if (*(unsigned char *)c3 == 'M') {
- if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
- (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
- ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
- 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
- c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
- ftnlen)2, (ftnlen)2) == 0) {
- nb = 32;
- }
- }
- } else if (s_cmp(c2, "GB", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- if (*n4 <= 64) {
- nb = 1;
- } else {
- nb = 32;
- }
- } else {
- if (*n4 <= 64) {
- nb = 1;
- } else {
- nb = 32;
- }
- }
- }
- } else if (s_cmp(c2, "PB", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- if (*n2 <= 64) {
- nb = 1;
- } else {
- nb = 32;
- }
- } else {
- if (*n2 <= 64) {
- nb = 1;
- } else {
- nb = 32;
- }
- }
- }
- } else if (s_cmp(c2, "TR", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nb = 64;
- } else {
- nb = 64;
- }
- }
- } else if (s_cmp(c2, "LA", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "UUM", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nb = 64;
- } else {
- nb = 64;
- }
- }
- } else if (sname && s_cmp(c2, "ST", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "EBZ", (ftnlen)3, (ftnlen)3) == 0) {
- nb = 1;
- }
- }
- ret_val = nb;
- return ret_val;
-
-L200:
-
-/* ISPEC = 2: minimum block size */
-
- nbmin = 2;
- if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
- ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)3, (
- ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0)
- {
- if (sname) {
- nbmin = 2;
- } else {
- nbmin = 2;
- }
- } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nbmin = 2;
- } else {
- nbmin = 2;
- }
- } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nbmin = 2;
- } else {
- nbmin = 2;
- }
- } else if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nbmin = 2;
- } else {
- nbmin = 2;
- }
- }
- } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nbmin = 8;
- } else {
- nbmin = 8;
- }
- } else if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
- nbmin = 2;
- }
- } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
- nbmin = 2;
- }
- } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) {
- if (*(unsigned char *)c3 == 'G') {
- if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
- (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
- ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
- 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
- c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
- ftnlen)2, (ftnlen)2) == 0) {
- nbmin = 2;
- }
- } else if (*(unsigned char *)c3 == 'M') {
- if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
- (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
- ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
- 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
- c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
- ftnlen)2, (ftnlen)2) == 0) {
- nbmin = 2;
- }
- }
- } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) {
- if (*(unsigned char *)c3 == 'G') {
- if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
- (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
- ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
- 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
- c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
- ftnlen)2, (ftnlen)2) == 0) {
- nbmin = 2;
- }
- } else if (*(unsigned char *)c3 == 'M') {
- if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
- (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
- ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
- 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
- c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
- ftnlen)2, (ftnlen)2) == 0) {
- nbmin = 2;
- }
- }
- }
- ret_val = nbmin;
- return ret_val;
-
-L300:
-
-/* ISPEC = 3: crossover point */
-
- nx = 0;
- if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
- ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)3, (
- ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0)
- {
- if (sname) {
- nx = 128;
- } else {
- nx = 128;
- }
- } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nx = 128;
- } else {
- nx = 128;
- }
- } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
- if (sname) {
- nx = 128;
- } else {
- nx = 128;
- }
- }
- } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
- if (sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
- nx = 32;
- }
- } else if (cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0) {
- if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
- nx = 32;
- }
- } else if (sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0) {
- if (*(unsigned char *)c3 == 'G') {
- if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
- (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
- ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
- 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
- c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
- ftnlen)2, (ftnlen)2) == 0) {
- nx = 128;
- }
- }
- } else if (cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0) {
- if (*(unsigned char *)c3 == 'G') {
- if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
- (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
- ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
- 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
- c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
- ftnlen)2, (ftnlen)2) == 0) {
- nx = 128;
- }
- }
- }
- ret_val = nx;
- return ret_val;
-
-L400:
-
-/* ISPEC = 4: number of shifts (used by xHSEQR) */
-
- ret_val = 6;
- return ret_val;
-
-L500:
-
-/* ISPEC = 5: minimum column dimension (not used) */
-
- ret_val = 2;
- return ret_val;
-
-L600:
-
-/* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) */
-
- ret_val = (integer) ((real) min(*n1,*n2) * 1.6f);
- return ret_val;
-
-L700:
-
-/* ISPEC = 7: number of processors (not used) */
-
- ret_val = 1;
- return ret_val;
-
-L800:
-
-/* ISPEC = 8: crossover point for multishift (used by xHSEQR) */
-
- ret_val = 50;
- return ret_val;
-
-L900:
-
-/*
- ISPEC = 9: maximum size of the subproblems at the bottom of the
- computation tree in the divide-and-conquer algorithm
- (used by xGELSD and xGESDD)
-*/
-
- ret_val = 25;
- return ret_val;
-
-L1000:
-
-/*
- ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
-
- ILAENV = 0
-*/
- ret_val = 1;
- if (ret_val == 1) {
- ret_val = ieeeck_(&c__0, &c_b163, &c_b164);
- }
- return ret_val;
-
-L1100:
-
-/*
- ISPEC = 11: infinity arithmetic can be trusted not to trap
-
- ILAENV = 0
-*/
- ret_val = 1;
- if (ret_val == 1) {
- ret_val = ieeeck_(&c__1, &c_b163, &c_b164);
- }
- return ret_val;
-
-/* End of ILAENV */
-
-} /* ilaenv_ */
-
-/* Subroutine */ int sposv_(char *uplo, integer *n, integer *nrhs, real *a,
- integer *lda, real *b, integer *ldb, integer *info)
-{
- /* System generated locals */
- integer a_dim1, a_offset, b_dim1, b_offset, i__1;
-
- /* Local variables */
- extern logical lsame_(char *, char *);
- extern /* Subroutine */ int xerbla_(char *, integer *), spotrf_(
- char *, integer *, real *, integer *, integer *), spotrs_(
- char *, integer *, integer *, real *, integer *, real *, integer *
- , integer *);
-
-
-/*
- -- LAPACK driver routine (version 3.0) --
- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
- Courant Institute, Argonne National Lab, and Rice University
- March 31, 1993
-
-
- Purpose
- =======
-
- SPOSV computes the solution to a real system of linear equations
- A * X = B,
- where A is an N-by-N symmetric positive definite matrix and X and B
- are N-by-NRHS matrices.
-
- The Cholesky decomposition is used to factor A as
- A = U**T* U, if UPLO = 'U', or
- A = L * L**T, if UPLO = 'L',
- where U is an upper triangular matrix and L is a lower triangular
- matrix. The factored form of A is then used to solve the system of
- equations A * X = B.
-
- Arguments
- =========
-
- UPLO (input) CHARACTER*1
- = 'U': Upper triangle of A is stored;
- = 'L': Lower triangle of A is stored.
-
- N (input) INTEGER
- The number of linear equations, i.e., the order of the
- matrix A. N >= 0.
-
- NRHS (input) INTEGER
- The number of right hand sides, i.e., the number of columns
- of the matrix B. NRHS >= 0.
-
- A (input/output) REAL array, dimension (LDA,N)
- On entry, the symmetric matrix A. If UPLO = 'U', the leading
- N-by-N upper triangular part of A contains the upper
- triangular part of the matrix A, and the strictly lower
- triangular part of A is not referenced. If UPLO = 'L', the
- leading N-by-N lower triangular part of A contains the lower
- triangular part of the matrix A, and the strictly upper
- triangular part of A is not referenced.
-
- On exit, if INFO = 0, the factor U or L from the Cholesky
- factorization A = U**T*U or A = L*L**T.
-
- LDA (input) INTEGER
- The leading dimension of the array A. LDA >= max(1,N).
-
- B (input/output) REAL array, dimension (LDB,NRHS)
- On entry, the N-by-NRHS right hand side matrix B.
- On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-
- LDB (input) INTEGER
- The leading dimension of the array B. LDB >= max(1,N).
-
- INFO (output) INTEGER
- = 0: successful exit
- < 0: if INFO = -i, the i-th argument had an illegal value
- > 0: if INFO = i, the leading minor of order i of A is not
- positive definite, so the factorization could not be
- completed, and the solution has not been computed.
-
- =====================================================================
-
-
- Test the input parameters.
-*/
-
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- b_dim1 = *ldb;
- b_offset = 1 + b_dim1;
- b -= b_offset;
-
- /* Function Body */
- *info = 0;
- if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
- *info = -1;
- } else if (*n < 0) {
- *info = -2;
- } else if (*nrhs < 0) {
- *info = -3;
- } else if (*lda < max(1,*n)) {
- *info = -5;
- } else if (*ldb < max(1,*n)) {
- *info = -7;
- }
- if (*info != 0) {
- i__1 = -(*info);
- xerbla_("SPOSV ", &i__1);
- return 0;
- }
-
-/* Compute the Cholesky factorization A = U'*U or A = L*L'. */
-
- spotrf_(uplo, n, &a[a_offset], lda, info);
- if (*info == 0) {
-
-/* Solve the system A*X = B, overwriting B with X. */
-
- spotrs_(uplo, n, nrhs, &a[a_offset], lda, &b[b_offset], ldb, info);
-
- }
- return 0;
-
-/* End of SPOSV */
-
-} /* sposv_ */
-
-/* Subroutine */ int spotf2_(char *uplo, integer *n, real *a, integer *lda,
- integer *info)
-{
- /* System generated locals */
- integer a_dim1, a_offset, i__1, i__2, i__3;
- real r__1;
-
- /* Builtin functions */
- double sqrt(doublereal);
-
- /* Local variables */
- static integer j;
- static real ajj;
- extern doublereal sdot_(integer *, real *, integer *, real *, integer *);
- extern logical lsame_(char *, char *);
- extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *),
- sgemv_(char *, integer *, integer *, real *, real *, integer *,
- real *, integer *, real *, real *, integer *);
- static logical upper;
- extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
- -- LAPACK routine (version 3.0) --
- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
- Courant Institute, Argonne National Lab, and Rice University
- February 29, 1992
-
-
- Purpose
- =======
-
- SPOTF2 computes the Cholesky factorization of a real symmetric
- positive definite matrix A.
-
- The factorization has the form
- A = U' * U , if UPLO = 'U', or
- A = L * L', if UPLO = 'L',
- where U is an upper triangular matrix and L is lower triangular.
-
- This is the unblocked version of the algorithm, calling Level 2 BLAS.
-
- Arguments
- =========
-
- UPLO (input) CHARACTER*1
- Specifies whether the upper or lower triangular part of the
- symmetric matrix A is stored.
- = 'U': Upper triangular
- = 'L': Lower triangular
-
- N (input) INTEGER
- The order of the matrix A. N >= 0.
-
- A (input/output) REAL array, dimension (LDA,N)
- On entry, the symmetric matrix A. If UPLO = 'U', the leading
- n by n upper triangular part of A contains the upper
- triangular part of the matrix A, and the strictly lower
- triangular part of A is not referenced. If UPLO = 'L', the
- leading n by n lower triangular part of A contains the lower
- triangular part of the matrix A, and the strictly upper
- triangular part of A is not referenced.
-
- On exit, if INFO = 0, the factor U or L from the Cholesky
- factorization A = U'*U or A = L*L'.
-
- LDA (input) INTEGER
- The leading dimension of the array A. LDA >= max(1,N).
-
- INFO (output) INTEGER
- = 0: successful exit
- < 0: if INFO = -k, the k-th argument had an illegal value
- > 0: if INFO = k, the leading minor of order k is not
- positive definite, and the factorization could not be
- completed.
-
- =====================================================================
-
-
- Test the input parameters.
-*/
-
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
-
- /* Function Body */
- *info = 0;
- upper = lsame_(uplo, "U");
- if (! upper && ! lsame_(uplo, "L")) {
- *info = -1;
- } else if (*n < 0) {
- *info = -2;
- } else if (*lda < max(1,*n)) {
- *info = -4;
- }
- if (*info != 0) {
- i__1 = -(*info);
- xerbla_("SPOTF2", &i__1);
- return 0;
- }
-
-/* Quick return if possible */
-
- if (*n == 0) {
- return 0;
- }
-
- if (upper) {
-
-/* Compute the Cholesky factorization A = U'*U. */
-
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
-
-/* Compute U(J,J) and test for non-positive-definiteness. */
-
- i__2 = j - 1;
- ajj = a[j + j * a_dim1] - sdot_(&i__2, &a[j * a_dim1 + 1], &c__1,
- &a[j * a_dim1 + 1], &c__1);
- if (ajj <= 0.f) {
- a[j + j * a_dim1] = ajj;
- goto L30;
- }
- ajj = sqrt(ajj);
- a[j + j * a_dim1] = ajj;
-
-/* Compute elements J+1:N of row J. */
-
- if (j < *n) {
- i__2 = j - 1;
- i__3 = *n - j;
- sgemv_("Transpose", &i__2, &i__3, &c_b181, &a[(j + 1) *
- a_dim1 + 1], lda, &a[j * a_dim1 + 1], &c__1, &c_b164,
- &a[j + (j + 1) * a_dim1], lda);
- i__2 = *n - j;
- r__1 = 1.f / ajj;
- sscal_(&i__2, &r__1, &a[j + (j + 1) * a_dim1], lda);
- }
-/* L10: */
- }
- } else {
-
-/* Compute the Cholesky factorization A = L*L'. */
-
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
-
-/* Compute L(J,J) and test for non-positive-definiteness. */
-
- i__2 = j - 1;
- ajj = a[j + j * a_dim1] - sdot_(&i__2, &a[j + a_dim1], lda, &a[j
- + a_dim1], lda);
- if (ajj <= 0.f) {
- a[j + j * a_dim1] = ajj;
- goto L30;
- }
- ajj = sqrt(ajj);
- a[j + j * a_dim1] = ajj;
-
-/* Compute elements J+1:N of column J. */
-
- if (j < *n) {
- i__2 = *n - j;
- i__3 = j - 1;
- sgemv_("No transpose", &i__2, &i__3, &c_b181, &a[j + 1 +
- a_dim1], lda, &a[j + a_dim1], lda, &c_b164, &a[j + 1
- + j * a_dim1], &c__1);
- i__2 = *n - j;
- r__1 = 1.f / ajj;
- sscal_(&i__2, &r__1, &a[j + 1 + j * a_dim1], &c__1);
- }
-/* L20: */
- }
- }
- goto L40;
-
-L30:
- *info = j;
-
-L40:
- return 0;
-
-/* End of SPOTF2 */
-
-} /* spotf2_ */
-
-/* Subroutine */ int spotrf_(char *uplo, integer *n, real *a, integer *lda,
- integer *info)
-{
- /* System generated locals */
- integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
-
- /* Local variables */
- static integer j, jb, nb;
- extern logical lsame_(char *, char *);
- extern /* Subroutine */ int sgemm_(char *, char *, integer *, integer *,
- integer *, real *, real *, integer *, real *, integer *, real *,
- real *, integer *);
- static logical upper;
- extern /* Subroutine */ int strsm_(char *, char *, char *, char *,
- integer *, integer *, real *, real *, integer *, real *, integer *
- ), ssyrk_(char *, char *, integer
- *, integer *, real *, real *, integer *, real *, real *, integer *
- ), spotf2_(char *, integer *, real *, integer *,
- integer *), xerbla_(char *, integer *);
- extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
- integer *, integer *, ftnlen, ftnlen);
-
-
-/*
- -- LAPACK routine (version 3.0) --
- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
- Courant Institute, Argonne National Lab, and Rice University
- March 31, 1993
-
-
- Purpose
- =======
-
- SPOTRF computes the Cholesky factorization of a real symmetric
- positive definite matrix A.
-
- The factorization has the form
- A = U**T * U, if UPLO = 'U', or
- A = L * L**T, if UPLO = 'L',
- where U is an upper triangular matrix and L is lower triangular.
-
- This is the block version of the algorithm, calling Level 3 BLAS.
-
- Arguments
- =========
-
- UPLO (input) CHARACTER*1
- = 'U': Upper triangle of A is stored;
- = 'L': Lower triangle of A is stored.
-
- N (input) INTEGER
- The order of the matrix A. N >= 0.
-
- A (input/output) REAL array, dimension (LDA,N)
- On entry, the symmetric matrix A. If UPLO = 'U', the leading
- N-by-N upper triangular part of A contains the upper
- triangular part of the matrix A, and the strictly lower
- triangular part of A is not referenced. If UPLO = 'L', the
- leading N-by-N lower triangular part of A contains the lower
- triangular part of the matrix A, and the strictly upper
- triangular part of A is not referenced.
-
- On exit, if INFO = 0, the factor U or L from the Cholesky
- factorization A = U**T*U or A = L*L**T.
-
- LDA (input) INTEGER
- The leading dimension of the array A. LDA >= max(1,N).
-
- INFO (output) INTEGER
- = 0: successful exit
- < 0: if INFO = -i, the i-th argument had an illegal value
- > 0: if INFO = i, the leading minor of order i is not
- positive definite, and the factorization could not be
- completed.
-
- =====================================================================
-
-
- Test the input parameters.
-*/
-
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
-
- /* Function Body */
- *info = 0;
- upper = lsame_(uplo, "U");
- if (! upper && ! lsame_(uplo, "L")) {
- *info = -1;
- } else if (*n < 0) {
- *info = -2;
- } else if (*lda < max(1,*n)) {
- *info = -4;
- }
- if (*info != 0) {
- i__1 = -(*info);
- xerbla_("SPOTRF", &i__1);
- return 0;
- }
-
-/* Quick return if possible */
-
- if (*n == 0) {
- return 0;
- }
-
-/* Determine the block size for this environment. */
-
- nb = ilaenv_(&c__1, "SPOTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (
- ftnlen)1);
- if (nb <= 1 || nb >= *n) {
-
-/* Use unblocked code. */
-
- spotf2_(uplo, n, &a[a_offset], lda, info);
- } else {
-
-/* Use blocked code. */
-
- if (upper) {
-
-/* Compute the Cholesky factorization A = U'*U. */
-
- i__1 = *n;
- i__2 = nb;
- for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
-
-/*
- Update and factorize the current diagonal block and test
- for non-positive-definiteness.
-
- Computing MIN
-*/
- i__3 = nb, i__4 = *n - j + 1;
- jb = min(i__3,i__4);
- i__3 = j - 1;
- ssyrk_("Upper", "Transpose", &jb, &i__3, &c_b181, &a[j *
- a_dim1 + 1], lda, &c_b164, &a[j + j * a_dim1], lda);
- spotf2_("Upper", &jb, &a[j + j * a_dim1], lda, info);
- if (*info != 0) {
- goto L30;
- }
- if (j + jb <= *n) {
-
-/* Compute the current block row. */
-
- i__3 = *n - j - jb + 1;
- i__4 = j - 1;
- sgemm_("Transpose", "No transpose", &jb, &i__3, &i__4, &
- c_b181, &a[j * a_dim1 + 1], lda, &a[(j + jb) *
- a_dim1 + 1], lda, &c_b164, &a[j + (j + jb) *
- a_dim1], lda);
- i__3 = *n - j - jb + 1;
- strsm_("Left", "Upper", "Transpose", "Non-unit", &jb, &
- i__3, &c_b164, &a[j + j * a_dim1], lda, &a[j + (j
- + jb) * a_dim1], lda);
- }
-/* L10: */
- }
-
- } else {
-
-/* Compute the Cholesky factorization A = L*L'. */
-
- i__2 = *n;
- i__1 = nb;
- for (j = 1; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {
-
-/*
- Update and factorize the current diagonal block and test
- for non-positive-definiteness.
-
- Computing MIN
-*/
- i__3 = nb, i__4 = *n - j + 1;
- jb = min(i__3,i__4);
- i__3 = j - 1;
- ssyrk_("Lower", "No transpose", &jb, &i__3, &c_b181, &a[j +
- a_dim1], lda, &c_b164, &a[j + j * a_dim1], lda);
- spotf2_("Lower", &jb, &a[j + j * a_dim1], lda, info);
- if (*info != 0) {
- goto L30;
- }
- if (j + jb <= *n) {
-
-/* Compute the current block column. */
-
- i__3 = *n - j - jb + 1;
- i__4 = j - 1;
- sgemm_("No transpose", "Transpose", &i__3, &jb, &i__4, &
- c_b181, &a[j + jb + a_dim1], lda, &a[j + a_dim1],
- lda, &c_b164, &a[j + jb + j * a_dim1], lda);
- i__3 = *n - j - jb + 1;
- strsm_("Right", "Lower", "Transpose", "Non-unit", &i__3, &
- jb, &c_b164, &a[j + j * a_dim1], lda, &a[j + jb +
- j * a_dim1], lda);
- }
-/* L20: */
- }
- }
- }
- goto L40;
-
-L30:
- *info = *info + j - 1;
-
-L40:
- return 0;
-
-/* End of SPOTRF */
-
-} /* spotrf_ */
-
-/* Subroutine */ int spotrs_(char *uplo, integer *n, integer *nrhs, real *a,
- integer *lda, real *b, integer *ldb, integer *info)
-{
- /* System generated locals */
- integer a_dim1, a_offset, b_dim1, b_offset, i__1;
-
- /* Local variables */
- extern logical lsame_(char *, char *);
- static logical upper;
- extern /* Subroutine */ int strsm_(char *, char *, char *, char *,
- integer *, integer *, real *, real *, integer *, real *, integer *
- ), xerbla_(char *, integer *);
-
-
-/*
- -- LAPACK routine (version 3.0) --
- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
- Courant Institute, Argonne National Lab, and Rice University
- March 31, 1993
-
-
- Purpose
- =======
-
- SPOTRS solves a system of linear equations A*X = B with a symmetric
- positive definite matrix A using the Cholesky factorization
- A = U**T*U or A = L*L**T computed by SPOTRF.
-
- Arguments
- =========
-
- UPLO (input) CHARACTER*1
- = 'U': Upper triangle of A is stored;
- = 'L': Lower triangle of A is stored.
-
- N (input) INTEGER
- The order of the matrix A. N >= 0.
-
- NRHS (input) INTEGER
- The number of right hand sides, i.e., the number of columns
- of the matrix B. NRHS >= 0.
-
- A (input) REAL array, dimension (LDA,N)
- The triangular factor U or L from the Cholesky factorization
- A = U**T*U or A = L*L**T, as computed by SPOTRF.
-
- LDA (input) INTEGER
- The leading dimension of the array A. LDA >= max(1,N).
-
- B (input/output) REAL array, dimension (LDB,NRHS)
- On entry, the right hand side matrix B.
- On exit, the solution matrix X.
-
- LDB (input) INTEGER
- The leading dimension of the array B. LDB >= max(1,N).
-
- INFO (output) INTEGER
- = 0: successful exit
- < 0: if INFO = -i, the i-th argument had an illegal value
-
- =====================================================================
-
-
- Test the input parameters.
-*/
-
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- b_dim1 = *ldb;
- b_offset = 1 + b_dim1;
- b -= b_offset;
-
- /* Function Body */
- *info = 0;
- upper = lsame_(uplo, "U");
- if (! upper && ! lsame_(uplo, "L")) {
- *info = -1;
- } else if (*n < 0) {
- *info = -2;
- } else if (*nrhs < 0) {
- *info = -3;
- } else if (*lda < max(1,*n)) {
- *info = -5;
- } else if (*ldb < max(1,*n)) {
- *info = -7;
- }
- if (*info != 0) {
- i__1 = -(*info);
- xerbla_("SPOTRS", &i__1);
- return 0;
- }
-
-/* Quick return if possible */
-
- if (*n == 0 || *nrhs == 0) {
- return 0;
- }
-
- if (upper) {
-
-/*
- Solve A*X = B where A = U'*U.
-
- Solve U'*X = B, overwriting B with X.
-*/
-
- strsm_("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &c_b164, &a[
- a_offset], lda, &b[b_offset], ldb);
-
-/* Solve U*X = B, overwriting B with X. */
-
- strsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b164,
- &a[a_offset], lda, &b[b_offset], ldb);
- } else {
-
-/*
- Solve A*X = B where A = L*L'.
-
- Solve L*X = B, overwriting B with X.
-*/
-
- strsm_("Left", "Lower", "No transpose", "Non-unit", n, nrhs, &c_b164,
- &a[a_offset], lda, &b[b_offset], ldb);
-
-/* Solve L'*X = B, overwriting B with X. */
-
- strsm_("Left", "Lower", "Transpose", "Non-unit", n, nrhs, &c_b164, &a[
- a_offset], lda, &b[b_offset], ldb);
- }
-
- return 0;
-
-/* End of SPOTRS */
-
-} /* spotrs_ */
-
generated by cgit v1.2.3 (git 2.26.2) at 2024-11-11 15:28:23 +0000