/* Subroutine */ int sgqrts_(integer *n, integer *m, integer *p, real *a,
real *af, real *q, real *r__, integer *lda, real *taua, real *b, real
*bf, real *z__, real *t, real *bwk, integer *ldb, real *taub, real *
work, integer *lwork, real *rwork, real *result)
{
/* System generated locals */
integer a_dim1, a_offset, af_dim1, af_offset, r_dim1, r_offset, q_dim1,
q_offset, b_dim1, b_offset, bf_dim1, bf_offset, t_dim1, t_offset,
z_dim1, z_offset, bwk_dim1, bwk_offset, i__1, i__2;
real r__1;
/* Local variables */
static integer info;
static real unfl, resid;
extern /* Subroutine */ int sgemm_(char *, char *, integer *, integer *,
integer *, real *, real *, integer *, real *, integer *, real *,
real *, integer *);
static real anorm, bnorm;
extern /* Subroutine */ int ssyrk_(char *, char *, integer *, integer *,
real *, real *, integer *, real *, real *, integer *);
extern doublereal slamch_(char *), slange_(char *, integer *,
integer *, real *, integer *, real *);
extern /* Subroutine */ int sggqrf_(integer *, integer *, integer *, real
*, integer *, real *, real *, integer *, real *, real *, integer *
, integer *), slacpy_(char *, integer *, integer *, real *,
integer *, real *, integer *), slaset_(char *, integer *,
integer *, real *, real *, real *, integer *);
extern doublereal slansy_(char *, char *, integer *, real *, integer *,
real *);
extern /* Subroutine */ int sorgqr_(integer *, integer *, integer *, real
*, integer *, real *, real *, integer *, integer *), sorgrq_(
integer *, integer *, integer *, real *, integer *, real *, real *
, integer *, integer *);
static real ulp;
#define q_ref(a_1,a_2) q[(a_2)*q_dim1 + a_1]
#define t_ref(a_1,a_2) t[(a_2)*t_dim1 + a_1]
#define z___ref(a_1,a_2) z__[(a_2)*z_dim1 + a_1]
#define af_ref(a_1,a_2) af[(a_2)*af_dim1 + a_1]
#define bf_ref(a_1,a_2) bf[(a_2)*bf_dim1 + a_1]
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
September 30, 1994
Purpose
=======
SGQRTS tests SGGQRF, which computes the GQR factorization of an
N-by-M matrix A and a N-by-P matrix B: A = Q*R and B = Q*T*Z.
Arguments
=========
N (input) INTEGER
The number of rows of the matrices A and B. N >= 0.
M (input) INTEGER
The number of columns of the matrix A. M >= 0.
P (input) INTEGER
The number of columns of the matrix B. P >= 0.
A (input) REAL array, dimension (LDA,M)
The N-by-M matrix A.
AF (output) REAL array, dimension (LDA,N)
Details of the GQR factorization of A and B, as returned
by SGGQRF, see SGGQRF for further details.
Q (output) REAL array, dimension (LDA,N)
The M-by-M orthogonal matrix Q.
R (workspace) REAL array, dimension (LDA,MAX(M,N))
LDA (input) INTEGER
The leading dimension of the arrays A, AF, R and Q.
LDA >= max(M,N).
TAUA (output) REAL array, dimension (min(M,N))
The scalar factors of the elementary reflectors, as returned
by SGGQRF.
B (input) REAL array, dimension (LDB,P)
On entry, the N-by-P matrix A.
BF (output) REAL array, dimension (LDB,N)
Details of the GQR factorization of A and B, as returned
by SGGQRF, see SGGQRF for further details.
Z (output) REAL array, dimension (LDB,P)
The P-by-P orthogonal matrix Z.
T (workspace) REAL array, dimension (LDB,max(P,N))
BWK (workspace) REAL array, dimension (LDB,N)
LDB (input) INTEGER
The leading dimension of the arrays B, BF, Z and T.
LDB >= max(P,N).
TAUB (output) REAL array, dimension (min(P,N))
The scalar factors of the elementary reflectors, as returned
by SGGRQF.
WORK (workspace) REAL array, dimension (LWORK)
LWORK (input) INTEGER
The dimension of the array WORK, LWORK >= max(N,M,P)**2.
RWORK (workspace) REAL array, dimension (max(N,M,P))
RESULT (output) REAL array, dimension (4)
The test ratios:
RESULT(1) = norm( R - Q'*A ) / ( MAX(M,N)*norm(A)*ULP)
RESULT(2) = norm( T*Z - Q'*B ) / (MAX(P,N)*norm(B)*ULP)
RESULT(3) = norm( I - Q'*Q ) / ( M*ULP )
RESULT(4) = norm( I - Z'*Z ) / ( P*ULP )
=====================================================================
Parameter adjustments */
r_dim1 = *lda;
r_offset = 1 + r_dim1 * 1;
r__ -= r_offset;
q_dim1 = *lda;
q_offset = 1 + q_dim1 * 1;
q -= q_offset;
af_dim1 = *lda;
af_offset = 1 + af_dim1 * 1;
af -= af_offset;
a_dim1 = *lda;
a_offset = 1 + a_dim1 * 1;
a -= a_offset;
--taua;
bwk_dim1 = *ldb;
bwk_offset = 1 + bwk_dim1 * 1;
bwk -= bwk_offset;
t_dim1 = *ldb;
t_offset = 1 + t_dim1 * 1;
t -= t_offset;
z_dim1 = *ldb;
z_offset = 1 + z_dim1 * 1;
z__ -= z_offset;
bf_dim1 = *ldb;
bf_offset = 1 + bf_dim1 * 1;
bf -= bf_offset;
b_dim1 = *ldb;
b_offset = 1 + b_dim1 * 1;
b -= b_offset;
--taub;
--work;
--rwork;
--result;
/* Function Body */
ulp = slamch_("Precision");
unfl = slamch_("Safe minimum");
/* Copy the matrix A to the array AF. */
slacpy_("Full", n, m, &a[a_offset], lda, &af[af_offset], lda);
slacpy_("Full", n, p, &b[b_offset], ldb, &bf[bf_offset], ldb);
/* Computing MAX */
r__1 = slange_("1", n, m, &a[a_offset], lda, &rwork[1]);
anorm = dmax(r__1,unfl);
/* Computing MAX */
r__1 = slange_("1", n, p, &b[b_offset], ldb, &rwork[1]);
bnorm = dmax(r__1,unfl);
/* Factorize the matrices A and B in the arrays AF and BF. */
sggqrf_(n, m, p, &af[af_offset], lda, &taua[1], &bf[bf_offset], ldb, &
taub[1], &work[1], lwork, &info);
/* Generate the N-by-N matrix Q */
slaset_("Full", n, n, &c_b9, &c_b9, &q[q_offset], lda);
i__1 = *n - 1;
slacpy_("Lower", &i__1, m, &af_ref(2, 1), lda, &q_ref(2, 1), lda);
i__1 = min(*n,*m);
sorgqr_(n, n, &i__1, &q[q_offset], lda, &taua[1], &work[1], lwork, &info);
/* Generate the P-by-P matrix Z */
slaset_("Full", p, p, &c_b9, &c_b9, &z__[z_offset], ldb);
if (*n <= *p) {
if (*n > 0 && *n < *p) {
i__1 = *p - *n;
slacpy_("Full", n, &i__1, &bf[bf_offset], ldb, &z___ref(*p - *n +
1, 1), ldb);
}
if (*n > 1) {
i__1 = *n - 1;
i__2 = *n - 1;
slacpy_("Lower", &i__1, &i__2, &bf_ref(2, *p - *n + 1), ldb, &
z___ref(*p - *n + 2, *p - *n + 1), ldb);
}
} else {
if (*p > 1) {
i__1 = *p - 1;
i__2 = *p - 1;
slacpy_("Lower", &i__1, &i__2, &bf_ref(*n - *p + 2, 1), ldb, &
z___ref(2, 1), ldb);
}
}
i__1 = min(*n,*p);
sorgrq_(p, p, &i__1, &z__[z_offset], ldb, &taub[1], &work[1], lwork, &
info);
/* Copy R */
slaset_("Full", n, m, &c_b19, &c_b19, &r__[r_offset], lda);
slacpy_("Upper", n, m, &af[af_offset], lda, &r__[r_offset], lda);
/* Copy T */
slaset_("Full", n, p, &c_b19, &c_b19, &t[t_offset], ldb);
if (*n <= *p) {
slacpy_("Upper", n, n, &bf_ref(1, *p - *n + 1), ldb, &t_ref(1, *p - *
n + 1), ldb);
} else {
i__1 = *n - *p;
slacpy_("Full", &i__1, p, &bf[bf_offset], ldb, &t[t_offset], ldb);
slacpy_("Upper", p, p, &bf_ref(*n - *p + 1, 1), ldb, &t_ref(*n - *p +
1, 1), ldb);
}
/* Compute R - Q'*A */
sgemm_("Transpose", "No transpose", n, m, n, &c_b30, &q[q_offset], lda, &
a[a_offset], lda, &c_b31, &r__[r_offset], lda);
/* Compute norm( R - Q'*A ) / ( MAX(M,N)*norm(A)*ULP ) . */
resid = slange_("1", n, m, &r__[r_offset], lda, &rwork[1]);
if (anorm > 0.f) {
/* Computing MAX */
i__1 = max(1,*m);
result[1] = resid / (real) max(i__1,*n) / anorm / ulp;
} else {
result[1] = 0.f;
}
/* Compute T*Z - Q'*B */
sgemm_("No Transpose", "No transpose", n, p, p, &c_b31, &t[t_offset], ldb,
&z__[z_offset], ldb, &c_b19, &bwk[bwk_offset], ldb);
sgemm_("Transpose", "No transpose", n, p, n, &c_b30, &q[q_offset], lda, &
b[b_offset], ldb, &c_b31, &bwk[bwk_offset], ldb);
/* Compute norm( T*Z - Q'*B ) / ( MAX(P,N)*norm(A)*ULP ) . */
resid = slange_("1", n, p, &bwk[bwk_offset], ldb, &rwork[1]);
if (bnorm > 0.f) {
/* Computing MAX */
i__1 = max(1,*p);
result[2] = resid / (real) max(i__1,*n) / bnorm / ulp;
} else {
result[2] = 0.f;
}
/* Compute I - Q'*Q */
slaset_("Full", n, n, &c_b19, &c_b31, &r__[r_offset], lda);
ssyrk_("Upper", "Transpose", n, n, &c_b30, &q[q_offset], lda, &c_b31, &
r__[r_offset], lda);
/* Compute norm( I - Q'*Q ) / ( N * ULP ) . */
resid = slansy_("1", "Upper", n, &r__[r_offset], lda, &rwork[1]);
result[3] = resid / (real) max(1,*n) / ulp;
/* Compute I - Z'*Z */
slaset_("Full", p, p, &c_b19, &c_b31, &t[t_offset], ldb);
ssyrk_("Upper", "Transpose", p, p, &c_b30, &z__[z_offset], ldb, &c_b31, &
t[t_offset], ldb);
/* Compute norm( I - Z'*Z ) / ( P*ULP ) . */
resid = slansy_("1", "Upper", p, &t[t_offset], ldb, &rwork[1]);
result[4] = resid / (real) max(1,*p) / ulp;
return 0;
/* End of SGQRTS */
} /* sgqrts_ */
/* Subroutine */ int sggglm_(integer *n, integer *m, integer *p, real *a,
integer *lda, real *b, integer *ldb, real *d__, real *x, real *y,
real *work, integer *lwork, integer *info)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;
/* Local variables */
integer i__, nb, np, nb1, nb2, nb3, nb4, lopt;
extern /* Subroutine */ int sgemv_(char *, integer *, integer *, real *,
real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *),
xerbla_(char *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *);
extern /* Subroutine */ int sggqrf_(integer *, integer *, integer *, real
*, integer *, real *, real *, integer *, real *, real *, integer *
, integer *);
integer lwkmin, lwkopt;
logical lquery;
extern /* Subroutine */ int sormqr_(char *, char *, integer *, integer *,
integer *, real *, integer *, real *, real *, integer *, real *,
integer *, integer *), sormrq_(char *, char *,
integer *, integer *, integer *, real *, integer *, real *, real *
, integer *, real *, integer *, integer *),
strtrs_(char *, char *, char *, integer *, integer *, real *,
integer *, real *, integer *, integer *);
/* -- LAPACK driver routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SGGGLM solves a general Gauss-Markov linear model (GLM) problem: */
/* minimize || y ||_2 subject to d = A*x + B*y */
/* x */
/* where A is an N-by-M matrix, B is an N-by-P matrix, and d is a */
/* given N-vector. It is assumed that M <= N <= M+P, and */
/* rank(A) = M and rank( A B ) = N. */
/* Under these assumptions, the constrained equation is always */
/* consistent, and there is a unique solution x and a minimal 2-norm */
/* solution y, which is obtained using a generalized QR factorization */
/* of the matrices (A, B) given by */
/* A = Q*(R), B = Q*T*Z. */
/* (0) */
/* In particular, if matrix B is square nonsingular, then the problem */
/* GLM is equivalent to the following weighted linear least squares */
/* problem */
/* minimize || inv(B)*(d-A*x) ||_2 */
/* x */
/* where inv(B) denotes the inverse of B. */
/* Arguments */
/* ========= */
/* N (input) INTEGER */
/* The number of rows of the matrices A and B. N >= 0. */
/* M (input) INTEGER */
/* The number of columns of the matrix A. 0 <= M <= N. */
/* P (input) INTEGER */
/* The number of columns of the matrix B. P >= N-M. */
/* A (input/output) REAL array, dimension (LDA,M) */
/* On entry, the N-by-M matrix A. */
/* On exit, the upper triangular part of the array A contains */
/* the M-by-M upper triangular matrix R. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,N). */
/* B (input/output) REAL array, dimension (LDB,P) */
/* On entry, the N-by-P matrix B. */
/* On exit, if N <= P, the upper triangle of the subarray */
/* B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T; */
/* if N > P, the elements on and above the (N-P)th subdiagonal */
/* contain the N-by-P upper trapezoidal matrix T. */
/* LDB (input) INTEGER */
/* The leading dimension of the array B. LDB >= max(1,N). */
/* D (input/output) REAL array, dimension (N) */
/* On entry, D is the left hand side of the GLM equation. */
/* On exit, D is destroyed. */
/* X (output) REAL array, dimension (M) */
/* Y (output) REAL array, dimension (P) */
/* On exit, X and Y are the solutions of the GLM problem. */
/* WORK (workspace/output) REAL array, dimension (MAX(1,LWORK)) */
/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
/* LWORK (input) INTEGER */
/* The dimension of the array WORK. LWORK >= max(1,N+M+P). */
/* For optimum performance, LWORK >= M+min(N,P)+max(N,P)*NB, */
/* where NB is an upper bound for the optimal blocksizes for */
/* SGEQRF, SGERQF, SORMQR and SORMRQ. */
/* If LWORK = -1, then a workspace query is assumed; the routine */
/* only calculates the optimal size of the WORK array, returns */
/* this value as the first entry of the WORK array, and no error */
/* message related to LWORK is issued by XERBLA. */
/* INFO (output) INTEGER */
/* = 0: successful exit. */
/* < 0: if INFO = -i, the i-th argument had an illegal value. */
/* = 1: the upper triangular factor R associated with A in the */
/* generalized QR factorization of the pair (A, B) is */
/* singular, so that rank(A) < M; the least squares */
/* solution could not be computed. */
/* = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal */
/* factor T associated with B in the generalized QR */
/* factorization of the pair (A, B) is singular, so that */
/* rank( A B ) < N; the least squares solution could not */
/* be computed. */
/* =================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* 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;
--d__;
--x;
--y;
--work;
/* Function Body */
*info = 0;
np = min(*n,*p);
lquery = *lwork == -1;
if (*n < 0) {
*info = -1;
} else if (*m < 0 || *m > *n) {
*info = -2;
} else if (*p < 0 || *p < *n - *m) {
*info = -3;
} else if (*lda < max(1,*n)) {
*info = -5;
} else if (*ldb < max(1,*n)) {
*info = -7;
}
/* Calculate workspace */
if (*info == 0) {
if (*n == 0) {
lwkmin = 1;
lwkopt = 1;
} else {
nb1 = ilaenv_(&c__1, "SGEQRF", " ", n, m, &c_n1, &c_n1);
nb2 = ilaenv_(&c__1, "SGERQF", " ", n, m, &c_n1, &c_n1);
nb3 = ilaenv_(&c__1, "SORMQR", " ", n, m, p, &c_n1);
nb4 = ilaenv_(&c__1, "SORMRQ", " ", n, m, p, &c_n1);
/* Computing MAX */
i__1 = max(nb1,nb2), i__1 = max(i__1,nb3);
nb = max(i__1,nb4);
lwkmin = *m + *n + *p;
lwkopt = *m + np + max(*n,*p) * nb;
}
work[1] = (real) lwkopt;
if (*lwork < lwkmin && ! lquery) {
*info = -12;
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("SGGGLM", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
/* Compute the GQR factorization of matrices A and B: */
/* Q'*A = ( R11 ) M, Q'*B*Z' = ( T11 T12 ) M */
/* ( 0 ) N-M ( 0 T22 ) N-M */
/* M M+P-N N-M */
/* where R11 and T22 are upper triangular, and Q and Z are */
/* orthogonal. */
i__1 = *lwork - *m - np;
sggqrf_(n, m, p, &a[a_offset], lda, &work[1], &b[b_offset], ldb, &work[*m
+ 1], &work[*m + np + 1], &i__1, info);
lopt = work[*m + np + 1];
/* Update left-hand-side vector d = Q'*d = ( d1 ) M */
/* ( d2 ) N-M */
i__1 = max(1,*n);
i__2 = *lwork - *m - np;
sormqr_("Left", "Transpose", n, &c__1, m, &a[a_offset], lda, &work[1], &
d__[1], &i__1, &work[*m + np + 1], &i__2, info);
/* Computing MAX */
i__1 = lopt, i__2 = (integer) work[*m + np + 1];
lopt = max(i__1,i__2);
/* Solve T22*y2 = d2 for y2 */
if (*n > *m) {
i__1 = *n - *m;
i__2 = *n - *m;
strtrs_("Upper", "No transpose", "Non unit", &i__1, &c__1, &b[*m + 1
+ (*m + *p - *n + 1) * b_dim1], ldb, &d__[*m + 1], &i__2,
info);
if (*info > 0) {
*info = 1;
return 0;
}
i__1 = *n - *m;
scopy_(&i__1, &d__[*m + 1], &c__1, &y[*m + *p - *n + 1], &c__1);
}
/* Set y1 = 0 */
i__1 = *m + *p - *n;
for (i__ = 1; i__ <= i__1; ++i__) {
y[i__] = 0.f;
/* L10: */
}
/* Update d1 = d1 - T12*y2 */
i__1 = *n - *m;
sgemv_("No transpose", m, &i__1, &c_b32, &b[(*m + *p - *n + 1) * b_dim1 +
1], ldb, &y[*m + *p - *n + 1], &c__1, &c_b34, &d__[1], &c__1);
/* Solve triangular system: R11*x = d1 */
if (*m > 0) {
strtrs_("Upper", "No Transpose", "Non unit", m, &c__1, &a[a_offset],
lda, &d__[1], m, info);
if (*info > 0) {
*info = 2;
return 0;
}
/* Copy D to X */
scopy_(m, &d__[1], &c__1, &x[1], &c__1);
}
/* Backward transformation y = Z'*y */
/* Computing MAX */
i__1 = 1, i__2 = *n - *p + 1;
i__3 = max(1,*p);
i__4 = *lwork - *m - np;
sormrq_("Left", "Transpose", p, &c__1, &np, &b[max(i__1, i__2)+ b_dim1],
ldb, &work[*m + 1], &y[1], &i__3, &work[*m + np + 1], &i__4, info);
/* Computing MAX */
i__1 = lopt, i__2 = (integer) work[*m + np + 1];
work[1] = (real) (*m + np + max(i__1,i__2));
return 0;
/* End of SGGGLM */
} /* sggglm_ */
/* Subroutine */ int serrgg_(char *path, integer *nunit)
{
/* Format strings */
static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e"
"rror exits (\002,i3,\002 tests done)\002)";
static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes"
"ts of the error \002,\002exits ***\002)";
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Local variables */
real a[9] /* was [3][3] */, b[9] /* was [3][3] */;
integer i__, j, m;
real q[9] /* was [3][3] */, u[9] /* was [3][3] */, v[9] /* was [3][3]
*/, w[18], z__[9] /* was [3][3] */;
char c2[2];
real r1[3], r2[3], r3[3];
logical bw[3];
real ls[3];
integer iw[3], nt;
real rs[3], dif, rce[2];
logical sel[3];
real tau[3], rcv[2];
integer info, sdim;
real anrm, bnrm, tola, tolb;
integer ifst, ilst;
real scale;
extern /* Subroutine */ int sgges_(char *, char *, char *, L_fp, integer *
, real *, integer *, real *, integer *, integer *, real *, real *,
real *, real *, integer *, real *, integer *, real *, integer *,
logical *, integer *), sggev_(char *,
char *, integer *, real *, integer *, real *, integer *, real *,
real *, real *, real *, integer *, real *, integer *, real *,
integer *, integer *);
integer ncycle;
extern /* Subroutine */ int sgghrd_(char *, char *, integer *, integer *,
integer *, real *, integer *, real *, integer *, real *, integer *
, real *, integer *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int sggglm_(integer *, integer *, integer *, real
*, integer *, real *, integer *, real *, real *, real *, real *,
integer *, integer *), chkxer_(char *, integer *, integer *,
logical *, logical *), sgglse_(integer *, integer *,
integer *, real *, integer *, real *, integer *, real *, real *,
real *, real *, integer *, integer *), sggqrf_(integer *, integer
*, integer *, real *, integer *, real *, real *, integer *, real *
, real *, integer *, integer *), sggrqf_(integer *, integer *,
integer *, real *, integer *, real *, real *, integer *, real *,
real *, integer *, integer *), stgevc_(char *, char *, logical *,
integer *, real *, integer *, real *, integer *, real *, integer *
, real *, integer *, integer *, integer *, real *, integer *);
extern logical slctes_();
extern /* Subroutine */ int sggsvd_(char *, char *, char *, integer *,
integer *, integer *, integer *, integer *, real *, integer *,
real *, integer *, real *, real *, real *, integer *, real *,
integer *, real *, integer *, real *, integer *, integer *), stgexc_(logical *, logical *, integer *,
real *, integer *, real *, integer *, real *, integer *, real *,
integer *, integer *, integer *, real *, integer *, integer *),
sggesx_(char *, char *, char *, L_fp, char *, integer *, real *,
integer *, real *, integer *, integer *, real *, real *, real *,
real *, integer *, real *, integer *, real *, real *, real *,
integer *, integer *, integer *, logical *, integer *), shgeqz_(char *, char *, char *, integer *
, integer *, integer *, real *, integer *, real *, integer *,
real *, real *, real *, real *, integer *, real *, integer *,
real *, integer *, integer *), stgsja_(
char *, char *, char *, integer *, integer *, integer *, integer *
, integer *, real *, integer *, real *, integer *, real *, real *,
real *, real *, real *, integer *, real *, integer *, real *,
integer *, real *, integer *, integer *),
sggevx_(char *, char *, char *, char *, integer *, real *,
integer *, real *, integer *, real *, real *, real *, real *,
integer *, real *, integer *, integer *, integer *, real *, real *
, real *, real *, real *, real *, real *, integer *, integer *,
logical *, integer *), stgsen_(
integer *, logical *, logical *, logical *, integer *, real *,
integer *, real *, integer *, real *, real *, real *, real *,
integer *, real *, integer *, integer *, real *, real *, real *,
real *, integer *, integer *, integer *, integer *), stgsna_(char
*, char *, logical *, integer *, real *, integer *, real *,
integer *, real *, integer *, real *, integer *, real *, real *,
integer *, integer *, real *, integer *, integer *, integer *);
integer dummyk, dummyl;
extern /* Subroutine */ int sggsvp_(char *, char *, char *, integer *,
integer *, integer *, real *, integer *, real *, integer *, real *
, real *, integer *, integer *, real *, integer *, real *,
integer *, real *, integer *, integer *, real *, real *, integer *
);
extern logical slctsx_();
extern /* Subroutine */ int stgsyl_(char *, integer *, integer *, integer
*, real *, integer *, real *, integer *, real *, integer *, real *
, integer *, real *, integer *, real *, integer *, real *, real *,
real *, integer *, integer *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
static cilist io___38 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___39 = { 0, 0, 0, fmt_9998, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SERRGG tests the error exits for SGGES, SGGESX, SGGEV, SGGEVX, */
/* SGGGLM, SGGHRD, SGGLSE, SGGQRF, SGGRQF, SGGSVD, SGGSVP, SHGEQZ, */
/* STGEVC, STGEXC, STGSEN, STGSJA, STGSNA, and STGSYL. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name for the routines to be tested. */
/* NUNIT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Set the variables to innocuous values. */
for (j = 1; j <= 3; ++j) {
sel[j - 1] = TRUE_;
for (i__ = 1; i__ <= 3; ++i__) {
a[i__ + j * 3 - 4] = 0.f;
b[i__ + j * 3 - 4] = 0.f;
/* L10: */
}
/* L20: */
}
for (i__ = 1; i__ <= 3; ++i__) {
a[i__ + i__ * 3 - 4] = 1.f;
b[i__ + i__ * 3 - 4] = 1.f;
/* L30: */
}
infoc_1.ok = TRUE_;
tola = 1.f;
tolb = 1.f;
ifst = 1;
ilst = 1;
nt = 0;
/* Test error exits for the GG path. */
if (lsamen_(&c__2, c2, "GG")) {
/* SGGHRD */
s_copy(srnamc_1.srnamt, "SGGHRD", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgghrd_("/", "N", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, q, &c__1,
z__, &c__1, &info);
chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgghrd_("N", "/", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, q, &c__1,
z__, &c__1, &info);
chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgghrd_("N", "N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, q, &c__1,
z__, &c__1, &info);
chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgghrd_("N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, q, &c__1,
z__, &c__1, &info);
chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgghrd_("N", "N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1,
z__, &c__1, &info);
chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgghrd_("N", "N", &c__2, &c__1, &c__1, a, &c__1, b, &c__2, q, &c__1,
z__, &c__1, &info);
chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
sgghrd_("N", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__1, q, &c__1,
z__, &c__1, &info);
chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
sgghrd_("V", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, q, &c__1,
z__, &c__1, &info);
chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
sgghrd_("N", "V", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, q, &c__1,
z__, &c__1, &info);
chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 9;
/* SHGEQZ */
s_copy(srnamc_1.srnamt, "SHGEQZ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
shgeqz_("/", "N", "N", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info);
chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
shgeqz_("E", "/", "N", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info);
chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
shgeqz_("E", "N", "/", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info);
chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
shgeqz_("E", "N", "N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info);
chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
shgeqz_("E", "N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info);
chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
shgeqz_("E", "N", "N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info);
chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
shgeqz_("E", "N", "N", &c__2, &c__1, &c__1, a, &c__1, b, &c__2, r1,
r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info);
chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
shgeqz_("E", "N", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info);
chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
shgeqz_("E", "V", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, r1,
r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info);
chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 17;
shgeqz_("E", "N", "V", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, r1,
r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info);
chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 10;
/* STGEVC */
s_copy(srnamc_1.srnamt, "STGEVC", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
stgevc_("/", "A", sel, &c__0, a, &c__1, b, &c__1, q, &c__1, z__, &
c__1, &c__0, &m, w, &info);
chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stgevc_("R", "/", sel, &c__0, a, &c__1, b, &c__1, q, &c__1, z__, &
c__1, &c__0, &m, w, &info);
chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
stgevc_("R", "A", sel, &c_n1, a, &c__1, b, &c__1, q, &c__1, z__, &
c__1, &c__0, &m, w, &info);
chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
stgevc_("R", "A", sel, &c__2, a, &c__1, b, &c__2, q, &c__1, z__, &
c__2, &c__0, &m, w, &info);
chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
stgevc_("R", "A", sel, &c__2, a, &c__2, b, &c__1, q, &c__1, z__, &
c__2, &c__0, &m, w, &info);
chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
stgevc_("L", "A", sel, &c__2, a, &c__2, b, &c__2, q, &c__1, z__, &
c__1, &c__0, &m, w, &info);
chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
stgevc_("R", "A", sel, &c__2, a, &c__2, b, &c__2, q, &c__1, z__, &
c__1, &c__0, &m, w, &info);
chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
stgevc_("R", "A", sel, &c__2, a, &c__2, b, &c__2, q, &c__1, z__, &
c__2, &c__1, &m, w, &info);
chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 8;
/* Test error exits for the GSV path. */
} else if (lsamen_(&c__3, path, "GSV")) {
/* SGGSVD */
s_copy(srnamc_1.srnamt, "SGGSVD", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sggsvd_("/", "N", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sggsvd_("N", "/", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sggsvd_("N", "N", "/", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sggsvd_("N", "N", "N", &c_n1, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sggsvd_("N", "N", "N", &c__0, &c_n1, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sggsvd_("N", "N", "N", &c__0, &c__0, &c_n1, &dummyk, &dummyl, a, &
c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sggsvd_("N", "N", "N", &c__2, &c__1, &c__1, &dummyk, &dummyl, a, &
c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
sggsvd_("N", "N", "N", &c__1, &c__1, &c__2, &dummyk, &dummyl, a, &
c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
sggsvd_("U", "N", "N", &c__2, &c__2, &c__2, &dummyk, &dummyl, a, &
c__2, b, &c__2, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 18;
sggsvd_("N", "V", "N", &c__1, &c__1, &c__2, &dummyk, &dummyl, a, &
c__1, b, &c__2, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 20;
sggsvd_("N", "N", "Q", &c__1, &c__2, &c__1, &dummyk, &dummyl, a, &
c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, &
info);
chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 11;
/* SGGSVP */
s_copy(srnamc_1.srnamt, "SGGSVP", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sggsvp_("/", "N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sggsvp_("N", "/", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sggsvp_("N", "N", "/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sggsvp_("N", "N", "N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sggsvp_("N", "N", "N", &c__0, &c_n1, &c__0, a, &c__1, b, &c__1, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sggsvp_("N", "N", "N", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
sggsvp_("N", "N", "N", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sggsvp_("N", "N", "N", &c__1, &c__2, &c__1, a, &c__1, b, &c__1, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
sggsvp_("U", "N", "N", &c__2, &c__2, &c__2, a, &c__2, b, &c__2, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 18;
sggsvp_("N", "V", "N", &c__1, &c__2, &c__1, a, &c__1, b, &c__2, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 20;
sggsvp_("N", "N", "Q", &c__1, &c__1, &c__2, a, &c__1, b, &c__1, &tola,
&tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw,
tau, w, &info);
chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 11;
/* STGSJA */
s_copy(srnamc_1.srnamt, "STGSJA", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
stgsja_("/", "N", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, &
c__1, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stgsja_("N", "/", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, &
c__1, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
stgsja_("N", "N", "/", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, &
c__1, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
stgsja_("N", "N", "N", &c_n1, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, &
c__1, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
stgsja_("N", "N", "N", &c__0, &c_n1, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, &
c__1, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
stgsja_("N", "N", "N", &c__0, &c__0, &c_n1, &dummyk, &dummyl, a, &
c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, &
c__1, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
stgsja_("N", "N", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__0, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, &
c__1, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
stgsja_("N", "N", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__0, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, &
c__1, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 18;
stgsja_("U", "N", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__0, v, &c__1, q, &
c__1, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 20;
stgsja_("N", "V", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__0, q, &
c__1, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 22;
stgsja_("N", "N", "Q", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, &
c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, &
c__0, w, &ncycle, &info);
chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 11;
/* Test error exits for the GLM path. */
} else if (lsamen_(&c__3, path, "GLM")) {
/* SGGGLM */
s_copy(srnamc_1.srnamt, "SGGGLM", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sggglm_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sggglm_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sggglm_(&c__0, &c__1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sggglm_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sggglm_(&c__1, &c__0, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sggglm_(&c__0, &c__0, &c__0, a, &c__0, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sggglm_(&c__0, &c__0, &c__0, a, &c__1, b, &c__0, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
sggglm_(&c__1, &c__1, &c__1, a, &c__1, b, &c__1, r1, r2, r3, w, &c__1,
&info);
chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 8;
/* Test error exits for the LSE path. */
} else if (lsamen_(&c__3, path, "LSE")) {
/* SGGLSE */
s_copy(srnamc_1.srnamt, "SGGLSE", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgglse_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgglse_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgglse_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgglse_(&c__0, &c__0, &c__1, a, &c__1, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgglse_(&c__0, &c__1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgglse_(&c__0, &c__0, &c__0, a, &c__0, b, &c__1, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgglse_(&c__0, &c__0, &c__0, a, &c__1, b, &c__0, r1, r2, r3, w, &
c__18, &info);
chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
sgglse_(&c__1, &c__1, &c__1, a, &c__1, b, &c__1, r1, r2, r3, w, &c__1,
&info);
chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 8;
/* Test error exits for the GQR path. */
} else if (lsamen_(&c__3, path, "GQR")) {
/* SGGQRF */
s_copy(srnamc_1.srnamt, "SGGQRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sggqrf_(&c_n1, &c__0, &c__0, a, &c__1, r1, b, &c__1, r2, w, &c__18, &
info);
chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sggqrf_(&c__0, &c_n1, &c__0, a, &c__1, r1, b, &c__1, r2, w, &c__18, &
info);
chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sggqrf_(&c__0, &c__0, &c_n1, a, &c__1, r1, b, &c__1, r2, w, &c__18, &
info);
chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sggqrf_(&c__0, &c__0, &c__0, a, &c__0, r1, b, &c__1, r2, w, &c__18, &
info);
chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
sggqrf_(&c__0, &c__0, &c__0, a, &c__1, r1, b, &c__0, r2, w, &c__18, &
info);
chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
sggqrf_(&c__1, &c__1, &c__2, a, &c__1, r1, b, &c__1, r2, w, &c__1, &
info);
chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 6;
/* SGGRQF */
s_copy(srnamc_1.srnamt, "SGGRQF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sggrqf_(&c_n1, &c__0, &c__0, a, &c__1, r1, b, &c__1, r2, w, &c__18, &
info);
chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sggrqf_(&c__0, &c_n1, &c__0, a, &c__1, r1, b, &c__1, r2, w, &c__18, &
info);
chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sggrqf_(&c__0, &c__0, &c_n1, a, &c__1, r1, b, &c__1, r2, w, &c__18, &
info);
chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sggrqf_(&c__0, &c__0, &c__0, a, &c__0, r1, b, &c__1, r2, w, &c__18, &
info);
chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
sggrqf_(&c__0, &c__0, &c__0, a, &c__1, r1, b, &c__0, r2, w, &c__18, &
info);
chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
sggrqf_(&c__1, &c__1, &c__2, a, &c__1, r1, b, &c__1, r2, w, &c__1, &
info);
chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 6;
/* Test error exits for the SGS, SGV, SGX, and SXV paths. */
} else if (lsamen_(&c__3, path, "SGS") || lsamen_(&
c__3, path, "SGV") || lsamen_(&c__3, path,
"SGX") || lsamen_(&c__3, path, "SXV")) {
/* SGGES */
s_copy(srnamc_1.srnamt, "SGGES ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgges_("/", "N", "S", (L_fp)slctes_, &c__1, a, &c__1, b, &c__1, &sdim,
r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgges_("N", "/", "S", (L_fp)slctes_, &c__1, a, &c__1, b, &c__1, &sdim,
r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgges_("N", "V", "/", (L_fp)slctes_, &c__1, a, &c__1, b, &c__1, &sdim,
r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgges_("N", "V", "S", (L_fp)slctes_, &c_n1, a, &c__1, b, &c__1, &sdim,
r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgges_("N", "V", "S", (L_fp)slctes_, &c__1, a, &c__0, b, &c__1, &sdim,
r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
sgges_("N", "V", "S", (L_fp)slctes_, &c__1, a, &c__1, b, &c__0, &sdim,
r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
sgges_("N", "V", "S", (L_fp)slctes_, &c__1, a, &c__1, b, &c__1, &sdim,
r1, r2, r3, q, &c__0, u, &c__1, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
sgges_("V", "V", "S", (L_fp)slctes_, &c__2, a, &c__2, b, &c__2, &sdim,
r1, r2, r3, q, &c__1, u, &c__2, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 17;
sgges_("N", "V", "S", (L_fp)slctes_, &c__1, a, &c__1, b, &c__1, &sdim,
r1, r2, r3, q, &c__1, u, &c__0, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 17;
sgges_("V", "V", "S", (L_fp)slctes_, &c__2, a, &c__2, b, &c__2, &sdim,
r1, r2, r3, q, &c__2, u, &c__1, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 19;
sgges_("V", "V", "S", (L_fp)slctes_, &c__2, a, &c__2, b, &c__2, &sdim,
r1, r2, r3, q, &c__2, u, &c__2, w, &c__1, bw, &info);
chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 11;
/* SGGESX */
s_copy(srnamc_1.srnamt, "SGGESX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sggesx_("/", "N", "S", (L_fp)slctsx_, "N", &c__1, a, &c__1, b, &c__1,
&sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sggesx_("N", "/", "S", (L_fp)slctsx_, "N", &c__1, a, &c__1, b, &c__1,
&sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sggesx_("V", "V", "/", (L_fp)slctsx_, "N", &c__1, a, &c__1, b, &c__1,
&sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sggesx_("V", "V", "S", (L_fp)slctsx_, "/", &c__1, a, &c__1, b, &c__1,
&sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c_n1, a, &c__1, b, &c__1,
&sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__1, a, &c__0, b, &c__1,
&sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__1, a, &c__1, b, &c__0,
&sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__1, a, &c__1, b, &c__1,
&sdim, r1, r2, r3, q, &c__0, u, &c__1, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__2, a, &c__2, b, &c__2,
&sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 18;
sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__1, a, &c__1, b, &c__1,
&sdim, r1, r2, r3, q, &c__1, u, &c__0, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 18;
sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__2, a, &c__2, b, &c__2,
&sdim, r1, r2, r3, q, &c__2, u, &c__1, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 22;
sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__2, a, &c__2, b, &c__2,
&sdim, r1, r2, r3, q, &c__2, u, &c__2, rce, rcv, w, &c__1, iw,
&c__1, bw, &info)
;
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 24;
sggesx_("V", "V", "S", (L_fp)slctsx_, "V", &c__1, a, &c__1, b, &c__1,
&sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__32,
iw, &c__0, bw, &info);
chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 13;
/* SGGEV */
s_copy(srnamc_1.srnamt, "SGGEV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sggev_("/", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, &
c__1, w, &c__1, &info);
chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sggev_("N", "/", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, &
c__1, w, &c__1, &info);
chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sggev_("V", "V", &c_n1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, &
c__1, w, &c__1, &info);
chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sggev_("V", "V", &c__1, a, &c__0, b, &c__1, r1, r2, r3, q, &c__1, u, &
c__1, w, &c__1, &info);
chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sggev_("V", "V", &c__1, a, &c__1, b, &c__0, r1, r2, r3, q, &c__1, u, &
c__1, w, &c__1, &info);
chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
sggev_("N", "V", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__0, u, &
c__1, w, &c__1, &info);
chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
sggev_("V", "V", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q, &c__1, u, &
c__2, w, &c__1, &info);
chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
sggev_("V", "N", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q, &c__2, u, &
c__0, w, &c__1, &info);
chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
sggev_("V", "V", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q, &c__2, u, &
c__1, w, &c__1, &info);
chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
sggev_("V", "V", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, &
c__1, w, &c__1, &info);
chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 10;
/* SGGEVX */
s_copy(srnamc_1.srnamt, "SGGEVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sggevx_("/", "N", "N", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q,
&c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sggevx_("N", "/", "N", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q,
&c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sggevx_("N", "N", "/", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q,
&c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sggevx_("N", "N", "N", "/", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q,
&c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sggevx_("N", "N", "N", "N", &c_n1, a, &c__1, b, &c__1, r1, r2, r3, q,
&c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sggevx_("N", "N", "N", "N", &c__1, a, &c__0, b, &c__1, r1, r2, r3, q,
&c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
sggevx_("N", "N", "N", "N", &c__1, a, &c__1, b, &c__0, r1, r2, r3, q,
&c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
sggevx_("N", "N", "N", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q,
&c__0, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
sggevx_("N", "V", "N", "N", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q,
&c__1, u, &c__2, &c__1, &c__2, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
sggevx_("N", "N", "N", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q,
&c__1, u, &c__0, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
sggevx_("N", "N", "V", "N", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q,
&c__2, u, &c__1, &c__1, &c__2, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 26;
sggevx_("N", "N", "V", "N", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q,
&c__2, u, &c__2, &c__1, &c__2, ls, rs, &anrm, &bnrm, rce, rcv,
w, &c__1, iw, bw, &info);
chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 12;
/* STGEXC */
s_copy(srnamc_1.srnamt, "STGEXC", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 3;
stgexc_(&c_true, &c_true, &c_n1, a, &c__1, b, &c__1, q, &c__1, z__, &
c__1, &ifst, &ilst, w, &c__1, &info);
chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
stgexc_(&c_true, &c_true, &c__1, a, &c__0, b, &c__1, q, &c__1, z__, &
c__1, &ifst, &ilst, w, &c__1, &info);
chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
stgexc_(&c_true, &c_true, &c__1, a, &c__1, b, &c__0, q, &c__1, z__, &
c__1, &ifst, &ilst, w, &c__1, &info);
chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
stgexc_(&c_false, &c_true, &c__1, a, &c__1, b, &c__1, q, &c__0, z__, &
c__1, &ifst, &ilst, w, &c__1, &info);
chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
stgexc_(&c_true, &c_true, &c__1, a, &c__1, b, &c__1, q, &c__0, z__, &
c__1, &ifst, &ilst, w, &c__1, &info);
chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
stgexc_(&c_true, &c_false, &c__1, a, &c__1, b, &c__1, q, &c__1, z__, &
c__0, &ifst, &ilst, w, &c__1, &info);
chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
stgexc_(&c_true, &c_true, &c__1, a, &c__1, b, &c__1, q, &c__1, z__, &
c__0, &ifst, &ilst, w, &c__1, &info);
chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
stgexc_(&c_true, &c_true, &c__1, a, &c__1, b, &c__1, q, &c__1, z__, &
c__1, &ifst, &ilst, w, &c__0, &info);
chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 8;
/* STGSEN */
s_copy(srnamc_1.srnamt, "STGSEN", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
stgsen_(&c_n1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1,
iw, &c__1, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
stgsen_(&c__1, &c_true, &c_true, sel, &c_n1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1,
iw, &c__1, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__0, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1,
iw, &c__1, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__0, r1,
r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1,
iw, &c__1, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__0, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1,
iw, &c__1, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__0, &m, &tola, &tolb, rcv, w, &c__1,
iw, &c__1, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 22;
stgsen_(&c__0, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1,
iw, &c__1, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 22;
stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1,
iw, &c__1, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 22;
stgsen_(&c__2, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1,
iw, &c__1, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 24;
stgsen_(&c__0, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &
c__20, iw, &c__0, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 24;
stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &
c__20, iw, &c__0, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 24;
stgsen_(&c__2, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1,
r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &
c__20, iw, &c__1, &info);
chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 12;
/* STGSNA */
s_copy(srnamc_1.srnamt, "STGSNA", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
stgsna_("/", "A", sel, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &c__1,
r1, r2, &c__1, &m, w, &c__1, iw, &info);
chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stgsna_("B", "/", sel, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &c__1,
r1, r2, &c__1, &m, w, &c__1, iw, &info);
chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
stgsna_("B", "A", sel, &c_n1, a, &c__1, b, &c__1, q, &c__1, u, &c__1,
r1, r2, &c__1, &m, w, &c__1, iw, &info);
chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
stgsna_("B", "A", sel, &c__1, a, &c__0, b, &c__1, q, &c__1, u, &c__1,
r1, r2, &c__1, &m, w, &c__1, iw, &info);
chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
stgsna_("B", "A", sel, &c__1, a, &c__1, b, &c__0, q, &c__1, u, &c__1,
r1, r2, &c__1, &m, w, &c__1, iw, &info);
chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
stgsna_("E", "A", sel, &c__1, a, &c__1, b, &c__1, q, &c__0, u, &c__1,
r1, r2, &c__1, &m, w, &c__1, iw, &info);
chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
stgsna_("E", "A", sel, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &c__0,
r1, r2, &c__1, &m, w, &c__1, iw, &info);
chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
stgsna_("E", "A", sel, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &c__1,
r1, r2, &c__0, &m, w, &c__1, iw, &info);
chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 18;
stgsna_("E", "A", sel, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &c__1,
r1, r2, &c__1, &m, w, &c__0, iw, &info);
chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 9;
/* STGSYL */
s_copy(srnamc_1.srnamt, "STGSYL", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
stgsyl_("/", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &
c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stgsyl_("N", &c_n1, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &
c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
stgsyl_("N", &c__0, &c__0, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &
c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
stgsyl_("N", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, q, &c__1, u, &
c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
stgsyl_("N", &c__0, &c__1, &c__1, a, &c__0, b, &c__1, q, &c__1, u, &
c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
stgsyl_("N", &c__0, &c__1, &c__1, a, &c__1, b, &c__0, q, &c__1, u, &
c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
stgsyl_("N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__0, u, &
c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
stgsyl_("N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &
c__0, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
stgsyl_("N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &
c__1, v, &c__0, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
stgsyl_("N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &
c__1, v, &c__1, z__, &c__0, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 20;
stgsyl_("N", &c__1, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &
c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 20;
stgsyl_("N", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &
c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info);
chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 12;
}
/* Print a summary line. */
if (infoc_1.ok) {
io___38.ciunit = infoc_1.nout;
s_wsfe(&io___38);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
e_wsfe();
} else {
io___39.ciunit = infoc_1.nout;
s_wsfe(&io___39);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
return 0;
/* End of SERRGG */
} /* serrgg_ */
/* Subroutine */ int sgqrts_(integer *n, integer *m, integer *p, real *a,
real *af, real *q, real *r__, integer *lda, real *taua, real *b, real
*bf, real *z__, real *t, real *bwk, integer *ldb, real *taub, real *
work, integer *lwork, real *rwork, real *result)
{
/* System generated locals */
integer a_dim1, a_offset, af_dim1, af_offset, r_dim1, r_offset, q_dim1,
q_offset, b_dim1, b_offset, bf_dim1, bf_offset, t_dim1, t_offset,
z_dim1, z_offset, bwk_dim1, bwk_offset, i__1, i__2;
real r__1;
/* Local variables */
real ulp;
integer info;
real unfl, resid;
extern /* Subroutine */ int sgemm_(char *, char *, integer *, integer *,
integer *, real *, real *, integer *, real *, integer *, real *,
real *, integer *);
real anorm, bnorm;
extern /* Subroutine */ int ssyrk_(char *, char *, integer *, integer *,
real *, real *, integer *, real *, real *, integer *);
extern doublereal slamch_(char *), slange_(char *, integer *,
integer *, real *, integer *, real *);
extern /* Subroutine */ int sggqrf_(integer *, integer *, integer *, real
*, integer *, real *, real *, integer *, real *, real *, integer *
, integer *), slacpy_(char *, integer *, integer *, real *,
integer *, real *, integer *), slaset_(char *, integer *,
integer *, real *, real *, real *, integer *);
extern doublereal slansy_(char *, char *, integer *, real *, integer *,
real *);
extern /* Subroutine */ int sorgqr_(integer *, integer *, integer *, real
*, integer *, real *, real *, integer *, integer *), sorgrq_(
integer *, integer *, integer *, real *, integer *, real *, real *
, integer *, integer *);
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SGQRTS tests SGGQRF, which computes the GQR factorization of an */
/* N-by-M matrix A and a N-by-P matrix B: A = Q*R and B = Q*T*Z. */
/* Arguments */
/* ========= */
/* N (input) INTEGER */
/* The number of rows of the matrices A and B. N >= 0. */
/* M (input) INTEGER */
/* The number of columns of the matrix A. M >= 0. */
/* P (input) INTEGER */
/* The number of columns of the matrix B. P >= 0. */
/* A (input) REAL array, dimension (LDA,M) */
/* The N-by-M matrix A. */
/* AF (output) REAL array, dimension (LDA,N) */
/* Details of the GQR factorization of A and B, as returned */
/* by SGGQRF, see SGGQRF for further details. */
/* Q (output) REAL array, dimension (LDA,N) */
/* The M-by-M orthogonal matrix Q. */
/* R (workspace) REAL array, dimension (LDA,MAX(M,N)) */
/* LDA (input) INTEGER */
/* The leading dimension of the arrays A, AF, R and Q. */
/* LDA >= max(M,N). */
/* TAUA (output) REAL array, dimension (min(M,N)) */
/* The scalar factors of the elementary reflectors, as returned */
/* by SGGQRF. */
/* B (input) REAL array, dimension (LDB,P) */
/* On entry, the N-by-P matrix A. */
/* BF (output) REAL array, dimension (LDB,N) */
/* Details of the GQR factorization of A and B, as returned */
/* by SGGQRF, see SGGQRF for further details. */
/* Z (output) REAL array, dimension (LDB,P) */
/* The P-by-P orthogonal matrix Z. */
/* T (workspace) REAL array, dimension (LDB,max(P,N)) */
/* BWK (workspace) REAL array, dimension (LDB,N) */
/* LDB (input) INTEGER */
/* The leading dimension of the arrays B, BF, Z and T. */
/* LDB >= max(P,N). */
/* TAUB (output) REAL array, dimension (min(P,N)) */
/* The scalar factors of the elementary reflectors, as returned */
/* by SGGRQF. */
/* WORK (workspace) REAL array, dimension (LWORK) */
/* LWORK (input) INTEGER */
/* The dimension of the array WORK, LWORK >= max(N,M,P)**2. */
/* RWORK (workspace) REAL array, dimension (max(N,M,P)) */
/* RESULT (output) REAL array, dimension (4) */
/* The test ratios: */
/* RESULT(1) = norm( R - Q'*A ) / ( MAX(M,N)*norm(A)*ULP) */
/* RESULT(2) = norm( T*Z - Q'*B ) / (MAX(P,N)*norm(B)*ULP) */
/* RESULT(3) = norm( I - Q'*Q ) / ( M*ULP ) */
/* RESULT(4) = norm( I - Z'*Z ) / ( P*ULP ) */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
r_dim1 = *lda;
r_offset = 1 + r_dim1;
r__ -= r_offset;
q_dim1 = *lda;
q_offset = 1 + q_dim1;
q -= q_offset;
af_dim1 = *lda;
af_offset = 1 + af_dim1;
af -= af_offset;
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--taua;
bwk_dim1 = *ldb;
bwk_offset = 1 + bwk_dim1;
bwk -= bwk_offset;
t_dim1 = *ldb;
t_offset = 1 + t_dim1;
t -= t_offset;
z_dim1 = *ldb;
z_offset = 1 + z_dim1;
z__ -= z_offset;
bf_dim1 = *ldb;
bf_offset = 1 + bf_dim1;
bf -= bf_offset;
b_dim1 = *ldb;
b_offset = 1 + b_dim1;
b -= b_offset;
--taub;
--work;
--rwork;
--result;
/* Function Body */
ulp = slamch_("Precision");
unfl = slamch_("Safe minimum");
/* Copy the matrix A to the array AF. */
slacpy_("Full", n, m, &a[a_offset], lda, &af[af_offset], lda);
slacpy_("Full", n, p, &b[b_offset], ldb, &bf[bf_offset], ldb);
/* Computing MAX */
r__1 = slange_("1", n, m, &a[a_offset], lda, &rwork[1]);
anorm = dmax(r__1,unfl);
/* Computing MAX */
r__1 = slange_("1", n, p, &b[b_offset], ldb, &rwork[1]);
bnorm = dmax(r__1,unfl);
/* Factorize the matrices A and B in the arrays AF and BF. */
sggqrf_(n, m, p, &af[af_offset], lda, &taua[1], &bf[bf_offset], ldb, &
taub[1], &work[1], lwork, &info);
/* Generate the N-by-N matrix Q */
slaset_("Full", n, n, &c_b9, &c_b9, &q[q_offset], lda);
i__1 = *n - 1;
slacpy_("Lower", &i__1, m, &af[af_dim1 + 2], lda, &q[q_dim1 + 2], lda);
i__1 = min(*n,*m);
sorgqr_(n, n, &i__1, &q[q_offset], lda, &taua[1], &work[1], lwork, &info);
/* Generate the P-by-P matrix Z */
slaset_("Full", p, p, &c_b9, &c_b9, &z__[z_offset], ldb);
if (*n <= *p) {
if (*n > 0 && *n < *p) {
i__1 = *p - *n;
slacpy_("Full", n, &i__1, &bf[bf_offset], ldb, &z__[*p - *n + 1 +
z_dim1], ldb);
}
if (*n > 1) {
i__1 = *n - 1;
i__2 = *n - 1;
slacpy_("Lower", &i__1, &i__2, &bf[(*p - *n + 1) * bf_dim1 + 2],
ldb, &z__[*p - *n + 2 + (*p - *n + 1) * z_dim1], ldb);
}
} else {
if (*p > 1) {
i__1 = *p - 1;
i__2 = *p - 1;
slacpy_("Lower", &i__1, &i__2, &bf[*n - *p + 2 + bf_dim1], ldb, &
z__[z_dim1 + 2], ldb);
}
}
i__1 = min(*n,*p);
sorgrq_(p, p, &i__1, &z__[z_offset], ldb, &taub[1], &work[1], lwork, &
info);
/* Copy R */
slaset_("Full", n, m, &c_b19, &c_b19, &r__[r_offset], lda);
slacpy_("Upper", n, m, &af[af_offset], lda, &r__[r_offset], lda);
/* Copy T */
slaset_("Full", n, p, &c_b19, &c_b19, &t[t_offset], ldb);
if (*n <= *p) {
slacpy_("Upper", n, n, &bf[(*p - *n + 1) * bf_dim1 + 1], ldb, &t[(*p
- *n + 1) * t_dim1 + 1], ldb);
} else {
i__1 = *n - *p;
slacpy_("Full", &i__1, p, &bf[bf_offset], ldb, &t[t_offset], ldb);
slacpy_("Upper", p, p, &bf[*n - *p + 1 + bf_dim1], ldb, &t[*n - *p +
1 + t_dim1], ldb);
}
/* Compute R - Q'*A */
sgemm_("Transpose", "No transpose", n, m, n, &c_b30, &q[q_offset], lda, &
a[a_offset], lda, &c_b31, &r__[r_offset], lda);
/* Compute norm( R - Q'*A ) / ( MAX(M,N)*norm(A)*ULP ) . */
resid = slange_("1", n, m, &r__[r_offset], lda, &rwork[1]);
if (anorm > 0.f) {
/* Computing MAX */
i__1 = max(1,*m);
result[1] = resid / (real) max(i__1,*n) / anorm / ulp;
} else {
result[1] = 0.f;
}
/* Compute T*Z - Q'*B */
sgemm_("No Transpose", "No transpose", n, p, p, &c_b31, &t[t_offset], ldb,
&z__[z_offset], ldb, &c_b19, &bwk[bwk_offset], ldb);
sgemm_("Transpose", "No transpose", n, p, n, &c_b30, &q[q_offset], lda, &
b[b_offset], ldb, &c_b31, &bwk[bwk_offset], ldb);
/* Compute norm( T*Z - Q'*B ) / ( MAX(P,N)*norm(A)*ULP ) . */
resid = slange_("1", n, p, &bwk[bwk_offset], ldb, &rwork[1]);
if (bnorm > 0.f) {
/* Computing MAX */
i__1 = max(1,*p);
result[2] = resid / (real) max(i__1,*n) / bnorm / ulp;
} else {
result[2] = 0.f;
}
/* Compute I - Q'*Q */
slaset_("Full", n, n, &c_b19, &c_b31, &r__[r_offset], lda);
ssyrk_("Upper", "Transpose", n, n, &c_b30, &q[q_offset], lda, &c_b31, &
r__[r_offset], lda);
/* Compute norm( I - Q'*Q ) / ( N * ULP ) . */
resid = slansy_("1", "Upper", n, &r__[r_offset], lda, &rwork[1]);
result[3] = resid / (real) max(1,*n) / ulp;
/* Compute I - Z'*Z */
slaset_("Full", p, p, &c_b19, &c_b31, &t[t_offset], ldb);
ssyrk_("Upper", "Transpose", p, p, &c_b30, &z__[z_offset], ldb, &c_b31, &
t[t_offset], ldb);
/* Compute norm( I - Z'*Z ) / ( P*ULP ) . */
resid = slansy_("1", "Upper", p, &t[t_offset], ldb, &rwork[1]);
result[4] = resid / (real) max(1,*p) / ulp;
return 0;
/* End of SGQRTS */
} /* sgqrts_ */
/* Subroutine */ int sggglm_(integer *n, integer *m, integer *p, real *a,
integer *lda, real *b, integer *ldb, real *d__, real *x, real *y,
real *work, integer *lwork, integer *info)
{
/* -- LAPACK driver 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
=======
SGGGLM solves a general Gauss-Markov linear model (GLM) problem:
minimize || y ||_2 subject to d = A*x + B*y
x
where A is an N-by-M matrix, B is an N-by-P matrix, and d is a
given N-vector. It is assumed that M <= N <= M+P, and
rank(A) = M and rank( A B ) = N.
Under these assumptions, the constrained equation is always
consistent, and there is a unique solution x and a minimal 2-norm
solution y, which is obtained using a generalized QR factorization
of A and B.
In particular, if matrix B is square nonsingular, then the problem
GLM is equivalent to the following weighted linear least squares
problem
minimize || inv(B)*(d-A*x) ||_2
x
where inv(B) denotes the inverse of B.
Arguments
=========
N (input) INTEGER
The number of rows of the matrices A and B. N >= 0.
M (input) INTEGER
The number of columns of the matrix A. 0 <= M <= N.
P (input) INTEGER
The number of columns of the matrix B. P >= N-M.
A (input/output) REAL array, dimension (LDA,M)
On entry, the N-by-M matrix A.
On exit, A is destroyed.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
B (input/output) REAL array, dimension (LDB,P)
On entry, the N-by-P matrix B.
On exit, B is destroyed.
LDB (input) INTEGER
The leading dimension of the array B. LDB >= max(1,N).
D (input/output) REAL array, dimension (N)
On entry, D is the left hand side of the GLM equation.
On exit, D is destroyed.
X (output) REAL array, dimension (M)
Y (output) REAL array, dimension (P)
On exit, X and Y are the solutions of the GLM problem.
WORK (workspace/output) REAL array, dimension (LWORK)
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= max(1,N+M+P).
For optimum performance, LWORK >= M+min(N,P)+max(N,P)*NB,
where NB is an upper bound for the optimal blocksizes for
SGEQRF, SGERQF, SORMQR and SORMRQ.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued by XERBLA.
INFO (output) INTEGER
= 0: successful exit.
< 0: if INFO = -i, the i-th argument had an illegal value.
===================================================================
Test the input parameters
Parameter adjustments */
/* Table of constant values */
static integer c__1 = 1;
static integer c_n1 = -1;
static real c_b32 = -1.f;
static real c_b34 = 1.f;
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;
/* Local variables */
static integer lopt, i__;
extern /* Subroutine */ int sgemv_(char *, integer *, integer *, real *,
real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *),
strsv_(char *, char *, char *, integer *, real *, integer *, real
*, integer *);
static integer nb, np;
extern /* Subroutine */ int xerbla_(char *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *, ftnlen, ftnlen);
extern /* Subroutine */ int sggqrf_(integer *, integer *, integer *, real
*, integer *, real *, real *, integer *, real *, real *, integer *
, integer *);
static integer nb1, nb2, nb3, nb4, lwkopt;
static logical lquery;
extern /* Subroutine */ int sormqr_(char *, char *, integer *, integer *,
integer *, real *, integer *, real *, real *, integer *, real *,
integer *, integer *), sormrq_(char *, char *,
integer *, integer *, integer *, real *, integer *, real *, real *
, integer *, real *, integer *, integer *);
#define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]
a_dim1 = *lda;
a_offset = 1 + a_dim1 * 1;
a -= a_offset;
b_dim1 = *ldb;
b_offset = 1 + b_dim1 * 1;
b -= b_offset;
--d__;
--x;
--y;
--work;
/* Function Body */
*info = 0;
np = min(*n,*p);
nb1 = ilaenv_(&c__1, "SGEQRF", " ", n, m, &c_n1, &c_n1, (ftnlen)6, (
ftnlen)1);
nb2 = ilaenv_(&c__1, "SGERQF", " ", n, m, &c_n1, &c_n1, (ftnlen)6, (
ftnlen)1);
nb3 = ilaenv_(&c__1, "SORMQR", " ", n, m, p, &c_n1, (ftnlen)6, (ftnlen)1);
nb4 = ilaenv_(&c__1, "SORMRQ", " ", n, m, p, &c_n1, (ftnlen)6, (ftnlen)1);
/* Computing MAX */
i__1 = max(nb1,nb2), i__1 = max(i__1,nb3);
nb = max(i__1,nb4);
lwkopt = *m + np + max(*n,*p) * nb;
work[1] = (real) lwkopt;
lquery = *lwork == -1;
if (*n < 0) {
*info = -1;
} else if (*m < 0 || *m > *n) {
*info = -2;
} else if (*p < 0 || *p < *n - *m) {
*info = -3;
} else if (*lda < max(1,*n)) {
*info = -5;
} else if (*ldb < max(1,*n)) {
*info = -7;
} else /* if(complicated condition) */ {
/* Computing MAX */
i__1 = 1, i__2 = *n + *m + *p;
if (*lwork < max(i__1,i__2) && ! lquery) {
*info = -12;
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("SGGGLM", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
/* Compute the GQR factorization of matrices A and B:
Q'*A = ( R11 ) M, Q'*B*Z' = ( T11 T12 ) M
( 0 ) N-M ( 0 T22 ) N-M
M M+P-N N-M
where R11 and T22 are upper triangular, and Q and Z are
orthogonal. */
i__1 = *lwork - *m - np;
sggqrf_(n, m, p, &a[a_offset], lda, &work[1], &b[b_offset], ldb, &work[*m
+ 1], &work[*m + np + 1], &i__1, info);
lopt = work[*m + np + 1];
/* Update left-hand-side vector d = Q'*d = ( d1 ) M
( d2 ) N-M */
i__1 = max(1,*n);
i__2 = *lwork - *m - np;
sormqr_("Left", "Transpose", n, &c__1, m, &a[a_offset], lda, &work[1], &
d__[1], &i__1, &work[*m + np + 1], &i__2, info);
/* Computing MAX */
i__1 = lopt, i__2 = (integer) work[*m + np + 1];
lopt = max(i__1,i__2);
/* Solve T22*y2 = d2 for y2 */
i__1 = *n - *m;
strsv_("Upper", "No transpose", "Non unit", &i__1, &b_ref(*m + 1, *m + *p
- *n + 1), ldb, &d__[*m + 1], &c__1);
i__1 = *n - *m;
scopy_(&i__1, &d__[*m + 1], &c__1, &y[*m + *p - *n + 1], &c__1);
/* Set y1 = 0 */
i__1 = *m + *p - *n;
for (i__ = 1; i__ <= i__1; ++i__) {
y[i__] = 0.f;
/* L10: */
}
/* Update d1 = d1 - T12*y2 */
i__1 = *n - *m;
sgemv_("No transpose", m, &i__1, &c_b32, &b_ref(1, *m + *p - *n + 1), ldb,
&y[*m + *p - *n + 1], &c__1, &c_b34, &d__[1], &c__1);
/* Solve triangular system: R11*x = d1 */
strsv_("Upper", "No Transpose", "Non unit", m, &a[a_offset], lda, &d__[1],
&c__1);
/* Copy D to X */
scopy_(m, &d__[1], &c__1, &x[1], &c__1);
/* Backward transformation y = Z'*y
Computing MAX */
i__1 = 1, i__2 = *n - *p + 1;
i__3 = max(1,*p);
i__4 = *lwork - *m - np;
sormrq_("Left", "Transpose", p, &c__1, &np, &b_ref(max(i__1,i__2), 1),
ldb, &work[*m + 1], &y[1], &i__3, &work[*m + np + 1], &i__4, info);
/* Computing MAX */
i__1 = lopt, i__2 = (integer) work[*m + np + 1];
work[1] = (real) (*m + np + max(i__1,i__2));
return 0;
/* End of SGGGLM */
} /* sggglm_ */
