/* Subroutine */ int stgsen_(integer *ijob, logical *wantq, logical *wantz,
logical *select, integer *n, real *a, integer *lda, real *b, integer *
ldb, real *alphar, real *alphai, real *beta, real *q, integer *ldq,
real *z__, integer *ldz, integer *m, real *pl, real *pr, real *dif,
real *work, integer *lwork, integer *iwork, integer *liwork, integer *
info)
{
/* -- LAPACK 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
=======
STGSEN reorders the generalized real Schur decomposition of a real
matrix pair (A, B) (in terms of an orthonormal equivalence trans-
formation Q' * (A, B) * Z), so that a selected cluster of eigenvalues
appears in the leading diagonal blocks of the upper quasi-triangular
matrix A and the upper triangular B. The leading columns of Q and
Z form orthonormal bases of the corresponding left and right eigen-
spaces (deflating subspaces). (A, B) must be in generalized real
Schur canonical form (as returned by SGGES), i.e. A is block upper
triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper
triangular.
STGSEN also computes the generalized eigenvalues
w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j)
of the reordered matrix pair (A, B).
Optionally, STGSEN computes the estimates of reciprocal condition
numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
(A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
between the matrix pairs (A11, B11) and (A22,B22) that correspond to
the selected cluster and the eigenvalues outside the cluster, resp.,
and norms of "projections" onto left and right eigenspaces w.r.t.
the selected cluster in the (1,1)-block.
Arguments
=========
IJOB (input) INTEGER
Specifies whether condition numbers are required for the
cluster of eigenvalues (PL and PR) or the deflating subspaces
(Difu and Difl):
=0: Only reorder w.r.t. SELECT. No extras.
=1: Reciprocal of norms of "projections" onto left and right
eigenspaces w.r.t. the selected cluster (PL and PR).
=2: Upper bounds on Difu and Difl. F-norm-based estimate
(DIF(1:2)).
=3: Estimate of Difu and Difl. 1-norm-based estimate
(DIF(1:2)).
About 5 times as expensive as IJOB = 2.
=4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
version to get it all.
=5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
WANTQ (input) LOGICAL
.TRUE. : update the left transformation matrix Q;
.FALSE.: do not update Q.
WANTZ (input) LOGICAL
.TRUE. : update the right transformation matrix Z;
.FALSE.: do not update Z.
SELECT (input) LOGICAL array, dimension (N)
SELECT specifies the eigenvalues in the selected cluster.
To select a real eigenvalue w(j), SELECT(j) must be set to
.TRUE.. To select a complex conjugate pair of eigenvalues
w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
either SELECT(j) or SELECT(j+1) or both must be set to
.TRUE.; a complex conjugate pair of eigenvalues must be
either both included in the cluster or both excluded.
N (input) INTEGER
The order of the matrices A and B. N >= 0.
A (input/output) REAL array, dimension(LDA,N)
On entry, the upper quasi-triangular matrix A, with (A, B) in
generalized real Schur canonical form.
On exit, A is overwritten by the reordered matrix A.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
B (input/output) REAL array, dimension(LDB,N)
On entry, the upper triangular matrix B, with (A, B) in
generalized real Schur canonical form.
On exit, B is overwritten by the reordered matrix B.
LDB (input) INTEGER
The leading dimension of the array B. LDB >= max(1,N).
ALPHAR (output) REAL array, dimension (N)
ALPHAI (output) REAL array, dimension (N)
BETA (output) REAL array, dimension (N)
On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
and BETA(j),j=1,...,N are the diagonals of the complex Schur
form (S,T) that would result if the 2-by-2 diagonal blocks of
the real generalized Schur form of (A,B) were further reduced
to triangular form using complex unitary transformations.
If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
positive, then the j-th and (j+1)-st eigenvalues are a
complex conjugate pair, with ALPHAI(j+1) negative.
Q (input/output) REAL array, dimension (LDQ,N)
On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
On exit, Q has been postmultiplied by the left orthogonal
transformation matrix which reorder (A, B); The leading M
columns of Q form orthonormal bases for the specified pair of
left eigenspaces (deflating subspaces).
If WANTQ = .FALSE., Q is not referenced.
LDQ (input) INTEGER
The leading dimension of the array Q. LDQ >= 1;
and if WANTQ = .TRUE., LDQ >= N.
Z (input/output) REAL array, dimension (LDZ,N)
On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
On exit, Z has been postmultiplied by the left orthogonal
transformation matrix which reorder (A, B); The leading M
columns of Z form orthonormal bases for the specified pair of
left eigenspaces (deflating subspaces).
If WANTZ = .FALSE., Z is not referenced.
LDZ (input) INTEGER
The leading dimension of the array Z. LDZ >= 1;
If WANTZ = .TRUE., LDZ >= N.
M (output) INTEGER
The dimension of the specified pair of left and right eigen-
spaces (deflating subspaces). 0 <= M <= N.
PL, PR (output) REAL
If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
reciprocal of the norm of "projections" onto left and right
eigenspaces with respect to the selected cluster.
0 < PL, PR <= 1.
If M = 0 or M = N, PL = PR = 1.
If IJOB = 0, 2 or 3, PL and PR are not referenced.
DIF (output) REAL array, dimension (2).
If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl.
If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
estimates of Difu and Difl.
If M = 0 or N, DIF(1:2) = F-norm([A, B]).
If IJOB = 0 or 1, DIF is not referenced.
WORK (workspace/output) REAL array, dimension (LWORK)
IF IJOB = 0, WORK is not referenced. Otherwise,
on exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= 4*N+16.
If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)).
If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)).
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.
IWORK (workspace/output) INTEGER array, dimension (LIWORK)
IF IJOB = 0, IWORK is not referenced. Otherwise,
on exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
LIWORK (input) INTEGER
The dimension of the array IWORK. LIWORK >= 1.
If IJOB = 1, 2 or 4, LIWORK >= N+6.
If IJOB = 3 or 5, LIWORK >= MAX(2*M*(N-M), N+6).
If LIWORK = -1, then a workspace query is assumed; the
routine only calculates the optimal size of the IWORK array,
returns this value as the first entry of the IWORK array, and
no error message related to LIWORK is issued by XERBLA.
INFO (output) INTEGER
=0: Successful exit.
<0: If INFO = -i, the i-th argument had an illegal value.
=1: Reordering of (A, B) failed because the transformed
matrix pair (A, B) would be too far from generalized
Schur form; the problem is very ill-conditioned.
(A, B) may have been partially reordered.
If requested, 0 is returned in DIF(*), PL and PR.
Further Details
===============
STGSEN first collects the selected eigenvalues by computing
orthogonal U and W that move them to the top left corner of (A, B).
In other words, the selected eigenvalues are the eigenvalues of
(A11, B11) in:
U'*(A, B)*W = (A11 A12) (B11 B12) n1
( 0 A22),( 0 B22) n2
n1 n2 n1 n2
where N = n1+n2 and U' means the transpose of U. The first n1 columns
of U and W span the specified pair of left and right eigenspaces
(deflating subspaces) of (A, B).
If (A, B) has been obtained from the generalized real Schur
decomposition of a matrix pair (C, D) = Q*(A, B)*Z', then the
reordered generalized real Schur form of (C, D) is given by
(C, D) = (Q*U)*(U'*(A, B)*W)*(Z*W)',
and the first n1 columns of Q*U and Z*W span the corresponding
deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
Note that if the selected eigenvalue is sufficiently ill-conditioned,
then its value may differ significantly from its value before
reordering.
The reciprocal condition numbers of the left and right eigenspaces
spanned by the first n1 columns of U and W (or Q*U and Z*W) may
be returned in DIF(1:2), corresponding to Difu and Difl, resp.
The Difu and Difl are defined as:
Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
and
Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
where sigma-min(Zu) is the smallest singular value of the
(2*n1*n2)-by-(2*n1*n2) matrix
Zu = [ kron(In2, A11) -kron(A22', In1) ]
[ kron(In2, B11) -kron(B22', In1) ].
Here, Inx is the identity matrix of size nx and A22' is the
transpose of A22. kron(X, Y) is the Kronecker product between
the matrices X and Y.
When DIF(2) is small, small changes in (A, B) can cause large changes
in the deflating subspace. An approximate (asymptotic) bound on the
maximum angular error in the computed deflating subspaces is
EPS * norm((A, B)) / DIF(2),
where EPS is the machine precision.
The reciprocal norm of the projectors on the left and right
eigenspaces associated with (A11, B11) may be returned in PL and PR.
They are computed as follows. First we compute L and R so that
P*(A, B)*Q is block diagonal, where
P = ( I -L ) n1 Q = ( I R ) n1
( 0 I ) n2 and ( 0 I ) n2
n1 n2 n1 n2
and (L, R) is the solution to the generalized Sylvester equation
A11*R - L*A22 = -A12
B11*R - L*B22 = -B12
Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
An approximate (asymptotic) bound on the average absolute error of
the selected eigenvalues is
EPS * norm((A, B)) / PL.
There are also global error bounds which valid for perturbations up
to a certain restriction: A lower bound (x) on the smallest
F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
(i.e. (A + E, B + F), is
x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
An approximate bound on x can be computed from DIF(1:2), PL and PR.
If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed
(L', R') and unperturbed (L, R) left and right deflating subspaces
associated with the selected cluster in the (1,1)-blocks can be
bounded as
max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
See LAPACK User's Guide section 4.11 or the following references
for more information.
Note that if the default method for computing the Frobenius-norm-
based estimate DIF is not wanted (see SLATDF), then the parameter
IDIFJB (see below) should be changed from 3 to 4 (routine SLATDF
(IJOB = 2 will be used)). See STGSYL for more details.
Based on contributions by
Bo Kagstrom and Peter Poromaa, Department of Computing Science,
Umea University, S-901 87 Umea, Sweden.
References
==========
[1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
M.S. Moonen et al (eds), Linear Algebra for Large Scale and
Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
[2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
Eigenvalues of a Regular Matrix Pair (A, B) and Condition
Estimation: Theory, Algorithms and Software,
Report UMINF - 94.04, Department of Computing Science, Umea
University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
Note 87. To appear in Numerical Algorithms, 1996.
[3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
for Solving the Generalized Sylvester Equation and Estimating the
Separation between Regular Matrix Pairs, Report UMINF - 93.23,
Department of Computing Science, Umea University, S-901 87 Umea,
Sweden, December 1993, Revised April 1994, Also as LAPACK Working
Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
1996.
=====================================================================
Decode and test the input parameters
Parameter adjustments */
/* Table of constant values */
static integer c__1 = 1;
static integer c__2 = 2;
static real c_b28 = 1.f;
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, z_dim1,
z_offset, i__1, i__2;
real r__1;
/* Builtin functions */
double sqrt(doublereal), r_sign(real *, real *);
/* Local variables */
static integer kase;
static logical pair;
static integer ierr;
static real dsum;
static logical swap;
extern /* Subroutine */ int slag2_(real *, integer *, real *, integer *,
real *, real *, real *, real *, real *, real *);
static integer i__, k;
static logical wantd;
static integer lwmin;
static logical wantp;
static integer n1, n2;
static logical wantd1, wantd2;
static integer kk;
static real dscale;
static integer ks;
static real rdscal;
extern doublereal slamch_(char *);
extern /* Subroutine */ int xerbla_(char *, integer *), slacon_(
integer *, real *, real *, integer *, real *, integer *), slacpy_(
char *, integer *, integer *, real *, integer *, real *, integer *
), stgexc_(logical *, logical *, integer *, real *,
integer *, real *, integer *, real *, integer *, real *, integer *
, integer *, integer *, real *, integer *, integer *);
static integer liwmin;
extern /* Subroutine */ int slassq_(integer *, real *, integer *, real *,
real *);
static real smlnum;
static integer mn2;
static logical lquery;
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 *);
static integer ijb;
static real eps;
#define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
#define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]
#define q_ref(a_1,a_2) q[(a_2)*q_dim1 + a_1]
--select;
a_dim1 = *lda;
a_offset = 1 + a_dim1 * 1;
a -= a_offset;
b_dim1 = *ldb;
b_offset = 1 + b_dim1 * 1;
b -= b_offset;
--alphar;
--alphai;
--beta;
q_dim1 = *ldq;
q_offset = 1 + q_dim1 * 1;
q -= q_offset;
z_dim1 = *ldz;
z_offset = 1 + z_dim1 * 1;
z__ -= z_offset;
--dif;
--work;
--iwork;
/* Function Body */
*info = 0;
lquery = *lwork == -1 || *liwork == -1;
if (*ijob < 0 || *ijob > 5) {
*info = -1;
} else if (*n < 0) {
*info = -5;
} else if (*lda < max(1,*n)) {
*info = -7;
} else if (*ldb < max(1,*n)) {
*info = -9;
} else if (*ldq < 1 || *wantq && *ldq < *n) {
*info = -14;
} else if (*ldz < 1 || *wantz && *ldz < *n) {
*info = -16;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("STGSEN", &i__1);
return 0;
}
/* Get machine constants */
eps = slamch_("P");
smlnum = slamch_("S") / eps;
ierr = 0;
wantp = *ijob == 1 || *ijob >= 4;
wantd1 = *ijob == 2 || *ijob == 4;
wantd2 = *ijob == 3 || *ijob == 5;
wantd = wantd1 || wantd2;
/* Set M to the dimension of the specified pair of deflating
subspaces. */
*m = 0;
pair = FALSE_;
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
if (pair) {
pair = FALSE_;
} else {
if (k < *n) {
if (a_ref(k + 1, k) == 0.f) {
if (select[k]) {
++(*m);
}
} else {
pair = TRUE_;
if (select[k] || select[k + 1]) {
*m += 2;
}
}
} else {
if (select[*n]) {
++(*m);
}
}
}
/* L10: */
}
if (*ijob == 1 || *ijob == 2 || *ijob == 4) {
/* Computing MAX */
i__1 = 1, i__2 = (*n << 2) + 16, i__1 = max(i__1,i__2), i__2 = (*m <<
1) * (*n - *m);
lwmin = max(i__1,i__2);
/* Computing MAX */
i__1 = 1, i__2 = *n + 6;
liwmin = max(i__1,i__2);
} else if (*ijob == 3 || *ijob == 5) {
/* Computing MAX */
i__1 = 1, i__2 = (*n << 2) + 16, i__1 = max(i__1,i__2), i__2 = (*m <<
2) * (*n - *m);
lwmin = max(i__1,i__2);
/* Computing MAX */
i__1 = 1, i__2 = (*m << 1) * (*n - *m), i__1 = max(i__1,i__2), i__2 =
*n + 6;
liwmin = max(i__1,i__2);
} else {
/* Computing MAX */
i__1 = 1, i__2 = (*n << 2) + 16;
lwmin = max(i__1,i__2);
liwmin = 1;
}
work[1] = (real) lwmin;
iwork[1] = liwmin;
if (*lwork < lwmin && ! lquery) {
*info = -22;
} else if (*liwork < liwmin && ! lquery) {
*info = -24;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("STGSEN", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible. */
if (*m == *n || *m == 0) {
if (wantp) {
*pl = 1.f;
*pr = 1.f;
}
if (wantd) {
dscale = 0.f;
dsum = 1.f;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
slassq_(n, &a_ref(1, i__), &c__1, &dscale, &dsum);
slassq_(n, &b_ref(1, i__), &c__1, &dscale, &dsum);
/* L20: */
}
dif[1] = dscale * sqrt(dsum);
dif[2] = dif[1];
}
goto L60;
}
/* Collect the selected blocks at the top-left corner of (A, B). */
ks = 0;
pair = FALSE_;
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
if (pair) {
pair = FALSE_;
} else {
swap = select[k];
if (k < *n) {
if (a_ref(k + 1, k) != 0.f) {
pair = TRUE_;
swap = swap || select[k + 1];
}
}
if (swap) {
++ks;
/* Swap the K-th block to position KS.
Perform the reordering of diagonal blocks in (A, B)
by orthogonal transformation matrices and update
Q and Z accordingly (if requested): */
kk = k;
if (k != ks) {
stgexc_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset],
ldb, &q[q_offset], ldq, &z__[z_offset], ldz, &kk,
&ks, &work[1], lwork, &ierr);
}
if (ierr > 0) {
/* Swap is rejected: exit. */
*info = 1;
if (wantp) {
*pl = 0.f;
*pr = 0.f;
}
if (wantd) {
dif[1] = 0.f;
dif[2] = 0.f;
}
goto L60;
}
if (pair) {
++ks;
}
}
}
/* L30: */
}
if (wantp) {
/* Solve generalized Sylvester equation for R and L
and compute PL and PR. */
n1 = *m;
n2 = *n - *m;
i__ = n1 + 1;
ijb = 0;
slacpy_("Full", &n1, &n2, &a_ref(1, i__), lda, &work[1], &n1);
slacpy_("Full", &n1, &n2, &b_ref(1, i__), ldb, &work[n1 * n2 + 1], &
n1);
i__1 = *lwork - (n1 << 1) * n2;
stgsyl_("N", &ijb, &n1, &n2, &a[a_offset], lda, &a_ref(i__, i__), lda,
&work[1], &n1, &b[b_offset], ldb, &b_ref(i__, i__), ldb, &
work[n1 * n2 + 1], &n1, &dscale, &dif[1], &work[(n1 * n2 << 1)
+ 1], &i__1, &iwork[1], &ierr);
/* Estimate the reciprocal of norms of "projections" onto left
and right eigenspaces. */
rdscal = 0.f;
dsum = 1.f;
i__1 = n1 * n2;
slassq_(&i__1, &work[1], &c__1, &rdscal, &dsum);
*pl = rdscal * sqrt(dsum);
if (*pl == 0.f) {
*pl = 1.f;
} else {
*pl = dscale / (sqrt(dscale * dscale / *pl + *pl) * sqrt(*pl));
}
rdscal = 0.f;
dsum = 1.f;
i__1 = n1 * n2;
slassq_(&i__1, &work[n1 * n2 + 1], &c__1, &rdscal, &dsum);
*pr = rdscal * sqrt(dsum);
if (*pr == 0.f) {
*pr = 1.f;
} else {
*pr = dscale / (sqrt(dscale * dscale / *pr + *pr) * sqrt(*pr));
}
}
if (wantd) {
/* Compute estimates of Difu and Difl. */
if (wantd1) {
n1 = *m;
n2 = *n - *m;
i__ = n1 + 1;
ijb = 3;
/* Frobenius norm-based Difu-estimate. */
i__1 = *lwork - (n1 << 1) * n2;
stgsyl_("N", &ijb, &n1, &n2, &a[a_offset], lda, &a_ref(i__, i__),
lda, &work[1], &n1, &b[b_offset], ldb, &b_ref(i__, i__),
ldb, &work[n1 * n2 + 1], &n1, &dscale, &dif[1], &work[(n1
<< 1) * n2 + 1], &i__1, &iwork[1], &ierr);
/* Frobenius norm-based Difl-estimate. */
i__1 = *lwork - (n1 << 1) * n2;
stgsyl_("N", &ijb, &n2, &n1, &a_ref(i__, i__), lda, &a[a_offset],
lda, &work[1], &n2, &b_ref(i__, i__), ldb, &b[b_offset],
ldb, &work[n1 * n2 + 1], &n2, &dscale, &dif[2], &work[(n1
<< 1) * n2 + 1], &i__1, &iwork[1], &ierr);
} else {
/* Compute 1-norm-based estimates of Difu and Difl using
reversed communication with SLACON. In each step a
generalized Sylvester equation or a transposed variant
is solved. */
kase = 0;
n1 = *m;
n2 = *n - *m;
i__ = n1 + 1;
ijb = 0;
mn2 = (n1 << 1) * n2;
/* 1-norm-based estimate of Difu. */
L40:
slacon_(&mn2, &work[mn2 + 1], &work[1], &iwork[1], &dif[1], &kase)
;
if (kase != 0) {
if (kase == 1) {
/* Solve generalized Sylvester equation. */
i__1 = *lwork - (n1 << 1) * n2;
stgsyl_("N", &ijb, &n1, &n2, &a[a_offset], lda, &a_ref(
i__, i__), lda, &work[1], &n1, &b[b_offset], ldb,
&b_ref(i__, i__), ldb, &work[n1 * n2 + 1], &n1, &
dscale, &dif[1], &work[(n1 << 1) * n2 + 1], &i__1,
&iwork[1], &ierr);
} else {
/* Solve the transposed variant. */
i__1 = *lwork - (n1 << 1) * n2;
stgsyl_("T", &ijb, &n1, &n2, &a[a_offset], lda, &a_ref(
i__, i__), lda, &work[1], &n1, &b[b_offset], ldb,
&b_ref(i__, i__), ldb, &work[n1 * n2 + 1], &n1, &
dscale, &dif[1], &work[(n1 << 1) * n2 + 1], &i__1,
&iwork[1], &ierr);
}
goto L40;
}
dif[1] = dscale / dif[1];
/* 1-norm-based estimate of Difl. */
L50:
slacon_(&mn2, &work[mn2 + 1], &work[1], &iwork[1], &dif[2], &kase)
;
if (kase != 0) {
if (kase == 1) {
/* Solve generalized Sylvester equation. */
i__1 = *lwork - (n1 << 1) * n2;
stgsyl_("N", &ijb, &n2, &n1, &a_ref(i__, i__), lda, &a[
a_offset], lda, &work[1], &n2, &b_ref(i__, i__),
ldb, &b[b_offset], ldb, &work[n1 * n2 + 1], &n2, &
dscale, &dif[2], &work[(n1 << 1) * n2 + 1], &i__1,
&iwork[1], &ierr);
} else {
/* Solve the transposed variant. */
i__1 = *lwork - (n1 << 1) * n2;
stgsyl_("T", &ijb, &n2, &n1, &a_ref(i__, i__), lda, &a[
a_offset], lda, &work[1], &n2, &b_ref(i__, i__),
ldb, &b[b_offset], ldb, &work[n1 * n2 + 1], &n2, &
dscale, &dif[2], &work[(n1 << 1) * n2 + 1], &i__1,
&iwork[1], &ierr);
}
goto L50;
}
dif[2] = dscale / dif[2];
}
}
L60:
/* Compute generalized eigenvalues of reordered pair (A, B) and
normalize the generalized Schur form. */
pair = FALSE_;
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
if (pair) {
pair = FALSE_;
} else {
if (k < *n) {
if (a_ref(k + 1, k) != 0.f) {
pair = TRUE_;
}
}
if (pair) {
/* Compute the eigenvalue(s) at position K. */
work[1] = a_ref(k, k);
work[2] = a_ref(k + 1, k);
work[3] = a_ref(k, k + 1);
work[4] = a_ref(k + 1, k + 1);
work[5] = b_ref(k, k);
work[6] = b_ref(k + 1, k);
work[7] = b_ref(k, k + 1);
work[8] = b_ref(k + 1, k + 1);
r__1 = smlnum * eps;
slag2_(&work[1], &c__2, &work[5], &c__2, &r__1, &beta[k], &
beta[k + 1], &alphar[k], &alphar[k + 1], &alphai[k]);
alphai[k + 1] = -alphai[k];
} else {
if (r_sign(&c_b28, &b_ref(k, k)) < 0.f) {
/* If B(K,K) is negative, make it positive */
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
a_ref(k, i__) = -a_ref(k, i__);
b_ref(k, i__) = -b_ref(k, i__);
q_ref(i__, k) = -q_ref(i__, k);
/* L80: */
}
}
alphar[k] = a_ref(k, k);
alphai[k] = 0.f;
beta[k] = b_ref(k, k);
}
}
/* L70: */
}
work[1] = (real) lwmin;
iwork[1] = liwmin;
return 0;
/* End of STGSEN */
} /* stgsen_ */
/* Subroutine */ int stgsna_(char *job, char *howmny, logical *select,
integer *n, real *a, integer *lda, real *b, integer *ldb, real *vl,
integer *ldvl, real *vr, integer *ldvr, real *s, real *dif, integer *
mm, integer *m, real *work, integer *lwork, integer *iwork, integer *
info)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, vl_dim1, vl_offset, vr_dim1,
vr_offset, i__1, i__2;
real r__1, r__2;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
integer i__, k;
real c1, c2;
integer n1, n2, ks, iz;
real eps, beta, cond;
logical pair;
integer ierr;
real uhav, uhbv;
integer ifst;
real lnrm;
extern doublereal sdot_(integer *, real *, integer *, real *, integer *);
integer ilst;
real rnrm;
extern /* Subroutine */ int slag2_(real *, integer *, real *, integer *,
real *, real *, real *, real *, real *, real *);
extern doublereal snrm2_(integer *, real *, integer *);
real root1, root2, scale;
extern logical lsame_(char *, char *);
real uhavi, uhbvi;
extern /* Subroutine */ int sgemv_(char *, integer *, integer *, real *,
real *, integer *, real *, integer *, real *, real *, integer *);
real tmpii;
integer lwmin;
logical wants;
real tmpir, tmpri, dummy[1], tmprr;
extern doublereal slapy2_(real *, real *);
real dummy1[1], alphai, alphar;
extern doublereal slamch_(char *);
extern /* Subroutine */ int xerbla_(char *, integer *);
logical wantbh, wantdf;
extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *,
integer *, real *, integer *), stgexc_(logical *, logical
*, integer *, real *, integer *, real *, integer *, real *,
integer *, real *, integer *, integer *, integer *, real *,
integer *, integer *);
logical somcon;
real alprqt, smlnum;
logical lquery;
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 *);
/* -- LAPACK routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* STGSNA estimates reciprocal condition numbers for specified */
/* eigenvalues and/or eigenvectors of a matrix pair (A, B) in */
/* generalized real Schur canonical form (or of any matrix pair */
/* (Q*A*Z', Q*B*Z') with orthogonal matrices Q and Z, where */
/* Z' denotes the transpose of Z. */
/* (A, B) must be in generalized real Schur form (as returned by SGGES), */
/* i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal */
/* blocks. B is upper triangular. */
/* Arguments */
/* ========= */
/* JOB (input) CHARACTER*1 */
/* Specifies whether condition numbers are required for */
/* eigenvalues (S) or eigenvectors (DIF): */
/* = 'E': for eigenvalues only (S); */
/* = 'V': for eigenvectors only (DIF); */
/* = 'B': for both eigenvalues and eigenvectors (S and DIF). */
/* HOWMNY (input) CHARACTER*1 */
/* = 'A': compute condition numbers for all eigenpairs; */
/* = 'S': compute condition numbers for selected eigenpairs */
/* specified by the array SELECT. */
/* SELECT (input) LOGICAL array, dimension (N) */
/* If HOWMNY = 'S', SELECT specifies the eigenpairs for which */
/* condition numbers are required. To select condition numbers */
/* for the eigenpair corresponding to a real eigenvalue w(j), */
/* SELECT(j) must be set to .TRUE.. To select condition numbers */
/* corresponding to a complex conjugate pair of eigenvalues w(j) */
/* and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be */
/* set to .TRUE.. */
/* If HOWMNY = 'A', SELECT is not referenced. */
/* N (input) INTEGER */
/* The order of the square matrix pair (A, B). N >= 0. */
/* A (input) REAL array, dimension (LDA,N) */
/* The upper quasi-triangular matrix A in the pair (A,B). */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,N). */
/* B (input) REAL array, dimension (LDB,N) */
/* The upper triangular matrix B in the pair (A,B). */
/* LDB (input) INTEGER */
/* The leading dimension of the array B. LDB >= max(1,N). */
/* VL (input) REAL array, dimension (LDVL,M) */
/* If JOB = 'E' or 'B', VL must contain left eigenvectors of */
/* (A, B), corresponding to the eigenpairs specified by HOWMNY */
/* and SELECT. The eigenvectors must be stored in consecutive */
/* columns of VL, as returned by STGEVC. */
/* If JOB = 'V', VL is not referenced. */
/* LDVL (input) INTEGER */
/* The leading dimension of the array VL. LDVL >= 1. */
/* If JOB = 'E' or 'B', LDVL >= N. */
/* VR (input) REAL array, dimension (LDVR,M) */
/* If JOB = 'E' or 'B', VR must contain right eigenvectors of */
/* (A, B), corresponding to the eigenpairs specified by HOWMNY */
/* and SELECT. The eigenvectors must be stored in consecutive */
/* columns ov VR, as returned by STGEVC. */
/* If JOB = 'V', VR is not referenced. */
/* LDVR (input) INTEGER */
/* The leading dimension of the array VR. LDVR >= 1. */
/* If JOB = 'E' or 'B', LDVR >= N. */
/* S (output) REAL array, dimension (MM) */
/* If JOB = 'E' or 'B', the reciprocal condition numbers of the */
/* selected eigenvalues, stored in consecutive elements of the */
/* array. For a complex conjugate pair of eigenvalues two */
/* consecutive elements of S are set to the same value. Thus */
/* S(j), DIF(j), and the j-th columns of VL and VR all */
/* correspond to the same eigenpair (but not in general the */
/* j-th eigenpair, unless all eigenpairs are selected). */
/* If JOB = 'V', S is not referenced. */
/* DIF (output) REAL array, dimension (MM) */
/* If JOB = 'V' or 'B', the estimated reciprocal condition */
/* numbers of the selected eigenvectors, stored in consecutive */
/* elements of the array. For a complex eigenvector two */
/* consecutive elements of DIF are set to the same value. If */
/* the eigenvalues cannot be reordered to compute DIF(j), DIF(j) */
/* is set to 0; this can only occur when the true value would be */
/* very small anyway. */
/* If JOB = 'E', DIF is not referenced. */
/* MM (input) INTEGER */
/* The number of elements in the arrays S and DIF. MM >= M. */
/* M (output) INTEGER */
/* The number of elements of the arrays S and DIF used to store */
/* the specified condition numbers; for each selected real */
/* eigenvalue one element is used, and for each selected complex */
/* conjugate pair of eigenvalues, two elements are used. */
/* If HOWMNY = 'A', M is set to N. */
/* 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). */
/* If JOB = 'V' or 'B' LWORK >= 2*N*(N+2)+16. */
/* 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. */
/* IWORK (workspace) INTEGER array, dimension (N + 6) */
/* If JOB = 'E', IWORK is not referenced. */
/* INFO (output) INTEGER */
/* =0: Successful exit */
/* <0: If INFO = -i, the i-th argument had an illegal value */
/* Further Details */
/* =============== */
/* The reciprocal of the condition number of a generalized eigenvalue */
/* w = (a, b) is defined as */
/* S(w) = (|u'Av|**2 + |u'Bv|**2)**(1/2) / (norm(u)*norm(v)) */
/* where u and v are the left and right eigenvectors of (A, B) */
/* corresponding to w; |z| denotes the absolute value of the complex */
/* number, and norm(u) denotes the 2-norm of the vector u. */
/* The pair (a, b) corresponds to an eigenvalue w = a/b (= u'Av/u'Bv) */
/* of the matrix pair (A, B). If both a and b equal zero, then (A B) is */
/* singular and S(I) = -1 is returned. */
/* An approximate error bound on the chordal distance between the i-th */
/* computed generalized eigenvalue w and the corresponding exact */
/* eigenvalue lambda is */
/* chord(w, lambda) <= EPS * norm(A, B) / S(I) */
/* where EPS is the machine precision. */
/* The reciprocal of the condition number DIF(i) of right eigenvector u */
/* and left eigenvector v corresponding to the generalized eigenvalue w */
/* is defined as follows: */
/* a) If the i-th eigenvalue w = (a,b) is real */
/* Suppose U and V are orthogonal transformations such that */
/* U'*(A, B)*V = (S, T) = ( a * ) ( b * ) 1 */
/* ( 0 S22 ),( 0 T22 ) n-1 */
/* 1 n-1 1 n-1 */
/* Then the reciprocal condition number DIF(i) is */
/* Difl((a, b), (S22, T22)) = sigma-min( Zl ), */
/* where sigma-min(Zl) denotes the smallest singular value of the */
/* 2(n-1)-by-2(n-1) matrix */
/* Zl = [ kron(a, In-1) -kron(1, S22) ] */
/* [ kron(b, In-1) -kron(1, T22) ] . */
/* Here In-1 is the identity matrix of size n-1. kron(X, Y) is the */
/* Kronecker product between the matrices X and Y. */
/* Note that if the default method for computing DIF(i) is wanted */
/* (see SLATDF), then the parameter DIFDRI (see below) should be */
/* changed from 3 to 4 (routine SLATDF(IJOB = 2 will be used)). */
/* See STGSYL for more details. */
/* b) If the i-th and (i+1)-th eigenvalues are complex conjugate pair, */
/* Suppose U and V are orthogonal transformations such that */
/* U'*(A, B)*V = (S, T) = ( S11 * ) ( T11 * ) 2 */
/* ( 0 S22 ),( 0 T22) n-2 */
/* 2 n-2 2 n-2 */
/* and (S11, T11) corresponds to the complex conjugate eigenvalue */
/* pair (w, conjg(w)). There exist unitary matrices U1 and V1 such */
/* that */
/* U1'*S11*V1 = ( s11 s12 ) and U1'*T11*V1 = ( t11 t12 ) */
/* ( 0 s22 ) ( 0 t22 ) */
/* where the generalized eigenvalues w = s11/t11 and */
/* conjg(w) = s22/t22. */
/* Then the reciprocal condition number DIF(i) is bounded by */
/* min( d1, max( 1, |real(s11)/real(s22)| )*d2 ) */
/* where, d1 = Difl((s11, t11), (s22, t22)) = sigma-min(Z1), where */
/* Z1 is the complex 2-by-2 matrix */
/* Z1 = [ s11 -s22 ] */
/* [ t11 -t22 ], */
/* This is done by computing (using real arithmetic) the */
/* roots of the characteristical polynomial det(Z1' * Z1 - lambda I), */
/* where Z1' denotes the conjugate transpose of Z1 and det(X) denotes */
/* the determinant of X. */
/* and d2 is an upper bound on Difl((S11, T11), (S22, T22)), i.e. an */
/* upper bound on sigma-min(Z2), where Z2 is (2n-2)-by-(2n-2) */
/* Z2 = [ kron(S11', In-2) -kron(I2, S22) ] */
/* [ kron(T11', In-2) -kron(I2, T22) ] */
/* Note that if the default method for computing DIF is wanted (see */
/* SLATDF), then the parameter DIFDRI (see below) should be changed */
/* from 3 to 4 (routine SLATDF(IJOB = 2 will be used)). See STGSYL */
/* for more details. */
/* For each eigenvalue/vector specified by SELECT, DIF stores a */
/* Frobenius norm-based estimate of Difl. */
/* An approximate error bound for the i-th computed eigenvector VL(i) or */
/* VR(i) is given by */
/* EPS * norm(A, B) / DIF(i). */
/* See ref. [2-3] for more details and further references. */
/* Based on contributions by */
/* Bo Kagstrom and Peter Poromaa, Department of Computing Science, */
/* Umea University, S-901 87 Umea, Sweden. */
/* References */
/* ========== */
/* [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the */
/* Generalized Real Schur Form of a Regular Matrix Pair (A, B), in */
/* M.S. Moonen et al (eds), Linear Algebra for Large Scale and */
/* Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218. */
/* [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified */
/* Eigenvalues of a Regular Matrix Pair (A, B) and Condition */
/* Estimation: Theory, Algorithms and Software, */
/* Report UMINF - 94.04, Department of Computing Science, Umea */
/* University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working */
/* Note 87. To appear in Numerical Algorithms, 1996. */
/* [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software */
/* for Solving the Generalized Sylvester Equation and Estimating the */
/* Separation between Regular Matrix Pairs, Report UMINF - 93.23, */
/* Department of Computing Science, Umea University, S-901 87 Umea, */
/* Sweden, December 1993, Revised April 1994, Also as LAPACK Working */
/* Note 75. To appear in ACM Trans. on Math. Software, Vol 22, */
/* No 1, 1996. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Decode and test the input parameters */
/* Parameter adjustments */
--select;
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
b_dim1 = *ldb;
b_offset = 1 + b_dim1;
b -= b_offset;
vl_dim1 = *ldvl;
vl_offset = 1 + vl_dim1;
vl -= vl_offset;
vr_dim1 = *ldvr;
vr_offset = 1 + vr_dim1;
vr -= vr_offset;
--s;
--dif;
--work;
--iwork;
/* Function Body */
wantbh = lsame_(job, "B");
wants = lsame_(job, "E") || wantbh;
wantdf = lsame_(job, "V") || wantbh;
somcon = lsame_(howmny, "S");
*info = 0;
lquery = *lwork == -1;
if (! wants && ! wantdf) {
*info = -1;
} else if (! lsame_(howmny, "A") && ! somcon) {
*info = -2;
} else if (*n < 0) {
*info = -4;
} else if (*lda < max(1,*n)) {
*info = -6;
} else if (*ldb < max(1,*n)) {
*info = -8;
} else if (wants && *ldvl < *n) {
*info = -10;
} else if (wants && *ldvr < *n) {
*info = -12;
} else {
/* Set M to the number of eigenpairs for which condition numbers */
/* are required, and test MM. */
if (somcon) {
*m = 0;
pair = FALSE_;
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
if (pair) {
pair = FALSE_;
} else {
if (k < *n) {
if (a[k + 1 + k * a_dim1] == 0.f) {
if (select[k]) {
++(*m);
}
} else {
pair = TRUE_;
if (select[k] || select[k + 1]) {
*m += 2;
}
}
} else {
if (select[*n]) {
++(*m);
}
}
}
/* L10: */
}
} else {
*m = *n;
}
if (*n == 0) {
lwmin = 1;
} else if (lsame_(job, "V") || lsame_(job,
"B")) {
lwmin = (*n << 1) * (*n + 2) + 16;
} else {
lwmin = *n;
}
work[1] = (real) lwmin;
if (*mm < *m) {
*info = -15;
} else if (*lwork < lwmin && ! lquery) {
*info = -18;
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("STGSNA", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
/* Get machine constants */
eps = slamch_("P");
smlnum = slamch_("S") / eps;
ks = 0;
pair = FALSE_;
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
/* Determine whether A(k,k) begins a 1-by-1 or 2-by-2 block. */
if (pair) {
pair = FALSE_;
goto L20;
} else {
if (k < *n) {
pair = a[k + 1 + k * a_dim1] != 0.f;
}
}
/* Determine whether condition numbers are required for the k-th */
/* eigenpair. */
if (somcon) {
if (pair) {
if (! select[k] && ! select[k + 1]) {
goto L20;
}
} else {
if (! select[k]) {
goto L20;
}
}
}
++ks;
if (wants) {
/* Compute the reciprocal condition number of the k-th */
/* eigenvalue. */
if (pair) {
/* Complex eigenvalue pair. */
r__1 = snrm2_(n, &vr[ks * vr_dim1 + 1], &c__1);
r__2 = snrm2_(n, &vr[(ks + 1) * vr_dim1 + 1], &c__1);
rnrm = slapy2_(&r__1, &r__2);
r__1 = snrm2_(n, &vl[ks * vl_dim1 + 1], &c__1);
r__2 = snrm2_(n, &vl[(ks + 1) * vl_dim1 + 1], &c__1);
lnrm = slapy2_(&r__1, &r__2);
sgemv_("N", n, n, &c_b19, &a[a_offset], lda, &vr[ks * vr_dim1
+ 1], &c__1, &c_b21, &work[1], &c__1);
tmprr = sdot_(n, &work[1], &c__1, &vl[ks * vl_dim1 + 1], &
c__1);
tmpri = sdot_(n, &work[1], &c__1, &vl[(ks + 1) * vl_dim1 + 1],
&c__1);
sgemv_("N", n, n, &c_b19, &a[a_offset], lda, &vr[(ks + 1) *
vr_dim1 + 1], &c__1, &c_b21, &work[1], &c__1);
tmpii = sdot_(n, &work[1], &c__1, &vl[(ks + 1) * vl_dim1 + 1],
&c__1);
tmpir = sdot_(n, &work[1], &c__1, &vl[ks * vl_dim1 + 1], &
c__1);
uhav = tmprr + tmpii;
uhavi = tmpir - tmpri;
sgemv_("N", n, n, &c_b19, &b[b_offset], ldb, &vr[ks * vr_dim1
+ 1], &c__1, &c_b21, &work[1], &c__1);
tmprr = sdot_(n, &work[1], &c__1, &vl[ks * vl_dim1 + 1], &
c__1);
tmpri = sdot_(n, &work[1], &c__1, &vl[(ks + 1) * vl_dim1 + 1],
&c__1);
sgemv_("N", n, n, &c_b19, &b[b_offset], ldb, &vr[(ks + 1) *
vr_dim1 + 1], &c__1, &c_b21, &work[1], &c__1);
tmpii = sdot_(n, &work[1], &c__1, &vl[(ks + 1) * vl_dim1 + 1],
&c__1);
tmpir = sdot_(n, &work[1], &c__1, &vl[ks * vl_dim1 + 1], &
c__1);
uhbv = tmprr + tmpii;
uhbvi = tmpir - tmpri;
uhav = slapy2_(&uhav, &uhavi);
uhbv = slapy2_(&uhbv, &uhbvi);
cond = slapy2_(&uhav, &uhbv);
s[ks] = cond / (rnrm * lnrm);
s[ks + 1] = s[ks];
} else {
/* Real eigenvalue. */
rnrm = snrm2_(n, &vr[ks * vr_dim1 + 1], &c__1);
lnrm = snrm2_(n, &vl[ks * vl_dim1 + 1], &c__1);
sgemv_("N", n, n, &c_b19, &a[a_offset], lda, &vr[ks * vr_dim1
+ 1], &c__1, &c_b21, &work[1], &c__1);
uhav = sdot_(n, &work[1], &c__1, &vl[ks * vl_dim1 + 1], &c__1)
;
sgemv_("N", n, n, &c_b19, &b[b_offset], ldb, &vr[ks * vr_dim1
+ 1], &c__1, &c_b21, &work[1], &c__1);
uhbv = sdot_(n, &work[1], &c__1, &vl[ks * vl_dim1 + 1], &c__1)
;
cond = slapy2_(&uhav, &uhbv);
if (cond == 0.f) {
s[ks] = -1.f;
} else {
s[ks] = cond / (rnrm * lnrm);
}
}
}
if (wantdf) {
if (*n == 1) {
dif[ks] = slapy2_(&a[a_dim1 + 1], &b[b_dim1 + 1]);
goto L20;
}
/* Estimate the reciprocal condition number of the k-th */
/* eigenvectors. */
if (pair) {
/* Copy the 2-by 2 pencil beginning at (A(k,k), B(k, k)). */
/* Compute the eigenvalue(s) at position K. */
work[1] = a[k + k * a_dim1];
work[2] = a[k + 1 + k * a_dim1];
work[3] = a[k + (k + 1) * a_dim1];
work[4] = a[k + 1 + (k + 1) * a_dim1];
work[5] = b[k + k * b_dim1];
work[6] = b[k + 1 + k * b_dim1];
work[7] = b[k + (k + 1) * b_dim1];
work[8] = b[k + 1 + (k + 1) * b_dim1];
r__1 = smlnum * eps;
slag2_(&work[1], &c__2, &work[5], &c__2, &r__1, &beta, dummy1,
&alphar, dummy, &alphai);
alprqt = 1.f;
c1 = (alphar * alphar + alphai * alphai + beta * beta) * 2.f;
c2 = beta * 4.f * beta * alphai * alphai;
root1 = c1 + sqrt(c1 * c1 - c2 * 4.f);
root2 = c2 / root1;
root1 /= 2.f;
/* Computing MIN */
r__1 = sqrt(root1), r__2 = sqrt(root2);
cond = dmin(r__1,r__2);
}
/* Copy the matrix (A, B) to the array WORK and swap the */
/* diagonal block beginning at A(k,k) to the (1,1) position. */
slacpy_("Full", n, n, &a[a_offset], lda, &work[1], n);
slacpy_("Full", n, n, &b[b_offset], ldb, &work[*n * *n + 1], n);
ifst = k;
ilst = 1;
i__2 = *lwork - (*n << 1) * *n;
stgexc_(&c_false, &c_false, n, &work[1], n, &work[*n * *n + 1], n,
dummy, &c__1, dummy1, &c__1, &ifst, &ilst, &work[(*n * *
n << 1) + 1], &i__2, &ierr);
if (ierr > 0) {
/* Ill-conditioned problem - swap rejected. */
dif[ks] = 0.f;
} else {
/* Reordering successful, solve generalized Sylvester */
/* equation for R and L, */
/* A22 * R - L * A11 = A12 */
/* B22 * R - L * B11 = B12, */
/* and compute estimate of Difl((A11,B11), (A22, B22)). */
n1 = 1;
if (work[2] != 0.f) {
n1 = 2;
}
n2 = *n - n1;
if (n2 == 0) {
dif[ks] = cond;
} else {
i__ = *n * *n + 1;
iz = (*n << 1) * *n + 1;
i__2 = *lwork - (*n << 1) * *n;
stgsyl_("N", &c__3, &n2, &n1, &work[*n * n1 + n1 + 1], n,
&work[1], n, &work[n1 + 1], n, &work[*n * n1 + n1
+ i__], n, &work[i__], n, &work[n1 + i__], n, &
scale, &dif[ks], &work[iz + 1], &i__2, &iwork[1],
&ierr);
if (pair) {
/* Computing MIN */
r__1 = dmax(1.f,alprqt) * dif[ks];
dif[ks] = dmin(r__1,cond);
}
}
}
if (pair) {
dif[ks + 1] = dif[ks];
}
}
if (pair) {
++ks;
}
L20:
;
}
work[1] = (real) lwmin;
return 0;
/* End of STGSNA */
} /* stgsna_ */
/* 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_ */