/* Subroutine */ int schkeq_(real *thresh, integer *nout)
{
/* Format strings */
static char fmt_9999[] = "(1x,\002All tests for \002,a3,\002 routines pa"
"ssed the threshold\002)";
static char fmt_9998[] = "(\002 SGEEQU failed test with value \002,e10"
".3,\002 exceeding\002,\002 threshold \002,e10.3)";
static char fmt_9997[] = "(\002 SGBEQU failed test with value \002,e10"
".3,\002 exceeding\002,\002 threshold \002,e10.3)";
static char fmt_9996[] = "(\002 SPOEQU failed test with value \002,e10"
".3,\002 exceeding\002,\002 threshold \002,e10.3)";
static char fmt_9995[] = "(\002 SPPEQU failed test with value \002,e10"
".3,\002 exceeding\002,\002 threshold \002,e10.3)";
static char fmt_9994[] = "(\002 SPBEQU failed test with value \002,e10"
".3,\002 exceeding\002,\002 threshold \002,e10.3)";
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8;
real r__1, r__2, r__3;
/* Local variables */
real a[25] /* was [5][5] */, c__[5];
integer i__, j, m, n;
real r__[5], ab[65] /* was [13][5] */, ap[15];
integer kl;
logical ok;
integer ku;
real eps, pow[11];
integer info;
char path[3];
real norm, rpow[11], ccond, rcond, rcmin, rcmax, ratio;
real reslts[5];
/* Fortran I/O blocks */
static cilist io___25 = { 0, 0, 0, 0, 0 };
static cilist io___26 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___27 = { 0, 0, 0, fmt_9998, 0 };
static cilist io___28 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___29 = { 0, 0, 0, fmt_9996, 0 };
static cilist io___30 = { 0, 0, 0, fmt_9995, 0 };
static cilist io___31 = { 0, 0, 0, fmt_9994, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SCHKEQ tests SGEEQU, SGBEQU, SPOEQU, SPPEQU and SPBEQU */
/* Arguments */
/* ========= */
/* THRESH (input) REAL */
/* Threshold for testing routines. Should be between 2 and 10. */
/* NOUT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
s_copy(path, "Single precision", (ftnlen)1, (ftnlen)16);
s_copy(path + 1, "EQ", (ftnlen)2, (ftnlen)2);
eps = slamch_("P");
for (i__ = 1; i__ <= 5; ++i__) {
reslts[i__ - 1] = 0.f;
/* L10: */
}
for (i__ = 1; i__ <= 11; ++i__) {
i__1 = i__ - 1;
pow[i__ - 1] = pow_ri(&c_b7, &i__1);
rpow[i__ - 1] = 1.f / pow[i__ - 1];
/* L20: */
}
/* Test SGEEQU */
for (n = 0; n <= 5; ++n) {
for (m = 0; m <= 5; ++m) {
for (j = 1; j <= 5; ++j) {
for (i__ = 1; i__ <= 5; ++i__) {
if (i__ <= m && j <= n) {
i__1 = i__ + j;
a[i__ + j * 5 - 6] = pow[i__ + j] * pow_ii(&c_n1, &
i__1);
} else {
a[i__ + j * 5 - 6] = 0.f;
}
/* L30: */
}
/* L40: */
}
sgeequ_(&m, &n, a, &c__5, r__, c__, &rcond, &ccond, &norm, &info);
if (info != 0) {
reslts[0] = 1.f;
} else {
if (n != 0 && m != 0) {
/* Computing MAX */
r__2 = reslts[0], r__3 = (r__1 = (rcond - rpow[m - 1]) /
rpow[m - 1], dabs(r__1));
reslts[0] = dmax(r__2,r__3);
/* Computing MAX */
r__2 = reslts[0], r__3 = (r__1 = (ccond - rpow[n - 1]) /
rpow[n - 1], dabs(r__1));
reslts[0] = dmax(r__2,r__3);
/* Computing MAX */
r__2 = reslts[0], r__3 = (r__1 = (norm - pow[n + m]) /
pow[n + m], dabs(r__1));
reslts[0] = dmax(r__2,r__3);
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Computing MAX */
r__2 = reslts[0], r__3 = (r__1 = (r__[i__ - 1] - rpow[
i__ + n]) / rpow[i__ + n], dabs(r__1));
reslts[0] = dmax(r__2,r__3);
/* L50: */
}
i__1 = n;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
r__2 = reslts[0], r__3 = (r__1 = (c__[j - 1] - pow[n
- j]) / pow[n - j], dabs(r__1));
reslts[0] = dmax(r__2,r__3);
/* L60: */
}
}
}
/* L70: */
}
/* L80: */
}
/* Test with zero rows and columns */
for (j = 1; j <= 5; ++j) {
a[j * 5 - 2] = 0.f;
/* L90: */
}
sgeequ_(&c__5, &c__5, a, &c__5, r__, c__, &rcond, &ccond, &norm, &info);
if (info != 4) {
reslts[0] = 1.f;
}
for (j = 1; j <= 5; ++j) {
a[j * 5 - 2] = 1.f;
/* L100: */
}
for (i__ = 1; i__ <= 5; ++i__) {
a[i__ + 14] = 0.f;
/* L110: */
}
sgeequ_(&c__5, &c__5, a, &c__5, r__, c__, &rcond, &ccond, &norm, &info);
if (info != 9) {
reslts[0] = 1.f;
}
reslts[0] /= eps;
/* Test SGBEQU */
for (n = 0; n <= 5; ++n) {
for (m = 0; m <= 5; ++m) {
/* Computing MAX */
i__2 = m - 1;
i__1 = max(i__2,0);
for (kl = 0; kl <= i__1; ++kl) {
/* Computing MAX */
i__3 = n - 1;
i__2 = max(i__3,0);
for (ku = 0; ku <= i__2; ++ku) {
for (j = 1; j <= 5; ++j) {
for (i__ = 1; i__ <= 13; ++i__) {
ab[i__ + j * 13 - 14] = 0.f;
/* L120: */
}
/* L130: */
}
i__3 = n;
for (j = 1; j <= i__3; ++j) {
i__4 = m;
for (i__ = 1; i__ <= i__4; ++i__) {
/* Computing MIN */
i__5 = m, i__6 = j + kl;
/* Computing MAX */
i__7 = 1, i__8 = j - ku;
if (i__ <= min(i__5,i__6) && i__ >= max(i__7,i__8)
&& j <= n) {
i__5 = i__ + j;
ab[ku + 1 + i__ - j + j * 13 - 14] = pow[i__
+ j] * pow_ii(&c_n1, &i__5);
}
/* L140: */
}
/* L150: */
}
sgbequ_(&m, &n, &kl, &ku, ab, &c__13, r__, c__, &rcond, &
ccond, &norm, &info);
if (info != 0) {
if (! (n + kl < m && info == n + kl + 1 || m + ku < n
&& info == (m << 1) + ku + 1)) {
reslts[1] = 1.f;
}
} else {
if (n != 0 && m != 0) {
rcmin = r__[0];
rcmax = r__[0];
i__3 = m;
for (i__ = 1; i__ <= i__3; ++i__) {
/* Computing MIN */
r__1 = rcmin, r__2 = r__[i__ - 1];
rcmin = dmin(r__1,r__2);
/* Computing MAX */
r__1 = rcmax, r__2 = r__[i__ - 1];
rcmax = dmax(r__1,r__2);
/* L160: */
}
ratio = rcmin / rcmax;
/* Computing MAX */
r__2 = reslts[1], r__3 = (r__1 = (rcond - ratio) /
ratio, dabs(r__1));
reslts[1] = dmax(r__2,r__3);
rcmin = c__[0];
rcmax = c__[0];
i__3 = n;
for (j = 1; j <= i__3; ++j) {
/* Computing MIN */
r__1 = rcmin, r__2 = c__[j - 1];
rcmin = dmin(r__1,r__2);
/* Computing MAX */
r__1 = rcmax, r__2 = c__[j - 1];
rcmax = dmax(r__1,r__2);
/* L170: */
}
ratio = rcmin / rcmax;
/* Computing MAX */
r__2 = reslts[1], r__3 = (r__1 = (ccond - ratio) /
ratio, dabs(r__1));
reslts[1] = dmax(r__2,r__3);
/* Computing MAX */
r__2 = reslts[1], r__3 = (r__1 = (norm - pow[n +
m]) / pow[n + m], dabs(r__1));
reslts[1] = dmax(r__2,r__3);
i__3 = m;
for (i__ = 1; i__ <= i__3; ++i__) {
rcmax = 0.f;
i__4 = n;
for (j = 1; j <= i__4; ++j) {
if (i__ <= j + kl && i__ >= j - ku) {
ratio = (r__1 = r__[i__ - 1] * pow[
i__ + j] * c__[j - 1], dabs(
r__1));
rcmax = dmax(rcmax,ratio);
}
/* L180: */
}
/* Computing MAX */
r__2 = reslts[1], r__3 = (r__1 = 1.f - rcmax,
dabs(r__1));
reslts[1] = dmax(r__2,r__3);
/* L190: */
}
i__3 = n;
for (j = 1; j <= i__3; ++j) {
rcmax = 0.f;
i__4 = m;
for (i__ = 1; i__ <= i__4; ++i__) {
if (i__ <= j + kl && i__ >= j - ku) {
ratio = (r__1 = r__[i__ - 1] * pow[
i__ + j] * c__[j - 1], dabs(
r__1));
rcmax = dmax(rcmax,ratio);
}
/* L200: */
}
/* Computing MAX */
r__2 = reslts[1], r__3 = (r__1 = 1.f - rcmax,
dabs(r__1));
reslts[1] = dmax(r__2,r__3);
/* L210: */
}
}
}
/* L220: */
}
/* L230: */
}
/* L240: */
}
/* L250: */
}
reslts[1] /= eps;
/* Test SPOEQU */
for (n = 0; n <= 5; ++n) {
for (i__ = 1; i__ <= 5; ++i__) {
for (j = 1; j <= 5; ++j) {
if (i__ <= n && j == i__) {
i__1 = i__ + j;
a[i__ + j * 5 - 6] = pow[i__ + j] * pow_ii(&c_n1, &i__1);
} else {
a[i__ + j * 5 - 6] = 0.f;
}
/* L260: */
}
/* L270: */
}
spoequ_(&n, a, &c__5, r__, &rcond, &norm, &info);
if (info != 0) {
reslts[2] = 1.f;
} else {
if (n != 0) {
/* Computing MAX */
r__2 = reslts[2], r__3 = (r__1 = (rcond - rpow[n - 1]) / rpow[
n - 1], dabs(r__1));
reslts[2] = dmax(r__2,r__3);
/* Computing MAX */
r__2 = reslts[2], r__3 = (r__1 = (norm - pow[n * 2]) / pow[n *
2], dabs(r__1));
reslts[2] = dmax(r__2,r__3);
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Computing MAX */
r__2 = reslts[2], r__3 = (r__1 = (r__[i__ - 1] - rpow[i__]
) / rpow[i__], dabs(r__1));
reslts[2] = dmax(r__2,r__3);
/* L280: */
}
}
}
/* L290: */
}
a[18] = -1.f;
spoequ_(&c__5, a, &c__5, r__, &rcond, &norm, &info);
if (info != 4) {
reslts[2] = 1.f;
}
reslts[2] /= eps;
/* Test SPPEQU */
for (n = 0; n <= 5; ++n) {
/* Upper triangular packed storage */
i__1 = n * (n + 1) / 2;
for (i__ = 1; i__ <= i__1; ++i__) {
ap[i__ - 1] = 0.f;
/* L300: */
}
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
ap[i__ * (i__ + 1) / 2 - 1] = pow[i__ * 2];
/* L310: */
}
sppequ_("U", &n, ap, r__, &rcond, &norm, &info);
if (info != 0) {
reslts[3] = 1.f;
} else {
if (n != 0) {
/* Computing MAX */
r__2 = reslts[3], r__3 = (r__1 = (rcond - rpow[n - 1]) / rpow[
n - 1], dabs(r__1));
reslts[3] = dmax(r__2,r__3);
/* Computing MAX */
r__2 = reslts[3], r__3 = (r__1 = (norm - pow[n * 2]) / pow[n *
2], dabs(r__1));
reslts[3] = dmax(r__2,r__3);
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Computing MAX */
r__2 = reslts[3], r__3 = (r__1 = (r__[i__ - 1] - rpow[i__]
) / rpow[i__], dabs(r__1));
reslts[3] = dmax(r__2,r__3);
/* L320: */
}
}
}
/* Lower triangular packed storage */
i__1 = n * (n + 1) / 2;
for (i__ = 1; i__ <= i__1; ++i__) {
ap[i__ - 1] = 0.f;
/* L330: */
}
j = 1;
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
ap[j - 1] = pow[i__ * 2];
j += n - i__ + 1;
/* L340: */
}
sppequ_("L", &n, ap, r__, &rcond, &norm, &info);
if (info != 0) {
reslts[3] = 1.f;
} else {
if (n != 0) {
/* Computing MAX */
r__2 = reslts[3], r__3 = (r__1 = (rcond - rpow[n - 1]) / rpow[
n - 1], dabs(r__1));
reslts[3] = dmax(r__2,r__3);
/* Computing MAX */
r__2 = reslts[3], r__3 = (r__1 = (norm - pow[n * 2]) / pow[n *
2], dabs(r__1));
reslts[3] = dmax(r__2,r__3);
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Computing MAX */
r__2 = reslts[3], r__3 = (r__1 = (r__[i__ - 1] - rpow[i__]
) / rpow[i__], dabs(r__1));
reslts[3] = dmax(r__2,r__3);
/* L350: */
}
}
}
/* L360: */
}
i__ = 13;
ap[i__ - 1] = -1.f;
sppequ_("L", &c__5, ap, r__, &rcond, &norm, &info);
if (info != 4) {
reslts[3] = 1.f;
}
reslts[3] /= eps;
/* Test SPBEQU */
for (n = 0; n <= 5; ++n) {
/* Computing MAX */
i__2 = n - 1;
i__1 = max(i__2,0);
for (kl = 0; kl <= i__1; ++kl) {
/* Test upper triangular storage */
for (j = 1; j <= 5; ++j) {
for (i__ = 1; i__ <= 13; ++i__) {
ab[i__ + j * 13 - 14] = 0.f;
/* L370: */
}
/* L380: */
}
i__2 = n;
for (j = 1; j <= i__2; ++j) {
ab[kl + 1 + j * 13 - 14] = pow[j * 2];
/* L390: */
}
spbequ_("U", &n, &kl, ab, &c__13, r__, &rcond, &norm, &info);
if (info != 0) {
reslts[4] = 1.f;
} else {
if (n != 0) {
/* Computing MAX */
r__2 = reslts[4], r__3 = (r__1 = (rcond - rpow[n - 1]) /
rpow[n - 1], dabs(r__1));
reslts[4] = dmax(r__2,r__3);
/* Computing MAX */
r__2 = reslts[4], r__3 = (r__1 = (norm - pow[n * 2]) /
pow[n * 2], dabs(r__1));
reslts[4] = dmax(r__2,r__3);
i__2 = n;
for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
r__2 = reslts[4], r__3 = (r__1 = (r__[i__ - 1] - rpow[
i__]) / rpow[i__], dabs(r__1));
reslts[4] = dmax(r__2,r__3);
/* L400: */
}
}
}
if (n != 0) {
/* Computing MAX */
i__2 = n - 1;
ab[kl + 1 + max(i__2,1) * 13 - 14] = -1.f;
spbequ_("U", &n, &kl, ab, &c__13, r__, &rcond, &norm, &info);
/* Computing MAX */
i__2 = n - 1;
if (info != max(i__2,1)) {
reslts[4] = 1.f;
}
}
/* Test lower triangular storage */
for (j = 1; j <= 5; ++j) {
for (i__ = 1; i__ <= 13; ++i__) {
ab[i__ + j * 13 - 14] = 0.f;
/* L410: */
}
/* L420: */
}
i__2 = n;
for (j = 1; j <= i__2; ++j) {
ab[j * 13 - 13] = pow[j * 2];
/* L430: */
}
spbequ_("L", &n, &kl, ab, &c__13, r__, &rcond, &norm, &info);
if (info != 0) {
reslts[4] = 1.f;
} else {
if (n != 0) {
/* Computing MAX */
r__2 = reslts[4], r__3 = (r__1 = (rcond - rpow[n - 1]) /
rpow[n - 1], dabs(r__1));
reslts[4] = dmax(r__2,r__3);
/* Computing MAX */
r__2 = reslts[4], r__3 = (r__1 = (norm - pow[n * 2]) /
pow[n * 2], dabs(r__1));
reslts[4] = dmax(r__2,r__3);
i__2 = n;
for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
r__2 = reslts[4], r__3 = (r__1 = (r__[i__ - 1] - rpow[
i__]) / rpow[i__], dabs(r__1));
reslts[4] = dmax(r__2,r__3);
/* L440: */
}
}
}
if (n != 0) {
/* Computing MAX */
i__2 = n - 1;
ab[max(i__2,1) * 13 - 13] = -1.f;
spbequ_("L", &n, &kl, ab, &c__13, r__, &rcond, &norm, &info);
/* Computing MAX */
i__2 = n - 1;
if (info != max(i__2,1)) {
reslts[4] = 1.f;
}
}
/* L450: */
}
/* L460: */
}
reslts[4] /= eps;
ok = reslts[0] <= *thresh && reslts[1] <= *thresh && reslts[2] <= *thresh
&& reslts[3] <= *thresh && reslts[4] <= *thresh;
io___25.ciunit = *nout;
s_wsle(&io___25);
e_wsle();
if (ok) {
io___26.ciunit = *nout;
s_wsfe(&io___26);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
} else {
if (reslts[0] > *thresh) {
io___27.ciunit = *nout;
s_wsfe(&io___27);
do_fio(&c__1, (char *)&reslts[0], (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(real));
e_wsfe();
}
if (reslts[1] > *thresh) {
io___28.ciunit = *nout;
s_wsfe(&io___28);
do_fio(&c__1, (char *)&reslts[1], (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(real));
e_wsfe();
}
if (reslts[2] > *thresh) {
io___29.ciunit = *nout;
s_wsfe(&io___29);
do_fio(&c__1, (char *)&reslts[2], (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(real));
e_wsfe();
}
if (reslts[3] > *thresh) {
io___30.ciunit = *nout;
s_wsfe(&io___30);
do_fio(&c__1, (char *)&reslts[3], (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(real));
e_wsfe();
}
if (reslts[4] > *thresh) {
io___31.ciunit = *nout;
s_wsfe(&io___31);
do_fio(&c__1, (char *)&reslts[4], (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(real));
e_wsfe();
}
}
return 0;
/* End of SCHKEQ */
} /* schkeq_ */
/* Subroutine */ int sgbsvx_(char *fact, char *trans, integer *n, integer *kl,
integer *ku, integer *nrhs, real *ab, integer *ldab, real *afb,
integer *ldafb, integer *ipiv, char *equed, real *r__, real *c__,
real *b, integer *ldb, real *x, integer *ldx, real *rcond, real *ferr,
real *berr, real *work, integer *iwork, integer *info)
{
/* System generated locals */
integer ab_dim1, ab_offset, afb_dim1, afb_offset, b_dim1, b_offset,
x_dim1, x_offset, i__1, i__2, i__3, i__4, i__5;
real r__1, r__2, r__3;
/* Local variables */
integer i__, j, j1, j2;
real amax;
char norm[1];
real rcmin, rcmax, anorm;
logical equil;
real colcnd;
logical nofact;
real bignum;
integer infequ;
logical colequ;
real rowcnd;
logical notran;
real smlnum;
logical rowequ;
real rpvgrw;
/* -- LAPACK driver routine (version 3.2) -- */
/* November 2006 */
/* Purpose */
/* ======= */
/* SGBSVX uses the LU factorization to compute the solution to a real */
/* system of linear equations A * X = B, A**T * X = B, or A**H * X = B, */
/* where A is a band matrix of order N with KL subdiagonals and KU */
/* superdiagonals, and X and B are N-by-NRHS matrices. */
/* Error bounds on the solution and a condition estimate are also */
/* provided. */
/* Description */
/* =========== */
/* The following steps are performed by this subroutine: */
/* 1. If FACT = 'E', real scaling factors are computed to equilibrate */
/* the system: */
/* TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B */
/* TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B */
/* TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B */
/* Whether or not the system will be equilibrated depends on the */
/* scaling of the matrix A, but if equilibration is used, A is */
/* overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N') */
/* or diag(C)*B (if TRANS = 'T' or 'C'). */
/* 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the */
/* matrix A (after equilibration if FACT = 'E') as */
/* A = L * U, */
/* where L is a product of permutation and unit lower triangular */
/* matrices with KL subdiagonals, and U is upper triangular with */
/* KL+KU superdiagonals. */
/* 3. If some U(i,i)=0, so that U is exactly singular, then the routine */
/* returns with INFO = i. Otherwise, the factored form of A is used */
/* to estimate the condition number of the matrix A. If the */
/* reciprocal of the condition number is less than machine precision, */
/* INFO = N+1 is returned as a warning, but the routine still goes on */
/* to solve for X and compute error bounds as described below. */
/* 4. The system of equations is solved for X using the factored form */
/* of A. */
/* 5. Iterative refinement is applied to improve the computed solution */
/* matrix and calculate error bounds and backward error estimates */
/* for it. */
/* 6. If equilibration was used, the matrix X is premultiplied by */
/* diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so */
/* that it solves the original system before equilibration. */
/* Arguments */
/* ========= */
/* FACT (input) CHARACTER*1 */
/* Specifies whether or not the factored form of the matrix A is */
/* supplied on entry, and if not, whether the matrix A should be */
/* equilibrated before it is factored. */
/* = 'F': On entry, AFB and IPIV contain the factored form of */
/* A. If EQUED is not 'N', the matrix A has been */
/* equilibrated with scaling factors given by R and C. */
/* AB, AFB, and IPIV are not modified. */
/* = 'N': The matrix A will be copied to AFB and factored. */
/* = 'E': The matrix A will be equilibrated if necessary, then */
/* copied to AFB and factored. */
/* TRANS (input) CHARACTER*1 */
/* Specifies the form of the system of equations. */
/* = 'N': A * X = B (No transpose) */
/* = 'T': A**T * X = B (Transpose) */
/* = 'C': A**H * X = B (Transpose) */
/* N (input) INTEGER */
/* The number of linear equations, i.e., the order of the */
/* matrix A. N >= 0. */
/* KL (input) INTEGER */
/* The number of subdiagonals within the band of A. KL >= 0. */
/* KU (input) INTEGER */
/* The number of superdiagonals within the band of A. KU >= 0. */
/* NRHS (input) INTEGER */
/* The number of right hand sides, i.e., the number of columns */
/* of the matrices B and X. NRHS >= 0. */
/* AB (input/output) REAL array, dimension (LDAB,N) */
/* On entry, the matrix A in band storage, in rows 1 to KL+KU+1. */
/* The j-th column of A is stored in the j-th column of the */
/* array AB as follows: */
/* AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl) */
/* If FACT = 'F' and EQUED is not 'N', then A must have been */
/* equilibrated by the scaling factors in R and/or C. AB is not */
/* modified if FACT = 'F' or 'N', or if FACT = 'E' and */
/* EQUED = 'N' on exit. */
/* On exit, if EQUED .ne. 'N', A is scaled as follows: */
/* EQUED = 'R': A := diag(R) * A */
/* EQUED = 'C': A := A * diag(C) */
/* EQUED = 'B': A := diag(R) * A * diag(C). */
/* LDAB (input) INTEGER */
/* The leading dimension of the array AB. LDAB >= KL+KU+1. */
/* AFB (input or output) REAL array, dimension (LDAFB,N) */
/* If FACT = 'F', then AFB is an input argument and on entry */
/* contains details of the LU factorization of the band matrix */
/* A, as computed by SGBTRF. U is stored as an upper triangular */
/* band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, */
/* and the multipliers used during the factorization are stored */
/* in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is */
/* the factored form of the equilibrated matrix A. */
/* If FACT = 'N', then AFB is an output argument and on exit */
/* returns details of the LU factorization of A. */
/* If FACT = 'E', then AFB is an output argument and on exit */
/* returns details of the LU factorization of the equilibrated */
/* matrix A (see the description of AB for the form of the */
/* equilibrated matrix). */
/* LDAFB (input) INTEGER */
/* The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1. */
/* IPIV (input or output) INTEGER array, dimension (N) */
/* If FACT = 'F', then IPIV is an input argument and on entry */
/* contains the pivot indices from the factorization A = L*U */
/* as computed by SGBTRF; row i of the matrix was interchanged */
/* with row IPIV(i). */
/* If FACT = 'N', then IPIV is an output argument and on exit */
/* contains the pivot indices from the factorization A = L*U */
/* of the original matrix A. */
/* If FACT = 'E', then IPIV is an output argument and on exit */
/* contains the pivot indices from the factorization A = L*U */
/* of the equilibrated matrix A. */
/* EQUED (input or output) CHARACTER*1 */
/* Specifies the form of equilibration that was done. */
/* = 'N': No equilibration (always true if FACT = 'N'). */
/* = 'R': Row equilibration, i.e., A has been premultiplied by */
/* diag(R). */
/* = 'C': Column equilibration, i.e., A has been postmultiplied */
/* by diag(C). */
/* = 'B': Both row and column equilibration, i.e., A has been */
/* replaced by diag(R) * A * diag(C). */
/* EQUED is an input argument if FACT = 'F'; otherwise, it is an */
/* output argument. */
/* R (input or output) REAL array, dimension (N) */
/* The row scale factors for A. If EQUED = 'R' or 'B', A is */
/* multiplied on the left by diag(R); if EQUED = 'N' or 'C', R */
/* is not accessed. R is an input argument if FACT = 'F'; */
/* otherwise, R is an output argument. If FACT = 'F' and */
/* EQUED = 'R' or 'B', each element of R must be positive. */
/* C (input or output) REAL array, dimension (N) */
/* The column scale factors for A. If EQUED = 'C' or 'B', A is */
/* multiplied on the right by diag(C); if EQUED = 'N' or 'R', C */
/* is not accessed. C is an input argument if FACT = 'F'; */
/* otherwise, C is an output argument. If FACT = 'F' and */
/* EQUED = 'C' or 'B', each element of C must be positive. */
/* B (input/output) REAL array, dimension (LDB,NRHS) */
/* On entry, the right hand side matrix B. */
/* On exit, */
/* if EQUED = 'N', B is not modified; */
/* if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by */
/* diag(R)*B; */
/* if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is */
/* overwritten by diag(C)*B. */
/* LDB (input) INTEGER */
/* The leading dimension of the array B. LDB >= max(1,N). */
/* X (output) REAL array, dimension (LDX,NRHS) */
/* If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X */
/* to the original system of equations. Note that A and B are */
/* modified on exit if EQUED .ne. 'N', and the solution to the */
/* equilibrated system is inv(diag(C))*X if TRANS = 'N' and */
/* EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C' */
/* and EQUED = 'R' or 'B'. */
/* LDX (input) INTEGER */
/* The leading dimension of the array X. LDX >= max(1,N). */
/* RCOND (output) REAL */
/* The estimate of the reciprocal condition number of the matrix */
/* A after equilibration (if done). If RCOND is less than the */
/* machine precision (in particular, if RCOND = 0), the matrix */
/* is singular to working precision. This condition is */
/* indicated by a return code of INFO > 0. */
/* FERR (output) REAL array, dimension (NRHS) */
/* The estimated forward error bound for each solution vector */
/* X(j) (the j-th column of the solution matrix X). */
/* If XTRUE is the true solution corresponding to X(j), FERR(j) */
/* is an estimated upper bound for the magnitude of the largest */
/* element in (X(j) - XTRUE) divided by the magnitude of the */
/* largest element in X(j). The estimate is as reliable as */
/* the estimate for RCOND, and is almost always a slight */
/* overestimate of the true error. */
/* BERR (output) REAL array, dimension (NRHS) */
/* The componentwise relative backward error of each solution */
/* vector X(j) (i.e., the smallest relative change in */
/* any element of A or B that makes X(j) an exact solution). */
/* WORK (workspace/output) REAL array, dimension (3*N) */
/* On exit, WORK(1) contains the reciprocal pivot growth */
/* factor norm(A)/norm(U). The "max absolute element" norm is */
/* used. If WORK(1) is much less than 1, then the stability */
/* of the LU factorization of the (equilibrated) matrix A */
/* could be poor. This also means that the solution X, condition */
/* estimator RCOND, and forward error bound FERR could be */
/* unreliable. If factorization fails with 0<INFO<=N, then */
/* WORK(1) contains the reciprocal pivot growth factor for the */
/* leading INFO columns of A. */
/* IWORK (workspace) INTEGER array, dimension (N) */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -i, the i-th argument had an illegal value */
/* > 0: if INFO = i, and i is */
/* <= N: U(i,i) is exactly zero. The factorization */
/* has been completed, but the factor U is exactly */
/* singular, so the solution and error bounds */
/* could not be computed. RCOND = 0 is returned. */
/* = N+1: U is nonsingular, but RCOND is less than machine */
/* precision, meaning that the matrix is singular */
/* to working precision. Nevertheless, the */
/* solution and error bounds are computed because */
/* there are a number of situations where the */
/* computed solution can be more accurate than the */
/* value of RCOND would suggest. */
/* ===================================================================== */
/* Moved setting of INFO = N+1 so INFO does not subsequently get */
/* overwritten. Sven, 17 Mar 05. */
/* ===================================================================== */
/* Parameter adjustments */
ab_dim1 = *ldab;
ab_offset = 1 + ab_dim1;
ab -= ab_offset;
afb_dim1 = *ldafb;
afb_offset = 1 + afb_dim1;
afb -= afb_offset;
--ipiv;
--r__;
--c__;
b_dim1 = *ldb;
b_offset = 1 + b_dim1;
b -= b_offset;
x_dim1 = *ldx;
x_offset = 1 + x_dim1;
x -= x_offset;
--ferr;
--berr;
--work;
--iwork;
/* Function Body */
*info = 0;
nofact = lsame_(fact, "N");
equil = lsame_(fact, "E");
notran = lsame_(trans, "N");
if (nofact || equil) {
*(unsigned char *)equed = 'N';
rowequ = FALSE_;
colequ = FALSE_;
} else {
rowequ = lsame_(equed, "R") || lsame_(equed,
"B");
colequ = lsame_(equed, "C") || lsame_(equed,
"B");
smlnum = slamch_("Safe minimum");
bignum = 1.f / smlnum;
}
/* Test the input parameters. */
if (! nofact && ! equil && ! lsame_(fact, "F")) {
*info = -1;
} else if (! notran && ! lsame_(trans, "T") && !
lsame_(trans, "C")) {
*info = -2;
} else if (*n < 0) {
*info = -3;
} else if (*kl < 0) {
*info = -4;
} else if (*ku < 0) {
*info = -5;
} else if (*nrhs < 0) {
*info = -6;
} else if (*ldab < *kl + *ku + 1) {
*info = -8;
} else if (*ldafb < (*kl << 1) + *ku + 1) {
*info = -10;
} else if (lsame_(fact, "F") && ! (rowequ || colequ
|| lsame_(equed, "N"))) {
*info = -12;
} else {
if (rowequ) {
rcmin = bignum;
rcmax = 0.f;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Computing MIN */
r__1 = rcmin, r__2 = r__[j];
rcmin = dmin(r__1,r__2);
/* Computing MAX */
r__1 = rcmax, r__2 = r__[j];
rcmax = dmax(r__1,r__2);
}
if (rcmin <= 0.f) {
*info = -13;
} else if (*n > 0) {
rowcnd = dmax(rcmin,smlnum) / dmin(rcmax,bignum);
} else {
rowcnd = 1.f;
}
}
if (colequ && *info == 0) {
rcmin = bignum;
rcmax = 0.f;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Computing MIN */
r__1 = rcmin, r__2 = c__[j];
rcmin = dmin(r__1,r__2);
/* Computing MAX */
r__1 = rcmax, r__2 = c__[j];
rcmax = dmax(r__1,r__2);
}
if (rcmin <= 0.f) {
*info = -14;
} else if (*n > 0) {
colcnd = dmax(rcmin,smlnum) / dmin(rcmax,bignum);
} else {
colcnd = 1.f;
}
}
if (*info == 0) {
if (*ldb < max(1,*n)) {
*info = -16;
} else if (*ldx < max(1,*n)) {
*info = -18;
}
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("SGBSVX", &i__1);
return 0;
}
if (equil) {
/* Compute row and column scalings to equilibrate the matrix A. */
sgbequ_(n, n, kl, ku, &ab[ab_offset], ldab, &r__[1], &c__[1], &rowcnd,
&colcnd, &amax, &infequ);
if (infequ == 0) {
/* Equilibrate the matrix. */
slaqgb_(n, n, kl, ku, &ab[ab_offset], ldab, &r__[1], &c__[1], &
rowcnd, &colcnd, &amax, equed);
rowequ = lsame_(equed, "R") || lsame_(equed,
"B");
colequ = lsame_(equed, "C") || lsame_(equed,
"B");
}
}
/* Scale the right hand side. */
if (notran) {
if (rowequ) {
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
b[i__ + j * b_dim1] = r__[i__] * b[i__ + j * b_dim1];
}
}
}
} else if (colequ) {
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
b[i__ + j * b_dim1] = c__[i__] * b[i__ + j * b_dim1];
}
}
}
if (nofact || equil) {
/* Compute the LU factorization of the band matrix A. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
i__2 = j - *ku;
j1 = max(i__2,1);
/* Computing MIN */
i__2 = j + *kl;
j2 = min(i__2,*n);
i__2 = j2 - j1 + 1;
scopy_(&i__2, &ab[*ku + 1 - j + j1 + j * ab_dim1], &c__1, &afb[*
kl + *ku + 1 - j + j1 + j * afb_dim1], &c__1);
}
sgbtrf_(n, n, kl, ku, &afb[afb_offset], ldafb, &ipiv[1], info);
/* Return if INFO is non-zero. */
if (*info > 0) {
/* Compute the reciprocal pivot growth factor of the */
/* leading rank-deficient INFO columns of A. */
anorm = 0.f;
i__1 = *info;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
i__2 = *ku + 2 - j;
/* Computing MIN */
i__4 = *n + *ku + 1 - j, i__5 = *kl + *ku + 1;
i__3 = min(i__4,i__5);
for (i__ = max(i__2,1); i__ <= i__3; ++i__) {
/* Computing MAX */
r__2 = anorm, r__3 = (r__1 = ab[i__ + j * ab_dim1], dabs(
r__1));
anorm = dmax(r__2,r__3);
}
}
/* Computing MIN */
i__3 = *info - 1, i__2 = *kl + *ku;
i__1 = min(i__3,i__2);
/* Computing MAX */
i__4 = 1, i__5 = *kl + *ku + 2 - *info;
rpvgrw = slantb_("M", "U", "N", info, &i__1, &afb[max(i__4, i__5)
+ afb_dim1], ldafb, &work[1]);
if (rpvgrw == 0.f) {
rpvgrw = 1.f;
} else {
rpvgrw = anorm / rpvgrw;
}
work[1] = rpvgrw;
*rcond = 0.f;
return 0;
}
}
/* Compute the norm of the matrix A and the */
/* reciprocal pivot growth factor RPVGRW. */
if (notran) {
*(unsigned char *)norm = '1';
} else {
*(unsigned char *)norm = 'I';
}
anorm = slangb_(norm, n, kl, ku, &ab[ab_offset], ldab, &work[1]);
i__1 = *kl + *ku;
rpvgrw = slantb_("M", "U", "N", n, &i__1, &afb[afb_offset], ldafb, &work[
1]);
if (rpvgrw == 0.f) {
rpvgrw = 1.f;
} else {
rpvgrw = slangb_("M", n, kl, ku, &ab[ab_offset], ldab, &work[1]) / rpvgrw;
}
/* Compute the reciprocal of the condition number of A. */
sgbcon_(norm, n, kl, ku, &afb[afb_offset], ldafb, &ipiv[1], &anorm, rcond,
&work[1], &iwork[1], info);
/* Compute the solution matrix X. */
slacpy_("Full", n, nrhs, &b[b_offset], ldb, &x[x_offset], ldx);
sgbtrs_(trans, n, kl, ku, nrhs, &afb[afb_offset], ldafb, &ipiv[1], &x[
x_offset], ldx, info);
/* Use iterative refinement to improve the computed solution and */
/* compute error bounds and backward error estimates for it. */
sgbrfs_(trans, n, kl, ku, nrhs, &ab[ab_offset], ldab, &afb[afb_offset],
ldafb, &ipiv[1], &b[b_offset], ldb, &x[x_offset], ldx, &ferr[1], &
berr[1], &work[1], &iwork[1], info);
/* Transform the solution matrix X to a solution of the original */
/* system. */
if (notran) {
if (colequ) {
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
i__3 = *n;
for (i__ = 1; i__ <= i__3; ++i__) {
x[i__ + j * x_dim1] = c__[i__] * x[i__ + j * x_dim1];
}
}
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
ferr[j] /= colcnd;
}
}
} else if (rowequ) {
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
i__3 = *n;
for (i__ = 1; i__ <= i__3; ++i__) {
x[i__ + j * x_dim1] = r__[i__] * x[i__ + j * x_dim1];
}
}
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
ferr[j] /= rowcnd;
}
}
/* Set INFO = N+1 if the matrix is singular to working precision. */
if (*rcond < slamch_("Epsilon")) {
*info = *n + 1;
}
work[1] = rpvgrw;
return 0;
/* End of SGBSVX */
} /* sgbsvx_ */
/* Subroutine */ int serrge_(char *path, integer *nunit)
{
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
real a[16] /* was [4][4] */, b[4], c__[4];
integer i__, j;
real r__[4], w[12], x[4];
char c2[2];
real r1[4], r2[4], af[16] /* was [4][4] */;
char eq[1];
integer ip[4], iw[4];
real err_bnds_c__[12] /* was [4][3] */;
integer n_err_bnds__;
real err_bnds_n__[12] /* was [4][3] */, berr;
integer info;
real anrm, ccond, rcond;
extern /* Subroutine */ int sgbtf2_(integer *, integer *, integer *,
integer *, real *, integer *, integer *, integer *), sgetf2_(
integer *, integer *, real *, integer *, integer *, integer *),
alaesm_(char *, logical *, integer *), sgbcon_(char *,
integer *, integer *, integer *, real *, integer *, integer *,
real *, real *, real *, integer *, integer *), sgecon_(
char *, integer *, real *, integer *, real *, real *, real *,
integer *, integer *);
extern logical lsamen_(integer *, char *, char *);
real params[1];
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), sgbequ_(integer *, integer *, integer *,
integer *, real *, integer *, real *, real *, real *, real *,
real *, integer *), sgbrfs_(char *, integer *, integer *, integer
*, integer *, real *, integer *, real *, integer *, integer *,
real *, integer *, real *, integer *, real *, real *, real *,
integer *, integer *), sgbtrf_(integer *, integer *,
integer *, integer *, real *, integer *, integer *, integer *),
sgeequ_(integer *, integer *, real *, integer *, real *, real *,
real *, real *, real *, integer *), sgerfs_(char *, integer *,
integer *, real *, integer *, real *, integer *, integer *, real *
, integer *, real *, integer *, real *, real *, real *, integer *,
integer *), sgetrf_(integer *, integer *, real *,
integer *, integer *, integer *), sgetri_(integer *, real *,
integer *, integer *, real *, integer *, integer *), sgbtrs_(char
*, integer *, integer *, integer *, integer *, real *, integer *,
integer *, real *, integer *, integer *), sgetrs_(char *,
integer *, integer *, real *, integer *, integer *, real *,
integer *, integer *), sgbequb_(integer *, integer *,
integer *, integer *, real *, integer *, real *, real *, real *,
real *, real *, integer *), sgeequb_(integer *, integer *, real *,
integer *, real *, real *, real *, real *, real *, integer *);
integer nparams;
extern /* Subroutine */ int sgbrfsx_(char *, char *, integer *, integer *,
integer *, integer *, real *, integer *, real *, integer *,
integer *, real *, real *, real *, integer *, real *, integer *,
real *, real *, integer *, real *, real *, integer *, real *,
real *, integer *, integer *), sgerfsx_(char *,
char *, integer *, integer *, real *, integer *, real *, integer *
, integer *, real *, real *, real *, integer *, real *, integer *,
real *, real *, integer *, real *, real *, integer *, real *,
real *, integer *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SERRGE tests the error exits for the REAL routines */
/* for general matrices. */
/* Note that this file is used only when the XBLAS are available, */
/* otherwise serrge.f defines this subroutine. */
/* 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 .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. 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 <= 4; ++j) {
for (i__ = 1; i__ <= 4; ++i__) {
a[i__ + (j << 2) - 5] = 1.f / (real) (i__ + j);
af[i__ + (j << 2) - 5] = 1.f / (real) (i__ + j);
/* L10: */
}
b[j - 1] = 0.f;
r1[j - 1] = 0.f;
r2[j - 1] = 0.f;
w[j - 1] = 0.f;
x[j - 1] = 0.f;
c__[j - 1] = 0.f;
r__[j - 1] = 0.f;
ip[j - 1] = j;
iw[j - 1] = j;
/* L20: */
}
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "GE")) {
/* Test error exits of the routines that use the LU decomposition */
/* of a general matrix. */
/* SGETRF */
s_copy(srnamc_1.srnamt, "SGETRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgetrf_(&c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgetrf_(&c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgetrf_(&c__2, &c__1, a, &c__1, ip, &info);
chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGETF2 */
s_copy(srnamc_1.srnamt, "SGETF2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgetf2_(&c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgetf2_(&c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgetf2_(&c__2, &c__1, a, &c__1, ip, &info);
chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGETRI */
s_copy(srnamc_1.srnamt, "SGETRI", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgetri_(&c_n1, a, &c__1, ip, w, &c__12, &info);
chkxer_("SGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgetri_(&c__2, a, &c__1, ip, w, &c__12, &info);
chkxer_("SGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGETRS */
s_copy(srnamc_1.srnamt, "SGETRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgetrs_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgetrs_("N", &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgetrs_("N", &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info);
chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgetrs_("N", &c__2, &c__1, a, &c__1, ip, b, &c__2, &info);
chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
sgetrs_("N", &c__2, &c__1, a, &c__2, ip, b, &c__1, &info);
chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGERFS */
s_copy(srnamc_1.srnamt, "SGERFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgerfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgerfs_("N", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgerfs_("N", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgerfs_("N", &c__2, &c__1, a, &c__1, af, &c__2, ip, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__1, ip, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__1, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__2, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGERFSX */
n_err_bnds__ = 3;
nparams = 0;
s_copy(srnamc_1.srnamt, "SGERFSX", (ftnlen)32, (ftnlen)7);
infoc_1.infot = 1;
sgerfsx_("/", eq, &c__0, &c__0, a, &c__1, af, &c__1, ip, r__, c__, b,
&c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__,
err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
*(unsigned char *)eq = '/';
sgerfsx_("N", eq, &c__2, &c__1, a, &c__1, af, &c__2, ip, r__, c__, b,
&c__2, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__,
err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
*(unsigned char *)eq = 'R';
sgerfsx_("N", eq, &c_n1, &c__0, a, &c__1, af, &c__1, ip, r__, c__, b,
&c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__,
err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgerfsx_("N", eq, &c__0, &c_n1, a, &c__1, af, &c__1, ip, r__, c__, b,
&c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__,
err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgerfsx_("N", eq, &c__2, &c__1, a, &c__1, af, &c__2, ip, r__, c__, b,
&c__2, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__,
err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
sgerfsx_("N", eq, &c__2, &c__1, a, &c__2, af, &c__1, ip, r__, c__, b,
&c__2, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__,
err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
*(unsigned char *)eq = 'C';
sgerfsx_("N", eq, &c__2, &c__1, a, &c__2, af, &c__2, ip, r__, c__, b,
&c__1, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__,
err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
sgerfsx_("N", eq, &c__2, &c__1, a, &c__2, af, &c__2, ip, r__, c__, b,
&c__2, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__,
err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGECON */
s_copy(srnamc_1.srnamt, "SGECON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgecon_("/", &c__0, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgecon_("1", &c_n1, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgecon_("1", &c__2, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGEEQU */
s_copy(srnamc_1.srnamt, "SGEEQU", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgeequ_(&c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info);
chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgeequ_(&c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info);
chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgeequ_(&c__2, &c__2, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info);
chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGEEQUB */
s_copy(srnamc_1.srnamt, "SGEEQUB", (ftnlen)32, (ftnlen)7);
infoc_1.infot = 1;
sgeequb_(&c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info)
;
chkxer_("SGEEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgeequb_(&c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info)
;
chkxer_("SGEEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgeequb_(&c__2, &c__2, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info)
;
chkxer_("SGEEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "GB")) {
/* Test error exits of the routines that use the LU decomposition */
/* of a general band matrix. */
/* SGBTRF */
s_copy(srnamc_1.srnamt, "SGBTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgbtrf_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbtrf_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbtrf_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbtrf_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgbtrf_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info);
chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBTF2 */
s_copy(srnamc_1.srnamt, "SGBTF2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgbtf2_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbtf2_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbtf2_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbtf2_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgbtf2_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info);
chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBTRS */
s_copy(srnamc_1.srnamt, "SGBTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgbtrs_("/", &c__0, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbtrs_("N", &c_n1, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbtrs_("N", &c__1, &c_n1, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbtrs_("N", &c__1, &c__0, &c_n1, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgbtrs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgbtrs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, ip, b, &c__2, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sgbtrs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBRFS */
s_copy(srnamc_1.srnamt, "SGBRFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgbrfs_("/", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbrfs_("N", &c_n1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbrfs_("N", &c__1, &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbrfs_("N", &c__1, &c__0, &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgbrfs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgbrfs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__2, af, &c__4, ip, b, &
c__2, x, &c__2, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
sgbrfs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__3, ip, b, &
c__2, x, &c__2, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
sgbrfs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__2, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
sgbrfs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, af, &c__1, ip, b, &
c__2, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBRFSX */
n_err_bnds__ = 3;
nparams = 0;
s_copy(srnamc_1.srnamt, "SGBRFSX", (ftnlen)32, (ftnlen)7);
infoc_1.infot = 1;
sgbrfsx_("/", eq, &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip,
r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__,
err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
*(unsigned char *)eq = '/';
sgbrfsx_("N", eq, &c__2, &c__1, &c__1, &c__1, a, &c__1, af, &c__2, ip,
r__, c__, b, &c__2, x, &c__2, &rcond, &berr, &n_err_bnds__,
err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
*(unsigned char *)eq = 'R';
sgbrfsx_("N", eq, &c_n1, &c__1, &c__1, &c__0, a, &c__1, af, &c__1, ip,
r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__,
err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
*(unsigned char *)eq = 'R';
sgbrfsx_("N", eq, &c__2, &c_n1, &c__1, &c__1, a, &c__3, af, &c__4, ip,
r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__,
err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
*(unsigned char *)eq = 'R';
sgbrfsx_("N", eq, &c__2, &c__1, &c_n1, &c__1, a, &c__3, af, &c__4, ip,
r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__,
err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgbrfsx_("N", eq, &c__0, &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, ip,
r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__,
err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
sgbrfsx_("N", eq, &c__2, &c__1, &c__1, &c__1, a, &c__1, af, &c__2, ip,
r__, c__, b, &c__2, x, &c__2, &rcond, &berr, &n_err_bnds__,
err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sgbrfsx_("N", eq, &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__3, ip,
r__, c__, b, &c__2, x, &c__2, &rcond, &berr, &n_err_bnds__,
err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
*(unsigned char *)eq = 'C';
sgbrfsx_("N", eq, &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__5, ip,
r__, c__, b, &c__1, x, &c__2, &rcond, &berr, &n_err_bnds__,
err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
sgbrfsx_("N", eq, &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__5, ip,
r__, c__, b, &c__2, x, &c__1, &rcond, &berr, &n_err_bnds__,
err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info);
chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBCON */
s_copy(srnamc_1.srnamt, "SGBCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgbcon_("/", &c__0, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbcon_("1", &c_n1, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbcon_("1", &c__1, &c_n1, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbcon_("1", &c__1, &c__0, &c_n1, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgbcon_("1", &c__2, &c__1, &c__1, a, &c__3, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBEQU */
s_copy(srnamc_1.srnamt, "SGBEQU", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgbequ_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbequ_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbequ_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbequ_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgbequ_(&c__2, &c__2, &c__1, &c__1, a, &c__2, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBEQUB */
s_copy(srnamc_1.srnamt, "SGBEQUB", (ftnlen)32, (ftnlen)7);
infoc_1.infot = 1;
sgbequb_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbequb_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbequb_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbequb_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgbequb_(&c__2, &c__2, &c__1, &c__1, a, &c__2, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
}
/* Print a summary line. */
alaesm_(path, &infoc_1.ok, &infoc_1.nout);
return 0;
/* End of SERRGE */
} /* serrge_ */
/* Subroutine */ int serrge_(char *path, integer *nunit)
{
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer info;
static real anrm, a[16] /* was [4][4] */, b[4];
static integer i__, j;
static real ccond, w[12], x[4], rcond;
static char c2[2];
static real r1[4], r2[4];
extern /* Subroutine */ int sgbtf2_(integer *, integer *, integer *,
integer *, real *, integer *, integer *, integer *), sgetf2_(
integer *, integer *, real *, integer *, integer *, integer *);
static real af[16] /* was [4][4] */;
static integer ip[4], iw[4];
extern /* Subroutine */ int alaesm_(char *, logical *, integer *),
sgbcon_(char *, integer *, integer *, integer *, real *, integer
*, integer *, real *, real *, real *, integer *, integer *), sgecon_(char *, integer *, real *, integer *, real *,
real *, real *, integer *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), sgbequ_(integer *, integer *, integer *,
integer *, real *, integer *, real *, real *, real *, real *,
real *, integer *), sgbrfs_(char *, integer *, integer *, integer
*, integer *, real *, integer *, real *, integer *, integer *,
real *, integer *, real *, integer *, real *, real *, real *,
integer *, integer *), sgbtrf_(integer *, integer *,
integer *, integer *, real *, integer *, integer *, integer *),
sgeequ_(integer *, integer *, real *, integer *, real *, real *,
real *, real *, real *, integer *), sgerfs_(char *, integer *,
integer *, real *, integer *, real *, integer *, integer *, real *
, integer *, real *, integer *, real *, real *, real *, integer *,
integer *), sgetrf_(integer *, integer *, real *,
integer *, integer *, integer *), sgetri_(integer *, real *,
integer *, integer *, real *, integer *, integer *), sgbtrs_(char
*, integer *, integer *, integer *, integer *, real *, integer *,
integer *, real *, integer *, integer *), sgetrs_(char *,
integer *, integer *, real *, integer *, integer *, real *,
integer *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
#define a_ref(a_1,a_2) a[(a_2)*4 + a_1 - 5]
#define af_ref(a_1,a_2) af[(a_2)*4 + a_1 - 5]
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
February 29, 1992
Purpose
=======
SERRGE tests the error exits for the REAL routines
for general matrices.
Arguments
=========
PATH (input) CHARACTER*3
The LAPACK path name for the routines to be tested.
NUNIT (input) INTEGER
The unit number for output.
===================================================================== */
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 <= 4; ++j) {
for (i__ = 1; i__ <= 4; ++i__) {
a_ref(i__, j) = 1.f / (real) (i__ + j);
af_ref(i__, j) = 1.f / (real) (i__ + j);
/* L10: */
}
b[j - 1] = 0.f;
r1[j - 1] = 0.f;
r2[j - 1] = 0.f;
w[j - 1] = 0.f;
x[j - 1] = 0.f;
ip[j - 1] = j;
iw[j - 1] = j;
/* L20: */
}
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "GE")) {
/* Test error exits of the routines that use the LU decomposition
of a general matrix.
SGETRF */
s_copy(srnamc_1.srnamt, "SGETRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgetrf_(&c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgetrf_(&c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgetrf_(&c__2, &c__1, a, &c__1, ip, &info);
chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGETF2 */
s_copy(srnamc_1.srnamt, "SGETF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgetf2_(&c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgetf2_(&c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgetf2_(&c__2, &c__1, a, &c__1, ip, &info);
chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGETRI */
s_copy(srnamc_1.srnamt, "SGETRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgetri_(&c_n1, a, &c__1, ip, w, &c__12, &info);
chkxer_("SGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgetri_(&c__2, a, &c__1, ip, w, &c__12, &info);
chkxer_("SGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGETRS */
s_copy(srnamc_1.srnamt, "SGETRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgetrs_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgetrs_("N", &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgetrs_("N", &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info);
chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgetrs_("N", &c__2, &c__1, a, &c__1, ip, b, &c__2, &info);
chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
sgetrs_("N", &c__2, &c__1, a, &c__2, ip, b, &c__1, &info);
chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGERFS */
s_copy(srnamc_1.srnamt, "SGERFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgerfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgerfs_("N", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgerfs_("N", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgerfs_("N", &c__2, &c__1, a, &c__1, af, &c__2, ip, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__1, ip, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__1, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__2, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGECON */
s_copy(srnamc_1.srnamt, "SGECON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgecon_("/", &c__0, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgecon_("1", &c_n1, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgecon_("1", &c__2, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGEEQU */
s_copy(srnamc_1.srnamt, "SGEEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgeequ_(&c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info);
chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgeequ_(&c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info);
chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgeequ_(&c__2, &c__2, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info);
chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "GB")) {
/* Test error exits of the routines that use the LU decomposition
of a general band matrix.
SGBTRF */
s_copy(srnamc_1.srnamt, "SGBTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgbtrf_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbtrf_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbtrf_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbtrf_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgbtrf_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info);
chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBTF2 */
s_copy(srnamc_1.srnamt, "SGBTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgbtf2_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbtf2_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbtf2_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbtf2_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgbtf2_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info);
chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBTRS */
s_copy(srnamc_1.srnamt, "SGBTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgbtrs_("/", &c__0, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbtrs_("N", &c_n1, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbtrs_("N", &c__1, &c_n1, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbtrs_("N", &c__1, &c__0, &c_n1, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgbtrs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgbtrs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, ip, b, &c__2, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sgbtrs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBRFS */
s_copy(srnamc_1.srnamt, "SGBRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgbrfs_("/", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbrfs_("N", &c_n1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbrfs_("N", &c__1, &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbrfs_("N", &c__1, &c__0, &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgbrfs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgbrfs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__2, af, &c__4, ip, b, &
c__2, x, &c__2, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
sgbrfs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__3, ip, b, &
c__2, x, &c__2, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
sgbrfs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, af, &c__1, ip, b, &
c__1, x, &c__2, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
sgbrfs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, af, &c__1, ip, b, &
c__2, x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBCON */
s_copy(srnamc_1.srnamt, "SGBCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgbcon_("/", &c__0, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbcon_("1", &c_n1, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbcon_("1", &c__1, &c_n1, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbcon_("1", &c__1, &c__0, &c_n1, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgbcon_("1", &c__2, &c__1, &c__1, a, &c__3, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGBEQU */
s_copy(srnamc_1.srnamt, "SGBEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgbequ_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgbequ_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgbequ_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgbequ_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgbequ_(&c__2, &c__2, &c__1, &c__1, a, &c__2, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
}
/* Print a summary line. */
alaesm_(path, &infoc_1.ok, &infoc_1.nout);
return 0;
/* End of SERRGE */
} /* serrge_ */
/* Subroutine */ int sdrvgb_(logical *dotype, integer *nn, integer *nval,
integer *nrhs, real *thresh, logical *tsterr, real *a, integer *la,
real *afb, integer *lafb, real *asav, real *b, real *bsav, real *x,
real *xact, real *s, real *work, real *rwork, integer *iwork, integer
*nout)
{
/* Initialized data */
static integer iseedy[4] = { 1988,1989,1990,1991 };
static char transs[1*3] = "N" "T" "C";
static char facts[1*3] = "F" "N" "E";
static char equeds[1*4] = "N" "R" "C" "B";
/* Format strings */
static char fmt_9999[] = "(\002 *** In SDRVGB, LA=\002,i5,\002 is too sm"
"all for N=\002,i5,\002, KU=\002,i5,\002, KL=\002,i5,/\002 ==> In"
"crease LA to at least \002,i5)";
static char fmt_9998[] = "(\002 *** In SDRVGB, LAFB=\002,i5,\002 is too "
"small for N=\002,i5,\002, KU=\002,i5,\002, KL=\002,i5,/\002 ==> "
"Increase LAFB to at least \002,i5)";
static char fmt_9997[] = "(1x,a,\002, N=\002,i5,\002, KL=\002,i5,\002, K"
"U=\002,i5,\002, type \002,i1,\002, test(\002,i1,\002)=\002,g12.5)"
;
static char fmt_9995[] = "(1x,a,\002( '\002,a1,\002','\002,a1,\002',\002"
",i5,\002,\002,i5,\002,\002,i5,\002,...), EQUED='\002,a1,\002', t"
"ype \002,i1,\002, test(\002,i1,\002)=\002,g12.5)";
static char fmt_9996[] = "(1x,a,\002( '\002,a1,\002','\002,a1,\002',\002"
",i5,\002,\002,i5,\002,\002,i5,\002,...), type \002,i1,\002, test("
"\002,i1,\002)=\002,g12.5)";
/* System generated locals */
address a__1[2];
integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10,
i__11[2];
real r__1, r__2, r__3;
char ch__1[2];
/* Local variables */
integer i__, j, k, n, i1, i2, k1, nb, in, kl, ku, nt, lda, ldb, ikl, nkl,
iku, nku;
char fact[1];
integer ioff, mode;
real amax;
char path[3];
integer imat, info;
char dist[1], type__[1];
integer nrun, ldafb, ifact, nfail, iseed[4], nfact;
char equed[1];
integer nbmin;
real rcond, roldc;
integer nimat;
real roldi;
real anorm;
integer itran;
logical equil;
real roldo;
char trans[1];
integer izero, nerrs;
logical zerot;
char xtype[1];
logical prefac;
real colcnd;
real rcondc;
logical nofact;
integer iequed;
real rcondi;
real cndnum, anormi, rcondo, ainvnm;
logical trfcon;
real anormo, rowcnd;
real anrmpv;
real result[7], rpvgrw;
/* Fortran I/O blocks */
static cilist io___26 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___27 = { 0, 0, 0, fmt_9998, 0 };
static cilist io___65 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___72 = { 0, 0, 0, fmt_9995, 0 };
static cilist io___73 = { 0, 0, 0, fmt_9996, 0 };
static cilist io___74 = { 0, 0, 0, fmt_9995, 0 };
static cilist io___75 = { 0, 0, 0, fmt_9996, 0 };
static cilist io___76 = { 0, 0, 0, fmt_9995, 0 };
static cilist io___77 = { 0, 0, 0, fmt_9996, 0 };
static cilist io___78 = { 0, 0, 0, fmt_9995, 0 };
static cilist io___79 = { 0, 0, 0, fmt_9996, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SDRVGB tests the driver routines SGBSV and -SVX. */
/* Arguments */
/* ========= */
/* DOTYPE (input) LOGICAL array, dimension (NTYPES) */
/* The matrix types to be used for testing. Matrices of type j */
/* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
/* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */
/* NN (input) INTEGER */
/* The number of values of N contained in the vector NVAL. */
/* NVAL (input) INTEGER array, dimension (NN) */
/* The values of the matrix column dimension N. */
/* NRHS (input) INTEGER */
/* The number of right hand side vectors to be generated for */
/* each linear system. */
/* THRESH (input) REAL */
/* The threshold value for the test ratios. A result is */
/* included in the output file if RESULT >= THRESH. To have */
/* every test ratio printed, use THRESH = 0. */
/* TSTERR (input) LOGICAL */
/* Flag that indicates whether error exits are to be tested. */
/* A (workspace) REAL array, dimension (LA) */
/* LA (input) INTEGER */
/* The length of the array A. LA >= (2*NMAX-1)*NMAX */
/* where NMAX is the largest entry in NVAL. */
/* AFB (workspace) REAL array, dimension (LAFB) */
/* LAFB (input) INTEGER */
/* The length of the array AFB. LAFB >= (3*NMAX-2)*NMAX */
/* where NMAX is the largest entry in NVAL. */
/* ASAV (workspace) REAL array, dimension (LA) */
/* B (workspace) REAL array, dimension (NMAX*NRHS) */
/* BSAV (workspace) REAL array, dimension (NMAX*NRHS) */
/* X (workspace) REAL array, dimension (NMAX*NRHS) */
/* XACT (workspace) REAL array, dimension (NMAX*NRHS) */
/* S (workspace) REAL array, dimension (2*NMAX) */
/* WORK (workspace) REAL array, dimension */
/* (NMAX*max(3,NRHS,NMAX)) */
/* RWORK (workspace) REAL array, dimension */
/* (max(NMAX,2*NRHS)) */
/* IWORK (workspace) INTEGER array, dimension (2*NMAX) */
/* NOUT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Data statements .. */
/* Parameter adjustments */
--iwork;
--rwork;
--work;
--s;
--xact;
--x;
--bsav;
--b;
--asav;
--afb;
--a;
--nval;
--dotype;
/* Function Body */
/* .. */
/* .. Executable Statements .. */
/* Initialize constants and the random number seed. */
s_copy(path, "Single precision", (ftnlen)1, (ftnlen)16);
s_copy(path + 1, "GB", (ftnlen)2, (ftnlen)2);
nrun = 0;
nfail = 0;
nerrs = 0;
for (i__ = 1; i__ <= 4; ++i__) {
iseed[i__ - 1] = iseedy[i__ - 1];
/* L10: */
}
/* Test the error exits */
if (*tsterr) {
serrvx_(path, nout);
}
infoc_1.infot = 0;
/* Set the block size and minimum block size for testing. */
nb = 1;
nbmin = 2;
xlaenv_(&c__1, &nb);
xlaenv_(&c__2, &nbmin);
/* Do for each value of N in NVAL */
i__1 = *nn;
for (in = 1; in <= i__1; ++in) {
n = nval[in];
ldb = max(n,1);
*(unsigned char *)xtype = 'N';
/* Set limits on the number of loop iterations. */
/* Computing MAX */
i__2 = 1, i__3 = min(n,4);
nkl = max(i__2,i__3);
if (n == 0) {
nkl = 1;
}
nku = nkl;
nimat = 8;
if (n <= 0) {
nimat = 1;
}
i__2 = nkl;
for (ikl = 1; ikl <= i__2; ++ikl) {
/* Do for KL = 0, N-1, (3N-1)/4, and (N+1)/4. This order makes */
/* it easier to skip redundant values for small values of N. */
if (ikl == 1) {
kl = 0;
} else if (ikl == 2) {
/* Computing MAX */
i__3 = n - 1;
kl = max(i__3,0);
} else if (ikl == 3) {
kl = (n * 3 - 1) / 4;
} else if (ikl == 4) {
kl = (n + 1) / 4;
}
i__3 = nku;
for (iku = 1; iku <= i__3; ++iku) {
/* Do for KU = 0, N-1, (3N-1)/4, and (N+1)/4. This order */
/* makes it easier to skip redundant values for small */
/* values of N. */
if (iku == 1) {
ku = 0;
} else if (iku == 2) {
/* Computing MAX */
i__4 = n - 1;
ku = max(i__4,0);
} else if (iku == 3) {
ku = (n * 3 - 1) / 4;
} else if (iku == 4) {
ku = (n + 1) / 4;
}
/* Check that A and AFB are big enough to generate this */
/* matrix. */
lda = kl + ku + 1;
ldafb = (kl << 1) + ku + 1;
if (lda * n > *la || ldafb * n > *lafb) {
if (nfail == 0 && nerrs == 0) {
aladhd_(nout, path);
}
if (lda * n > *la) {
io___26.ciunit = *nout;
s_wsfe(&io___26);
do_fio(&c__1, (char *)&(*la), (ftnlen)sizeof(integer))
;
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
i__4 = n * (kl + ku + 1);
do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
e_wsfe();
++nerrs;
}
if (ldafb * n > *lafb) {
io___27.ciunit = *nout;
s_wsfe(&io___27);
do_fio(&c__1, (char *)&(*lafb), (ftnlen)sizeof(
integer));
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
i__4 = n * ((kl << 1) + ku + 1);
do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
e_wsfe();
++nerrs;
}
goto L130;
}
i__4 = nimat;
for (imat = 1; imat <= i__4; ++imat) {
/* Do the tests only if DOTYPE( IMAT ) is true. */
if (! dotype[imat]) {
goto L120;
}
/* Skip types 2, 3, or 4 if the matrix is too small. */
zerot = imat >= 2 && imat <= 4;
if (zerot && n < imat - 1) {
goto L120;
}
/* Set up parameters with SLATB4 and generate a */
/* test matrix with SLATMS. */
slatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &
mode, &cndnum, dist);
rcondc = 1.f / cndnum;
s_copy(srnamc_1.srnamt, "SLATMS", (ftnlen)32, (ftnlen)6);
slatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &
cndnum, &anorm, &kl, &ku, "Z", &a[1], &lda, &work[
1], &info);
/* Check the error code from SLATMS. */
if (info != 0) {
alaerh_(path, "SLATMS", &info, &c__0, " ", &n, &n, &
kl, &ku, &c_n1, &imat, &nfail, &nerrs, nout);
goto L120;
}
/* For types 2, 3, and 4, zero one or more columns of */
/* the matrix to test that INFO is returned correctly. */
izero = 0;
if (zerot) {
if (imat == 2) {
izero = 1;
} else if (imat == 3) {
izero = n;
} else {
izero = n / 2 + 1;
}
ioff = (izero - 1) * lda;
if (imat < 4) {
/* Computing MAX */
i__5 = 1, i__6 = ku + 2 - izero;
i1 = max(i__5,i__6);
/* Computing MIN */
i__5 = kl + ku + 1, i__6 = ku + 1 + (n - izero);
i2 = min(i__5,i__6);
i__5 = i2;
for (i__ = i1; i__ <= i__5; ++i__) {
a[ioff + i__] = 0.f;
/* L20: */
}
} else {
i__5 = n;
for (j = izero; j <= i__5; ++j) {
/* Computing MAX */
i__6 = 1, i__7 = ku + 2 - j;
/* Computing MIN */
i__9 = kl + ku + 1, i__10 = ku + 1 + (n - j);
i__8 = min(i__9,i__10);
for (i__ = max(i__6,i__7); i__ <= i__8; ++i__)
{
a[ioff + i__] = 0.f;
/* L30: */
}
ioff += lda;
/* L40: */
}
}
}
/* Save a copy of the matrix A in ASAV. */
i__5 = kl + ku + 1;
slacpy_("Full", &i__5, &n, &a[1], &lda, &asav[1], &lda);
for (iequed = 1; iequed <= 4; ++iequed) {
*(unsigned char *)equed = *(unsigned char *)&equeds[
iequed - 1];
if (iequed == 1) {
nfact = 3;
} else {
nfact = 1;
}
i__5 = nfact;
for (ifact = 1; ifact <= i__5; ++ifact) {
*(unsigned char *)fact = *(unsigned char *)&facts[
ifact - 1];
prefac = lsame_(fact, "F");
nofact = lsame_(fact, "N");
equil = lsame_(fact, "E");
if (zerot) {
if (prefac) {
goto L100;
}
rcondo = 0.f;
rcondi = 0.f;
} else if (! nofact) {
/* Compute the condition number for comparison */
/* with the value returned by SGESVX (FACT = */
/* 'N' reuses the condition number from the */
/* previous iteration with FACT = 'F'). */
i__8 = kl + ku + 1;
slacpy_("Full", &i__8, &n, &asav[1], &lda, &
afb[kl + 1], &ldafb);
if (equil || iequed > 1) {
/* Compute row and column scale factors to */
/* equilibrate the matrix A. */
sgbequ_(&n, &n, &kl, &ku, &afb[kl + 1], &
ldafb, &s[1], &s[n + 1], &rowcnd,
&colcnd, &amax, &info);
if (info == 0 && n > 0) {
if (lsame_(equed, "R")) {
rowcnd = 0.f;
colcnd = 1.f;
} else if (lsame_(equed, "C")) {
rowcnd = 1.f;
colcnd = 0.f;
} else if (lsame_(equed, "B")) {
rowcnd = 0.f;
colcnd = 0.f;
}
/* Equilibrate the matrix. */
slaqgb_(&n, &n, &kl, &ku, &afb[kl + 1]
, &ldafb, &s[1], &s[n + 1], &
rowcnd, &colcnd, &amax, equed);
}
}
/* Save the condition number of the */
/* non-equilibrated system for use in SGET04. */
if (equil) {
roldo = rcondo;
roldi = rcondi;
}
/* Compute the 1-norm and infinity-norm of A. */
anormo = slangb_("1", &n, &kl, &ku, &afb[kl +
1], &ldafb, &rwork[1]);
anormi = slangb_("I", &n, &kl, &ku, &afb[kl +
1], &ldafb, &rwork[1]);
/* Factor the matrix A. */
sgbtrf_(&n, &n, &kl, &ku, &afb[1], &ldafb, &
iwork[1], &info);
/* Form the inverse of A. */
slaset_("Full", &n, &n, &c_b48, &c_b49, &work[
1], &ldb);
s_copy(srnamc_1.srnamt, "SGBTRS", (ftnlen)32,
(ftnlen)6);
sgbtrs_("No transpose", &n, &kl, &ku, &n, &
afb[1], &ldafb, &iwork[1], &work[1], &
ldb, &info);
/* Compute the 1-norm condition number of A. */
ainvnm = slange_("1", &n, &n, &work[1], &ldb,
&rwork[1]);
if (anormo <= 0.f || ainvnm <= 0.f) {
rcondo = 1.f;
} else {
rcondo = 1.f / anormo / ainvnm;
}
/* Compute the infinity-norm condition number */
/* of A. */
ainvnm = slange_("I", &n, &n, &work[1], &ldb,
&rwork[1]);
if (anormi <= 0.f || ainvnm <= 0.f) {
rcondi = 1.f;
} else {
rcondi = 1.f / anormi / ainvnm;
}
}
for (itran = 1; itran <= 3; ++itran) {
/* Do for each value of TRANS. */
*(unsigned char *)trans = *(unsigned char *)&
transs[itran - 1];
if (itran == 1) {
rcondc = rcondo;
} else {
rcondc = rcondi;
}
/* Restore the matrix A. */
i__8 = kl + ku + 1;
slacpy_("Full", &i__8, &n, &asav[1], &lda, &a[
1], &lda);
/* Form an exact solution and set the right hand */
/* side. */
s_copy(srnamc_1.srnamt, "SLARHS", (ftnlen)32,
(ftnlen)6);
slarhs_(path, xtype, "Full", trans, &n, &n, &
kl, &ku, nrhs, &a[1], &lda, &xact[1],
&ldb, &b[1], &ldb, iseed, &info);
*(unsigned char *)xtype = 'C';
slacpy_("Full", &n, nrhs, &b[1], &ldb, &bsav[
1], &ldb);
if (nofact && itran == 1) {
/* --- Test SGBSV --- */
/* Compute the LU factorization of the matrix */
/* and solve the system. */
i__8 = kl + ku + 1;
slacpy_("Full", &i__8, &n, &a[1], &lda, &
afb[kl + 1], &ldafb);
slacpy_("Full", &n, nrhs, &b[1], &ldb, &x[
1], &ldb);
s_copy(srnamc_1.srnamt, "SGBSV ", (ftnlen)
32, (ftnlen)6);
sgbsv_(&n, &kl, &ku, nrhs, &afb[1], &
ldafb, &iwork[1], &x[1], &ldb, &
info);
/* Check error code from SGBSV . */
if (info != izero) {
alaerh_(path, "SGBSV ", &info, &izero,
" ", &n, &n, &kl, &ku, nrhs,
&imat, &nfail, &nerrs, nout);
}
/* Reconstruct matrix from factors and */
/* compute residual. */
sgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
afb[1], &ldafb, &iwork[1], &work[
1], result);
nt = 1;
if (izero == 0) {
/* Compute residual of the computed */
/* solution. */
slacpy_("Full", &n, nrhs, &b[1], &ldb,
&work[1], &ldb);
sgbt02_("No transpose", &n, &n, &kl, &
ku, nrhs, &a[1], &lda, &x[1],
&ldb, &work[1], &ldb, &result[
1]);
/* Check solution from generated exact */
/* solution. */
sget04_(&n, nrhs, &x[1], &ldb, &xact[
1], &ldb, &rcondc, &result[2])
;
nt = 3;
}
/* Print information about the tests that did */
/* not pass the threshold. */
i__8 = nt;
for (k = 1; k <= i__8; ++k) {
if (result[k - 1] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
aladhd_(nout, path);
}
io___65.ciunit = *nout;
s_wsfe(&io___65);
do_fio(&c__1, "SGBSV ", (ftnlen)6)
;
do_fio(&c__1, (char *)&n, (ftnlen)
sizeof(integer));
do_fio(&c__1, (char *)&kl, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&imat, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&k, (ftnlen)
sizeof(integer));
do_fio(&c__1, (char *)&result[k -
1], (ftnlen)sizeof(real));
e_wsfe();
++nfail;
}
/* L50: */
}
nrun += nt;
}
/* --- Test SGBSVX --- */
if (! prefac) {
i__8 = (kl << 1) + ku + 1;
slaset_("Full", &i__8, &n, &c_b48, &c_b48,
&afb[1], &ldafb);
}
slaset_("Full", &n, nrhs, &c_b48, &c_b48, &x[
1], &ldb);
if (iequed > 1 && n > 0) {
/* Equilibrate the matrix if FACT = 'F' and */
/* EQUED = 'R', 'C', or 'B'. */
slaqgb_(&n, &n, &kl, &ku, &a[1], &lda, &s[
1], &s[n + 1], &rowcnd, &colcnd, &
amax, equed);
}
/* Solve the system and compute the condition */
/* number and error bounds using SGBSVX. */
s_copy(srnamc_1.srnamt, "SGBSVX", (ftnlen)32,
(ftnlen)6);
sgbsvx_(fact, trans, &n, &kl, &ku, nrhs, &a[1]
, &lda, &afb[1], &ldafb, &iwork[1],
equed, &s[1], &s[n + 1], &b[1], &ldb,
&x[1], &ldb, &rcond, &rwork[1], &
rwork[*nrhs + 1], &work[1], &iwork[n
+ 1], &info);
/* Check the error code from SGBSVX. */
if (info != izero) {
/* Writing concatenation */
i__11[0] = 1, a__1[0] = fact;
i__11[1] = 1, a__1[1] = trans;
s_cat(ch__1, a__1, i__11, &c__2, (ftnlen)
2);
alaerh_(path, "SGBSVX", &info, &izero,
ch__1, &n, &n, &kl, &ku, nrhs, &
imat, &nfail, &nerrs, nout);
}
/* Compare WORK(1) from SGBSVX with the computed */
/* reciprocal pivot growth factor RPVGRW */
if (info != 0) {
anrmpv = 0.f;
i__8 = info;
for (j = 1; j <= i__8; ++j) {
/* Computing MAX */
i__6 = ku + 2 - j;
/* Computing MIN */
i__9 = n + ku + 1 - j, i__10 = kl +
ku + 1;
i__7 = min(i__9,i__10);
for (i__ = max(i__6,1); i__ <= i__7;
++i__) {
/* Computing MAX */
r__2 = anrmpv, r__3 = (r__1 = a[
i__ + (j - 1) * lda],
dabs(r__1));
anrmpv = dmax(r__2,r__3);
/* L60: */
}
/* L70: */
}
/* Computing MIN */
i__7 = info - 1, i__6 = kl + ku;
i__8 = min(i__7,i__6);
/* Computing MAX */
i__9 = 1, i__10 = kl + ku + 2 - info;
rpvgrw = slantb_("M", "U", "N", &info, &
i__8, &afb[max(i__9, i__10)], &
ldafb, &work[1]);
if (rpvgrw == 0.f) {
rpvgrw = 1.f;
} else {
rpvgrw = anrmpv / rpvgrw;
}
} else {
i__8 = kl + ku;
rpvgrw = slantb_("M", "U", "N", &n, &i__8,
&afb[1], &ldafb, &work[1]);
if (rpvgrw == 0.f) {
rpvgrw = 1.f;
} else {
rpvgrw = slangb_("M", &n, &kl, &ku, &
a[1], &lda, &work[1]) / rpvgrw;
}
}
result[6] = (r__1 = rpvgrw - work[1], dabs(
r__1)) / dmax(work[1],rpvgrw) /
slamch_("E");
if (! prefac) {
/* Reconstruct matrix from factors and */
/* compute residual. */
sgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
afb[1], &ldafb, &iwork[1], &work[
1], result);
k1 = 1;
} else {
k1 = 2;
}
if (info == 0) {
trfcon = FALSE_;
/* Compute residual of the computed solution. */
slacpy_("Full", &n, nrhs, &bsav[1], &ldb,
&work[1], &ldb);
sgbt02_(trans, &n, &n, &kl, &ku, nrhs, &
asav[1], &lda, &x[1], &ldb, &work[
1], &ldb, &result[1]);
/* Check solution from generated exact */
/* solution. */
if (nofact || prefac && lsame_(equed,
"N")) {
sget04_(&n, nrhs, &x[1], &ldb, &xact[
1], &ldb, &rcondc, &result[2])
;
} else {
if (itran == 1) {
roldc = roldo;
} else {
roldc = roldi;
}
sget04_(&n, nrhs, &x[1], &ldb, &xact[
1], &ldb, &roldc, &result[2]);
}
/* Check the error bounds from iterative */
/* refinement. */
sgbt05_(trans, &n, &kl, &ku, nrhs, &asav[
1], &lda, &b[1], &ldb, &x[1], &
ldb, &xact[1], &ldb, &rwork[1], &
rwork[*nrhs + 1], &result[3]);
} else {
trfcon = TRUE_;
}
/* Compare RCOND from SGBSVX with the computed */
/* value in RCONDC. */
result[5] = sget06_(&rcond, &rcondc);
/* Print information about the tests that did */
/* not pass the threshold. */
if (! trfcon) {
for (k = k1; k <= 7; ++k) {
if (result[k - 1] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
aladhd_(nout, path);
}
if (prefac) {
io___72.ciunit = *nout;
s_wsfe(&io___72);
do_fio(&c__1, "SGBSVX", (ftnlen)6);
do_fio(&c__1, fact, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
do_fio(&c__1, equed, (ftnlen)1);
do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
);
do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
sizeof(real));
e_wsfe();
} else {
io___73.ciunit = *nout;
s_wsfe(&io___73);
do_fio(&c__1, "SGBSVX", (ftnlen)6);
do_fio(&c__1, fact, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
);
do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
sizeof(real));
e_wsfe();
}
++nfail;
}
/* L80: */
}
nrun = nrun + 7 - k1;
} else {
if (result[0] >= *thresh && ! prefac) {
if (nfail == 0 && nerrs == 0) {
aladhd_(nout, path);
}
if (prefac) {
io___74.ciunit = *nout;
s_wsfe(&io___74);
do_fio(&c__1, "SGBSVX", (ftnlen)6)
;
do_fio(&c__1, fact, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)
sizeof(integer));
do_fio(&c__1, (char *)&kl, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (
ftnlen)sizeof(integer));
do_fio(&c__1, equed, (ftnlen)1);
do_fio(&c__1, (char *)&imat, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__1, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[0],
(ftnlen)sizeof(real));
e_wsfe();
} else {
io___75.ciunit = *nout;
s_wsfe(&io___75);
do_fio(&c__1, "SGBSVX", (ftnlen)6)
;
do_fio(&c__1, fact, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)
sizeof(integer));
do_fio(&c__1, (char *)&kl, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&imat, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__1, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[0],
(ftnlen)sizeof(real));
e_wsfe();
}
++nfail;
++nrun;
}
if (result[5] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
aladhd_(nout, path);
}
if (prefac) {
io___76.ciunit = *nout;
s_wsfe(&io___76);
do_fio(&c__1, "SGBSVX", (ftnlen)6)
;
do_fio(&c__1, fact, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)
sizeof(integer));
do_fio(&c__1, (char *)&kl, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (
ftnlen)sizeof(integer));
do_fio(&c__1, equed, (ftnlen)1);
do_fio(&c__1, (char *)&imat, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__6, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[5],
(ftnlen)sizeof(real));
e_wsfe();
} else {
io___77.ciunit = *nout;
s_wsfe(&io___77);
do_fio(&c__1, "SGBSVX", (ftnlen)6)
;
do_fio(&c__1, fact, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)
sizeof(integer));
do_fio(&c__1, (char *)&kl, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&imat, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__6, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[5],
(ftnlen)sizeof(real));
e_wsfe();
}
++nfail;
++nrun;
}
if (result[6] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
aladhd_(nout, path);
}
if (prefac) {
io___78.ciunit = *nout;
s_wsfe(&io___78);
do_fio(&c__1, "SGBSVX", (ftnlen)6)
;
do_fio(&c__1, fact, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)
sizeof(integer));
do_fio(&c__1, (char *)&kl, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (
ftnlen)sizeof(integer));
do_fio(&c__1, equed, (ftnlen)1);
do_fio(&c__1, (char *)&imat, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__7, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[6],
(ftnlen)sizeof(real));
e_wsfe();
} else {
io___79.ciunit = *nout;
s_wsfe(&io___79);
do_fio(&c__1, "SGBSVX", (ftnlen)6)
;
do_fio(&c__1, fact, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)
sizeof(integer));
do_fio(&c__1, (char *)&kl, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ku, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&imat, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__7, (
ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[6],
(ftnlen)sizeof(real));
e_wsfe();
}
++nfail;
++nrun;
}
}
/* L90: */
}
L100:
;
}
/* L110: */
}
L120:
;
}
L130:
;
}
/* L140: */
}
/* L150: */
}
/* Print a summary of the results. */
alasvm_(path, nout, &nfail, &nrun, &nerrs);
return 0;
/* End of SDRVGB */
} /* sdrvgb_ */
