/* Subroutine */ int cerrtr_(char *path, integer *nunit)
{
/* Local variables */
complex a[4] /* was [2][2] */, b[2], w[2], x[2];
char c2[2];
real r1[2], r2[2], rw[2];
integer info;
real scale, rcond;
/* 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 */
/* ======= */
/* CERRTR tests the error exits for the COMPLEX triangular routines. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name for the routines to be tested. */
/* NUNIT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
a[0].r = 1.f, a[0].i = 0.f;
a[2].r = 2.f, a[2].i = 0.f;
a[3].r = 3.f, a[3].i = 0.f;
a[1].r = 4.f, a[1].i = 0.f;
infoc_1.ok = TRUE_;
/* Test error exits for the general triangular routines. */
if (lsamen_(&c__2, c2, "TR")) {
/* CTRTRI */
s_copy(srnamc_1.srnamt, "CTRTRI", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctrtri_("/", "N", &c__0, a, &c__1, &info);
chkxer_("CTRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctrtri_("U", "/", &c__0, a, &c__1, &info);
chkxer_("CTRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctrtri_("U", "N", &c_n1, a, &c__1, &info);
chkxer_("CTRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
ctrtri_("U", "N", &c__2, a, &c__1, &info);
chkxer_("CTRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CTRTI2 */
s_copy(srnamc_1.srnamt, "CTRTI2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctrti2_("/", "N", &c__0, a, &c__1, &info);
chkxer_("CTRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctrti2_("U", "/", &c__0, a, &c__1, &info);
chkxer_("CTRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctrti2_("U", "N", &c_n1, a, &c__1, &info);
chkxer_("CTRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
ctrti2_("U", "N", &c__2, a, &c__1, &info);
chkxer_("CTRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CTRTRS */
s_copy(srnamc_1.srnamt, "CTRTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctrtrs_("/", "N", "N", &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("CTRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctrtrs_("U", "/", "N", &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("CTRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctrtrs_("U", "N", "/", &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("CTRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ctrtrs_("U", "N", "N", &c_n1, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("CTRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
ctrtrs_("U", "N", "N", &c__0, &c_n1, a, &c__1, x, &c__1, &info);
chkxer_("CTRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
/* CTRRFS */
s_copy(srnamc_1.srnamt, "CTRRFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctrrfs_("/", "N", "N", &c__0, &c__0, a, &c__1, b, &c__1, x, &c__1, r1,
r2, w, rw, &info);
chkxer_("CTRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctrrfs_("U", "/", "N", &c__0, &c__0, a, &c__1, b, &c__1, x, &c__1, r1,
r2, w, rw, &info);
chkxer_("CTRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctrrfs_("U", "N", "/", &c__0, &c__0, a, &c__1, b, &c__1, x, &c__1, r1,
r2, w, rw, &info);
chkxer_("CTRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ctrrfs_("U", "N", "N", &c_n1, &c__0, a, &c__1, b, &c__1, x, &c__1, r1,
r2, w, rw, &info);
chkxer_("CTRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
ctrrfs_("U", "N", "N", &c__0, &c_n1, a, &c__1, b, &c__1, x, &c__1, r1,
r2, w, rw, &info);
chkxer_("CTRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
ctrrfs_("U", "N", "N", &c__2, &c__1, a, &c__1, b, &c__2, x, &c__2, r1,
r2, w, rw, &info);
chkxer_("CTRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
ctrrfs_("U", "N", "N", &c__2, &c__1, a, &c__2, b, &c__1, x, &c__2, r1,
r2, w, rw, &info);
chkxer_("CTRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
ctrrfs_("U", "N", "N", &c__2, &c__1, a, &c__2, b, &c__2, x, &c__1, r1,
r2, w, rw, &info);
chkxer_("CTRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CTRCON */
s_copy(srnamc_1.srnamt, "CTRCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctrcon_("/", "U", "N", &c__0, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctrcon_("1", "/", "N", &c__0, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctrcon_("1", "U", "/", &c__0, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ctrcon_("1", "U", "N", &c_n1, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
ctrcon_("1", "U", "N", &c__2, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CLATRS */
s_copy(srnamc_1.srnamt, "CLATRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
clatrs_("/", "N", "N", "N", &c__0, a, &c__1, x, &scale, rw, &info);
chkxer_("CLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
clatrs_("U", "/", "N", "N", &c__0, a, &c__1, x, &scale, rw, &info);
chkxer_("CLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
clatrs_("U", "N", "/", "N", &c__0, a, &c__1, x, &scale, rw, &info);
chkxer_("CLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
clatrs_("U", "N", "N", "/", &c__0, a, &c__1, x, &scale, rw, &info);
chkxer_("CLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
clatrs_("U", "N", "N", "N", &c_n1, a, &c__1, x, &scale, rw, &info);
chkxer_("CLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
clatrs_("U", "N", "N", "N", &c__2, a, &c__1, x, &scale, rw, &info);
chkxer_("CLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Test error exits for the packed triangular routines. */
} else if (lsamen_(&c__2, c2, "TP")) {
/* CTPTRI */
s_copy(srnamc_1.srnamt, "CTPTRI", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctptri_("/", "N", &c__0, a, &info);
chkxer_("CTPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctptri_("U", "/", &c__0, a, &info);
chkxer_("CTPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctptri_("U", "N", &c_n1, a, &info);
chkxer_("CTPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CTPTRS */
s_copy(srnamc_1.srnamt, "CTPTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctptrs_("/", "N", "N", &c__0, &c__0, a, x, &c__1, &info);
chkxer_("CTPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctptrs_("U", "/", "N", &c__0, &c__0, a, x, &c__1, &info);
chkxer_("CTPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctptrs_("U", "N", "/", &c__0, &c__0, a, x, &c__1, &info);
chkxer_("CTPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ctptrs_("U", "N", "N", &c_n1, &c__0, a, x, &c__1, &info);
chkxer_("CTPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
ctptrs_("U", "N", "N", &c__0, &c_n1, a, x, &c__1, &info);
chkxer_("CTPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
ctptrs_("U", "N", "N", &c__2, &c__1, a, x, &c__1, &info);
chkxer_("CTPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CTPRFS */
s_copy(srnamc_1.srnamt, "CTPRFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctprfs_("/", "N", "N", &c__0, &c__0, a, b, &c__1, x, &c__1, r1, r2, w,
rw, &info);
chkxer_("CTPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctprfs_("U", "/", "N", &c__0, &c__0, a, b, &c__1, x, &c__1, r1, r2, w,
rw, &info);
chkxer_("CTPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctprfs_("U", "N", "/", &c__0, &c__0, a, b, &c__1, x, &c__1, r1, r2, w,
rw, &info);
chkxer_("CTPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ctprfs_("U", "N", "N", &c_n1, &c__0, a, b, &c__1, x, &c__1, r1, r2, w,
rw, &info);
chkxer_("CTPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
ctprfs_("U", "N", "N", &c__0, &c_n1, a, b, &c__1, x, &c__1, r1, r2, w,
rw, &info);
chkxer_("CTPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
ctprfs_("U", "N", "N", &c__2, &c__1, a, b, &c__1, x, &c__2, r1, r2, w,
rw, &info);
chkxer_("CTPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
ctprfs_("U", "N", "N", &c__2, &c__1, a, b, &c__2, x, &c__1, r1, r2, w,
rw, &info);
chkxer_("CTPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CTPCON */
s_copy(srnamc_1.srnamt, "CTPCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctpcon_("/", "U", "N", &c__0, a, &rcond, w, rw, &info);
chkxer_("CTPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctpcon_("1", "/", "N", &c__0, a, &rcond, w, rw, &info);
chkxer_("CTPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctpcon_("1", "U", "/", &c__0, a, &rcond, w, rw, &info);
chkxer_("CTPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ctpcon_("1", "U", "N", &c_n1, a, &rcond, w, rw, &info);
chkxer_("CTPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CLATPS */
s_copy(srnamc_1.srnamt, "CLATPS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
clatps_("/", "N", "N", "N", &c__0, a, x, &scale, rw, &info);
chkxer_("CLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
clatps_("U", "/", "N", "N", &c__0, a, x, &scale, rw, &info);
chkxer_("CLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
clatps_("U", "N", "/", "N", &c__0, a, x, &scale, rw, &info);
chkxer_("CLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
clatps_("U", "N", "N", "/", &c__0, a, x, &scale, rw, &info);
chkxer_("CLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
clatps_("U", "N", "N", "N", &c_n1, a, x, &scale, rw, &info);
chkxer_("CLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Test error exits for the banded triangular routines. */
} else if (lsamen_(&c__2, c2, "TB")) {
/* CTBTRS */
s_copy(srnamc_1.srnamt, "CTBTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctbtrs_("/", "N", "N", &c__0, &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("CTBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctbtrs_("U", "/", "N", &c__0, &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("CTBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctbtrs_("U", "N", "/", &c__0, &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("CTBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ctbtrs_("U", "N", "N", &c_n1, &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("CTBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
ctbtrs_("U", "N", "N", &c__0, &c_n1, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("CTBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
ctbtrs_("U", "N", "N", &c__0, &c__0, &c_n1, a, &c__1, x, &c__1, &info);
chkxer_("CTBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
ctbtrs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__1, x, &c__2, &info);
chkxer_("CTBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
ctbtrs_("U", "N", "N", &c__2, &c__0, &c__1, a, &c__1, x, &c__1, &info);
chkxer_("CTBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CTBRFS */
s_copy(srnamc_1.srnamt, "CTBRFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctbrfs_("/", "N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, rw, &info);
chkxer_("CTBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctbrfs_("U", "/", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, rw, &info);
chkxer_("CTBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctbrfs_("U", "N", "/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, rw, &info);
chkxer_("CTBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ctbrfs_("U", "N", "N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, rw, &info);
chkxer_("CTBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
ctbrfs_("U", "N", "N", &c__0, &c_n1, &c__0, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, rw, &info);
chkxer_("CTBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
ctbrfs_("U", "N", "N", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, rw, &info);
chkxer_("CTBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
ctbrfs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__1, b, &c__2, x, &
c__2, r1, r2, w, rw, &info);
chkxer_("CTBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
ctbrfs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__1, x, &
c__2, r1, r2, w, rw, &info);
chkxer_("CTBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
ctbrfs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, x, &
c__1, r1, r2, w, rw, &info);
chkxer_("CTBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CTBCON */
s_copy(srnamc_1.srnamt, "CTBCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ctbcon_("/", "U", "N", &c__0, &c__0, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ctbcon_("1", "/", "N", &c__0, &c__0, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
ctbcon_("1", "U", "/", &c__0, &c__0, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ctbcon_("1", "U", "N", &c_n1, &c__0, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
ctbcon_("1", "U", "N", &c__0, &c_n1, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
ctbcon_("1", "U", "N", &c__2, &c__1, a, &c__1, &rcond, w, rw, &info);
chkxer_("CTBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CLATBS */
s_copy(srnamc_1.srnamt, "CLATBS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
clatbs_("/", "N", "N", "N", &c__0, &c__0, a, &c__1, x, &scale, rw, &
info);
chkxer_("CLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
clatbs_("U", "/", "N", "N", &c__0, &c__0, a, &c__1, x, &scale, rw, &
info);
chkxer_("CLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
clatbs_("U", "N", "/", "N", &c__0, &c__0, a, &c__1, x, &scale, rw, &
info);
chkxer_("CLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
clatbs_("U", "N", "N", "/", &c__0, &c__0, a, &c__1, x, &scale, rw, &
info);
chkxer_("CLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
clatbs_("U", "N", "N", "N", &c_n1, &c__0, a, &c__1, x, &scale, rw, &
info);
chkxer_("CLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
clatbs_("U", "N", "N", "N", &c__1, &c_n1, a, &c__1, x, &scale, rw, &
info);
chkxer_("CLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
clatbs_("U", "N", "N", "N", &c__2, &c__1, a, &c__1, x, &scale, rw, &
info);
chkxer_("CLATBS", &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 CERRTR */
} /* cerrtr_ */
/* Subroutine */ int serrgt_(char *path, integer *nunit)
{
/* System generated locals */
real r__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
real b[2], c__[2], d__[2], e[2], f[2], w[2], x[2];
char c2[2];
real r1[2], r2[2], cf[2], df[2], ef[2];
integer ip[2], iw[2], info;
real rcond, anorm;
extern /* Subroutine */ int alaesm_(char *, logical *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), sgtcon_(char *, integer *, real *, real *,
real *, real *, integer *, real *, real *, real *, integer *,
integer *), sptcon_(integer *, real *, real *, real *,
real *, real *, integer *), sgtrfs_(char *, integer *, integer *,
real *, real *, real *, real *, real *, real *, real *, integer *,
real *, integer *, real *, integer *, real *, real *, real *,
integer *, integer *), sgttrf_(integer *, real *, real *,
real *, real *, integer *, integer *), sptrfs_(integer *, integer
*, real *, real *, real *, real *, real *, integer *, real *,
integer *, real *, real *, real *, integer *), spttrf_(integer *,
real *, real *, integer *), sgttrs_(char *, integer *, integer *,
real *, real *, real *, real *, integer *, real *, integer *,
integer *), spttrs_(integer *, integer *, real *, 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 */
/* ======= */
/* SERRGT tests the error exits for the REAL tridiagonal */
/* routines. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name for the routines to be tested. */
/* NUNIT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
d__[0] = 1.f;
d__[1] = 2.f;
df[0] = 1.f;
df[1] = 2.f;
e[0] = 3.f;
e[1] = 4.f;
ef[0] = 3.f;
ef[1] = 4.f;
anorm = 1.f;
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "GT")) {
/* Test error exits for the general tridiagonal routines. */
/* SGTTRF */
s_copy(srnamc_1.srnamt, "SGTTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgttrf_(&c_n1, c__, d__, e, f, ip, &info);
chkxer_("SGTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGTTRS */
s_copy(srnamc_1.srnamt, "SGTTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgttrs_("/", &c__0, &c__0, c__, d__, e, f, ip, x, &c__1, &info);
chkxer_("SGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgttrs_("N", &c_n1, &c__0, c__, d__, e, f, ip, x, &c__1, &info);
chkxer_("SGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgttrs_("N", &c__0, &c_n1, c__, d__, e, f, ip, x, &c__1, &info);
chkxer_("SGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sgttrs_("N", &c__2, &c__1, c__, d__, e, f, ip, x, &c__1, &info);
chkxer_("SGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGTRFS */
s_copy(srnamc_1.srnamt, "SGTRFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgtrfs_("/", &c__0, &c__0, c__, d__, e, cf, df, ef, f, ip, b, &c__1,
x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgtrfs_("N", &c_n1, &c__0, c__, d__, e, cf, df, ef, f, ip, b, &c__1,
x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgtrfs_("N", &c__0, &c_n1, c__, d__, e, cf, df, ef, f, ip, b, &c__1,
x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
sgtrfs_("N", &c__2, &c__1, c__, d__, e, cf, df, ef, f, ip, b, &c__1,
x, &c__2, r1, r2, w, iw, &info);
chkxer_("SGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
sgtrfs_("N", &c__2, &c__1, c__, d__, e, cf, df, ef, f, ip, b, &c__2,
x, &c__1, r1, r2, w, iw, &info);
chkxer_("SGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGTCON */
s_copy(srnamc_1.srnamt, "SGTCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgtcon_("/", &c__0, c__, d__, e, f, ip, &anorm, &rcond, w, iw, &info);
chkxer_("SGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgtcon_("I", &c_n1, c__, d__, e, f, ip, &anorm, &rcond, w, iw, &info);
chkxer_("SGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
r__1 = -anorm;
sgtcon_("I", &c__0, c__, d__, e, f, ip, &r__1, &rcond, w, iw, &info);
chkxer_("SGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "PT")) {
/* Test error exits for the positive definite tridiagonal */
/* routines. */
/* SPTTRF */
s_copy(srnamc_1.srnamt, "SPTTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spttrf_(&c_n1, d__, e, &info);
chkxer_("SPTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPTTRS */
s_copy(srnamc_1.srnamt, "SPTTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spttrs_(&c_n1, &c__0, d__, e, x, &c__1, &info);
chkxer_("SPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spttrs_(&c__0, &c_n1, d__, e, x, &c__1, &info);
chkxer_("SPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
spttrs_(&c__2, &c__1, d__, e, x, &c__1, &info);
chkxer_("SPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPTRFS */
s_copy(srnamc_1.srnamt, "SPTRFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sptrfs_(&c_n1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, &
info);
chkxer_("SPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sptrfs_(&c__0, &c_n1, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, &
info);
chkxer_("SPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
sptrfs_(&c__2, &c__1, d__, e, df, ef, b, &c__1, x, &c__2, r1, r2, w, &
info);
chkxer_("SPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sptrfs_(&c__2, &c__1, d__, e, df, ef, b, &c__2, x, &c__1, r1, r2, w, &
info);
chkxer_("SPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPTCON */
s_copy(srnamc_1.srnamt, "SPTCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sptcon_(&c_n1, d__, e, &anorm, &rcond, w, &info);
chkxer_("SPTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
r__1 = -anorm;
sptcon_(&c__0, d__, e, &r__1, &rcond, w, &info);
chkxer_("SPTCON", &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 SERRGT */
} /* serrgt_ */
/* Subroutine */ int zerrhs_(char *path, integer *nunit)
{
/* Format strings */
static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e"
"rror exits\002,\002 (\002,i3,\002 tests done)\002)";
static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes"
"ts of the error \002,\002exits ***\002)";
/* System generated locals */
integer i__1;
doublereal d__1;
/* Local variables */
doublecomplex a[9] /* was [3][3] */, c__[9] /* was [3][3] */;
integer i__, j, m;
doublereal s[3];
doublecomplex w[9], x[3];
char c2[2];
integer nt;
doublecomplex vl[9] /* was [3][3] */, vr[9] /* was [3][3] */;
doublereal rw[3];
integer ihi, ilo;
logical sel[3];
doublecomplex tau[3];
integer info, ifaill[3];
extern /* Subroutine */ int zgebak_(char *, char *, integer *, integer *,
integer *, doublereal *, integer *, doublecomplex *, integer *,
integer *), zgebal_(char *, integer *,
doublecomplex *, integer *, integer *, integer *, doublereal *,
integer *);
integer ifailr[3];
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int zgehrd_(integer *, integer *, integer *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
integer *, integer *), chkxer_(char *, integer *, integer *,
logical *, logical *), zhsein_(char *, char *, char *,
logical *, integer *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, integer *, integer *
, integer *, doublecomplex *, doublereal *, integer *, integer *,
integer *), zhseqr_(char *, char *,
integer *, integer *, integer *, doublecomplex *, integer *,
doublecomplex *, doublecomplex *, integer *, doublecomplex *,
integer *, integer *), ztrevc_(char *, char *,
logical *, integer *, doublecomplex *, integer *, doublecomplex *,
integer *, doublecomplex *, integer *, integer *, integer *,
doublecomplex *, doublereal *, integer *),
zunghr_(integer *, integer *, integer *, doublecomplex *, integer
*, doublecomplex *, doublecomplex *, integer *, integer *),
zunmhr_(char *, char *, integer *, integer *, integer *, integer *
, doublecomplex *, integer *, doublecomplex *, doublecomplex *,
integer *, doublecomplex *, integer *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
static cilist io___22 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___23 = { 0, 0, 0, fmt_9998, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZERRHS tests the error exits for ZGEBAK, CGEBAL, CGEHRD, ZUNGHR, */
/* ZUNMHR, ZHSEQR, CHSEIN, and ZTREVC. */
/* 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 .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Set the variables to innocuous values. */
for (j = 1; j <= 3; ++j) {
for (i__ = 1; i__ <= 3; ++i__) {
i__1 = i__ + j * 3 - 4;
d__1 = 1. / (doublereal) (i__ + j);
a[i__1].r = d__1, a[i__1].i = 0.;
/* L10: */
}
sel[j - 1] = TRUE_;
/* L20: */
}
infoc_1.ok = TRUE_;
nt = 0;
/* Test error exits of the nonsymmetric eigenvalue routines. */
if (lsamen_(&c__2, c2, "HS")) {
/* ZGEBAL */
s_copy(srnamc_1.srnamt, "ZGEBAL", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgebal_("/", &c__0, a, &c__1, &ilo, &ihi, s, &info);
chkxer_("ZGEBAL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgebal_("N", &c_n1, a, &c__1, &ilo, &ihi, s, &info);
chkxer_("ZGEBAL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zgebal_("N", &c__2, a, &c__1, &ilo, &ihi, s, &info);
chkxer_("ZGEBAL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 3;
/* ZGEBAK */
s_copy(srnamc_1.srnamt, "ZGEBAK", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgebak_("/", "R", &c__0, &c__1, &c__0, s, &c__0, a, &c__1, &info);
chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgebak_("N", "/", &c__0, &c__1, &c__0, s, &c__0, a, &c__1, &info);
chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zgebak_("N", "R", &c_n1, &c__1, &c__0, s, &c__0, a, &c__1, &info);
chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zgebak_("N", "R", &c__0, &c__0, &c__0, s, &c__0, a, &c__1, &info);
chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zgebak_("N", "R", &c__0, &c__2, &c__0, s, &c__0, a, &c__1, &info);
chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zgebak_("N", "R", &c__2, &c__2, &c__1, s, &c__0, a, &c__2, &info);
chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zgebak_("N", "R", &c__0, &c__1, &c__1, s, &c__0, a, &c__1, &info);
chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zgebak_("N", "R", &c__0, &c__1, &c__0, s, &c_n1, a, &c__1, &info);
chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
zgebak_("N", "R", &c__2, &c__1, &c__2, s, &c__0, a, &c__1, &info);
chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 9;
/* ZGEHRD */
s_copy(srnamc_1.srnamt, "ZGEHRD", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgehrd_(&c_n1, &c__1, &c__1, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgehrd_(&c__0, &c__0, &c__0, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgehrd_(&c__0, &c__2, &c__0, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zgehrd_(&c__1, &c__1, &c__0, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zgehrd_(&c__0, &c__1, &c__1, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zgehrd_(&c__2, &c__1, &c__1, a, &c__1, tau, w, &c__2, &info);
chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zgehrd_(&c__2, &c__1, &c__2, a, &c__2, tau, w, &c__1, &info);
chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 7;
/* ZUNGHR */
s_copy(srnamc_1.srnamt, "ZUNGHR", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zunghr_(&c_n1, &c__1, &c__1, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zunghr_(&c__0, &c__0, &c__0, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zunghr_(&c__0, &c__2, &c__0, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zunghr_(&c__1, &c__1, &c__0, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zunghr_(&c__0, &c__1, &c__1, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunghr_(&c__2, &c__1, &c__1, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zunghr_(&c__3, &c__1, &c__3, a, &c__3, tau, w, &c__1, &info);
chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 7;
/* ZUNMHR */
s_copy(srnamc_1.srnamt, "ZUNMHR", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zunmhr_("/", "N", &c__0, &c__0, &c__1, &c__0, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zunmhr_("L", "/", &c__0, &c__0, &c__1, &c__0, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zunmhr_("L", "N", &c_n1, &c__0, &c__1, &c__0, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zunmhr_("L", "N", &c__0, &c_n1, &c__1, &c__0, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunmhr_("L", "N", &c__0, &c__0, &c__0, &c__0, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunmhr_("L", "N", &c__0, &c__0, &c__2, &c__0, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunmhr_("L", "N", &c__1, &c__2, &c__2, &c__1, a, &c__1, tau, c__, &
c__1, w, &c__2, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunmhr_("R", "N", &c__2, &c__1, &c__2, &c__1, a, &c__1, tau, c__, &
c__2, w, &c__2, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zunmhr_("L", "N", &c__1, &c__1, &c__1, &c__0, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zunmhr_("L", "N", &c__0, &c__1, &c__1, &c__1, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zunmhr_("R", "N", &c__1, &c__0, &c__1, &c__1, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zunmhr_("L", "N", &c__2, &c__1, &c__1, &c__1, a, &c__1, tau, c__, &
c__2, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zunmhr_("R", "N", &c__1, &c__2, &c__1, &c__1, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
zunmhr_("L", "N", &c__2, &c__1, &c__1, &c__1, a, &c__2, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
zunmhr_("L", "N", &c__1, &c__2, &c__1, &c__1, a, &c__1, tau, c__, &
c__1, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
zunmhr_("R", "N", &c__2, &c__1, &c__1, &c__1, a, &c__1, tau, c__, &
c__2, w, &c__1, &info);
chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 16;
/* ZHSEQR */
s_copy(srnamc_1.srnamt, "ZHSEQR", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zhseqr_("/", "N", &c__0, &c__1, &c__0, a, &c__1, x, c__, &c__1, w, &
c__1, &info);
chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zhseqr_("E", "/", &c__0, &c__1, &c__0, a, &c__1, x, c__, &c__1, w, &
c__1, &info);
chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zhseqr_("E", "N", &c_n1, &c__1, &c__0, a, &c__1, x, c__, &c__1, w, &
c__1, &info);
chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zhseqr_("E", "N", &c__0, &c__0, &c__0, a, &c__1, x, c__, &c__1, w, &
c__1, &info);
chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zhseqr_("E", "N", &c__0, &c__2, &c__0, a, &c__1, x, c__, &c__1, w, &
c__1, &info);
chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zhseqr_("E", "N", &c__1, &c__1, &c__0, a, &c__1, x, c__, &c__1, w, &
c__1, &info);
chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zhseqr_("E", "N", &c__1, &c__1, &c__2, a, &c__1, x, c__, &c__1, w, &
c__1, &info);
chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zhseqr_("E", "N", &c__2, &c__1, &c__2, a, &c__1, x, c__, &c__2, w, &
c__1, &info);
chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zhseqr_("E", "V", &c__2, &c__1, &c__2, a, &c__2, x, c__, &c__1, w, &
c__1, &info);
chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 9;
/* ZHSEIN */
s_copy(srnamc_1.srnamt, "ZHSEIN", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zhsein_("/", "N", "N", sel, &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
&c__0, &m, w, rw, ifaill, ifailr, &info);
chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zhsein_("R", "/", "N", sel, &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
&c__0, &m, w, rw, ifaill, ifailr, &info);
chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zhsein_("R", "N", "/", sel, &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
&c__0, &m, w, rw, ifaill, ifailr, &info);
chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zhsein_("R", "N", "N", sel, &c_n1, a, &c__1, x, vl, &c__1, vr, &c__1,
&c__0, &m, w, rw, ifaill, ifailr, &info);
chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zhsein_("R", "N", "N", sel, &c__2, a, &c__1, x, vl, &c__1, vr, &c__2,
&c__4, &m, w, rw, ifaill, ifailr, &info);
chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zhsein_("L", "N", "N", sel, &c__2, a, &c__2, x, vl, &c__1, vr, &c__1,
&c__4, &m, w, rw, ifaill, ifailr, &info);
chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
zhsein_("R", "N", "N", sel, &c__2, a, &c__2, x, vl, &c__1, vr, &c__1,
&c__4, &m, w, rw, ifaill, ifailr, &info);
chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
zhsein_("R", "N", "N", sel, &c__2, a, &c__2, x, vl, &c__1, vr, &c__2,
&c__1, &m, w, rw, ifaill, ifailr, &info);
chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 8;
/* ZTREVC */
s_copy(srnamc_1.srnamt, "ZTREVC", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
ztrevc_("/", "A", sel, &c__0, a, &c__1, vl, &c__1, vr, &c__1, &c__0, &
m, w, rw, &info);
chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ztrevc_("L", "/", sel, &c__0, a, &c__1, vl, &c__1, vr, &c__1, &c__0, &
m, w, rw, &info);
chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ztrevc_("L", "A", sel, &c_n1, a, &c__1, vl, &c__1, vr, &c__1, &c__0, &
m, w, rw, &info);
chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
ztrevc_("L", "A", sel, &c__2, a, &c__1, vl, &c__2, vr, &c__1, &c__4, &
m, w, rw, &info);
chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
ztrevc_("L", "A", sel, &c__2, a, &c__2, vl, &c__1, vr, &c__1, &c__4, &
m, w, rw, &info);
chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
ztrevc_("R", "A", sel, &c__2, a, &c__2, vl, &c__1, vr, &c__1, &c__4, &
m, w, rw, &info);
chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
ztrevc_("L", "A", sel, &c__2, a, &c__2, vl, &c__2, vr, &c__1, &c__1, &
m, w, rw, &info);
chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 7;
}
/* Print a summary line. */
if (infoc_1.ok) {
io___22.ciunit = infoc_1.nout;
s_wsfe(&io___22);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
e_wsfe();
} else {
io___23.ciunit = infoc_1.nout;
s_wsfe(&io___23);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
return 0;
/* End of ZERRHS */
} /* zerrhs_ */
/* Subroutine */ int zlatb4_(char *path, integer *imat, integer *m, integer *
n, char *type__, integer *kl, integer *ku, doublereal *anorm, integer
*mode, doublereal *cndnum, char *dist)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1;
/* Builtin functions */
double sqrt(doublereal);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
char c2[2];
integer mat;
static doublereal eps, badc1, badc2, large, small;
extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
extern doublereal dlamch_(char *);
extern logical lsamen_(integer *, char *, char *);
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZLATB4 sets parameters for the matrix generator based on the type of */
/* matrix to be generated. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name. */
/* IMAT (input) INTEGER */
/* An integer key describing which matrix to generate for this */
/* path. */
/* M (input) INTEGER */
/* The number of rows in the matrix to be generated. */
/* N (input) INTEGER */
/* The number of columns in the matrix to be generated. */
/* TYPE (output) CHARACTER*1 */
/* The type of the matrix to be generated: */
/* = 'S': symmetric matrix */
/* = 'P': symmetric positive (semi)definite matrix */
/* = 'N': nonsymmetric matrix */
/* KL (output) INTEGER */
/* The lower band width of the matrix to be generated. */
/* KU (output) INTEGER */
/* The upper band width of the matrix to be generated. */
/* ANORM (output) DOUBLE PRECISION */
/* The desired norm of the matrix to be generated. The diagonal */
/* matrix of singular values or eigenvalues is scaled by this */
/* value. */
/* MODE (output) INTEGER */
/* A key indicating how to choose the vector of eigenvalues. */
/* CNDNUM (output) DOUBLE PRECISION */
/* The desired condition number. */
/* DIST (output) CHARACTER*1 */
/* The type of distribution to be used by the random number */
/* generator. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Save statement .. */
/* .. */
/* .. Data statements .. */
/* .. */
/* .. Executable Statements .. */
/* Set some constants for use in the subroutine. */
if (first) {
first = FALSE_;
eps = dlamch_("Precision");
badc2 = .1 / eps;
badc1 = sqrt(badc2);
small = dlamch_("Safe minimum");
large = 1. / small;
/* If it looks like we're on a Cray, take the square root of */
/* SMALL and LARGE to avoid overflow and underflow problems. */
dlabad_(&small, &large);
small = small / eps * .25;
large = 1. / small;
}
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Set some parameters we don't plan to change. */
*(unsigned char *)dist = 'S';
*mode = 3;
/* xQR, xLQ, xQL, xRQ: Set parameters to generate a general */
/* M x N matrix. */
if (lsamen_(&c__2, c2, "QR") || lsamen_(&c__2, c2,
"LQ") || lsamen_(&c__2, c2, "QL") || lsamen_(&c__2, c2, "RQ")) {
/* Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type__ = 'N';
/* Set the lower and upper bandwidths. */
if (*imat == 1) {
*kl = 0;
*ku = 0;
} else if (*imat == 2) {
*kl = 0;
/* Computing MAX */
i__1 = *n - 1;
*ku = max(i__1,0);
} else if (*imat == 3) {
/* Computing MAX */
i__1 = *m - 1;
*kl = max(i__1,0);
*ku = 0;
} else {
/* Computing MAX */
i__1 = *m - 1;
*kl = max(i__1,0);
/* Computing MAX */
i__1 = *n - 1;
*ku = max(i__1,0);
}
/* Set the condition number and norm. */
if (*imat == 5) {
*cndnum = badc1;
} else if (*imat == 6) {
*cndnum = badc2;
} else {
*cndnum = 2.;
}
if (*imat == 7) {
*anorm = small;
} else if (*imat == 8) {
*anorm = large;
} else {
*anorm = 1.;
}
} else if (lsamen_(&c__2, c2, "GE")) {
/* xGE: Set parameters to generate a general M x N matrix. */
/* Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type__ = 'N';
/* Set the lower and upper bandwidths. */
if (*imat == 1) {
*kl = 0;
*ku = 0;
} else if (*imat == 2) {
*kl = 0;
/* Computing MAX */
i__1 = *n - 1;
*ku = max(i__1,0);
} else if (*imat == 3) {
/* Computing MAX */
i__1 = *m - 1;
*kl = max(i__1,0);
*ku = 0;
} else {
/* Computing MAX */
i__1 = *m - 1;
*kl = max(i__1,0);
/* Computing MAX */
i__1 = *n - 1;
*ku = max(i__1,0);
}
/* Set the condition number and norm. */
if (*imat == 8) {
*cndnum = badc1;
} else if (*imat == 9) {
*cndnum = badc2;
} else {
*cndnum = 2.;
}
if (*imat == 10) {
*anorm = small;
} else if (*imat == 11) {
*anorm = large;
} else {
*anorm = 1.;
}
} else if (lsamen_(&c__2, c2, "GB")) {
/* xGB: Set parameters to generate a general banded matrix. */
/* Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type__ = 'N';
/* Set the condition number and norm. */
if (*imat == 5) {
*cndnum = badc1;
} else if (*imat == 6) {
*cndnum = badc2 * .1;
} else {
*cndnum = 2.;
}
if (*imat == 7) {
*anorm = small;
} else if (*imat == 8) {
*anorm = large;
} else {
*anorm = 1.;
}
} else if (lsamen_(&c__2, c2, "GT")) {
/* xGT: Set parameters to generate a general tridiagonal matrix. */
/* Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type__ = 'N';
/* Set the lower and upper bandwidths. */
if (*imat == 1) {
*kl = 0;
} else {
*kl = 1;
}
*ku = *kl;
/* Set the condition number and norm. */
if (*imat == 3) {
*cndnum = badc1;
} else if (*imat == 4) {
*cndnum = badc2;
} else {
*cndnum = 2.;
}
if (*imat == 5 || *imat == 11) {
*anorm = small;
} else if (*imat == 6 || *imat == 12) {
*anorm = large;
} else {
*anorm = 1.;
}
} else if (lsamen_(&c__2, c2, "PO") || lsamen_(&
c__2, c2, "PP") || lsamen_(&c__2, c2, "HE") || lsamen_(&c__2, c2, "HP") || lsamen_(&c__2, c2, "SY") ||
lsamen_(&c__2, c2, "SP")) {
/* xPO, xPP, xHE, xHP, xSY, xSP: Set parameters to generate a */
/* symmetric or Hermitian matrix. */
/* Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type__ = *(unsigned char *)c2;
/* Set the lower and upper bandwidths. */
if (*imat == 1) {
*kl = 0;
} else {
/* Computing MAX */
i__1 = *n - 1;
*kl = max(i__1,0);
}
*ku = *kl;
/* Set the condition number and norm. */
if (*imat == 6) {
*cndnum = badc1;
} else if (*imat == 7) {
*cndnum = badc2;
} else {
*cndnum = 2.;
}
if (*imat == 8) {
*anorm = small;
} else if (*imat == 9) {
*anorm = large;
} else {
*anorm = 1.;
}
} else if (lsamen_(&c__2, c2, "PB")) {
/* xPB: Set parameters to generate a symmetric band matrix. */
/* Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type__ = 'P';
/* Set the norm and condition number. */
if (*imat == 5) {
*cndnum = badc1;
} else if (*imat == 6) {
*cndnum = badc2;
} else {
*cndnum = 2.;
}
if (*imat == 7) {
*anorm = small;
} else if (*imat == 8) {
*anorm = large;
} else {
*anorm = 1.;
}
} else if (lsamen_(&c__2, c2, "PT")) {
/* xPT: Set parameters to generate a symmetric positive definite */
/* tridiagonal matrix. */
*(unsigned char *)type__ = 'P';
if (*imat == 1) {
*kl = 0;
} else {
*kl = 1;
}
*ku = *kl;
/* Set the condition number and norm. */
if (*imat == 3) {
*cndnum = badc1;
} else if (*imat == 4) {
*cndnum = badc2;
} else {
*cndnum = 2.;
}
if (*imat == 5 || *imat == 11) {
*anorm = small;
} else if (*imat == 6 || *imat == 12) {
*anorm = large;
} else {
*anorm = 1.;
}
} else if (lsamen_(&c__2, c2, "TR") || lsamen_(&
c__2, c2, "TP")) {
/* xTR, xTP: Set parameters to generate a triangular matrix */
/* Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type__ = 'N';
/* Set the lower and upper bandwidths. */
mat = abs(*imat);
if (mat == 1 || mat == 7) {
*kl = 0;
*ku = 0;
} else if (*imat < 0) {
/* Computing MAX */
i__1 = *n - 1;
*kl = max(i__1,0);
*ku = 0;
} else {
*kl = 0;
/* Computing MAX */
i__1 = *n - 1;
*ku = max(i__1,0);
}
/* Set the condition number and norm. */
if (mat == 3 || mat == 9) {
*cndnum = badc1;
} else if (mat == 4 || mat == 10) {
*cndnum = badc2;
} else {
*cndnum = 2.;
}
if (mat == 5) {
*anorm = small;
} else if (mat == 6) {
*anorm = large;
} else {
*anorm = 1.;
}
} else if (lsamen_(&c__2, c2, "TB")) {
/* xTB: Set parameters to generate a triangular band matrix. */
/* Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type__ = 'N';
/* Set the norm and condition number. */
if (*imat == 2 || *imat == 8) {
*cndnum = badc1;
} else if (*imat == 3 || *imat == 9) {
*cndnum = badc2;
} else {
*cndnum = 2.;
}
if (*imat == 4) {
*anorm = small;
} else if (*imat == 5) {
*anorm = large;
} else {
*anorm = 1.;
}
}
if (*n <= 1) {
*cndnum = 1.;
}
return 0;
/* End of ZLATB4 */
} /* zlatb4_ */
/* Subroutine */ int derrge_(char *path, integer *nunit)
{
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
doublereal a[16] /* was [4][4] */, b[4];
integer i__, j;
doublereal w[12], x[4];
char c2[2];
doublereal r1[4], r2[4], af[16] /* was [4][4] */;
integer ip[4], iw[4], info;
doublereal anrm, ccond, rcond;
extern /* Subroutine */ int dgbtf2_(integer *, integer *, integer *,
integer *, doublereal *, integer *, integer *, integer *),
dgetf2_(integer *, integer *, doublereal *, integer *, integer *,
integer *), dgbcon_(char *, integer *, integer *, integer *,
doublereal *, integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *, integer *), dgecon_(char *,
integer *, doublereal *, integer *, doublereal *, doublereal *,
doublereal *, integer *, integer *), alaesm_(char *,
logical *, integer *), dgbequ_(integer *, integer *,
integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, integer *)
, dgbrfs_(char *, integer *, integer *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *, doublereal *,
doublereal *, doublereal *, integer *, integer *),
dgbtrf_(integer *, integer *, integer *, integer *, doublereal *,
integer *, integer *, integer *), dgeequ_(integer *, integer *,
doublereal *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *), dgerfs_(char *, integer *
, integer *, doublereal *, integer *, doublereal *, integer *,
integer *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, doublereal *, integer *, integer *), dgetrf_(integer *, integer *, doublereal *, integer *,
integer *, integer *), dgetri_(integer *, doublereal *, integer *,
integer *, doublereal *, integer *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), dgbtrs_(char *, integer *, integer *,
integer *, integer *, doublereal *, integer *, integer *,
doublereal *, integer *, integer *), dgetrs_(char *,
integer *, integer *, doublereal *, integer *, integer *,
doublereal *, 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 */
/* ======= */
/* DERRGE tests the error exits for the DOUBLE PRECISION 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. */
/* ===================================================================== */
/* .. 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. / (doublereal) (i__ + j);
af[i__ + (j << 2) - 5] = 1. / (doublereal) (i__ + j);
/* L10: */
}
b[j - 1] = 0.;
r1[j - 1] = 0.;
r2[j - 1] = 0.;
w[j - 1] = 0.;
x[j - 1] = 0.;
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. */
/* DGETRF */
s_copy(srnamc_1.srnamt, "DGETRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgetrf_(&c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("DGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgetrf_(&c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("DGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgetrf_(&c__2, &c__1, a, &c__1, ip, &info);
chkxer_("DGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGETF2 */
s_copy(srnamc_1.srnamt, "DGETF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgetf2_(&c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("DGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgetf2_(&c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("DGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgetf2_(&c__2, &c__1, a, &c__1, ip, &info);
chkxer_("DGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGETRI */
s_copy(srnamc_1.srnamt, "DGETRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgetri_(&c_n1, a, &c__1, ip, w, &c__12, &info);
chkxer_("DGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dgetri_(&c__2, a, &c__1, ip, w, &c__12, &info);
chkxer_("DGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGETRS */
s_copy(srnamc_1.srnamt, "DGETRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgetrs_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("DGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgetrs_("N", &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("DGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dgetrs_("N", &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info);
chkxer_("DGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
dgetrs_("N", &c__2, &c__1, a, &c__1, ip, b, &c__2, &info);
chkxer_("DGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
dgetrs_("N", &c__2, &c__1, a, &c__2, ip, b, &c__1, &info);
chkxer_("DGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGERFS */
s_copy(srnamc_1.srnamt, "DGERFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgerfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgerfs_("N", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dgerfs_("N", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
dgerfs_("N", &c__2, &c__1, a, &c__1, af, &c__2, ip, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
dgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__1, ip, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
dgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__1, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
dgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__2, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGECON */
s_copy(srnamc_1.srnamt, "DGECON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgecon_("/", &c__0, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("DGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgecon_("1", &c_n1, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("DGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgecon_("1", &c__2, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("DGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGEEQU */
s_copy(srnamc_1.srnamt, "DGEEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgeequ_(&c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info);
chkxer_("DGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgeequ_(&c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info);
chkxer_("DGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgeequ_(&c__2, &c__2, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info);
chkxer_("DGEEQU", &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. */
/* DGBTRF */
s_copy(srnamc_1.srnamt, "DGBTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgbtrf_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("DGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgbtrf_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("DGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dgbtrf_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("DGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgbtrf_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("DGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
dgbtrf_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info);
chkxer_("DGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGBTF2 */
s_copy(srnamc_1.srnamt, "DGBTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgbtf2_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("DGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgbtf2_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info);
chkxer_("DGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dgbtf2_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info);
chkxer_("DGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgbtf2_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info);
chkxer_("DGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
dgbtf2_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info);
chkxer_("DGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGBTRS */
s_copy(srnamc_1.srnamt, "DGBTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgbtrs_("/", &c__0, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgbtrs_("N", &c_n1, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dgbtrs_("N", &c__1, &c_n1, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgbtrs_("N", &c__1, &c__0, &c_n1, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
dgbtrs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
dgbtrs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, ip, b, &c__2, &
info);
chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
dgbtrs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, &
info);
chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGBRFS */
s_copy(srnamc_1.srnamt, "DGBRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgbrfs_("/", &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_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgbrfs_("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_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dgbrfs_("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_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgbrfs_("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_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
dgbrfs_("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_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
dgbrfs_("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_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
dgbrfs_("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_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
dgbrfs_("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_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
dgbrfs_("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_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGBCON */
s_copy(srnamc_1.srnamt, "DGBCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgbcon_("/", &c__0, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("DGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgbcon_("1", &c_n1, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("DGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dgbcon_("1", &c__1, &c_n1, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("DGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgbcon_("1", &c__1, &c__0, &c_n1, a, &c__1, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("DGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
dgbcon_("1", &c__2, &c__1, &c__1, a, &c__3, ip, &anrm, &rcond, w, iw,
&info);
chkxer_("DGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DGBEQU */
s_copy(srnamc_1.srnamt, "DGBEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgbequ_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("DGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgbequ_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("DGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dgbequ_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("DGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgbequ_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("DGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
dgbequ_(&c__2, &c__2, &c__1, &c__1, a, &c__2, r1, r2, &rcond, &ccond,
&anrm, &info);
chkxer_("DGBEQU", &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 DERRGE */
} /* derrge_ */
/* Subroutine */ int zerrtz_(char *path, integer *nunit)
{
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsle(cilist *), e_wsle(void);
/* Local variables */
doublecomplex a[4] /* was [2][2] */, w[2];
char c2[2];
doublecomplex tau[2];
integer info;
extern /* Subroutine */ int alaesm_(char *, logical *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), ztzrqf_(integer *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *), ztzrzf_(
integer *, integer *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, integer *);
/* Fortran I/O blocks */
static cilist io___4 = { 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 */
/* ======= */
/* ZERRTZ tests the error exits for ZTZRQF and ZTZRZF. */
/* 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;
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
a[0].r = 1., a[0].i = -1.;
a[2].r = 2., a[2].i = -2.;
a[3].r = 3., a[3].i = -3.;
a[1].r = 4., a[1].i = -4.;
w[0].r = 0., w[0].i = 0.;
w[1].r = 0., w[1].i = 0.;
infoc_1.ok = TRUE_;
/* Test error exits for the trapezoidal routines. */
io___4.ciunit = infoc_1.nout;
s_wsle(&io___4);
e_wsle();
if (lsamen_(&c__2, c2, "TZ")) {
/* ZTZRQF */
s_copy(srnamc_1.srnamt, "ZTZRQF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
ztzrqf_(&c_n1, &c__0, a, &c__1, tau, &info);
chkxer_("ZTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ztzrqf_(&c__1, &c__0, a, &c__1, tau, &info);
chkxer_("ZTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ztzrqf_(&c__2, &c__2, a, &c__1, tau, &info);
chkxer_("ZTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZTZRZF */
s_copy(srnamc_1.srnamt, "ZTZRZF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
ztzrzf_(&c_n1, &c__0, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
ztzrzf_(&c__1, &c__0, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
ztzrzf_(&c__2, &c__2, a, &c__1, tau, w, &c__1, &info);
chkxer_("ZTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
ztzrzf_(&c__2, &c__2, a, &c__2, tau, w, &c__1, &info);
chkxer_("ZTZRZF", &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 ZERRTZ */
} /* zerrtz_ */
/* Subroutine */ int cerrqp_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
/* Local variables */
complex a[9] /* was [3][3] */, w[15];
char c2[2];
integer ip[3], lw;
real rw[6];
complex tau[3];
integer info;
/* Fortran I/O blocks */
static cilist io___4 = { 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 */
/* ======= */
/* CERRQP tests the error exits for CGEQPF and CGEQP3. */
/* 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;
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
lw = 4;
a[0].r = 1.f, a[0].i = -1.f;
a[3].r = 2.f, a[3].i = -2.f;
a[4].r = 3.f, a[4].i = -3.f;
a[1].r = 4.f, a[1].i = -4.f;
infoc_1.ok = TRUE_;
io___4.ciunit = infoc_1.nout;
s_wsle(&io___4);
e_wsle();
/* Test error exits for QR factorization with pivoting */
if (lsamen_(&c__2, c2, "QP")) {
/* CGEQPF */
s_copy(srnamc_1.srnamt, "CGEQPF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cgeqpf_(&c_n1, &c__0, a, &c__1, ip, tau, w, rw, &info);
chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgeqpf_(&c__0, &c_n1, a, &c__1, ip, tau, w, rw, &info);
chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cgeqpf_(&c__2, &c__0, a, &c__1, ip, tau, w, rw, &info);
chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CGEQP3 */
s_copy(srnamc_1.srnamt, "CGEQP3", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cgeqp3_(&c_n1, &c__0, a, &c__1, ip, tau, w, &lw, rw, &info);
chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgeqp3_(&c__1, &c_n1, a, &c__1, ip, tau, w, &lw, rw, &info);
chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cgeqp3_(&c__2, &c__3, a, &c__1, ip, tau, w, &lw, rw, &info);
chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
i__1 = lw - 10;
cgeqp3_(&c__2, &c__2, a, &c__2, ip, tau, w, &i__1, rw, &info);
chkxer_("CGEQP3", &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 CERRQP */
} /* cerrqp_ */
/* Subroutine */ int dtimmv_(char *vname, integer *nn, integer *nval, integer
*nk, integer *kval, integer *nlda, integer *ldaval, doublereal *
timmin, doublereal *a, integer *lb, doublereal *b, doublereal *c__,
doublereal *reslts, integer *ldr1, integer *ldr2, integer *nout,
ftnlen vname_len)
{
/* Initialized data */
static char subnam[6*2] = "DGEMV " "DGBMV ";
/* Format strings */
static char fmt_9999[] = "(1x,a6,\002: Unrecognized path or subroutine "
"name\002,/)";
static char fmt_9998[] = "(1x,a6,\002 timing run not attempted\002,/)";
static char fmt_9997[] = "(/\002 *** Speed of \002,a6,\002 in megaflops "
"***\002)";
static char fmt_9996[] = "(5x,\002with LDA = \002,i5)";
static char fmt_9995[] = "(5x,\002line \002,i2,\002 with LDA = \002,i5)";
/* System generated locals */
integer reslts_dim1, reslts_dim2, reslts_offset, i__1, i__2, i__3, i__4,
i__5, i__6, i__7;
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
s_wsle(cilist *), e_wsle(void);
/* Local variables */
static integer ilda, info;
static doublereal time;
static integer isub, nrhs, i__, k, n;
static char cname[6];
extern /* Subroutine */ int dgbmv_(char *, integer *, integer *, integer *
, integer *, doublereal *, doublereal *, integer *, doublereal *,
integer *, doublereal *, doublereal *, integer *);
extern logical lsame_(char *, char *);
extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *);
static doublereal s1, s2;
extern doublereal dopbl2_(char *, integer *, integer *, integer *,
integer *);
static integer ib, ic, ik, in, kl, ku;
extern doublereal dsecnd_(void);
extern /* Subroutine */ int atimck_(integer *, char *, integer *, integer
*, integer *, integer *, integer *, integer *, ftnlen);
extern logical lsamen_(integer *, char *, char *);
extern doublereal dmflop_(doublereal *, doublereal *, integer *);
extern /* Subroutine */ int dtimmg_(integer *, integer *, integer *,
doublereal *, integer *, integer *, integer *), dprtbl_(char *,
char *, integer *, integer *, integer *, integer *, integer *,
doublereal *, integer *, integer *, integer *, ftnlen, ftnlen);
static doublereal untime;
static logical timsub[2];
static integer lda, ldb, icl;
static doublereal ops;
static char lab1[1], lab2[1];
/* Fortran I/O blocks */
static cilist io___5 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___9 = { 0, 0, 0, fmt_9998, 0 };
static cilist io___10 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___11 = { 0, 0, 0, fmt_9996, 0 };
static cilist io___13 = { 0, 0, 0, fmt_9995, 0 };
static cilist io___14 = { 0, 0, 0, 0, 0 };
#define subnam_ref(a_0,a_1) &subnam[(a_1)*6 + a_0 - 6]
#define reslts_ref(a_1,a_2,a_3) reslts[((a_3)*reslts_dim2 + (a_2))*\
reslts_dim1 + a_1]
/* -- LAPACK timing routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
March 31, 1993
Purpose
=======
DTIMMV times individual BLAS 2 routines.
Arguments
=========
VNAME (input) CHARACTER*(*)
The name of the Level 2 BLAS routine to be timed.
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 dimension N.
NK (input) INTEGER
The number of values of K contained in the vector KVAL.
KVAL (input) INTEGER array, dimension (NK)
The values of the bandwidth K.
NLDA (input) INTEGER
The number of values of LDA contained in the vector LDAVAL.
LDAVAL (input) INTEGER array, dimension (NLDA)
The values of the leading dimension of the array A.
TIMMIN (input) DOUBLE PRECISION
The minimum time a subroutine will be timed.
A (workspace) DOUBLE PRECISION array, dimension (LDAMAX*NMAX)
where LDAMAX and NMAX are the maximum values permitted
for LDA and N.
LB (input) INTEGER
The length of B and C, needed when timing DGBMV. If timing
DGEMV, LB >= LDAMAX*NMAX.
B (workspace) DOUBLE PRECISION array, dimension (LB)
C (workspace) DOUBLE PRECISION array, dimension (LB)
RESLTS (output) DOUBLE PRECISION array, dimension (LDR1,LDR2,NLDA)
The timing results for each subroutine over the relevant
values of N and LDA.
LDR1 (input) INTEGER
The first dimension of RESLTS. LDR1 >= max(1,NK).
LDR2 (input) INTEGER
The second dimension of RESLTS. LDR2 >= max(1,NN).
NOUT (input) INTEGER
The unit number for output.
=====================================================================
Parameter adjustments */
--nval;
--kval;
--ldaval;
--a;
--b;
--c__;
reslts_dim1 = *ldr1;
reslts_dim2 = *ldr2;
reslts_offset = 1 + reslts_dim1 * (1 + reslts_dim2 * 1);
reslts -= reslts_offset;
/* Function Body */
s_copy(cname, vname, (ftnlen)6, vname_len);
for (isub = 1; isub <= 2; ++isub) {
timsub[isub - 1] = lsamen_(&c__6, cname, subnam_ref(0, isub));
if (timsub[isub - 1]) {
goto L20;
}
/* L10: */
}
io___5.ciunit = *nout;
s_wsfe(&io___5);
do_fio(&c__1, cname, (ftnlen)6);
e_wsfe();
goto L150;
L20:
/* Check that N or K <= LDA for the input values. */
if (lsame_(cname + 2, "B")) {
atimck_(&c__0, cname, nk, &kval[1], nlda, &ldaval[1], nout, &info, (
ftnlen)6);
*(unsigned char *)lab1 = 'M';
*(unsigned char *)lab2 = 'K';
} else {
atimck_(&c__2, cname, nn, &nval[1], nlda, &ldaval[1], nout, &info, (
ftnlen)6);
*(unsigned char *)lab1 = ' ';
*(unsigned char *)lab2 = 'N';
}
if (info > 0) {
io___9.ciunit = *nout;
s_wsfe(&io___9);
do_fio(&c__1, cname, (ftnlen)6);
e_wsfe();
goto L150;
}
/* Print the table header on unit NOUT. */
io___10.ciunit = *nout;
s_wsfe(&io___10);
do_fio(&c__1, vname, vname_len);
e_wsfe();
if (*nlda == 1) {
io___11.ciunit = *nout;
s_wsfe(&io___11);
do_fio(&c__1, (char *)&ldaval[1], (ftnlen)sizeof(integer));
e_wsfe();
} else {
i__1 = *nlda;
for (i__ = 1; i__ <= i__1; ++i__) {
io___13.ciunit = *nout;
s_wsfe(&io___13);
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ldaval[i__], (ftnlen)sizeof(integer));
e_wsfe();
/* L30: */
}
}
io___14.ciunit = *nout;
s_wsle(&io___14);
e_wsle();
/* Time DGEMV */
if (timsub[0]) {
i__1 = *nlda;
for (ilda = 1; ilda <= i__1; ++ilda) {
lda = ldaval[ilda];
i__2 = *nn;
for (in = 1; in <= i__2; ++in) {
n = nval[in];
nrhs = n;
ldb = lda;
dtimmg_(&c__1, &n, &n, &a[1], &lda, &c__0, &c__0);
dtimmg_(&c__0, &n, &nrhs, &b[1], &ldb, &c__0, &c__0);
dtimmg_(&c__1, &n, &nrhs, &c__[1], &ldb, &c__0, &c__0);
ic = 0;
s1 = dsecnd_();
L40:
ib = 1;
i__3 = nrhs;
for (i__ = 1; i__ <= i__3; ++i__) {
dgemv_("No transpose", &n, &n, &c_b44, &a[1], &lda, &b[ib]
, &c__1, &c_b44, &c__[ib], &c__1);
ib += ldb;
/* L50: */
}
s2 = dsecnd_();
time = s2 - s1;
++ic;
if (time < *timmin) {
dtimmg_(&c__1, &n, &nrhs, &c__[1], &ldb, &c__0, &c__0);
goto L40;
}
/* Subtract the time used in DTIMMG. */
icl = 1;
s1 = dsecnd_();
L60:
s2 = dsecnd_();
untime = s2 - s1;
++icl;
if (icl <= ic) {
dtimmg_(&c__1, &n, &nrhs, &c__[1], &ldb, &c__0, &c__0);
goto L60;
}
time = (time - untime) / (doublereal) ic;
ops = nrhs * dopbl2_("DGEMV ", &n, &n, &c__0, &c__0);
reslts_ref(1, in, ilda) = dmflop_(&ops, &time, &c__0);
/* L70: */
}
/* L80: */
}
dprtbl_(lab1, lab2, &c__1, &nval[1], nn, &nval[1], nlda, &reslts[
reslts_offset], ldr1, ldr2, nout, (ftnlen)1, (ftnlen)1);
} else if (timsub[1]) {
/* Time DGBMV */
i__1 = *nlda;
for (ilda = 1; ilda <= i__1; ++ilda) {
lda = ldaval[ilda];
i__2 = *nn;
for (in = 1; in <= i__2; ++in) {
n = nval[in];
i__3 = *nk;
for (ik = 1; ik <= i__3; ++ik) {
/* Computing MIN
Computing MAX */
i__6 = 0, i__7 = kval[ik];
i__4 = n - 1, i__5 = max(i__6,i__7);
k = min(i__4,i__5);
kl = k;
ku = k;
ldb = n;
dtimmg_(&c__2, &n, &n, &a[1], &lda, &kl, &ku);
/* Computing MIN */
i__4 = k, i__5 = *lb / ldb;
nrhs = min(i__4,i__5);
dtimmg_(&c__0, &n, &nrhs, &b[1], &ldb, &c__0, &c__0);
dtimmg_(&c__1, &n, &nrhs, &c__[1], &ldb, &c__0, &c__0);
ic = 0;
s1 = dsecnd_();
L90:
ib = 1;
i__4 = nrhs;
for (i__ = 1; i__ <= i__4; ++i__) {
dgbmv_("No transpose", &n, &n, &kl, &ku, &c_b44, &a[
ku + 1], &lda, &b[ib], &c__1, &c_b44, &c__[ib]
, &c__1);
ib += ldb;
/* L100: */
}
s2 = dsecnd_();
time = s2 - s1;
++ic;
if (time < *timmin) {
dtimmg_(&c__1, &n, &nrhs, &c__[1], &ldb, &c__0, &c__0)
;
goto L90;
}
/* Subtract the time used in DTIMMG. */
icl = 1;
s1 = dsecnd_();
L110:
s2 = dsecnd_();
untime = s2 - s1;
++icl;
if (icl <= ic) {
dtimmg_(&c__1, &n, &nrhs, &c__[1], &ldb, &c__0, &c__0)
;
goto L110;
}
time = (time - untime) / (doublereal) ic;
ops = nrhs * dopbl2_("DGBMV ", &n, &n, &kl, &ku);
reslts_ref(in, ik, ilda) = dmflop_(&ops, &time, &c__0);
/* L120: */
}
/* L130: */
}
/* L140: */
}
dprtbl_(lab1, lab2, nn, &nval[1], nk, &kval[1], nlda, &reslts[
reslts_offset], ldr1, ldr2, nout, (ftnlen)1, (ftnlen)1);
}
L150:
return 0;
/* End of DTIMMV */
} /* dtimmv_ */
/* Subroutine */ int cerrvx_(char *path, integer *nunit)
{
/* Format strings */
static char fmt_9999[] = "(1x,a3,\002 drivers passed the tests of the er"
"ror exits\002)";
static char fmt_9998[] = "(\002 *** \002,a3,\002 drivers failed the test"
"s of the error \002,\002exits ***\002)";
/* System generated locals */
integer i__1;
real r__1, r__2;
complex q__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Local variables */
complex a[16] /* was [4][4] */, b[4];
real c__[4];
integer i__, j;
real r__[4];
complex w[8], x[4];
char c2[2];
real r1[4], r2[4];
complex af[16] /* was [4][4] */;
char eq[1];
real rf[4];
integer ip[4];
real rw[4];
integer info;
extern /* Subroutine */ int cgbsv_(integer *, integer *, integer *,
integer *, complex *, integer *, integer *, complex *, integer *,
integer *);
real rcond;
extern /* Subroutine */ int cgesv_(integer *, integer *, complex *,
integer *, integer *, complex *, integer *, integer *), chesv_(
char *, integer *, integer *, complex *, integer *, integer *,
complex *, integer *, complex *, integer *, integer *),
cpbsv_(char *, integer *, integer *, integer *, complex *,
integer *, complex *, integer *, integer *), chpsv_(char *
, integer *, integer *, complex *, integer *, complex *, integer *
, integer *), cgtsv_(integer *, integer *, complex *,
complex *, complex *, complex *, integer *, integer *), cposv_(
char *, integer *, integer *, complex *, integer *, complex *,
integer *, integer *), cppsv_(char *, integer *, integer *
, complex *, complex *, integer *, integer *), cspsv_(
char *, integer *, integer *, complex *, integer *, complex *,
integer *, integer *), cptsv_(integer *, integer *, real *
, complex *, complex *, integer *, integer *), csysv_(char *,
integer *, integer *, complex *, integer *, integer *, complex *,
integer *, complex *, integer *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), cgbsvx_(char *, char *, integer *, integer
*, integer *, integer *, complex *, integer *, complex *, integer
*, integer *, char *, real *, real *, complex *, integer *,
complex *, integer *, real *, real *, real *, complex *, real *,
integer *), cgesvx_(char *, char *,
integer *, integer *, complex *, integer *, complex *, integer *,
integer *, char *, real *, real *, complex *, integer *, complex *
, integer *, real *, real *, real *, complex *, real *, integer *), chesvx_(char *, char *, integer *,
integer *, complex *, integer *, complex *, integer *, integer *,
complex *, integer *, complex *, integer *, real *, real *, real *
, complex *, integer *, real *, integer *),
cpbsvx_(char *, char *, integer *, integer *, integer *, complex *
, integer *, complex *, integer *, char *, real *, complex *,
integer *, complex *, integer *, real *, real *, real *, complex *
, real *, integer *), chpsvx_(char *,
char *, integer *, integer *, complex *, complex *, integer *,
complex *, integer *, complex *, integer *, real *, real *, real *
, complex *, real *, integer *), cgtsvx_(char *,
char *, integer *, integer *, complex *, complex *, complex *,
complex *, complex *, complex *, complex *, integer *, complex *,
integer *, complex *, integer *, real *, real *, real *, complex *
, real *, integer *), cposvx_(char *, char *,
integer *, integer *, complex *, integer *, complex *, integer *,
char *, real *, complex *, integer *, complex *, integer *, real *
, real *, real *, complex *, real *, integer *), cppsvx_(char *, char *, integer *, integer *, complex *,
complex *, char *, real *, complex *, integer *, complex *,
integer *, real *, real *, real *, complex *, real *, integer *), cspsvx_(char *, char *, integer *,
integer *, complex *, complex *, integer *, complex *, integer *,
complex *, integer *, real *, real *, real *, complex *, real *,
integer *), cptsvx_(char *, integer *, integer *,
real *, complex *, real *, complex *, complex *, integer *,
complex *, integer *, real *, real *, real *, complex *, real *,
integer *), csysvx_(char *, char *, integer *, integer *,
complex *, integer *, complex *, integer *, integer *, complex *,
integer *, complex *, integer *, real *, real *, real *, complex *
, integer *, real *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
static cilist io___20 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___21 = { 0, 0, 0, fmt_9998, 0 };
/* -- LAPACK test routine (version 3.1.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* January 2007 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* CERRVX tests the error exits for the COMPLEX driver routines */
/* for solving linear systems of equations. */
/* 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__) {
i__1 = i__ + (j << 2) - 5;
r__1 = 1.f / (real) (i__ + j);
r__2 = -1.f / (real) (i__ + j);
q__1.r = r__1, q__1.i = r__2;
a[i__1].r = q__1.r, a[i__1].i = q__1.i;
i__1 = i__ + (j << 2) - 5;
r__1 = 1.f / (real) (i__ + j);
r__2 = -1.f / (real) (i__ + j);
q__1.r = r__1, q__1.i = r__2;
af[i__1].r = q__1.r, af[i__1].i = q__1.i;
/* L10: */
}
i__1 = j - 1;
b[i__1].r = 0.f, b[i__1].i = 0.f;
r1[j - 1] = 0.f;
r2[j - 1] = 0.f;
i__1 = j - 1;
w[i__1].r = 0.f, w[i__1].i = 0.f;
i__1 = j - 1;
x[i__1].r = 0.f, x[i__1].i = 0.f;
c__[j - 1] = 0.f;
r__[j - 1] = 0.f;
ip[j - 1] = j;
/* L20: */
}
*(unsigned char *)eq = ' ';
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "GE")) {
/* CGESV */
s_copy(srnamc_1.srnamt, "CGESV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cgesv_(&c_n1, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("CGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgesv_(&c__0, &c_n1, a, &c__1, ip, b, &c__1, &info);
chkxer_("CGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cgesv_(&c__2, &c__1, a, &c__1, ip, b, &c__2, &info);
chkxer_("CGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
cgesv_(&c__2, &c__1, a, &c__2, ip, b, &c__1, &info);
chkxer_("CGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CGESVX */
s_copy(srnamc_1.srnamt, "CGESVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cgesvx_("/", "N", &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgesvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cgesvx_("N", "N", &c_n1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cgesvx_("N", "N", &c__0, &c_n1, a, &c__1, af, &c__1, ip, eq, r__, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
cgesvx_("N", "N", &c__2, &c__1, a, &c__1, af, &c__2, ip, eq, r__, c__,
b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
cgesvx_("N", "N", &c__2, &c__1, a, &c__2, af, &c__1, ip, eq, r__, c__,
b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
*(unsigned char *)eq = '/';
cgesvx_("F", "N", &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
*(unsigned char *)eq = 'R';
cgesvx_("F", "N", &c__1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
*(unsigned char *)eq = 'C';
cgesvx_("F", "N", &c__1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
cgesvx_("N", "N", &c__2, &c__1, a, &c__2, af, &c__2, ip, eq, r__, c__,
b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
cgesvx_("N", "N", &c__2, &c__1, a, &c__2, af, &c__2, ip, eq, r__, c__,
b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "GB")) {
/* CGBSV */
s_copy(srnamc_1.srnamt, "CGBSV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cgbsv_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgbsv_(&c__1, &c_n1, &c__0, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cgbsv_(&c__1, &c__0, &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cgbsv_(&c__0, &c__0, &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info);
chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
cgbsv_(&c__1, &c__1, &c__1, &c__0, a, &c__3, ip, b, &c__1, &info);
chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
cgbsv_(&c__2, &c__0, &c__0, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CGBSVX */
s_copy(srnamc_1.srnamt, "CGBSVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cgbsvx_("/", "N", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgbsvx_("N", "/", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cgbsvx_("N", "N", &c_n1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cgbsvx_("N", "N", &c__1, &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
cgbsvx_("N", "N", &c__1, &c__0, &c_n1, &c__0, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
cgbsvx_("N", "N", &c__0, &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
cgbsvx_("N", "N", &c__1, &c__1, &c__1, &c__0, a, &c__2, af, &c__4, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
cgbsvx_("N", "N", &c__1, &c__1, &c__1, &c__0, a, &c__3, af, &c__3, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
*(unsigned char *)eq = '/';
cgbsvx_("F", "N", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
*(unsigned char *)eq = 'R';
cgbsvx_("F", "N", &c__1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
*(unsigned char *)eq = 'C';
cgbsvx_("F", "N", &c__1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
cgbsvx_("N", "N", &c__2, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 18;
cgbsvx_("N", "N", &c__2, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip,
eq, r__, c__, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &
info);
chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "GT")) {
/* CGTSV */
s_copy(srnamc_1.srnamt, "CGTSV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cgtsv_(&c_n1, &c__0, a, &a[4], &a[8], b, &c__1, &info);
chkxer_("CGTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgtsv_(&c__0, &c_n1, a, &a[4], &a[8], b, &c__1, &info);
chkxer_("CGTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
cgtsv_(&c__2, &c__0, a, &a[4], &a[8], b, &c__1, &info);
chkxer_("CGTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CGTSVX */
s_copy(srnamc_1.srnamt, "CGTSVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cgtsvx_("/", "N", &c__0, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], &
af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgtsvx_("N", "/", &c__0, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], &
af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cgtsvx_("N", "N", &c_n1, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], &
af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cgtsvx_("N", "N", &c__0, &c_n1, a, &a[4], &a[8], af, &af[4], &af[8], &
af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
cgtsvx_("N", "N", &c__2, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], &
af[12], ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info);
chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
cgtsvx_("N", "N", &c__2, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], &
af[12], ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "PO")) {
/* CPOSV */
s_copy(srnamc_1.srnamt, "CPOSV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cposv_("/", &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("CPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cposv_("U", &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("CPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cposv_("U", &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("CPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
cposv_("U", &c__2, &c__0, a, &c__1, b, &c__2, &info);
chkxer_("CPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
cposv_("U", &c__2, &c__0, a, &c__2, b, &c__1, &info);
chkxer_("CPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPOSVX */
s_copy(srnamc_1.srnamt, "CPOSVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cposvx_("/", "U", &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &
c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cposvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &
c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cposvx_("N", "U", &c_n1, &c__0, a, &c__1, af, &c__1, eq, c__, b, &
c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cposvx_("N", "U", &c__0, &c_n1, a, &c__1, af, &c__1, eq, c__, b, &
c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
cposvx_("N", "U", &c__2, &c__0, a, &c__1, af, &c__2, eq, c__, b, &
c__2, x, &c__2, &rcond, r1, r2, w, rw, &info);
chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
cposvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__1, eq, c__, b, &
c__2, x, &c__2, &rcond, r1, r2, w, rw, &info);
chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
*(unsigned char *)eq = '/';
cposvx_("F", "U", &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &
c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
*(unsigned char *)eq = 'Y';
cposvx_("F", "U", &c__1, &c__0, a, &c__1, af, &c__1, eq, c__, b, &
c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
cposvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, eq, c__, b, &
c__1, x, &c__2, &rcond, r1, r2, w, rw, &info);
chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 14;
cposvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, eq, c__, b, &
c__2, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "PP")) {
/* CPPSV */
s_copy(srnamc_1.srnamt, "CPPSV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cppsv_("/", &c__0, &c__0, a, b, &c__1, &info);
chkxer_("CPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cppsv_("U", &c_n1, &c__0, a, b, &c__1, &info);
chkxer_("CPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cppsv_("U", &c__0, &c_n1, a, b, &c__1, &info);
chkxer_("CPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
cppsv_("U", &c__2, &c__0, a, b, &c__1, &info);
chkxer_("CPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPPSVX */
s_copy(srnamc_1.srnamt, "CPPSVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cppsvx_("/", "U", &c__0, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, &
rcond, r1, r2, w, rw, &info);
chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cppsvx_("N", "/", &c__0, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, &
rcond, r1, r2, w, rw, &info);
chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cppsvx_("N", "U", &c_n1, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, &
rcond, r1, r2, w, rw, &info);
chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cppsvx_("N", "U", &c__0, &c_n1, a, af, eq, c__, b, &c__1, x, &c__1, &
rcond, r1, r2, w, rw, &info);
chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
*(unsigned char *)eq = '/';
cppsvx_("F", "U", &c__0, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, &
rcond, r1, r2, w, rw, &info);
chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
*(unsigned char *)eq = 'Y';
cppsvx_("F", "U", &c__1, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, &
rcond, r1, r2, w, rw, &info);
chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
cppsvx_("N", "U", &c__2, &c__0, a, af, eq, c__, b, &c__1, x, &c__2, &
rcond, r1, r2, w, rw, &info);
chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
cppsvx_("N", "U", &c__2, &c__0, a, af, eq, c__, b, &c__2, x, &c__1, &
rcond, r1, r2, w, rw, &info);
chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "PB")) {
/* CPBSV */
s_copy(srnamc_1.srnamt, "CPBSV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpbsv_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &info)
;
chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpbsv_("U", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &info)
;
chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpbsv_("U", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, &info)
;
chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cpbsv_("U", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &info)
;
chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
cpbsv_("U", &c__1, &c__1, &c__0, a, &c__1, b, &c__2, &info)
;
chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
cpbsv_("U", &c__2, &c__0, &c__0, a, &c__1, b, &c__1, &info)
;
chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPBSVX */
s_copy(srnamc_1.srnamt, "CPBSVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpbsvx_("/", "U", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpbsvx_("N", "/", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpbsvx_("N", "U", &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cpbsvx_("N", "U", &c__1, &c_n1, &c__0, a, &c__1, af, &c__1, eq, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
cpbsvx_("N", "U", &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, eq, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
cpbsvx_("N", "U", &c__1, &c__1, &c__0, a, &c__1, af, &c__2, eq, c__,
b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
cpbsvx_("N", "U", &c__1, &c__1, &c__0, a, &c__2, af, &c__1, eq, c__,
b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
*(unsigned char *)eq = '/';
cpbsvx_("F", "U", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
*(unsigned char *)eq = 'Y';
cpbsvx_("F", "U", &c__1, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__,
b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
cpbsvx_("N", "U", &c__2, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__,
b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
cpbsvx_("N", "U", &c__2, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__,
b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info);
chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "PT")) {
/* CPTSV */
s_copy(srnamc_1.srnamt, "CPTSV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cptsv_(&c_n1, &c__0, r__, a, b, &c__1, &info);
chkxer_("CPTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cptsv_(&c__0, &c_n1, r__, a, b, &c__1, &info);
chkxer_("CPTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
cptsv_(&c__2, &c__0, r__, a, b, &c__1, &info);
chkxer_("CPTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPTSVX */
s_copy(srnamc_1.srnamt, "CPTSVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cptsvx_("/", &c__0, &c__0, r__, a, rf, af, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cptsvx_("N", &c_n1, &c__0, r__, a, rf, af, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cptsvx_("N", &c__0, &c_n1, r__, a, rf, af, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
cptsvx_("N", &c__2, &c__0, r__, a, rf, af, b, &c__1, x, &c__2, &rcond,
r1, r2, w, rw, &info);
chkxer_("CPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
cptsvx_("N", &c__2, &c__0, r__, a, rf, af, b, &c__2, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "HE")) {
/* CHESV */
s_copy(srnamc_1.srnamt, "CHESV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
chesv_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info);
chkxer_("CHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
chesv_("U", &c_n1, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info);
chkxer_("CHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
chesv_("U", &c__0, &c_n1, a, &c__1, ip, b, &c__1, w, &c__1, &info);
chkxer_("CHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
chesv_("U", &c__2, &c__0, a, &c__1, ip, b, &c__2, w, &c__1, &info);
chkxer_("CHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
chesv_("U", &c__2, &c__0, a, &c__2, ip, b, &c__1, w, &c__1, &info);
chkxer_("CHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CHESVX */
s_copy(srnamc_1.srnamt, "CHESVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
chesvx_("/", "U", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x,
&c__1, &rcond, r1, r2, w, &c__1, rw, &info);
chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
chesvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x,
&c__1, &rcond, r1, r2, w, &c__1, rw, &info);
chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
chesvx_("N", "U", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x,
&c__1, &rcond, r1, r2, w, &c__1, rw, &info);
chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
chesvx_("N", "U", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x,
&c__1, &rcond, r1, r2, w, &c__1, rw, &info);
chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
chesvx_("N", "U", &c__2, &c__0, a, &c__1, af, &c__2, ip, b, &c__2, x,
&c__2, &rcond, r1, r2, w, &c__4, rw, &info);
chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
chesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__1, ip, b, &c__2, x,
&c__2, &rcond, r1, r2, w, &c__4, rw, &info);
chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
chesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__1, x,
&c__2, &rcond, r1, r2, w, &c__4, rw, &info);
chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
chesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x,
&c__1, &rcond, r1, r2, w, &c__4, rw, &info);
chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 18;
chesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x,
&c__2, &rcond, r1, r2, w, &c__3, rw, &info);
chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "HP")) {
/* CHPSV */
s_copy(srnamc_1.srnamt, "CHPSV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
chpsv_("/", &c__0, &c__0, a, ip, b, &c__1, &info);
chkxer_("CHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
chpsv_("U", &c_n1, &c__0, a, ip, b, &c__1, &info);
chkxer_("CHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
chpsv_("U", &c__0, &c_n1, a, ip, b, &c__1, &info);
chkxer_("CHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
chpsv_("U", &c__2, &c__0, a, ip, b, &c__1, &info);
chkxer_("CHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CHPSVX */
s_copy(srnamc_1.srnamt, "CHPSVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
chpsvx_("/", "U", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
chpsvx_("N", "/", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
chpsvx_("N", "U", &c_n1, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
chpsvx_("N", "U", &c__0, &c_n1, a, af, ip, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
chpsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__1, x, &c__2, &rcond,
r1, r2, w, rw, &info);
chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
chpsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__2, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "SY")) {
/* CSYSV */
s_copy(srnamc_1.srnamt, "CSYSV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
csysv_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info);
chkxer_("CSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
csysv_("U", &c_n1, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info);
chkxer_("CSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
csysv_("U", &c__0, &c_n1, a, &c__1, ip, b, &c__1, w, &c__1, &info);
chkxer_("CSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
csysv_("U", &c__2, &c__0, a, &c__2, ip, b, &c__1, w, &c__1, &info);
chkxer_("CSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CSYSVX */
s_copy(srnamc_1.srnamt, "CSYSVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
csysvx_("/", "U", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x,
&c__1, &rcond, r1, r2, w, &c__1, rw, &info);
chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
csysvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x,
&c__1, &rcond, r1, r2, w, &c__1, rw, &info);
chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
csysvx_("N", "U", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x,
&c__1, &rcond, r1, r2, w, &c__1, rw, &info);
chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
csysvx_("N", "U", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x,
&c__1, &rcond, r1, r2, w, &c__1, rw, &info);
chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
csysvx_("N", "U", &c__2, &c__0, a, &c__1, af, &c__2, ip, b, &c__2, x,
&c__2, &rcond, r1, r2, w, &c__4, rw, &info);
chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
csysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__1, ip, b, &c__2, x,
&c__2, &rcond, r1, r2, w, &c__4, rw, &info);
chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
csysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__1, x,
&c__2, &rcond, r1, r2, w, &c__4, rw, &info);
chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
csysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x,
&c__1, &rcond, r1, r2, w, &c__4, rw, &info);
chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 18;
csysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x,
&c__2, &rcond, r1, r2, w, &c__3, rw, &info);
chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "SP")) {
/* CSPSV */
s_copy(srnamc_1.srnamt, "CSPSV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cspsv_("/", &c__0, &c__0, a, ip, b, &c__1, &info);
chkxer_("CSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cspsv_("U", &c_n1, &c__0, a, ip, b, &c__1, &info);
chkxer_("CSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cspsv_("U", &c__0, &c_n1, a, ip, b, &c__1, &info);
chkxer_("CSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
cspsv_("U", &c__2, &c__0, a, ip, b, &c__1, &info);
chkxer_("CSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CSPSVX */
s_copy(srnamc_1.srnamt, "CSPSVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cspsvx_("/", "U", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cspsvx_("N", "/", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cspsvx_("N", "U", &c_n1, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cspsvx_("N", "U", &c__0, &c_n1, a, af, ip, b, &c__1, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
cspsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__1, x, &c__2, &rcond,
r1, r2, w, rw, &info);
chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
cspsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__2, x, &c__1, &rcond,
r1, r2, w, rw, &info);
chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
}
/* Print a summary line. */
if (infoc_1.ok) {
io___20.ciunit = infoc_1.nout;
s_wsfe(&io___20);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
} else {
io___21.ciunit = infoc_1.nout;
s_wsfe(&io___21);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
return 0;
/* End of CERRVX */
} /* cerrvx_ */
/* Subroutine */ int serred_(char *path, integer *nunit)
{
/* Format strings */
static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e"
"rror exits (\002,i3,\002 tests done)\002)";
static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes"
"ts of the error ex\002,\002its ***\002)";
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Local variables */
static integer info, sdim;
static real a[16] /* was [4][4] */;
static logical b[4];
static integer i__, j;
static real s[4], u[16] /* was [4][4] */, w[16], abnrm;
extern /* Subroutine */ int sgees_(char *, char *, L_fp, integer *, real *
, integer *, integer *, real *, real *, real *, integer *, real *,
integer *, logical *, integer *), sgeev_(char *,
char *, integer *, real *, integer *, real *, real *, real *,
integer *, real *, integer *, real *, integer *, integer *);
static char c2[2];
static real r1[4], r2[4];
static integer iw[8];
static real wi[4];
static integer nt;
static real vl[16] /* was [4][4] */, vr[16] /* was [4][4] */, wr[
4], vt[16] /* was [4][4] */;
extern /* Subroutine */ int sgesdd_(char *, integer *, integer *, real *,
integer *, real *, real *, integer *, real *, integer *, real *,
integer *, integer *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), sgesvd_(char *, char *, integer *, integer
*, real *, integer *, real *, real *, integer *, real *, integer *
, real *, integer *, integer *);
extern logical sslect_();
extern /* Subroutine */ int sgeesx_(char *, char *, L_fp, char *, integer
*, real *, integer *, integer *, real *, real *, real *, integer *
, real *, real *, real *, integer *, integer *, integer *,
logical *, integer *), sgeevx_(char *,
char *, char *, char *, integer *, real *, integer *, real *,
real *, real *, integer *, real *, integer *, integer *, integer *
, real *, real *, real *, real *, real *, integer *, integer *,
integer *);
static integer ihi, ilo;
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
static cilist io___24 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___25 = { 0, 0, 0, fmt_9998, 0 };
#define a_ref(a_1,a_2) a[(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
December 22, 1999
Purpose
=======
SERRED tests the error exits for the eigenvalue driver routines for
REAL matrices:
PATH driver description
---- ------ -----------
SEV SGEEV find eigenvalues/eigenvectors for nonsymmetric A
SES SGEES find eigenvalues/Schur form for nonsymmetric A
SVX SGEEVX SGEEV + balancing and condition estimation
SSX SGEESX SGEES + balancing and condition estimation
SBD SGESVD compute SVD of an M-by-N matrix A
SGESDD compute SVD of an M-by-N matrix A (by divide and
conquer)
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);
/* Initialize A */
for (j = 1; j <= 4; ++j) {
for (i__ = 1; i__ <= 4; ++i__) {
a_ref(i__, j) = 0.f;
/* L10: */
}
/* L20: */
}
for (i__ = 1; i__ <= 4; ++i__) {
a_ref(i__, i__) = 1.f;
/* L30: */
}
infoc_1.ok = TRUE_;
nt = 0;
if (lsamen_(&c__2, c2, "EV")) {
/* Test SGEEV */
s_copy(srnamc_1.srnamt, "SGEEV ", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgeev_("X", "N", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, &c__1, w, &
c__1, &info);
chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgeev_("N", "X", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, &c__1, w, &
c__1, &info);
chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgeev_("N", "N", &c_n1, a, &c__1, wr, wi, vl, &c__1, vr, &c__1, w, &
c__1, &info);
chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgeev_("N", "N", &c__2, a, &c__1, wr, wi, vl, &c__1, vr, &c__1, w, &
c__6, &info);
chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
sgeev_("V", "N", &c__2, a, &c__2, wr, wi, vl, &c__1, vr, &c__1, w, &
c__8, &info);
chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
sgeev_("N", "V", &c__2, a, &c__2, wr, wi, vl, &c__1, vr, &c__1, w, &
c__8, &info);
chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
sgeev_("V", "V", &c__1, a, &c__1, wr, wi, vl, &c__1, vr, &c__1, w, &
c__3, &info);
chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 7;
} else if (lsamen_(&c__2, c2, "ES")) {
/* Test SGEES */
s_copy(srnamc_1.srnamt, "SGEES ", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgees_("X", "N", (L_fp)sslect_, &c__0, a, &c__1, &sdim, wr, wi, vl, &
c__1, w, &c__1, b, &info);
chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgees_("N", "X", (L_fp)sslect_, &c__0, a, &c__1, &sdim, wr, wi, vl, &
c__1, w, &c__1, b, &info);
chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgees_("N", "S", (L_fp)sslect_, &c_n1, a, &c__1, &sdim, wr, wi, vl, &
c__1, w, &c__1, b, &info);
chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgees_("N", "S", (L_fp)sslect_, &c__2, a, &c__1, &sdim, wr, wi, vl, &
c__1, w, &c__6, b, &info);
chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
sgees_("V", "S", (L_fp)sslect_, &c__2, a, &c__2, &sdim, wr, wi, vl, &
c__1, w, &c__6, b, &info);
chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
sgees_("N", "S", (L_fp)sslect_, &c__1, a, &c__1, &sdim, wr, wi, vl, &
c__1, w, &c__2, b, &info);
chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 6;
} else if (lsamen_(&c__2, c2, "VX")) {
/* Test SGEEVX */
s_copy(srnamc_1.srnamt, "SGEEVX", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgeevx_("X", "N", "N", "N", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgeevx_("N", "X", "N", "N", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgeevx_("N", "N", "X", "N", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgeevx_("N", "N", "N", "X", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgeevx_("N", "N", "N", "N", &c_n1, a, &c__1, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgeevx_("N", "N", "N", "N", &c__2, a, &c__1, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
sgeevx_("N", "V", "N", "N", &c__2, a, &c__2, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__6, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
sgeevx_("N", "N", "V", "N", &c__2, a, &c__2, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__6, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 21;
sgeevx_("N", "N", "N", "N", &c__1, a, &c__1, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 21;
sgeevx_("N", "V", "N", "N", &c__1, a, &c__1, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__2, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 21;
sgeevx_("N", "N", "V", "V", &c__1, a, &c__1, wr, wi, vl, &c__1, vr, &
c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__3, iw, &info);
chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 11;
} else if (lsamen_(&c__2, c2, "SX")) {
/* Test SGEESX */
s_copy(srnamc_1.srnamt, "SGEESX", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgeesx_("X", "N", (L_fp)sslect_, "N", &c__0, a, &c__1, &sdim, wr, wi,
vl, &c__1, r1, r2, w, &c__1, iw, &c__1, b, &info);
chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgeesx_("N", "X", (L_fp)sslect_, "N", &c__0, a, &c__1, &sdim, wr, wi,
vl, &c__1, r1, r2, w, &c__1, iw, &c__1, b, &info);
chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgeesx_("N", "N", (L_fp)sslect_, "X", &c__0, a, &c__1, &sdim, wr, wi,
vl, &c__1, r1, r2, w, &c__1, iw, &c__1, b, &info);
chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgeesx_("N", "N", (L_fp)sslect_, "N", &c_n1, a, &c__1, &sdim, wr, wi,
vl, &c__1, r1, r2, w, &c__1, iw, &c__1, b, &info);
chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgeesx_("N", "N", (L_fp)sslect_, "N", &c__2, a, &c__1, &sdim, wr, wi,
vl, &c__1, r1, r2, w, &c__6, iw, &c__1, b, &info);
chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
sgeesx_("V", "N", (L_fp)sslect_, "N", &c__2, a, &c__2, &sdim, wr, wi,
vl, &c__1, r1, r2, w, &c__6, iw, &c__1, b, &info);
chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 16;
sgeesx_("N", "N", (L_fp)sslect_, "N", &c__1, a, &c__1, &sdim, wr, wi,
vl, &c__1, r1, r2, w, &c__2, iw, &c__1, b, &info);
chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 7;
} else if (lsamen_(&c__2, c2, "BD")) {
/* Test SGESVD */
s_copy(srnamc_1.srnamt, "SGESVD", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgesvd_("X", "N", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__1, &info);
chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgesvd_("N", "X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__1, &info);
chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgesvd_("O", "O", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__1, &info);
chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgesvd_("N", "N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__1, &info);
chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgesvd_("N", "N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__1, &info);
chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
sgesvd_("N", "N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__5, &info);
chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
sgesvd_("A", "N", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, &
c__5, &info);
chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
sgesvd_("N", "A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__5, &info);
chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 8;
/* Test SGESDD */
s_copy(srnamc_1.srnamt, "SGESDD", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sgesdd_("X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1,
iw, &info);
chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgesdd_("N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1,
iw, &info);
chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sgesdd_("N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1,
iw, &info);
chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sgesdd_("N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5,
iw, &info);
chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
sgesdd_("A", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, &c__5,
iw, &info);
chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
sgesdd_("A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5,
iw, &info);
chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 6;
}
/* Print a summary line. */
if (! lsamen_(&c__2, c2, "BD")) {
if (infoc_1.ok) {
io___24.ciunit = infoc_1.nout;
s_wsfe(&io___24);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
e_wsfe();
} else {
io___25.ciunit = infoc_1.nout;
s_wsfe(&io___25);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
}
return 0;
/* End of SERRED */
} /* serred_ */
/* Subroutine */ int zlarhs_(char *path, char *xtype, char *uplo, char *trans,
integer *m, integer *n, integer *kl, integer *ku, integer *nrhs,
doublecomplex *a, integer *lda, doublecomplex *x, integer *ldx,
doublecomplex *b, integer *ldb, integer *iseed, integer *info)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, x_dim1, x_offset, i__1;
/* Local variables */
integer j;
char c1[1], c2[2];
integer mb, nx;
logical gen, tri, qrs, sym, band;
char diag[1];
logical tran;
extern /* Subroutine */ int zgemm_(char *, char *, integer *, integer *,
integer *, doublecomplex *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
integer *), zhemm_(char *, char *, integer *,
integer *, doublecomplex *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
integer *), zgbmv_(char *, integer *, integer *,
integer *, integer *, doublecomplex *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
integer *), zhbmv_(char *, integer *, integer *,
doublecomplex *, doublecomplex *, integer *, doublecomplex *,
integer *, doublecomplex *, doublecomplex *, integer *),
zsbmv_(char *, integer *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, doublecomplex *, integer *), ztbmv_(char
*, char *, char *, integer *, integer *, doublecomplex *, integer
*, doublecomplex *, integer *), zhpmv_(
char *, integer *, doublecomplex *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
integer *), ztrmm_(char *, char *, char *, char *,
integer *, integer *, doublecomplex *, doublecomplex *, integer *,
doublecomplex *, integer *),
zspmv_(char *, integer *, doublecomplex *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
integer *), zsymm_(char *, char *, integer *, integer *,
doublecomplex *, doublecomplex *, integer *, doublecomplex *,
integer *, doublecomplex *, doublecomplex *, integer *), ztpmv_(char *, char *, char *, integer *, doublecomplex *
, doublecomplex *, integer *), xerbla_(
char *, integer *);
extern logical lsamen_(integer *, char *, char *);
logical notran;
extern /* Subroutine */ int zlacpy_(char *, integer *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *),
zlarnv_(integer *, integer *, integer *, doublecomplex *);
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZLARHS chooses a set of NRHS random solution vectors and sets */
/* up the right hand sides for the linear system */
/* op( A ) * X = B, */
/* where op( A ) may be A, A**T (transpose of A), or A**H (conjugate */
/* transpose of A). */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The type of the complex matrix A. PATH may be given in any */
/* combination of upper and lower case. Valid paths include */
/* xGE: General m x n matrix */
/* xGB: General banded matrix */
/* xPO: Hermitian positive definite, 2-D storage */
/* xPP: Hermitian positive definite packed */
/* xPB: Hermitian positive definite banded */
/* xHE: Hermitian indefinite, 2-D storage */
/* xHP: Hermitian indefinite packed */
/* xHB: Hermitian indefinite banded */
/* xSY: Symmetric indefinite, 2-D storage */
/* xSP: Symmetric indefinite packed */
/* xSB: Symmetric indefinite banded */
/* xTR: Triangular */
/* xTP: Triangular packed */
/* xTB: Triangular banded */
/* xQR: General m x n matrix */
/* xLQ: General m x n matrix */
/* xQL: General m x n matrix */
/* xRQ: General m x n matrix */
/* where the leading character indicates the precision. */
/* XTYPE (input) CHARACTER*1 */
/* Specifies how the exact solution X will be determined: */
/* = 'N': New solution; generate a random X. */
/* = 'C': Computed; use value of X on entry. */
/* UPLO (input) CHARACTER*1 */
/* Used only if A is symmetric or triangular; specifies whether */
/* the upper or lower triangular part of the matrix A is stored. */
/* = 'U': Upper triangular */
/* = 'L': Lower triangular */
/* TRANS (input) CHARACTER*1 */
/* Used only if A is nonsymmetric; specifies the operation */
/* applied to the matrix A. */
/* = 'N': B := A * X */
/* = 'T': B := A**T * X */
/* = 'C': B := A**H * X */
/* M (input) INTEGER */
/* The number of rows of the matrix A. M >= 0. */
/* N (input) INTEGER */
/* The number of columns of the matrix A. N >= 0. */
/* KL (input) INTEGER */
/* Used only if A is a band matrix; specifies the number of */
/* subdiagonals of A if A is a general band matrix or if A is */
/* symmetric or triangular and UPLO = 'L'; specifies the number */
/* of superdiagonals of A if A is symmetric or triangular and */
/* UPLO = 'U'. 0 <= KL <= M-1. */
/* KU (input) INTEGER */
/* Used only if A is a general band matrix or if A is */
/* triangular. */
/* If PATH = xGB, specifies the number of superdiagonals of A, */
/* and 0 <= KU <= N-1. */
/* If PATH = xTR, xTP, or xTB, specifies whether or not the */
/* matrix has unit diagonal: */
/* = 1: matrix has non-unit diagonal (default) */
/* = 2: matrix has unit diagonal */
/* NRHS (input) INTEGER */
/* The number of right hand side vectors in the system A*X = B. */
/* A (input) COMPLEX*16 array, dimension (LDA,N) */
/* The test matrix whose type is given by PATH. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. */
/* If PATH = xGB, LDA >= KL+KU+1. */
/* If PATH = xPB, xSB, xHB, or xTB, LDA >= KL+1. */
/* Otherwise, LDA >= max(1,M). */
/* X (input or output) COMPLEX*16 array, dimension (LDX,NRHS) */
/* On entry, if XTYPE = 'C' (for 'Computed'), then X contains */
/* the exact solution to the system of linear equations. */
/* On exit, if XTYPE = 'N' (for 'New'), then X is initialized */
/* with random values. */
/* LDX (input) INTEGER */
/* The leading dimension of the array X. If TRANS = 'N', */
/* LDX >= max(1,N); if TRANS = 'T', LDX >= max(1,M). */
/* B (output) COMPLEX*16 array, dimension (LDB,NRHS) */
/* The right hand side vector(s) for the system of equations, */
/* computed from B = op(A) * X, where op(A) is determined by */
/* TRANS. */
/* LDB (input) INTEGER */
/* The leading dimension of the array B. If TRANS = 'N', */
/* LDB >= max(1,M); if TRANS = 'T', LDB >= max(1,N). */
/* ISEED (input/output) INTEGER array, dimension (4) */
/* The seed vector for the random number generator (used in */
/* ZLATMS). Modified on exit. */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -i, the i-th argument had an illegal value */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
x_dim1 = *ldx;
x_offset = 1 + x_dim1;
x -= x_offset;
b_dim1 = *ldb;
b_offset = 1 + b_dim1;
b -= b_offset;
--iseed;
/* Function Body */
*info = 0;
*(unsigned char *)c1 = *(unsigned char *)path;
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
tran = lsame_(trans, "T") || lsame_(trans, "C");
notran = ! tran;
gen = lsame_(path + 1, "G");
qrs = lsame_(path + 1, "Q") || lsame_(path + 2,
"Q");
sym = lsame_(path + 1, "P") || lsame_(path + 1,
"S") || lsame_(path + 1, "H");
tri = lsame_(path + 1, "T");
band = lsame_(path + 2, "B");
if (! lsame_(c1, "Zomplex precision")) {
*info = -1;
} else if (! (lsame_(xtype, "N") || lsame_(xtype,
"C"))) {
*info = -2;
} else if ((sym || tri) && ! (lsame_(uplo, "U") ||
lsame_(uplo, "L"))) {
*info = -3;
} else if ((gen || qrs) && ! (tran || lsame_(trans, "N"))) {
*info = -4;
} else if (*m < 0) {
*info = -5;
} else if (*n < 0) {
*info = -6;
} else if (band && *kl < 0) {
*info = -7;
} else if (band && *ku < 0) {
*info = -8;
} else if (*nrhs < 0) {
*info = -9;
} else if (! band && *lda < max(1,*m) || band && (sym || tri) && *lda < *
kl + 1 || band && gen && *lda < *kl + *ku + 1) {
*info = -11;
} else if (notran && *ldx < max(1,*n) || tran && *ldx < max(1,*m)) {
*info = -13;
} else if (notran && *ldb < max(1,*m) || tran && *ldb < max(1,*n)) {
*info = -15;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("ZLARHS", &i__1);
return 0;
}
/* Initialize X to NRHS random vectors unless XTYPE = 'C'. */
if (tran) {
nx = *m;
mb = *n;
} else {
nx = *n;
mb = *m;
}
if (! lsame_(xtype, "C")) {
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
zlarnv_(&c__2, &iseed[1], n, &x[j * x_dim1 + 1]);
/* L10: */
}
}
/* Multiply X by op( A ) using an appropriate */
/* matrix multiply routine. */
if (lsamen_(&c__2, c2, "GE") || lsamen_(&c__2, c2,
"QR") || lsamen_(&c__2, c2, "LQ") || lsamen_(&c__2, c2, "QL") ||
lsamen_(&c__2, c2, "RQ")) {
/* General matrix */
zgemm_(trans, "N", &mb, nrhs, &nx, &c_b1, &a[a_offset], lda, &x[
x_offset], ldx, &c_b2, &b[b_offset], ldb);
} else if (lsamen_(&c__2, c2, "PO") || lsamen_(&
c__2, c2, "HE")) {
/* Hermitian matrix, 2-D storage */
zhemm_("Left", uplo, n, nrhs, &c_b1, &a[a_offset], lda, &x[x_offset],
ldx, &c_b2, &b[b_offset], ldb);
} else if (lsamen_(&c__2, c2, "SY")) {
/* Symmetric matrix, 2-D storage */
zsymm_("Left", uplo, n, nrhs, &c_b1, &a[a_offset], lda, &x[x_offset],
ldx, &c_b2, &b[b_offset], ldb);
} else if (lsamen_(&c__2, c2, "GB")) {
/* General matrix, band storage */
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
zgbmv_(trans, m, n, kl, ku, &c_b1, &a[a_offset], lda, &x[j *
x_dim1 + 1], &c__1, &c_b2, &b[j * b_dim1 + 1], &c__1);
/* L20: */
}
} else if (lsamen_(&c__2, c2, "PB") || lsamen_(&
c__2, c2, "HB")) {
/* Hermitian matrix, band storage */
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
zhbmv_(uplo, n, kl, &c_b1, &a[a_offset], lda, &x[j * x_dim1 + 1],
&c__1, &c_b2, &b[j * b_dim1 + 1], &c__1);
/* L30: */
}
} else if (lsamen_(&c__2, c2, "SB")) {
/* Symmetric matrix, band storage */
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
zsbmv_(uplo, n, kl, &c_b1, &a[a_offset], lda, &x[j * x_dim1 + 1],
&c__1, &c_b2, &b[j * b_dim1 + 1], &c__1);
/* L40: */
}
} else if (lsamen_(&c__2, c2, "PP") || lsamen_(&
c__2, c2, "HP")) {
/* Hermitian matrix, packed storage */
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
zhpmv_(uplo, n, &c_b1, &a[a_offset], &x[j * x_dim1 + 1], &c__1, &
c_b2, &b[j * b_dim1 + 1], &c__1);
/* L50: */
}
} else if (lsamen_(&c__2, c2, "SP")) {
/* Symmetric matrix, packed storage */
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
zspmv_(uplo, n, &c_b1, &a[a_offset], &x[j * x_dim1 + 1], &c__1, &
c_b2, &b[j * b_dim1 + 1], &c__1);
/* L60: */
}
} else if (lsamen_(&c__2, c2, "TR")) {
/* Triangular matrix. Note that for triangular matrices, */
/* KU = 1 => non-unit triangular */
/* KU = 2 => unit triangular */
zlacpy_("Full", n, nrhs, &x[x_offset], ldx, &b[b_offset], ldb);
if (*ku == 2) {
*(unsigned char *)diag = 'U';
} else {
*(unsigned char *)diag = 'N';
}
ztrmm_("Left", uplo, trans, diag, n, nrhs, &c_b1, &a[a_offset], lda, &
b[b_offset], ldb);
} else if (lsamen_(&c__2, c2, "TP")) {
/* Triangular matrix, packed storage */
zlacpy_("Full", n, nrhs, &x[x_offset], ldx, &b[b_offset], ldb);
if (*ku == 2) {
*(unsigned char *)diag = 'U';
} else {
*(unsigned char *)diag = 'N';
}
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
ztpmv_(uplo, trans, diag, n, &a[a_offset], &b[j * b_dim1 + 1], &
c__1);
/* L70: */
}
} else if (lsamen_(&c__2, c2, "TB")) {
/* Triangular matrix, banded storage */
zlacpy_("Full", n, nrhs, &x[x_offset], ldx, &b[b_offset], ldb);
if (*ku == 2) {
*(unsigned char *)diag = 'U';
} else {
*(unsigned char *)diag = 'N';
}
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
ztbmv_(uplo, trans, diag, n, kl, &a[a_offset], lda, &b[j * b_dim1
+ 1], &c__1);
/* L80: */
}
} else {
/* If none of the above, set INFO = -1 and return */
*info = -1;
i__1 = -(*info);
xerbla_("ZLARHS", &i__1);
}
return 0;
/* End of ZLARHS */
} /* zlarhs_ */
/* Subroutine */ int zerred_(char *path, integer *nunit)
{
/* Format strings */
static char fmt_9999[] = "(1x,a,\002 passed the tests of the error exits"
" (\002,i3,\002 tests done)\002)";
static char fmt_9998[] = "(\002 *** \002,a,\002 failed the tests of the "
"error exits ***\002)";
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), i_len_trim(char *, ftnlen), do_fio(integer *,
char *, ftnlen), e_wsfe(void);
/* Local variables */
doublecomplex a[16] /* was [4][4] */;
logical b[4];
integer i__, j;
doublereal s[4];
doublecomplex u[16] /* was [4][4] */, w[16], x[4];
char c2[2];
doublereal r1[4], r2[4];
integer iw[16], nt;
doublecomplex vl[16] /* was [4][4] */, vr[16] /* was [4][4]
*/;
doublereal rw[20];
doublecomplex vt[16] /* was [4][4] */;
integer ihi, ilo, info, sdim;
doublereal abnrm;
extern /* Subroutine */ int zgees_(char *, char *, L_fp, integer *,
doublecomplex *, integer *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, integer *,
doublereal *, logical *, integer *), zgeev_(char *
, char *, integer *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublereal *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int zgesdd_(char *, integer *, integer *,
doublecomplex *, integer *, doublereal *, doublecomplex *,
integer *, doublecomplex *, integer *, doublecomplex *, integer *,
doublereal *, integer *, integer *), chkxer_(char *,
integer *, integer *, logical *, logical *), zgesvd_(char
*, char *, integer *, integer *, doublecomplex *, integer *,
doublereal *, doublecomplex *, integer *, doublecomplex *,
integer *, doublecomplex *, integer *, doublereal *, integer *);
extern logical zslect_();
extern /* Subroutine */ int zgeesx_(char *, char *, L_fp, char *, integer
*, doublecomplex *, integer *, integer *, doublecomplex *,
doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, integer *, doublereal *, logical *, integer *), zgeevx_(char *, char *, char *, char *,
integer *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, integer *, integer *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *
, doublecomplex *, integer *, doublereal *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
static cilist io___23 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___24 = { 0, 0, 0, fmt_9998, 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_9999, 0 };
static cilist io___29 = { 0, 0, 0, fmt_9998, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZERRED tests the error exits for the eigenvalue driver routines for */
/* DOUBLE PRECISION matrices: */
/* PATH driver description */
/* ---- ------ ----------- */
/* ZEV ZGEEV find eigenvalues/eigenvectors for nonsymmetric A */
/* ZES ZGEES find eigenvalues/Schur form for nonsymmetric A */
/* ZVX ZGEEVX ZGEEV + balancing and condition estimation */
/* ZSX ZGEESX ZGEES + balancing and condition estimation */
/* ZBD ZGESVD compute SVD of an M-by-N matrix A */
/* ZGESDD compute SVD of an M-by-N matrix A(by divide and */
/* conquer) */
/* 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 Subroutines .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Arrays in Common .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Initialize A */
for (j = 1; j <= 4; ++j) {
for (i__ = 1; i__ <= 4; ++i__) {
i__1 = i__ + (j << 2) - 5;
a[i__1].r = 0., a[i__1].i = 0.;
/* L10: */
}
/* L20: */
}
for (i__ = 1; i__ <= 4; ++i__) {
i__1 = i__ + (i__ << 2) - 5;
a[i__1].r = 1., a[i__1].i = 0.;
/* L30: */
}
infoc_1.ok = TRUE_;
nt = 0;
if (lsamen_(&c__2, c2, "EV")) {
/* Test ZGEEV */
s_copy(srnamc_1.srnamt, "ZGEEV ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgeev_("X", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1,
rw, &info);
chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgeev_("N", "X", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1,
rw, &info);
chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zgeev_("N", "N", &c_n1, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1,
rw, &info);
chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zgeev_("N", "N", &c__2, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__4,
rw, &info);
chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zgeev_("V", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, w, &c__4,
rw, &info);
chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zgeev_("N", "V", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, w, &c__4,
rw, &info);
chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
zgeev_("V", "V", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1,
rw, &info);
chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 7;
} else if (lsamen_(&c__2, c2, "ES")) {
/* Test ZGEES */
s_copy(srnamc_1.srnamt, "ZGEES ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgees_("X", "N", (L_fp)zslect_, &c__0, a, &c__1, &sdim, x, vl, &c__1,
w, &c__1, rw, b, &info);
chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgees_("N", "X", (L_fp)zslect_, &c__0, a, &c__1, &sdim, x, vl, &c__1,
w, &c__1, rw, b, &info);
chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zgees_("N", "S", (L_fp)zslect_, &c_n1, a, &c__1, &sdim, x, vl, &c__1,
w, &c__1, rw, b, &info);
chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zgees_("N", "S", (L_fp)zslect_, &c__2, a, &c__1, &sdim, x, vl, &c__1,
w, &c__4, rw, b, &info);
chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zgees_("V", "S", (L_fp)zslect_, &c__2, a, &c__2, &sdim, x, vl, &c__1,
w, &c__4, rw, b, &info);
chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
zgees_("N", "S", (L_fp)zslect_, &c__1, a, &c__1, &sdim, x, vl, &c__1,
w, &c__1, rw, b, &info);
chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 6;
} else if (lsamen_(&c__2, c2, "VX")) {
/* Test ZGEEVX */
s_copy(srnamc_1.srnamt, "ZGEEVX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgeevx_("X", "N", "N", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
&ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgeevx_("N", "X", "N", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
&ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zgeevx_("N", "N", "X", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
&ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zgeevx_("N", "N", "N", "X", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
&ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zgeevx_("N", "N", "N", "N", &c_n1, a, &c__1, x, vl, &c__1, vr, &c__1,
&ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zgeevx_("N", "N", "N", "N", &c__2, a, &c__1, x, vl, &c__1, vr, &c__1,
&ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info);
chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zgeevx_("N", "V", "N", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1,
&ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info);
chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
zgeevx_("N", "N", "V", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1,
&ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info);
chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 20;
zgeevx_("N", "N", "N", "N", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1,
&ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 20;
zgeevx_("N", "N", "V", "V", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1,
&ilo, &ihi, s, &abnrm, r1, r2, w, &c__2, rw, &info);
chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 10;
} else if (lsamen_(&c__2, c2, "SX")) {
/* Test ZGEESX */
s_copy(srnamc_1.srnamt, "ZGEESX", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgeesx_("X", "N", (L_fp)zslect_, "N", &c__0, a, &c__1, &sdim, x, vl, &
c__1, r1, r2, w, &c__1, rw, b, &info);
chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgeesx_("N", "X", (L_fp)zslect_, "N", &c__0, a, &c__1, &sdim, x, vl, &
c__1, r1, r2, w, &c__1, rw, b, &info);
chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zgeesx_("N", "N", (L_fp)zslect_, "X", &c__0, a, &c__1, &sdim, x, vl, &
c__1, r1, r2, w, &c__1, rw, b, &info);
chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zgeesx_("N", "N", (L_fp)zslect_, "N", &c_n1, a, &c__1, &sdim, x, vl, &
c__1, r1, r2, w, &c__1, rw, b, &info);
chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zgeesx_("N", "N", (L_fp)zslect_, "N", &c__2, a, &c__1, &sdim, x, vl, &
c__1, r1, r2, w, &c__4, rw, b, &info);
chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
zgeesx_("V", "N", (L_fp)zslect_, "N", &c__2, a, &c__2, &sdim, x, vl, &
c__1, r1, r2, w, &c__4, rw, b, &info);
chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
zgeesx_("N", "N", (L_fp)zslect_, "N", &c__1, a, &c__1, &sdim, x, vl, &
c__1, r1, r2, w, &c__1, rw, b, &info);
chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 7;
} else if (lsamen_(&c__2, c2, "BD")) {
/* Test ZGESVD */
s_copy(srnamc_1.srnamt, "ZGESVD", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgesvd_("X", "N", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__1, rw, &info);
chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgesvd_("N", "X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__1, rw, &info);
chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgesvd_("O", "O", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__1, rw, &info);
chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zgesvd_("N", "N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__1, rw, &info);
chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zgesvd_("N", "N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__1, rw, &info);
chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zgesvd_("N", "N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__5, rw, &info);
chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
zgesvd_("A", "N", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, &
c__5, rw, &info);
chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
zgesvd_("N", "A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, &
c__5, rw, &info);
chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 8;
if (infoc_1.ok) {
io___23.ciunit = infoc_1.nout;
s_wsfe(&io___23);
do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, (
ftnlen)32));
do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
e_wsfe();
} else {
io___24.ciunit = infoc_1.nout;
s_wsfe(&io___24);
e_wsfe();
}
/* Test ZGESDD */
s_copy(srnamc_1.srnamt, "ZGESDD", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgesdd_("X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1,
rw, iw, &info);
chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgesdd_("N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1,
rw, iw, &info);
chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zgesdd_("N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1,
rw, iw, &info);
chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zgesdd_("N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5,
rw, iw, &info);
chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zgesdd_("A", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, &c__5,
rw, iw, &info);
chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zgesdd_("A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5,
rw, iw, &info);
chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += -2;
if (infoc_1.ok) {
io___26.ciunit = infoc_1.nout;
s_wsfe(&io___26);
do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, (
ftnlen)32));
do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
e_wsfe();
} else {
io___27.ciunit = infoc_1.nout;
s_wsfe(&io___27);
e_wsfe();
}
}
/* Print a summary line. */
if (! lsamen_(&c__2, c2, "BD")) {
if (infoc_1.ok) {
io___28.ciunit = infoc_1.nout;
s_wsfe(&io___28);
do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, (
ftnlen)32));
do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
e_wsfe();
} else {
io___29.ciunit = infoc_1.nout;
s_wsfe(&io___29);
e_wsfe();
}
}
return 0;
/* End of ZERRED */
} /* zerred_ */
/* Main program */ int MAIN__(void)
{
/* Initialized data */
static doublereal threq = 2.;
static char intstr[10] = "0123456789";
/* Format strings */
static char fmt_9994[] = "(\002 Tests of the COMPLEX*16 LAPACK routines"
" \002,/\002 LAPACK VERSION \002,i1,\002.\002,i1,\002.\002,i1,/"
"/\002 The following parameter values will be used:\002)";
static char fmt_9996[] = "(\002 Invalid input value: \002,a4,\002=\002,i"
"6,\002; must be >=\002,i6)";
static char fmt_9995[] = "(\002 Invalid input value: \002,a4,\002=\002,i"
"6,\002; must be <=\002,i6)";
static char fmt_9993[] = "(4x,a4,\002: \002,10i6,/11x,10i6)";
static char fmt_9992[] = "(/\002 Routines pass computational tests if te"
"st ratio is \002,\002less than\002,f8.2,/)";
static char fmt_9999[] = "(/\002 Execution not attempted due to input er"
"rors\002)";
static char fmt_9991[] = "(\002 Relative machine \002,a,\002 is taken to"
" be\002,d16.6)";
static char fmt_9990[] = "(/1x,a3,\002: Unrecognized path name\002)";
static char fmt_9989[] = "(/1x,a3,\002 routines were not tested\002)";
static char fmt_9988[] = "(/1x,a3,\002 driver routines were not teste"
"d\002)";
static char fmt_9998[] = "(/\002 End of tests\002)";
static char fmt_9997[] = "(\002 Total time used = \002,f12.2,\002 seco"
"nds\002,/)";
/* System generated locals */
integer i__1, i__2;
doublereal d__1;
cilist ci__1;
cllist cl__1;
/* Builtin functions */
integer s_rsle(cilist *), e_rsle(void), s_wsfe(cilist *), do_fio(integer *
, char *, ftnlen), e_wsfe(void), do_lio(integer *, integer *,
char *, ftnlen);
/* Subroutine */ int s_stop(char *, ftnlen);
integer s_wsle(cilist *), e_wsle(void), s_rsfe(cilist *), e_rsfe(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer f_clos(cllist *);
/* Local variables */
doublecomplex a[153384] /* was [21912][7] */, b[8448] /* was [2112][
4] */;
integer i__, j, k;
doublereal s[264];
char c1[1], c2[2];
doublereal s1, s2;
integer ic, la, nb, nm, nn, vers_patch__, vers_major__, vers_minor__, lda,
nnb;
doublereal eps;
integer nns, nnb2;
char path[3];
integer mval[12], nval[12], nrhs;
doublecomplex work[20856] /* was [132][158] */;
integer lafac;
logical fatal;
char aline[72];
extern logical lsame_(char *, char *);
integer nbval[12], nmats, nsval[12], nxval[12], iwork[3300];
doublereal rwork[19832];
integer nbval2[12];
extern /* Subroutine */ int zchkq3_(logical *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, doublereal
*, doublecomplex *, doublecomplex *, doublereal *, doublereal *,
doublecomplex *, doublecomplex *, doublereal *, integer *,
integer *);
extern doublereal dlamch_(char *), dsecnd_(void);
extern /* Subroutine */ int alareq_(char *, integer *, logical *, integer
*, integer *, integer *), zchkgb_(logical *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, doublereal *, logical *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublereal *, integer *,
integer *), zchkge_(logical *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, doublereal
*, logical *, integer *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublereal *, integer *, integer *), zchkhe_(
logical *, integer *, integer *, integer *, integer *, integer *,
integer *, doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublereal *, integer *,
integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int zchkpb_(logical *, integer *, integer *,
integer *, integer *, integer *, integer *, doublereal *, logical
*, integer *, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublereal *, integer *), ilaver_(integer *, integer *, integer
*), zchkeq_(doublereal *, integer *), zchktb_(logical *, integer *
, integer *, integer *, integer *, doublereal *, logical *,
integer *, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublereal *,
integer *), zchkhp_(logical *, integer *, integer *, integer *,
integer *, doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublereal *, integer *,
integer *), zchkgt_(logical *, integer *, integer *, integer *,
integer *, doublereal *, logical *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublereal *, integer *, integer *), zchklq_(
logical *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, doublereal *, logical *, integer
*, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublecomplex *, doublereal *,
integer *, integer *);
doublereal thresh;
extern /* Subroutine */ int zchkpo_(logical *, integer *, integer *,
integer *, integer *, integer *, integer *, doublereal *, logical
*, integer *, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublereal *, integer *), zchkpp_(logical *, integer *, integer
*, integer *, integer *, doublereal *, logical *, integer *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublecomplex *, doublereal *,
integer *);
logical tstchk;
extern /* Subroutine */ int zchkql_(logical *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublereal *, integer *,
integer *), zchkpt_(logical *, integer *, integer *, integer *,
integer *, doublereal *, logical *, doublecomplex *, doublereal *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex
*, doublecomplex *, doublereal *, integer *);
logical dotype[30];
extern /* Subroutine */ int zchkqp_(logical *, integer *, integer *,
integer *, integer *, doublereal *, logical *, doublecomplex *,
doublecomplex *, doublereal *, doublereal *, doublecomplex *,
doublecomplex *, doublereal *, integer *, integer *), zchkqr_(
logical *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, doublereal *, logical *, integer
*, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublecomplex *, doublereal *,
integer *, integer *), zchkrq_(logical *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublereal *, integer *,
integer *), zchksp_(logical *, integer *, integer *, integer *,
integer *, doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublereal *, integer *,
integer *), zchktp_(logical *, integer *, integer *, integer *,
integer *, doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublereal *, integer *), zchktr_(logical *,
integer *, integer *, integer *, integer *, integer *, integer *,
doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublereal *, integer *), zchksy_(logical *,
integer *, integer *, integer *, integer *, integer *, integer *,
doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublereal *, integer *,
integer *), zdrvgb_(logical *, integer *, integer *, integer *,
doublereal *, logical *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublereal *,
doublecomplex *, doublereal *, integer *, integer *), zchktz_(
logical *, integer *, integer *, integer *, integer *, doublereal
*, logical *, doublecomplex *, doublecomplex *, doublereal *,
doublereal *, doublecomplex *, doublecomplex *, doublereal *,
integer *), zdrvge_(logical *, integer *, integer *, integer *,
doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublereal *, doublecomplex *,
doublereal *, integer *, integer *), zdrvhe_(logical *, integer *
, integer *, integer *, doublereal *, logical *, integer *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublecomplex *, doublereal *,
integer *, integer *), zdrvgt_(logical *, integer *, integer *,
integer *, doublereal *, logical *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublereal *, integer *, integer *), zdrvhp_(
logical *, integer *, integer *, integer *, doublereal *, logical
*, integer *, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublereal *, integer *, integer *);
integer ntypes;
logical tsterr;
extern /* Subroutine */ int zdrvls_(logical *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, doublereal *, logical *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *, integer *);
logical tstdrv;
extern /* Subroutine */ int zdrvpb_(logical *, integer *, integer *,
integer *, doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublereal *, doublecomplex *,
doublereal *, integer *), zdrvpo_(logical *, integer *, integer *
, integer *, doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublereal *, doublecomplex *,
doublereal *, integer *), zdrvpp_(logical *, integer *, integer *
, integer *, doublereal *, logical *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublecomplex *, doublereal *, doublecomplex *,
doublereal *, integer *), zdrvpt_(logical *, integer *, integer *
, integer *, doublereal *, logical *, doublecomplex *, doublereal
*, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublereal *, integer *),
zdrvsp_(logical *, integer *, integer *, integer *, doublereal *,
logical *, integer *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublecomplex *, doublereal *, integer *, integer *), zdrvsy_(
logical *, integer *, integer *, integer *, doublereal *, logical
*, integer *, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, doublereal *, integer *, integer *);
/* Fortran I/O blocks */
static cilist io___6 = { 0, 5, 0, 0, 0 };
static cilist io___10 = { 0, 6, 0, fmt_9994, 0 };
static cilist io___11 = { 0, 5, 0, 0, 0 };
static cilist io___13 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___14 = { 0, 6, 0, fmt_9995, 0 };
static cilist io___15 = { 0, 5, 0, 0, 0 };
static cilist io___18 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___19 = { 0, 6, 0, fmt_9995, 0 };
static cilist io___20 = { 0, 6, 0, fmt_9993, 0 };
static cilist io___21 = { 0, 5, 0, 0, 0 };
static cilist io___23 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___24 = { 0, 6, 0, fmt_9995, 0 };
static cilist io___25 = { 0, 5, 0, 0, 0 };
static cilist io___27 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___28 = { 0, 6, 0, fmt_9995, 0 };
static cilist io___29 = { 0, 6, 0, fmt_9993, 0 };
static cilist io___30 = { 0, 5, 0, 0, 0 };
static cilist io___32 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___33 = { 0, 6, 0, fmt_9995, 0 };
static cilist io___34 = { 0, 5, 0, 0, 0 };
static cilist io___36 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___37 = { 0, 6, 0, fmt_9995, 0 };
static cilist io___38 = { 0, 6, 0, fmt_9993, 0 };
static cilist io___39 = { 0, 5, 0, 0, 0 };
static cilist io___41 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___42 = { 0, 6, 0, fmt_9995, 0 };
static cilist io___43 = { 0, 5, 0, 0, 0 };
static cilist io___45 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___46 = { 0, 6, 0, fmt_9993, 0 };
static cilist io___51 = { 0, 5, 0, 0, 0 };
static cilist io___53 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___54 = { 0, 6, 0, fmt_9993, 0 };
static cilist io___55 = { 0, 5, 0, 0, 0 };
static cilist io___57 = { 0, 6, 0, fmt_9992, 0 };
static cilist io___58 = { 0, 5, 0, 0, 0 };
static cilist io___60 = { 0, 5, 0, 0, 0 };
static cilist io___62 = { 0, 5, 0, 0, 0 };
static cilist io___64 = { 0, 6, 0, fmt_9999, 0 };
static cilist io___66 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___67 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___68 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___69 = { 0, 6, 0, 0, 0 };
static cilist io___78 = { 0, 6, 0, fmt_9990, 0 };
static cilist io___79 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___87 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___89 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___92 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___93 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___94 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___95 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___96 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___97 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___98 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___99 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___100 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___101 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___102 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___103 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___104 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___105 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___106 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___107 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___108 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___109 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___110 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___111 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___112 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___113 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___114 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___115 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___116 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___117 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___118 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___119 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___120 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___121 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___122 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___123 = { 0, 6, 0, fmt_9990, 0 };
static cilist io___125 = { 0, 6, 0, fmt_9998, 0 };
static cilist io___126 = { 0, 6, 0, fmt_9997, 0 };
/* -- LAPACK test routine (version 3.1.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* January 2007 */
/* Purpose */
/* ======= */
/* ZCHKAA is the main test program for the COMPLEX*16 linear equation */
/* routines. */
/* The program must be driven by a short data file. The first 14 records */
/* specify problem dimensions and program options using list-directed */
/* input. The remaining lines specify the LAPACK test paths and the */
/* number of matrix types to use in testing. An annotated example of a */
/* data file can be obtained by deleting the first 3 characters from the */
/* following 38 lines: */
/* Data file for testing COMPLEX*16 LAPACK linear equation routines */
/* 7 Number of values of M */
/* 0 1 2 3 5 10 16 Values of M (row dimension) */
/* 7 Number of values of N */
/* 0 1 2 3 5 10 16 Values of N (column dimension) */
/* 1 Number of values of NRHS */
/* 2 Values of NRHS (number of right hand sides) */
/* 5 Number of values of NB */
/* 1 3 3 3 20 Values of NB (the blocksize) */
/* 1 0 5 9 1 Values of NX (crossover point) */
/* 30.0 Threshold value of test ratio */
/* T Put T to test the LAPACK routines */
/* T Put T to test the driver routines */
/* T Put T to test the error exits */
/* ZGE 11 List types on next line if 0 < NTYPES < 11 */
/* ZGB 8 List types on next line if 0 < NTYPES < 8 */
/* ZGT 12 List types on next line if 0 < NTYPES < 12 */
/* ZPO 9 List types on next line if 0 < NTYPES < 9 */
/* ZPP 9 List types on next line if 0 < NTYPES < 9 */
/* ZPB 8 List types on next line if 0 < NTYPES < 8 */
/* ZPT 12 List types on next line if 0 < NTYPES < 12 */
/* ZHE 10 List types on next line if 0 < NTYPES < 10 */
/* ZHP 10 List types on next line if 0 < NTYPES < 10 */
/* ZSY 11 List types on next line if 0 < NTYPES < 11 */
/* ZSP 11 List types on next line if 0 < NTYPES < 11 */
/* ZTR 18 List types on next line if 0 < NTYPES < 18 */
/* ZTP 18 List types on next line if 0 < NTYPES < 18 */
/* ZTB 17 List types on next line if 0 < NTYPES < 17 */
/* ZQR 8 List types on next line if 0 < NTYPES < 8 */
/* ZRQ 8 List types on next line if 0 < NTYPES < 8 */
/* ZLQ 8 List types on next line if 0 < NTYPES < 8 */
/* ZQL 8 List types on next line if 0 < NTYPES < 8 */
/* ZQP 6 List types on next line if 0 < NTYPES < 6 */
/* ZTZ 3 List types on next line if 0 < NTYPES < 3 */
/* ZLS 6 List types on next line if 0 < NTYPES < 6 */
/* ZEQ */
/* Internal Parameters */
/* =================== */
/* NMAX INTEGER */
/* The maximum allowable value for N. */
/* MAXIN INTEGER */
/* The number of different values that can be used for each of */
/* M, N, or NB */
/* MAXRHS INTEGER */
/* The maximum number of right hand sides */
/* NIN INTEGER */
/* The unit number for input */
/* NOUT INTEGER */
/* The unit number for output */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Arrays in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Data statements .. */
/* .. */
/* .. Executable Statements .. */
s1 = dsecnd_();
lda = 132;
fatal = FALSE_;
/* Read a dummy line. */
s_rsle(&io___6);
e_rsle();
/* Report values of parameters. */
ilaver_(&vers_major__, &vers_minor__, &vers_patch__);
s_wsfe(&io___10);
do_fio(&c__1, (char *)&vers_major__, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&vers_minor__, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&vers_patch__, (ftnlen)sizeof(integer));
e_wsfe();
/* Read the values of M */
s_rsle(&io___11);
do_lio(&c__3, &c__1, (char *)&nm, (ftnlen)sizeof(integer));
e_rsle();
if (nm < 1) {
s_wsfe(&io___13);
do_fio(&c__1, " NM ", (ftnlen)4);
do_fio(&c__1, (char *)&nm, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
nm = 0;
fatal = TRUE_;
} else if (nm > 12) {
s_wsfe(&io___14);
do_fio(&c__1, " NM ", (ftnlen)4);
do_fio(&c__1, (char *)&nm, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__12, (ftnlen)sizeof(integer));
e_wsfe();
nm = 0;
fatal = TRUE_;
}
s_rsle(&io___15);
i__1 = nm;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&mval[i__ - 1], (ftnlen)sizeof(integer));
}
e_rsle();
i__1 = nm;
for (i__ = 1; i__ <= i__1; ++i__) {
if (mval[i__ - 1] < 0) {
s_wsfe(&io___18);
do_fio(&c__1, " M ", (ftnlen)4);
do_fio(&c__1, (char *)&mval[i__ - 1], (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
e_wsfe();
fatal = TRUE_;
} else if (mval[i__ - 1] > 132) {
s_wsfe(&io___19);
do_fio(&c__1, " M ", (ftnlen)4);
do_fio(&c__1, (char *)&mval[i__ - 1], (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__132, (ftnlen)sizeof(integer));
e_wsfe();
fatal = TRUE_;
}
/* L10: */
}
if (nm > 0) {
s_wsfe(&io___20);
do_fio(&c__1, "M ", (ftnlen)4);
i__1 = nm;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&mval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
}
/* Read the values of N */
s_rsle(&io___21);
do_lio(&c__3, &c__1, (char *)&nn, (ftnlen)sizeof(integer));
e_rsle();
if (nn < 1) {
s_wsfe(&io___23);
do_fio(&c__1, " NN ", (ftnlen)4);
do_fio(&c__1, (char *)&nn, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
nn = 0;
fatal = TRUE_;
} else if (nn > 12) {
s_wsfe(&io___24);
do_fio(&c__1, " NN ", (ftnlen)4);
do_fio(&c__1, (char *)&nn, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__12, (ftnlen)sizeof(integer));
e_wsfe();
nn = 0;
fatal = TRUE_;
}
s_rsle(&io___25);
i__1 = nn;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
}
e_rsle();
i__1 = nn;
for (i__ = 1; i__ <= i__1; ++i__) {
if (nval[i__ - 1] < 0) {
s_wsfe(&io___27);
do_fio(&c__1, " N ", (ftnlen)4);
do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
e_wsfe();
fatal = TRUE_;
} else if (nval[i__ - 1] > 132) {
s_wsfe(&io___28);
do_fio(&c__1, " N ", (ftnlen)4);
do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__132, (ftnlen)sizeof(integer));
e_wsfe();
fatal = TRUE_;
}
/* L20: */
}
if (nn > 0) {
s_wsfe(&io___29);
do_fio(&c__1, "N ", (ftnlen)4);
i__1 = nn;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
}
/* Read the values of NRHS */
s_rsle(&io___30);
do_lio(&c__3, &c__1, (char *)&nns, (ftnlen)sizeof(integer));
e_rsle();
if (nns < 1) {
s_wsfe(&io___32);
do_fio(&c__1, " NNS", (ftnlen)4);
do_fio(&c__1, (char *)&nns, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
nns = 0;
fatal = TRUE_;
} else if (nns > 12) {
s_wsfe(&io___33);
do_fio(&c__1, " NNS", (ftnlen)4);
do_fio(&c__1, (char *)&nns, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__12, (ftnlen)sizeof(integer));
e_wsfe();
nns = 0;
fatal = TRUE_;
}
s_rsle(&io___34);
i__1 = nns;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer))
;
}
e_rsle();
i__1 = nns;
for (i__ = 1; i__ <= i__1; ++i__) {
if (nsval[i__ - 1] < 0) {
s_wsfe(&io___36);
do_fio(&c__1, "NRHS", (ftnlen)4);
do_fio(&c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
e_wsfe();
fatal = TRUE_;
} else if (nsval[i__ - 1] > 16) {
s_wsfe(&io___37);
do_fio(&c__1, "NRHS", (ftnlen)4);
do_fio(&c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__16, (ftnlen)sizeof(integer));
e_wsfe();
fatal = TRUE_;
}
/* L30: */
}
if (nns > 0) {
s_wsfe(&io___38);
do_fio(&c__1, "NRHS", (ftnlen)4);
i__1 = nns;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
}
/* Read the values of NB */
s_rsle(&io___39);
do_lio(&c__3, &c__1, (char *)&nnb, (ftnlen)sizeof(integer));
e_rsle();
if (nnb < 1) {
s_wsfe(&io___41);
do_fio(&c__1, "NNB ", (ftnlen)4);
do_fio(&c__1, (char *)&nnb, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
nnb = 0;
fatal = TRUE_;
} else if (nnb > 12) {
s_wsfe(&io___42);
do_fio(&c__1, "NNB ", (ftnlen)4);
do_fio(&c__1, (char *)&nnb, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__12, (ftnlen)sizeof(integer));
e_wsfe();
nnb = 0;
fatal = TRUE_;
}
s_rsle(&io___43);
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&nbval[i__ - 1], (ftnlen)sizeof(integer))
;
}
e_rsle();
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
if (nbval[i__ - 1] < 0) {
s_wsfe(&io___45);
do_fio(&c__1, " NB ", (ftnlen)4);
do_fio(&c__1, (char *)&nbval[i__ - 1], (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
e_wsfe();
fatal = TRUE_;
}
/* L40: */
}
if (nnb > 0) {
s_wsfe(&io___46);
do_fio(&c__1, "NB ", (ftnlen)4);
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&nbval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
}
/* Set NBVAL2 to be the set of unique values of NB */
nnb2 = 0;
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
nb = nbval[i__ - 1];
i__2 = nnb2;
for (j = 1; j <= i__2; ++j) {
if (nb == nbval2[j - 1]) {
goto L60;
}
/* L50: */
}
++nnb2;
nbval2[nnb2 - 1] = nb;
L60:
;
}
/* Read the values of NX */
s_rsle(&io___51);
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&nxval[i__ - 1], (ftnlen)sizeof(integer))
;
}
e_rsle();
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
if (nxval[i__ - 1] < 0) {
s_wsfe(&io___53);
do_fio(&c__1, " NX ", (ftnlen)4);
do_fio(&c__1, (char *)&nxval[i__ - 1], (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
e_wsfe();
fatal = TRUE_;
}
/* L70: */
}
if (nnb > 0) {
s_wsfe(&io___54);
do_fio(&c__1, "NX ", (ftnlen)4);
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&nxval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
}
/* Read the threshold value for the test ratios. */
s_rsle(&io___55);
do_lio(&c__5, &c__1, (char *)&thresh, (ftnlen)sizeof(doublereal));
e_rsle();
s_wsfe(&io___57);
do_fio(&c__1, (char *)&thresh, (ftnlen)sizeof(doublereal));
e_wsfe();
/* Read the flag that indicates whether to test the LAPACK routines. */
s_rsle(&io___58);
do_lio(&c__8, &c__1, (char *)&tstchk, (ftnlen)sizeof(logical));
e_rsle();
/* Read the flag that indicates whether to test the driver routines. */
s_rsle(&io___60);
do_lio(&c__8, &c__1, (char *)&tstdrv, (ftnlen)sizeof(logical));
e_rsle();
/* Read the flag that indicates whether to test the error exits. */
s_rsle(&io___62);
do_lio(&c__8, &c__1, (char *)&tsterr, (ftnlen)sizeof(logical));
e_rsle();
if (fatal) {
s_wsfe(&io___64);
e_wsfe();
s_stop("", (ftnlen)0);
}
/* Calculate and print the machine dependent constants. */
eps = dlamch_("Underflow threshold");
s_wsfe(&io___66);
do_fio(&c__1, "underflow", (ftnlen)9);
do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(doublereal));
e_wsfe();
eps = dlamch_("Overflow threshold");
s_wsfe(&io___67);
do_fio(&c__1, "overflow ", (ftnlen)9);
do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(doublereal));
e_wsfe();
eps = dlamch_("Epsilon");
s_wsfe(&io___68);
do_fio(&c__1, "precision", (ftnlen)9);
do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(doublereal));
e_wsfe();
s_wsle(&io___69);
e_wsle();
nrhs = nsval[0];
L80:
/* Read a test path and the number of matrix types to use. */
ci__1.cierr = 0;
ci__1.ciend = 1;
ci__1.ciunit = 5;
ci__1.cifmt = "(A72)";
i__1 = s_rsfe(&ci__1);
if (i__1 != 0) {
goto L140;
}
i__1 = do_fio(&c__1, aline, (ftnlen)72);
if (i__1 != 0) {
goto L140;
}
i__1 = e_rsfe();
if (i__1 != 0) {
goto L140;
}
s_copy(path, aline, (ftnlen)3, (ftnlen)3);
nmats = 30;
i__ = 3;
L90:
++i__;
if (i__ > 72) {
goto L130;
}
if (*(unsigned char *)&aline[i__ - 1] == ' ') {
goto L90;
}
nmats = 0;
L100:
*(unsigned char *)c1 = *(unsigned char *)&aline[i__ - 1];
for (k = 1; k <= 10; ++k) {
if (*(unsigned char *)c1 == *(unsigned char *)&intstr[k - 1]) {
ic = k - 1;
goto L120;
}
/* L110: */
}
goto L130;
L120:
nmats = nmats * 10 + ic;
++i__;
if (i__ > 72) {
goto L130;
}
goto L100;
L130:
*(unsigned char *)c1 = *(unsigned char *)path;
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Check first character for correct precision. */
if (! lsame_(c1, "Zomplex precision")) {
s_wsfe(&io___78);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
} else if (nmats <= 0) {
/* Check for a positive number of tests requested. */
s_wsfe(&io___79);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
} else if (lsamen_(&c__2, c2, "GE")) {
/* GE: general matrices */
ntypes = 11;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkge_(dotype, &nm, mval, &nn, nval, &nnb2, nbval2, &nns, nsval,
&thresh, &tsterr, &lda, a, &a[21912], &a[43824], b, &b[
2112], &b[4224], work, rwork, iwork, &c__6);
} else {
s_wsfe(&io___87);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvge_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, &lda, a, &a[
21912], &a[43824], b, &b[2112], &b[4224], &b[6336], s,
work, rwork, iwork, &c__6);
} else {
s_wsfe(&io___89);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "GB")) {
/* GB: general banded matrices */
la = 43692;
lafac = 65472;
ntypes = 8;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkgb_(dotype, &nm, mval, &nn, nval, &nnb2, nbval2, &nns, nsval,
&thresh, &tsterr, a, &la, &a[43824], &lafac, b, &b[2112],
&b[4224], work, rwork, iwork, &c__6);
} else {
s_wsfe(&io___92);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvgb_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, a, &la, &a[
43824], &lafac, &a[109560], b, &b[2112], &b[4224], &b[
6336], s, work, rwork, iwork, &c__6);
} else {
s_wsfe(&io___93);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "GT")) {
/* GT: general tridiagonal matrices */
ntypes = 12;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkgt_(dotype, &nn, nval, &nns, nsval, &thresh, &tsterr, a, &a[
21912], b, &b[2112], &b[4224], work, rwork, iwork, &c__6);
} else {
s_wsfe(&io___94);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvgt_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, a, &a[21912],
b, &b[2112], &b[4224], work, rwork, iwork, &c__6);
} else {
s_wsfe(&io___95);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "PO")) {
/* PO: positive definite matrices */
ntypes = 9;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkpo_(dotype, &nn, nval, &nnb2, nbval2, &nns, nsval, &thresh, &
tsterr, &lda, a, &a[21912], &a[43824], b, &b[2112], &b[
4224], work, rwork, &c__6);
} else {
s_wsfe(&io___96);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvpo_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, &lda, a, &a[
21912], &a[43824], b, &b[2112], &b[4224], &b[6336], s,
work, rwork, &c__6);
} else {
s_wsfe(&io___97);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "PP")) {
/* PP: positive definite packed matrices */
ntypes = 9;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkpp_(dotype, &nn, nval, &nns, nsval, &thresh, &tsterr, &lda, a,
&a[21912], &a[43824], b, &b[2112], &b[4224], work, rwork,
&c__6);
} else {
s_wsfe(&io___98);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvpp_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, &lda, a, &a[
21912], &a[43824], b, &b[2112], &b[4224], &b[6336], s,
work, rwork, &c__6);
} else {
s_wsfe(&io___99);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "PB")) {
/* PB: positive definite banded matrices */
ntypes = 8;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkpb_(dotype, &nn, nval, &nnb2, nbval2, &nns, nsval, &thresh, &
tsterr, &lda, a, &a[21912], &a[43824], b, &b[2112], &b[
4224], work, rwork, &c__6);
} else {
s_wsfe(&io___100);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvpb_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, &lda, a, &a[
21912], &a[43824], b, &b[2112], &b[4224], &b[6336], s,
work, rwork, &c__6);
} else {
s_wsfe(&io___101);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "PT")) {
/* PT: positive definite tridiagonal matrices */
ntypes = 12;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkpt_(dotype, &nn, nval, &nns, nsval, &thresh, &tsterr, a, s, &
a[21912], b, &b[2112], &b[4224], work, rwork, &c__6);
} else {
s_wsfe(&io___102);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvpt_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, a, s, &a[
21912], b, &b[2112], &b[4224], work, rwork, &c__6);
} else {
s_wsfe(&io___103);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "HE")) {
/* HE: Hermitian indefinite matrices */
ntypes = 10;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkhe_(dotype, &nn, nval, &nnb2, nbval2, &nns, nsval, &thresh, &
tsterr, &lda, a, &a[21912], &a[43824], b, &b[2112], &b[
4224], work, rwork, iwork, &c__6);
} else {
s_wsfe(&io___104);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvhe_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, &lda, a, &a[
21912], &a[43824], b, &b[2112], &b[4224], work, rwork,
iwork, &c__6);
} else {
s_wsfe(&io___105);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "HP")) {
/* HP: Hermitian indefinite packed matrices */
ntypes = 10;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkhp_(dotype, &nn, nval, &nns, nsval, &thresh, &tsterr, &lda, a,
&a[21912], &a[43824], b, &b[2112], &b[4224], work, rwork,
iwork, &c__6);
} else {
s_wsfe(&io___106);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvhp_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, &lda, a, &a[
21912], &a[43824], b, &b[2112], &b[4224], work, rwork,
iwork, &c__6);
} else {
s_wsfe(&io___107);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "SY")) {
/* SY: symmetric indefinite matrices */
ntypes = 11;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchksy_(dotype, &nn, nval, &nnb2, nbval2, &nns, nsval, &thresh, &
tsterr, &lda, a, &a[21912], &a[43824], b, &b[2112], &b[
4224], work, rwork, iwork, &c__6);
} else {
s_wsfe(&io___108);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvsy_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, &lda, a, &a[
21912], &a[43824], b, &b[2112], &b[4224], work, rwork,
iwork, &c__6);
} else {
s_wsfe(&io___109);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "SP")) {
/* SP: symmetric indefinite packed matrices */
ntypes = 11;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchksp_(dotype, &nn, nval, &nns, nsval, &thresh, &tsterr, &lda, a,
&a[21912], &a[43824], b, &b[2112], &b[4224], work, rwork,
iwork, &c__6);
} else {
s_wsfe(&io___110);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
if (tstdrv) {
zdrvsp_(dotype, &nn, nval, &nrhs, &thresh, &tsterr, &lda, a, &a[
21912], &a[43824], b, &b[2112], &b[4224], work, rwork,
iwork, &c__6);
} else {
s_wsfe(&io___111);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "TR")) {
/* TR: triangular matrices */
ntypes = 18;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchktr_(dotype, &nn, nval, &nnb2, nbval2, &nns, nsval, &thresh, &
tsterr, &lda, a, &a[21912], b, &b[2112], &b[4224], work,
rwork, &c__6);
} else {
s_wsfe(&io___112);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "TP")) {
/* TP: triangular packed matrices */
ntypes = 18;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchktp_(dotype, &nn, nval, &nns, nsval, &thresh, &tsterr, &lda, a,
&a[21912], b, &b[2112], &b[4224], work, rwork, &c__6);
} else {
s_wsfe(&io___113);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "TB")) {
/* TB: triangular banded matrices */
ntypes = 17;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchktb_(dotype, &nn, nval, &nns, nsval, &thresh, &tsterr, &lda, a,
&a[21912], b, &b[2112], &b[4224], work, rwork, &c__6);
} else {
s_wsfe(&io___114);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "QR")) {
/* QR: QR factorization */
ntypes = 8;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkqr_(dotype, &nm, mval, &nn, nval, &nnb, nbval, nxval, &nrhs, &
thresh, &tsterr, &c__132, a, &a[21912], &a[43824], &a[
65736], &a[87648], b, &b[2112], &b[4224], &b[6336], work,
rwork, iwork, &c__6);
} else {
s_wsfe(&io___115);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "LQ")) {
/* LQ: LQ factorization */
ntypes = 8;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchklq_(dotype, &nm, mval, &nn, nval, &nnb, nbval, nxval, &nrhs, &
thresh, &tsterr, &c__132, a, &a[21912], &a[43824], &a[
65736], &a[87648], b, &b[2112], &b[4224], &b[6336], work,
rwork, iwork, &c__6);
} else {
s_wsfe(&io___116);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "QL")) {
/* QL: QL factorization */
ntypes = 8;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkql_(dotype, &nm, mval, &nn, nval, &nnb, nbval, nxval, &nrhs, &
thresh, &tsterr, &c__132, a, &a[21912], &a[43824], &a[
65736], &a[87648], b, &b[2112], &b[4224], &b[6336], work,
rwork, iwork, &c__6);
} else {
s_wsfe(&io___117);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "RQ")) {
/* RQ: RQ factorization */
ntypes = 8;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkrq_(dotype, &nm, mval, &nn, nval, &nnb, nbval, nxval, &nrhs, &
thresh, &tsterr, &c__132, a, &a[21912], &a[43824], &a[
65736], &a[87648], b, &b[2112], &b[4224], &b[6336], work,
rwork, iwork, &c__6);
} else {
s_wsfe(&io___118);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "EQ")) {
/* EQ: Equilibration routines for general and positive definite */
/* matrices (THREQ should be between 2 and 10) */
if (tstchk) {
zchkeq_(&threq, &c__6);
} else {
s_wsfe(&io___119);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "TZ")) {
/* TZ: Trapezoidal matrix */
ntypes = 3;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchktz_(dotype, &nm, mval, &nn, nval, &thresh, &tsterr, a, &a[
21912], s, &s[132], b, work, rwork, &c__6);
} else {
s_wsfe(&io___120);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "QP")) {
/* QP: QR factorization with pivoting */
ntypes = 6;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstchk) {
zchkqp_(dotype, &nm, mval, &nn, nval, &thresh, &tsterr, a, &a[
21912], s, &s[132], b, work, rwork, iwork, &c__6);
zchkq3_(dotype, &nm, mval, &nn, nval, &nnb, nbval, nxval, &thresh,
a, &a[21912], s, &s[132], b, work, rwork, iwork, &c__6);
} else {
s_wsfe(&io___121);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "LS")) {
/* LS: Least squares drivers */
ntypes = 6;
alareq_(path, &nmats, dotype, &ntypes, &c__5, &c__6);
if (tstdrv) {
zdrvls_(dotype, &nm, mval, &nn, nval, &nns, nsval, &nnb, nbval,
nxval, &thresh, &tsterr, a, &a[21912], &a[43824], &a[
65736], &a[87648], s, &s[132], work, rwork, iwork, &c__6);
} else {
s_wsfe(&io___122);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
} else {
s_wsfe(&io___123);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
/* Go back to get another input line. */
goto L80;
/* Branch to this line when the last record is read. */
L140:
cl__1.cerr = 0;
cl__1.cunit = 5;
cl__1.csta = 0;
f_clos(&cl__1);
s2 = dsecnd_();
s_wsfe(&io___125);
e_wsfe();
s_wsfe(&io___126);
d__1 = s2 - s1;
do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal));
e_wsfe();
/* End of ZCHKAA */
return 0;
} /* MAIN__ */
/* Subroutine */ int cerrqp_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsle(cilist *), e_wsle(void);
/* Local variables */
static integer info;
static complex a[4] /* was [2][2] */, w[10];
static char c2[2];
extern /* Subroutine */ int cgeqp3_(integer *, integer *, complex *,
integer *, integer *, complex *, complex *, integer *, real *,
integer *);
static integer ip[2];
extern /* Subroutine */ int alaesm_(char *, logical *, integer *);
static integer lw;
extern /* Subroutine */ int cgeqpf_(integer *, integer *, complex *,
integer *, integer *, complex *, complex *, real *, integer *);
static real rw[4];
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *);
static complex tau[2];
/* Fortran I/O blocks */
static cilist io___4 = { 0, 0, 0, 0, 0 };
#define a_subscr(a_1,a_2) (a_2)*2 + a_1 - 3
#define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)]
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
June 30, 1999
Purpose
=======
CERRQP tests the error exits for CGEQPF and CGEQP3.
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;
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
lw = 3;
i__1 = a_subscr(1, 1);
a[i__1].r = 1.f, a[i__1].i = -1.f;
i__1 = a_subscr(1, 2);
a[i__1].r = 2.f, a[i__1].i = -2.f;
i__1 = a_subscr(2, 2);
a[i__1].r = 3.f, a[i__1].i = -3.f;
i__1 = a_subscr(2, 1);
a[i__1].r = 4.f, a[i__1].i = -4.f;
infoc_1.ok = TRUE_;
io___4.ciunit = infoc_1.nout;
s_wsle(&io___4);
e_wsle();
/* Test error exits for QR factorization with pivoting */
if (lsamen_(&c__2, c2, "QP")) {
/* CGEQPF */
s_copy(srnamc_1.srnamt, "CGEQPF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
cgeqpf_(&c_n1, &c__0, a, &c__1, ip, tau, w, rw, &info);
chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgeqpf_(&c__0, &c_n1, a, &c__1, ip, tau, w, rw, &info);
chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cgeqpf_(&c__2, &c__0, a, &c__1, ip, tau, w, rw, &info);
chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CGEQP3 */
s_copy(srnamc_1.srnamt, "CGEQP3", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
cgeqp3_(&c_n1, &c__0, a, &c__1, ip, tau, w, &lw, rw, &info);
chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgeqp3_(&c__1, &c_n1, a, &c__1, ip, tau, w, &lw, rw, &info);
chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cgeqp3_(&c__1, &c__1, a, &c__0, ip, tau, w, &lw, rw, &info);
chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
i__1 = lw - 1;
cgeqp3_(&c__2, &c__2, a, &c__2, ip, tau, w, &i__1, rw, &info);
chkxer_("CGEQP3", &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 CERRQP */
} /* cerrqp_ */
/* Subroutine */ int alahdg_(integer *iounit, char *path)
{
/* Format strings */
static char fmt_9991[] = "(/1x,a3,\002: GQR factorization of general mat"
"rices\002)";
static char fmt_9992[] = "(/1x,a3,\002: GRQ factorization of general mat"
"rices\002)";
static char fmt_9993[] = "(/1x,a3,\002: LSE Problem\002)";
static char fmt_9994[] = "(/1x,a3,\002: GLM Problem\002)";
static char fmt_9995[] = "(/1x,a3,\002: Generalized Singular Value Decom"
"position\002)";
static char fmt_9999[] = "(1x,a)";
static char fmt_9950[] = "(3x,i2,\002: A-diagonal matrix B-upper triang"
"ular\002)";
static char fmt_9952[] = "(3x,i2,\002: A-upper triangular B-upper triang"
"ular\002)";
static char fmt_9954[] = "(3x,i2,\002: A-lower triangular B-upper triang"
"ular\002)";
static char fmt_9955[] = "(3x,i2,\002: Random matrices cond(A)=100, cond"
"(B)=10,\002)";
static char fmt_9956[] = "(3x,i2,\002: Random matrices cond(A)= sqrt( 0."
"1/EPS ) \002,\002cond(B)= sqrt( 0.1/EPS )\002)";
static char fmt_9957[] = "(3x,i2,\002: Random matrices cond(A)= 0.1/EPS"
" \002,\002cond(B)= 0.1/EPS\002)";
static char fmt_9961[] = "(3x,i2,\002: Matrix scaled near underflow li"
"mit\002)";
static char fmt_9962[] = "(3x,i2,\002: Matrix scaled near overflow limi"
"t\002)";
static char fmt_9951[] = "(3x,i2,\002: A-diagonal matrix B-lower triang"
"ular\002)";
static char fmt_9953[] = "(3x,i2,\002: A-lower triangular B-diagonal tri"
"angular\002)";
static char fmt_9959[] = "(3x,i2,\002: Random matrices cond(A)= sqrt( 0."
"1/EPS ) \002,\002cond(B)= 0.1/EPS \002)";
static char fmt_9960[] = "(3x,i2,\002: Random matrices cond(A)= 0.1/EPS"
" \002,\002cond(B)= sqrt( 0.1/EPS )\002)";
static char fmt_9930[] = "(3x,i2,\002: norm( R - Q' * A ) / ( min( N, M "
")*norm( A )\002,\002* EPS )\002)";
static char fmt_9931[] = "(3x,i2,\002: norm( T * Z - Q' * B ) / ( min(P"
",N)*norm(B)\002,\002* EPS )\002)";
static char fmt_9932[] = "(3x,i2,\002: norm( I - Q'*Q ) / ( N * EPS "
")\002)";
static char fmt_9933[] = "(3x,i2,\002: norm( I - Z'*Z ) / ( P * EPS "
")\002)";
static char fmt_9934[] = "(3x,i2,\002: norm( R - A * Q' ) / ( min( N,M )"
"*norm(A) * \002,\002EPS )\002)";
static char fmt_9935[] = "(3x,i2,\002: norm( T * Q - Z' * B ) / ( min( "
"P,N ) * nor\002,\002m(B)*EPS )\002)";
static char fmt_9937[] = "(3x,i2,\002: norm( A*x - c ) / ( norm(A)*norm"
"(x) * EPS )\002)";
static char fmt_9938[] = "(3x,i2,\002: norm( B*x - d ) / ( norm(B)*norm"
"(x) * EPS )\002)";
static char fmt_9939[] = "(3x,i2,\002: norm( d - A*x - B*y ) / ( (norm(A"
")+norm(B) )*\002,\002(norm(x)+norm(y))*EPS )\002)";
static char fmt_9940[] = "(3x,i2,\002: norm( U' * A * Q - D1 * R ) / ( m"
"in( M, N )*\002,\002norm( A ) * EPS )\002)";
static char fmt_9941[] = "(3x,i2,\002: norm( V' * B * Q - D2 * R ) / ( m"
"in( P, N )*\002,\002norm( B ) * EPS )\002)";
static char fmt_9942[] = "(3x,i2,\002: norm( I - U'*U ) / ( M * EPS "
")\002)";
static char fmt_9943[] = "(3x,i2,\002: norm( I - V'*V ) / ( P * EPS "
")\002)";
static char fmt_9944[] = "(3x,i2,\002: norm( I - Q'*Q ) / ( N * EPS "
")\002)";
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Local variables */
char c2[3];
integer itype;
extern logical lsamen_(integer *, char *, char *);
/* Fortran I/O blocks */
static cilist io___3 = { 0, 0, 0, fmt_9991, 0 };
static cilist io___4 = { 0, 0, 0, fmt_9992, 0 };
static cilist io___5 = { 0, 0, 0, fmt_9993, 0 };
static cilist io___6 = { 0, 0, 0, fmt_9994, 0 };
static cilist io___7 = { 0, 0, 0, fmt_9995, 0 };
static cilist io___8 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___9 = { 0, 0, 0, fmt_9950, 0 };
static cilist io___10 = { 0, 0, 0, fmt_9952, 0 };
static cilist io___11 = { 0, 0, 0, fmt_9954, 0 };
static cilist io___12 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___13 = { 0, 0, 0, fmt_9956, 0 };
static cilist io___14 = { 0, 0, 0, fmt_9957, 0 };
static cilist io___15 = { 0, 0, 0, fmt_9961, 0 };
static cilist io___16 = { 0, 0, 0, fmt_9962, 0 };
static cilist io___17 = { 0, 0, 0, fmt_9951, 0 };
static cilist io___18 = { 0, 0, 0, fmt_9953, 0 };
static cilist io___19 = { 0, 0, 0, fmt_9954, 0 };
static cilist io___20 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___21 = { 0, 0, 0, fmt_9956, 0 };
static cilist io___22 = { 0, 0, 0, fmt_9957, 0 };
static cilist io___23 = { 0, 0, 0, fmt_9961, 0 };
static cilist io___24 = { 0, 0, 0, fmt_9962, 0 };
static cilist io___25 = { 0, 0, 0, fmt_9950, 0 };
static cilist io___26 = { 0, 0, 0, fmt_9952, 0 };
static cilist io___27 = { 0, 0, 0, fmt_9954, 0 };
static cilist io___28 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___29 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___30 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___31 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___32 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___33 = { 0, 0, 0, fmt_9951, 0 };
static cilist io___34 = { 0, 0, 0, fmt_9953, 0 };
static cilist io___35 = { 0, 0, 0, fmt_9954, 0 };
static cilist io___36 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___37 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___38 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___39 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___40 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___41 = { 0, 0, 0, fmt_9950, 0 };
static cilist io___42 = { 0, 0, 0, fmt_9952, 0 };
static cilist io___43 = { 0, 0, 0, fmt_9954, 0 };
static cilist io___44 = { 0, 0, 0, fmt_9955, 0 };
static cilist io___45 = { 0, 0, 0, fmt_9956, 0 };
static cilist io___46 = { 0, 0, 0, fmt_9957, 0 };
static cilist io___47 = { 0, 0, 0, fmt_9959, 0 };
static cilist io___48 = { 0, 0, 0, fmt_9960, 0 };
static cilist io___49 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___50 = { 0, 0, 0, fmt_9930, 0 };
static cilist io___51 = { 0, 0, 0, fmt_9931, 0 };
static cilist io___52 = { 0, 0, 0, fmt_9932, 0 };
static cilist io___53 = { 0, 0, 0, fmt_9933, 0 };
static cilist io___54 = { 0, 0, 0, fmt_9934, 0 };
static cilist io___55 = { 0, 0, 0, fmt_9935, 0 };
static cilist io___56 = { 0, 0, 0, fmt_9932, 0 };
static cilist io___57 = { 0, 0, 0, fmt_9933, 0 };
static cilist io___58 = { 0, 0, 0, fmt_9937, 0 };
static cilist io___59 = { 0, 0, 0, fmt_9938, 0 };
static cilist io___60 = { 0, 0, 0, fmt_9939, 0 };
static cilist io___61 = { 0, 0, 0, fmt_9940, 0 };
static cilist io___62 = { 0, 0, 0, fmt_9941, 0 };
static cilist io___63 = { 0, 0, 0, fmt_9942, 0 };
static cilist io___64 = { 0, 0, 0, fmt_9943, 0 };
static cilist io___65 = { 0, 0, 0, fmt_9944, 0 };
/* -- LAPACK test routine (version 3.1.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ALAHDG prints header information for the different test paths. */
/* Arguments */
/* ========= */
/* IOUNIT (input) INTEGER */
/* The unit number to which the header information should be */
/* printed. */
/* PATH (input) CHARACTER*3 */
/* The name of the path for which the header information is to */
/* be printed. Current paths are */
/* GQR: GQR (general matrices) */
/* GRQ: GRQ (general matrices) */
/* LSE: LSE Problem */
/* GLM: GLM Problem */
/* GSV: Generalized Singular Value Decomposition */
/* ===================================================================== */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Executable Statements .. */
if (*iounit <= 0) {
return 0;
}
s_copy(c2, path, (ftnlen)3, (ftnlen)3);
/* First line describing matrices in this path */
if (lsamen_(&c__3, c2, "GQR")) {
itype = 1;
io___3.ciunit = *iounit;
s_wsfe(&io___3);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
} else if (lsamen_(&c__3, c2, "GRQ")) {
itype = 2;
io___4.ciunit = *iounit;
s_wsfe(&io___4);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
} else if (lsamen_(&c__3, c2, "LSE")) {
itype = 3;
io___5.ciunit = *iounit;
s_wsfe(&io___5);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
} else if (lsamen_(&c__3, c2, "GLM")) {
itype = 4;
io___6.ciunit = *iounit;
s_wsfe(&io___6);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
} else if (lsamen_(&c__3, c2, "GSV")) {
itype = 5;
io___7.ciunit = *iounit;
s_wsfe(&io___7);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
/* Matrix types */
io___8.ciunit = *iounit;
s_wsfe(&io___8);
do_fio(&c__1, "Matrix types: ", (ftnlen)14);
e_wsfe();
if (itype == 1) {
io___9.ciunit = *iounit;
s_wsfe(&io___9);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___10.ciunit = *iounit;
s_wsfe(&io___10);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___11.ciunit = *iounit;
s_wsfe(&io___11);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___12.ciunit = *iounit;
s_wsfe(&io___12);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___13.ciunit = *iounit;
s_wsfe(&io___13);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___14.ciunit = *iounit;
s_wsfe(&io___14);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___15.ciunit = *iounit;
s_wsfe(&io___15);
do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
e_wsfe();
io___16.ciunit = *iounit;
s_wsfe(&io___16);
do_fio(&c__1, (char *)&c__8, (ftnlen)sizeof(integer));
e_wsfe();
} else if (itype == 2) {
io___17.ciunit = *iounit;
s_wsfe(&io___17);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___18.ciunit = *iounit;
s_wsfe(&io___18);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___19.ciunit = *iounit;
s_wsfe(&io___19);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___20.ciunit = *iounit;
s_wsfe(&io___20);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___21.ciunit = *iounit;
s_wsfe(&io___21);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___22.ciunit = *iounit;
s_wsfe(&io___22);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___23.ciunit = *iounit;
s_wsfe(&io___23);
do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
e_wsfe();
io___24.ciunit = *iounit;
s_wsfe(&io___24);
do_fio(&c__1, (char *)&c__8, (ftnlen)sizeof(integer));
e_wsfe();
} else if (itype == 3) {
io___25.ciunit = *iounit;
s_wsfe(&io___25);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___26.ciunit = *iounit;
s_wsfe(&io___26);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___27.ciunit = *iounit;
s_wsfe(&io___27);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___28.ciunit = *iounit;
s_wsfe(&io___28);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___29.ciunit = *iounit;
s_wsfe(&io___29);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___30.ciunit = *iounit;
s_wsfe(&io___30);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___31.ciunit = *iounit;
s_wsfe(&io___31);
do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
e_wsfe();
io___32.ciunit = *iounit;
s_wsfe(&io___32);
do_fio(&c__1, (char *)&c__8, (ftnlen)sizeof(integer));
e_wsfe();
} else if (itype == 4) {
io___33.ciunit = *iounit;
s_wsfe(&io___33);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___34.ciunit = *iounit;
s_wsfe(&io___34);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___35.ciunit = *iounit;
s_wsfe(&io___35);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___36.ciunit = *iounit;
s_wsfe(&io___36);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___37.ciunit = *iounit;
s_wsfe(&io___37);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___38.ciunit = *iounit;
s_wsfe(&io___38);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___39.ciunit = *iounit;
s_wsfe(&io___39);
do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
e_wsfe();
io___40.ciunit = *iounit;
s_wsfe(&io___40);
do_fio(&c__1, (char *)&c__8, (ftnlen)sizeof(integer));
e_wsfe();
} else if (itype == 5) {
io___41.ciunit = *iounit;
s_wsfe(&io___41);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___42.ciunit = *iounit;
s_wsfe(&io___42);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___43.ciunit = *iounit;
s_wsfe(&io___43);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___44.ciunit = *iounit;
s_wsfe(&io___44);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___45.ciunit = *iounit;
s_wsfe(&io___45);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___46.ciunit = *iounit;
s_wsfe(&io___46);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___47.ciunit = *iounit;
s_wsfe(&io___47);
do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
e_wsfe();
io___48.ciunit = *iounit;
s_wsfe(&io___48);
do_fio(&c__1, (char *)&c__8, (ftnlen)sizeof(integer));
e_wsfe();
}
/* Tests performed */
io___49.ciunit = *iounit;
s_wsfe(&io___49);
do_fio(&c__1, "Test ratios: ", (ftnlen)13);
e_wsfe();
if (itype == 1) {
/* GQR decomposition of rectangular matrices */
io___50.ciunit = *iounit;
s_wsfe(&io___50);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___51.ciunit = *iounit;
s_wsfe(&io___51);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___52.ciunit = *iounit;
s_wsfe(&io___52);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___53.ciunit = *iounit;
s_wsfe(&io___53);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
} else if (itype == 2) {
/* GRQ decomposition of rectangular matrices */
io___54.ciunit = *iounit;
s_wsfe(&io___54);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___55.ciunit = *iounit;
s_wsfe(&io___55);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___56.ciunit = *iounit;
s_wsfe(&io___56);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___57.ciunit = *iounit;
s_wsfe(&io___57);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
} else if (itype == 3) {
/* LSE Problem */
io___58.ciunit = *iounit;
s_wsfe(&io___58);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___59.ciunit = *iounit;
s_wsfe(&io___59);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
} else if (itype == 4) {
/* GLM Problem */
io___60.ciunit = *iounit;
s_wsfe(&io___60);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
} else if (itype == 5) {
/* GSVD */
io___61.ciunit = *iounit;
s_wsfe(&io___61);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___62.ciunit = *iounit;
s_wsfe(&io___62);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___63.ciunit = *iounit;
s_wsfe(&io___63);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___64.ciunit = *iounit;
s_wsfe(&io___64);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___65.ciunit = *iounit;
s_wsfe(&io___65);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
}
/* GQR test ratio */
/* GRQ test ratio */
/* LSE test ratio */
/* GLM test ratio */
/* GSVD test ratio */
return 0;
/* End of ALAHDG */
} /* alahdg_ */
/* Subroutine */ int aladhd_(integer *iounit, char *path)
{
/* Format strings */
static char fmt_9999[] = "(/1x,a3,\002 drivers: General dense matrice"
"s\002)";
static char fmt_9989[] = "(4x,\0021. Diagonal\002,24x,\0027. Last n/2 co"
"lumns zero\002,/4x,\0022. Upper triangular\002,16x,\0028. Random"
", CNDNUM = sqrt(0.1/EPS)\002,/4x,\0023. Lower triangular\002,16x,"
"\0029. Random, CNDNUM = 0.1/EPS\002,/4x,\0024. Random, CNDNUM = 2"
"\002,13x,\00210. Scaled near underflow\002,/4x,\0025. First colu"
"mn zero\002,14x,\00211. Scaled near overflow\002,/4x,\0026. Last"
" column zero\002)";
static char fmt_9981[] = "(3x,i2,\002: norm( L * U - A ) / ( N * norm(A"
") * EPS )\002)";
static char fmt_9980[] = "(3x,i2,\002: norm( B - A * X ) / \002,\002( n"
"orm(A) * norm(X) * EPS )\002)";
static char fmt_9979[] = "(3x,i2,\002: norm( X - XACT ) / \002,\002( n"
"orm(XACT) * CNDNUM * EPS )\002)";
static char fmt_9978[] = "(3x,i2,\002: norm( X - XACT ) / \002,\002( n"
"orm(XACT) * (error bound) )\002)";
static char fmt_9977[] = "(3x,i2,\002: (backward error) / EPS\002)";
static char fmt_9976[] = "(3x,i2,\002: RCOND * CNDNUM - 1.0\002)";
static char fmt_9972[] = "(3x,i2,\002: abs( WORK(1) - RPVGRW ) /\002,"
"\002 ( max( WORK(1), RPVGRW ) * EPS )\002)";
static char fmt_9998[] = "(/1x,a3,\002 drivers: General band matrice"
"s\002)";
static char fmt_9988[] = "(4x,\0021. Random, CNDNUM = 2\002,14x,\0025. R"
"andom, CNDNUM = sqrt(0.1/EPS)\002,/4x,\0022. First column zer"
"o\002,15x,\0026. Random, CNDNUM = 0.1/EPS\002,/4x,\0023. Last co"
"lumn zero\002,16x,\0027. Scaled near underflow\002,/4x,\0024. La"
"st n/2 columns zero\002,11x,\0028. Scaled near overflow\002)";
static char fmt_9997[] = "(/1x,a3,\002 drivers: General tridiagonal\002)"
;
static char fmt_9987[] = "(\002 Matrix types (1-6 have specified conditi"
"on numbers):\002,/4x,\0021. Diagonal\002,24x,\0027. Random, unsp"
"ecified CNDNUM\002,/4x,\0022. Random, CNDNUM = 2\002,14x,\0028. "
"First column zero\002,/4x,\0023. Random, CNDNUM = sqrt(0.1/EPS"
")\002,2x,\0029. Last column zero\002,/4x,\0024. Random, CNDNUM ="
" 0.1/EPS\002,7x,\00210. Last n/2 columns zero\002,/4x,\0025. Sca"
"led near underflow\002,10x,\00211. Scaled near underflow\002,/4x,"
"\0026. Scaled near overflow\002,11x,\00212. Scaled near overflo"
"w\002)";
static char fmt_9996[] = "(/1x,a3,\002 drivers: \002,a9,\002 positive d"
"efinite matrices\002)";
static char fmt_9995[] = "(/1x,a3,\002 drivers: \002,a9,\002 positive d"
"efinite packed matrices\002)";
static char fmt_9985[] = "(4x,\0021. Diagonal\002,24x,\0026. Random, CND"
"NUM = sqrt(0.1/EPS)\002,/4x,\0022. Random, CNDNUM = 2\002,14x"
",\0027. Random, CNDNUM = 0.1/EPS\002,/3x,\002*3. First row and c"
"olumn zero\002,7x,\0028. Scaled near underflow\002,/3x,\002*4. L"
"ast row and column zero\002,8x,\0029. Scaled near overflow\002,/"
"3x,\002*5. Middle row and column zero\002,/3x,\002(* - tests err"
"or exits from \002,a3,\002TRF, no test ratios are computed)\002)";
static char fmt_9975[] = "(3x,i2,\002: norm( U' * U - A ) / ( N * norm(A"
") * EPS )\002,\002, or\002,/7x,\002norm( L * L' - A ) / ( N * no"
"rm(A) * EPS )\002)";
static char fmt_9994[] = "(/1x,a3,\002 drivers: \002,a9,\002 positive d"
"efinite band matrices\002)";
static char fmt_9984[] = "(4x,\0021. Random, CNDNUM = 2\002,14x,\0025. R"
"andom, CNDNUM = sqrt(0.1/EPS)\002,/3x,\002*2. First row and colu"
"mn zero\002,7x,\0026. Random, CNDNUM = 0.1/EPS\002,/3x,\002*3. L"
"ast row and column zero\002,8x,\0027. Scaled near underflow\002,"
"/3x,\002*4. Middle row and column zero\002,6x,\0028. Scaled near"
" overflow\002,/3x,\002(* - tests error exits from \002,a3,\002TR"
"F, no test ratios are computed)\002)";
static char fmt_9993[] = "(/1x,a3,\002 drivers: \002,a9,\002 positive d"
"efinite tridiagonal\002)";
static char fmt_9986[] = "(\002 Matrix types (1-6 have specified conditi"
"on numbers):\002,/4x,\0021. Diagonal\002,24x,\0027. Random, unsp"
"ecified CNDNUM\002,/4x,\0022. Random, CNDNUM = 2\002,14x,\0028. "
"First row and column zero\002,/4x,\0023. Random, CNDNUM = sqrt(0"
".1/EPS)\002,2x,\0029. Last row and column zero\002,/4x,\0024. Ra"
"ndom, CNDNUM = 0.1/EPS\002,7x,\00210. Middle row and column zer"
"o\002,/4x,\0025. Scaled near underflow\002,10x,\00211. Scaled ne"
"ar underflow\002,/4x,\0026. Scaled near overflow\002,11x,\00212."
" Scaled near overflow\002)";
static char fmt_9973[] = "(3x,i2,\002: norm( U'*D*U - A ) / ( N * norm(A"
") * EPS )\002,\002, or\002,/7x,\002norm( L*D*L' - A ) / ( N * no"
"rm(A) * EPS )\002)";
static char fmt_9992[] = "(/1x,a3,\002 drivers: \002,a9,\002 indefinite"
" matrices\002)";
static char fmt_9991[] = "(/1x,a3,\002 drivers: \002,a9,\002 indefinite"
" packed matrices\002)";
static char fmt_9983[] = "(4x,\0021. Diagonal\002,24x,\0026. Last n/2 ro"
"ws and columns zero\002,/4x,\0022. Random, CNDNUM = 2\002,14x"
",\0027. Random, CNDNUM = sqrt(0.1/EPS)\002,/4x,\0023. First row "
"and column zero\002,7x,\0028. Random, CNDNUM = 0.1/EPS\002,/4x"
",\0024. Last row and column zero\002,8x,\0029. Scaled near under"
"flow\002,/4x,\0025. Middle row and column zero\002,5x,\00210. Sc"
"aled near overflow\002)";
static char fmt_9982[] = "(4x,\0021. Diagonal\002,24x,\0027. Random, CND"
"NUM = sqrt(0.1/EPS)\002,/4x,\0022. Random, CNDNUM = 2\002,14x"
",\0028. Random, CNDNUM = 0.1/EPS\002,/4x,\0023. First row and co"
"lumn zero\002,7x,\0029. Scaled near underflow\002,/4x,\0024. Las"
"t row and column zero\002,7x,\00210. Scaled near overflow\002,/4"
"x,\0025. Middle row and column zero\002,5x,\00211. Block diagona"
"l matrix\002,/4x,\0026. Last n/2 rows and columns zero\002)";
static char fmt_9974[] = "(3x,i2,\002: norm( U*D*U' - A ) / ( N * norm(A"
") * EPS )\002,\002, or\002,/7x,\002norm( L*D*L' - A ) / ( N * no"
"rm(A) * EPS )\002)";
static char fmt_9990[] = "(/1x,a3,\002: No header available\002)";
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Local variables */
static logical sord, corz;
extern logical lsame_(char *, char *);
static char c1[1], c3[1], p2[2];
extern logical lsamen_(integer *, char *, char *);
static char sym[9];
/* Fortran I/O blocks */
static cilist io___6 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___7 = { 0, 0, 0, "( ' Matrix types:' )", 0 };
static cilist io___8 = { 0, 0, 0, fmt_9989, 0 };
static cilist io___9 = { 0, 0, 0, "( ' Test ratios:' )", 0 };
static cilist io___10 = { 0, 0, 0, fmt_9981, 0 };
static cilist io___11 = { 0, 0, 0, fmt_9980, 0 };
static cilist io___12 = { 0, 0, 0, fmt_9979, 0 };
static cilist io___13 = { 0, 0, 0, fmt_9978, 0 };
static cilist io___14 = { 0, 0, 0, fmt_9977, 0 };
static cilist io___15 = { 0, 0, 0, fmt_9976, 0 };
static cilist io___16 = { 0, 0, 0, fmt_9972, 0 };
static cilist io___17 = { 0, 0, 0, "( ' Messages:' )", 0 };
static cilist io___18 = { 0, 0, 0, fmt_9998, 0 };
static cilist io___19 = { 0, 0, 0, "( ' Matrix types:' )", 0 };
static cilist io___20 = { 0, 0, 0, fmt_9988, 0 };
static cilist io___21 = { 0, 0, 0, "( ' Test ratios:' )", 0 };
static cilist io___22 = { 0, 0, 0, fmt_9981, 0 };
static cilist io___23 = { 0, 0, 0, fmt_9980, 0 };
static cilist io___24 = { 0, 0, 0, fmt_9979, 0 };
static cilist io___25 = { 0, 0, 0, fmt_9978, 0 };
static cilist io___26 = { 0, 0, 0, fmt_9977, 0 };
static cilist io___27 = { 0, 0, 0, fmt_9976, 0 };
static cilist io___28 = { 0, 0, 0, fmt_9972, 0 };
static cilist io___29 = { 0, 0, 0, "( ' Messages:' )", 0 };
static cilist io___30 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___31 = { 0, 0, 0, fmt_9987, 0 };
static cilist io___32 = { 0, 0, 0, "( ' Test ratios:' )", 0 };
static cilist io___33 = { 0, 0, 0, fmt_9981, 0 };
static cilist io___34 = { 0, 0, 0, fmt_9980, 0 };
static cilist io___35 = { 0, 0, 0, fmt_9979, 0 };
static cilist io___36 = { 0, 0, 0, fmt_9978, 0 };
static cilist io___37 = { 0, 0, 0, fmt_9977, 0 };
static cilist io___38 = { 0, 0, 0, fmt_9976, 0 };
static cilist io___39 = { 0, 0, 0, "( ' Messages:' )", 0 };
static cilist io___41 = { 0, 0, 0, fmt_9996, 0 };
static cilist io___42 = { 0, 0, 0, fmt_9995, 0 };
static cilist io___43 = { 0, 0, 0, "( ' Matrix types:' )", 0 };
static cilist io___44 = { 0, 0, 0, fmt_9985, 0 };
static cilist io___45 = { 0, 0, 0, "( ' Test ratios:' )", 0 };
static cilist io___46 = { 0, 0, 0, fmt_9975, 0 };
static cilist io___47 = { 0, 0, 0, fmt_9980, 0 };
static cilist io___48 = { 0, 0, 0, fmt_9979, 0 };
static cilist io___49 = { 0, 0, 0, fmt_9978, 0 };
static cilist io___50 = { 0, 0, 0, fmt_9977, 0 };
static cilist io___51 = { 0, 0, 0, fmt_9976, 0 };
static cilist io___52 = { 0, 0, 0, "( ' Messages:' )", 0 };
static cilist io___53 = { 0, 0, 0, fmt_9994, 0 };
static cilist io___54 = { 0, 0, 0, fmt_9994, 0 };
static cilist io___55 = { 0, 0, 0, "( ' Matrix types:' )", 0 };
static cilist io___56 = { 0, 0, 0, fmt_9984, 0 };
static cilist io___57 = { 0, 0, 0, "( ' Test ratios:' )", 0 };
static cilist io___58 = { 0, 0, 0, fmt_9975, 0 };
static cilist io___59 = { 0, 0, 0, fmt_9980, 0 };
static cilist io___60 = { 0, 0, 0, fmt_9979, 0 };
static cilist io___61 = { 0, 0, 0, fmt_9978, 0 };
static cilist io___62 = { 0, 0, 0, fmt_9977, 0 };
static cilist io___63 = { 0, 0, 0, fmt_9976, 0 };
static cilist io___64 = { 0, 0, 0, "( ' Messages:' )", 0 };
static cilist io___65 = { 0, 0, 0, fmt_9993, 0 };
static cilist io___66 = { 0, 0, 0, fmt_9993, 0 };
static cilist io___67 = { 0, 0, 0, fmt_9986, 0 };
static cilist io___68 = { 0, 0, 0, "( ' Test ratios:' )", 0 };
static cilist io___69 = { 0, 0, 0, fmt_9973, 0 };
static cilist io___70 = { 0, 0, 0, fmt_9980, 0 };
static cilist io___71 = { 0, 0, 0, fmt_9979, 0 };
static cilist io___72 = { 0, 0, 0, fmt_9978, 0 };
static cilist io___73 = { 0, 0, 0, fmt_9977, 0 };
static cilist io___74 = { 0, 0, 0, fmt_9976, 0 };
static cilist io___75 = { 0, 0, 0, "( ' Messages:' )", 0 };
static cilist io___76 = { 0, 0, 0, fmt_9992, 0 };
static cilist io___77 = { 0, 0, 0, fmt_9991, 0 };
static cilist io___78 = { 0, 0, 0, "( ' Matrix types:' )", 0 };
static cilist io___79 = { 0, 0, 0, fmt_9983, 0 };
static cilist io___80 = { 0, 0, 0, fmt_9982, 0 };
static cilist io___81 = { 0, 0, 0, "( ' Test ratios:' )", 0 };
static cilist io___82 = { 0, 0, 0, fmt_9974, 0 };
static cilist io___83 = { 0, 0, 0, fmt_9980, 0 };
static cilist io___84 = { 0, 0, 0, fmt_9979, 0 };
static cilist io___85 = { 0, 0, 0, fmt_9977, 0 };
static cilist io___86 = { 0, 0, 0, fmt_9978, 0 };
static cilist io___87 = { 0, 0, 0, fmt_9976, 0 };
static cilist io___88 = { 0, 0, 0, "( ' Messages:' )", 0 };
static cilist io___89 = { 0, 0, 0, fmt_9992, 0 };
static cilist io___90 = { 0, 0, 0, fmt_9991, 0 };
static cilist io___91 = { 0, 0, 0, "( ' Matrix types:' )", 0 };
static cilist io___92 = { 0, 0, 0, fmt_9983, 0 };
static cilist io___93 = { 0, 0, 0, "( ' Test ratios:' )", 0 };
static cilist io___94 = { 0, 0, 0, fmt_9974, 0 };
static cilist io___95 = { 0, 0, 0, fmt_9980, 0 };
static cilist io___96 = { 0, 0, 0, fmt_9979, 0 };
static cilist io___97 = { 0, 0, 0, fmt_9977, 0 };
static cilist io___98 = { 0, 0, 0, fmt_9978, 0 };
static cilist io___99 = { 0, 0, 0, fmt_9976, 0 };
static cilist io___100 = { 0, 0, 0, "( ' Messages:' )", 0 };
static cilist io___101 = { 0, 0, 0, fmt_9990, 0 };
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
September 30, 1994
Purpose
=======
ALADHD prints header information for the driver routines test paths.
Arguments
=========
IOUNIT (input) INTEGER
The unit number to which the header information should be
printed.
PATH (input) CHARACTER*3
The name of the path for which the header information is to
be printed. Current paths are
_GE: General matrices
_GB: General band
_GT: General Tridiagonal
_PO: Symmetric or Hermitian positive definite
_PP: Symmetric or Hermitian positive definite packed
_PB: Symmetric or Hermitian positive definite band
_PT: Symmetric or Hermitian positive definite tridiagonal
_SY: Symmetric indefinite
_SP: Symmetric indefinite packed
_HE: (complex) Hermitian indefinite
_HP: (complex) Hermitian indefinite packed
The first character must be one of S, D, C, or Z (C or Z only
if complex). */
if (*iounit <= 0) {
return 0;
}
*(unsigned char *)c1 = *(unsigned char *)path;
*(unsigned char *)c3 = *(unsigned char *)&path[2];
s_copy(p2, path + 1, (ftnlen)2, (ftnlen)2);
sord = lsame_(c1, "S") || lsame_(c1, "D");
corz = lsame_(c1, "C") || lsame_(c1, "Z");
if (! (sord || corz)) {
return 0;
}
if (lsamen_(&c__2, p2, "GE")) {
/* GE: General dense */
io___6.ciunit = *iounit;
s_wsfe(&io___6);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
io___7.ciunit = *iounit;
s_wsfe(&io___7);
e_wsfe();
io___8.ciunit = *iounit;
s_wsfe(&io___8);
e_wsfe();
io___9.ciunit = *iounit;
s_wsfe(&io___9);
e_wsfe();
io___10.ciunit = *iounit;
s_wsfe(&io___10);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___11.ciunit = *iounit;
s_wsfe(&io___11);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___12.ciunit = *iounit;
s_wsfe(&io___12);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___13.ciunit = *iounit;
s_wsfe(&io___13);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___14.ciunit = *iounit;
s_wsfe(&io___14);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___15.ciunit = *iounit;
s_wsfe(&io___15);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___16.ciunit = *iounit;
s_wsfe(&io___16);
do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
e_wsfe();
io___17.ciunit = *iounit;
s_wsfe(&io___17);
e_wsfe();
} else if (lsamen_(&c__2, p2, "GB")) {
/* GB: General band */
io___18.ciunit = *iounit;
s_wsfe(&io___18);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
io___19.ciunit = *iounit;
s_wsfe(&io___19);
e_wsfe();
io___20.ciunit = *iounit;
s_wsfe(&io___20);
e_wsfe();
io___21.ciunit = *iounit;
s_wsfe(&io___21);
e_wsfe();
io___22.ciunit = *iounit;
s_wsfe(&io___22);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___23.ciunit = *iounit;
s_wsfe(&io___23);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___24.ciunit = *iounit;
s_wsfe(&io___24);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___25.ciunit = *iounit;
s_wsfe(&io___25);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___26.ciunit = *iounit;
s_wsfe(&io___26);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___27.ciunit = *iounit;
s_wsfe(&io___27);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___28.ciunit = *iounit;
s_wsfe(&io___28);
do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
e_wsfe();
io___29.ciunit = *iounit;
s_wsfe(&io___29);
e_wsfe();
} else if (lsamen_(&c__2, p2, "GT")) {
/* GT: General tridiagonal */
io___30.ciunit = *iounit;
s_wsfe(&io___30);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
io___31.ciunit = *iounit;
s_wsfe(&io___31);
e_wsfe();
io___32.ciunit = *iounit;
s_wsfe(&io___32);
e_wsfe();
io___33.ciunit = *iounit;
s_wsfe(&io___33);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___34.ciunit = *iounit;
s_wsfe(&io___34);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___35.ciunit = *iounit;
s_wsfe(&io___35);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___36.ciunit = *iounit;
s_wsfe(&io___36);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___37.ciunit = *iounit;
s_wsfe(&io___37);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___38.ciunit = *iounit;
s_wsfe(&io___38);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___39.ciunit = *iounit;
s_wsfe(&io___39);
e_wsfe();
} else if (lsamen_(&c__2, p2, "PO") || lsamen_(&
c__2, p2, "PP")) {
/* PO: Positive definite full
PP: Positive definite packed */
if (sord) {
s_copy(sym, "Symmetric", (ftnlen)9, (ftnlen)9);
} else {
s_copy(sym, "Hermitian", (ftnlen)9, (ftnlen)9);
}
if (lsame_(c3, "O")) {
io___41.ciunit = *iounit;
s_wsfe(&io___41);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, sym, (ftnlen)9);
e_wsfe();
} else {
io___42.ciunit = *iounit;
s_wsfe(&io___42);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, sym, (ftnlen)9);
e_wsfe();
}
io___43.ciunit = *iounit;
s_wsfe(&io___43);
e_wsfe();
io___44.ciunit = *iounit;
s_wsfe(&io___44);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
io___45.ciunit = *iounit;
s_wsfe(&io___45);
e_wsfe();
io___46.ciunit = *iounit;
s_wsfe(&io___46);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___47.ciunit = *iounit;
s_wsfe(&io___47);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___48.ciunit = *iounit;
s_wsfe(&io___48);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___49.ciunit = *iounit;
s_wsfe(&io___49);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___50.ciunit = *iounit;
s_wsfe(&io___50);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___51.ciunit = *iounit;
s_wsfe(&io___51);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___52.ciunit = *iounit;
s_wsfe(&io___52);
e_wsfe();
} else if (lsamen_(&c__2, p2, "PB")) {
/* PB: Positive definite band */
if (sord) {
io___53.ciunit = *iounit;
s_wsfe(&io___53);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, "Symmetric", (ftnlen)9);
e_wsfe();
} else {
io___54.ciunit = *iounit;
s_wsfe(&io___54);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, "Hermitian", (ftnlen)9);
e_wsfe();
}
io___55.ciunit = *iounit;
s_wsfe(&io___55);
e_wsfe();
io___56.ciunit = *iounit;
s_wsfe(&io___56);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
io___57.ciunit = *iounit;
s_wsfe(&io___57);
e_wsfe();
io___58.ciunit = *iounit;
s_wsfe(&io___58);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___59.ciunit = *iounit;
s_wsfe(&io___59);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___60.ciunit = *iounit;
s_wsfe(&io___60);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___61.ciunit = *iounit;
s_wsfe(&io___61);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___62.ciunit = *iounit;
s_wsfe(&io___62);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___63.ciunit = *iounit;
s_wsfe(&io___63);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___64.ciunit = *iounit;
s_wsfe(&io___64);
e_wsfe();
} else if (lsamen_(&c__2, p2, "PT")) {
/* PT: Positive definite tridiagonal */
if (sord) {
io___65.ciunit = *iounit;
s_wsfe(&io___65);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, "Symmetric", (ftnlen)9);
e_wsfe();
} else {
io___66.ciunit = *iounit;
s_wsfe(&io___66);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, "Hermitian", (ftnlen)9);
e_wsfe();
}
io___67.ciunit = *iounit;
s_wsfe(&io___67);
e_wsfe();
io___68.ciunit = *iounit;
s_wsfe(&io___68);
e_wsfe();
io___69.ciunit = *iounit;
s_wsfe(&io___69);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___70.ciunit = *iounit;
s_wsfe(&io___70);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___71.ciunit = *iounit;
s_wsfe(&io___71);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___72.ciunit = *iounit;
s_wsfe(&io___72);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___73.ciunit = *iounit;
s_wsfe(&io___73);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___74.ciunit = *iounit;
s_wsfe(&io___74);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___75.ciunit = *iounit;
s_wsfe(&io___75);
e_wsfe();
} else if (lsamen_(&c__2, p2, "SY") || lsamen_(&
c__2, p2, "SP")) {
/* SY: Symmetric indefinite full
SP: Symmetric indefinite packed */
if (lsame_(c3, "Y")) {
io___76.ciunit = *iounit;
s_wsfe(&io___76);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, "Symmetric", (ftnlen)9);
e_wsfe();
} else {
io___77.ciunit = *iounit;
s_wsfe(&io___77);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, "Symmetric", (ftnlen)9);
e_wsfe();
}
io___78.ciunit = *iounit;
s_wsfe(&io___78);
e_wsfe();
if (sord) {
io___79.ciunit = *iounit;
s_wsfe(&io___79);
e_wsfe();
} else {
io___80.ciunit = *iounit;
s_wsfe(&io___80);
e_wsfe();
}
io___81.ciunit = *iounit;
s_wsfe(&io___81);
e_wsfe();
io___82.ciunit = *iounit;
s_wsfe(&io___82);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___83.ciunit = *iounit;
s_wsfe(&io___83);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___84.ciunit = *iounit;
s_wsfe(&io___84);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___85.ciunit = *iounit;
s_wsfe(&io___85);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___86.ciunit = *iounit;
s_wsfe(&io___86);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___87.ciunit = *iounit;
s_wsfe(&io___87);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___88.ciunit = *iounit;
s_wsfe(&io___88);
e_wsfe();
} else if (lsamen_(&c__2, p2, "HE") || lsamen_(&
c__2, p2, "HP")) {
/* HE: Hermitian indefinite full
HP: Hermitian indefinite packed */
if (lsame_(c3, "E")) {
io___89.ciunit = *iounit;
s_wsfe(&io___89);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, "Hermitian", (ftnlen)9);
e_wsfe();
} else {
io___90.ciunit = *iounit;
s_wsfe(&io___90);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, "Hermitian", (ftnlen)9);
e_wsfe();
}
io___91.ciunit = *iounit;
s_wsfe(&io___91);
e_wsfe();
io___92.ciunit = *iounit;
s_wsfe(&io___92);
e_wsfe();
io___93.ciunit = *iounit;
s_wsfe(&io___93);
e_wsfe();
io___94.ciunit = *iounit;
s_wsfe(&io___94);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
io___95.ciunit = *iounit;
s_wsfe(&io___95);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
io___96.ciunit = *iounit;
s_wsfe(&io___96);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
io___97.ciunit = *iounit;
s_wsfe(&io___97);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
io___98.ciunit = *iounit;
s_wsfe(&io___98);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
io___99.ciunit = *iounit;
s_wsfe(&io___99);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
io___100.ciunit = *iounit;
s_wsfe(&io___100);
e_wsfe();
} else {
/* Print error message if no header is available. */
io___101.ciunit = *iounit;
s_wsfe(&io___101);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
/* First line of header
GE matrix types
GB matrix types
GT matrix types
PT matrix types
PO, PP matrix types
PB matrix types
SSY, SSP, CHE, CHP matrix types
CSY, CSP matrix types
Test ratios */
return 0;
/* End of ALADHD */
} /* aladhd_ */
/* Main program */ MAIN__(void)
{
/* Format strings */
static char fmt_9983[] = "(\002 LAPACK VERSION 3.0, released June 30, 19"
"99 \002,/)";
static char fmt_9992[] = "(\002 The following parameter values will be u"
"sed:\002)";
static char fmt_9999[] = "(\002 Too many values of \002,a,\002 using "
"\002,a,\002 = \002,i2)";
static char fmt_9991[] = "(4x,a7,1x,10i6,/12x,10i6)";
static char fmt_9997[] = "(\002 *** \002,a1,\002 = \002,i7,\002 is too b"
"ig: \002,\002maximum allowed is\002,i7)";
static char fmt_9998[] = "(\002 *** LDA = \002,i7,\002 is too small, mus"
"t have \002,\002LDA > 0.\002)";
static char fmt_9995[] = "(\002 *** LDA*N is too big for the dense routi"
"nes \002,\002(LDA =\002,i6,\002, N =\002,i6,\002)\002,/\002 --> "
"Increase LA to at least \002,i8)";
static char fmt_9994[] = "(\002 *** (LDA+K)*M is too big for the band ro"
"utines \002,\002(LDA=\002,i6,\002, M=\002,i6,\002, K=\002,i6,"
"\002)\002,/\002 --> Increase LA to at least \002,i8)";
static char fmt_9996[] = "(\002 *** N*NB is too big for N =\002,i6,\002,"
" NB =\002,i6,/\002 --> Increase LA to at least \002,i8)";
static char fmt_9984[] = "(/\002 Tests not done due to input errors\002)";
static char fmt_9993[] = "(\002 The minimum time a subroutine will be ti"
"med = \002,f6.3,\002 seconds\002)";
static char fmt_9990[] = "(/\002 ------------------------------\002,/"
"\002 >>>>> Sample BLAS <<<<<\002,/\002 ------------------"
"------------\002)";
static char fmt_9989[] = "(1x,a6,\002 not timed due to input errors\002,"
"/)";
static char fmt_9988[] = "(/\002 ------------------------------\002,/"
"\002 >>>>> Timing data <<<<<\002,/\002 ------------------"
"------------\002)";
static char fmt_9987[] = "(1x,a6,\002: Unrecognized path or subroutine "
"name\002,/)";
static char fmt_9986[] = "(\002 End of tests\002)";
static char fmt_9985[] = "(\002 Total time used = \002,f12.2,\002 seco"
"nds\002)";
/* System generated locals */
integer i__1, i__2;
real r__1;
/* Builtin functions */
integer s_wsfe(cilist *), e_wsfe(void), s_rsfe(cilist *), do_fio(integer *
, char *, ftnlen), e_rsfe(void), s_rsle(cilist *), do_lio(integer
*, integer *, char *, ftnlen), e_rsle(void), s_wsle(cilist *),
e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer need, nlda;
static logical blas;
static char line[80];
static integer kval[6], mval[6], maxk, nval[6], maxm, maxn;
static real work[280576] /* was [512][548] */, a[817152] /* was [
272384][3] */, b[817152] /* was [272384][3] */, d__[2048]
/* was [1024][2] */;
static integer i__, l;
static real s[1024];
static logical ldaok;
extern logical lsame_(char *, char *);
static integer nbval[6], maxnb, mkmax;
static char c1[1], c2[2], c3[3];
static integer nxval[6], i2, j2, iwork[10000];
static real s1, s2;
extern /* Subroutine */ int stimb2_(char *, integer *, integer *, integer
*, integer *, integer *, integer *, integer *, integer *, integer
*, integer *, integer *, real *, real *, real *, real *, real *,
integer *, integer *, integer *, ftnlen), stimb3_(char *, integer
*, integer *, integer *, integer *, integer *, integer *, integer
*, integer *, real *, real *, real *, real *, real *, integer *,
integer *, integer *, ftnlen), stimq3_(char *, integer *, integer
*, integer *, integer *, integer *, integer *, integer *, integer
*, real *, real *, real *, real *, real *, integer *, real *,
integer *, integer *, integer *, ftnlen);
static integer nk, nm, nn, ldaval[4];
static logical ldamok, ldanok;
static integer maxlda;
extern doublereal second_(void);
extern logical lsamen_(integer *, char *, char *);
static real flptbl[1088640], opctbl[1088640];
extern /* Subroutine */ int stimgb_(char *, integer *, integer *, integer
*, integer *, integer *, integer *, integer *, integer *, integer
*, integer *, real *, real *, real *, integer *, real *, integer *
, integer *, integer *, integer *, ftnlen), stimge_(char *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *, real *, real *, real *, real *, integer *,
real *, integer *, integer *, integer *, integer *, ftnlen);
static real timtbl[1088640], timmin;
extern /* Subroutine */ int stimpb_(char *, integer *, integer *, integer
*, integer *, integer *, integer *, integer *, integer *, integer
*, integer *, real *, real *, real *, integer *, real *, integer *
, integer *, integer *, integer *, ftnlen);
static logical nxnbok;
extern /* Subroutine */ int stimbr_(char *, integer *, integer *, integer
*, integer *, integer *, integer *, integer *, integer *, integer
*, integer *, real *, real *, real *, real *, real *, real *,
real *, integer *, integer *, integer *, integer *, ftnlen),
stimtb_(char *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *, real *, real *, real *
, real *, integer *, integer *, integer *, integer *, ftnlen),
stimtd_(char *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, real *,
real *, real *, real *, real *, real *, real *, integer *,
integer *, integer *, integer *, ftnlen), stimhr_(char *, integer
*, integer *, integer *, integer *, integer *, integer *, integer
*, integer *, integer *, real *, real *, real *, real *, real *,
real *, integer *, integer *, integer *, integer *, ftnlen),
stimgt_(char *, integer *, integer *, integer *, integer *,
integer *, integer *, real *, real *, real *, integer *, real *,
integer *, integer *, integer *, integer *, ftnlen), stimmm_(char
*, char *, integer *, integer *, integer *, integer *, real *,
real *, real *, real *, real *, integer *, integer *, integer *,
ftnlen, ftnlen), stimlq_(char *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, real *, real *, real *, real *, real *, real *,
integer *, integer *, integer *, integer *, ftnlen), stimql_(char
*, integer *, integer *, integer *, integer *, integer *, integer
*, integer *, integer *, integer *, integer *, real *, real *,
real *, real *, real *, real *, integer *, integer *, integer *,
integer *, ftnlen), stimls_(char *, integer *, integer *, integer
*, integer *, integer *, integer *, integer *, integer *, integer
*, integer *, integer *, real *, real *, real *, real *, real *,
real *, real *, real *, real *, real *, real *, integer *,
integer *, ftnlen);
static real reslts[6912] /* was [6][6][8][24] */;
extern /* Subroutine */ int stimpo_(char *, integer *, integer *, integer
*, integer *, integer *, integer *, integer *, integer *, real *,
real *, real *, integer *, real *, integer *, integer *, integer *
, integer *, ftnlen), stimpp_(char *, integer *, integer *,
integer *, integer *, integer *, real *, real *, real *, integer *
, real *, integer *, integer *, integer *, integer *, ftnlen),
stimmv_(char *, integer *, integer *, integer *, integer *,
integer *, integer *, real *, real *, integer *, real *, real *,
real *, integer *, integer *, integer *, ftnlen), stimpt_(char *,
integer *, integer *, integer *, integer *, integer *, integer *,
real *, real *, real *, real *, integer *, integer *, integer *,
integer *, ftnlen), stimqp_(char *, integer *, integer *, integer
*, integer *, integer *, real *, real *, real *, real *, real *,
integer *, real *, integer *, integer *, integer *, ftnlen),
stimqr_(char *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
real *, real *, real *, real *, real *, real *, integer *,
integer *, integer *, integer *, ftnlen), stimrq_(char *, integer
*, integer *, integer *, integer *, integer *, integer *, integer
*, integer *, integer *, integer *, real *, real *, real *, real *
, real *, real *, integer *, integer *, integer *, integer *,
ftnlen), stimsp_(char *, integer *, integer *, integer *, integer
*, integer *, real *, real *, real *, real *, integer *, real *,
integer *, integer *, integer *, integer *, ftnlen), stimtp_(char
*, integer *, integer *, integer *, integer *, integer *, real *,
real *, real *, real *, integer *, integer *, integer *, integer *
, ftnlen), stimtr_(char *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, real *,
real *, real *, real *, integer *, integer *, integer *, integer *
, ftnlen), stimsy_(char *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, real *,
real *, real *, real *, integer *, real *, integer *, integer *,
integer *, integer *, ftnlen);
static integer nnb;
static logical mok, nok;
static integer ldr1, ldr2, ldr3;
/* Fortran I/O blocks */
static cilist io___5 = { 0, 6, 0, fmt_9983, 0 };
static cilist io___6 = { 0, 5, 0, "( A80 )", 0 };
static cilist io___10 = { 0, 6, 0, "( 1X, A, / )", 0 };
static cilist io___11 = { 0, 6, 0, fmt_9992, 0 };
static cilist io___12 = { 0, 5, 0, 0, 0 };
static cilist io___14 = { 0, 6, 0, fmt_9999, 0 };
static cilist io___15 = { 0, 5, 0, 0, 0 };
static cilist io___18 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___21 = { 0, 6, 0, fmt_9997, 0 };
static cilist io___22 = { 0, 6, 0, 0, 0 };
static cilist io___23 = { 0, 5, 0, 0, 0 };
static cilist io___25 = { 0, 6, 0, fmt_9999, 0 };
static cilist io___26 = { 0, 5, 0, 0, 0 };
static cilist io___28 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___31 = { 0, 6, 0, fmt_9997, 0 };
static cilist io___32 = { 0, 6, 0, 0, 0 };
static cilist io___33 = { 0, 5, 0, 0, 0 };
static cilist io___35 = { 0, 6, 0, fmt_9999, 0 };
static cilist io___36 = { 0, 5, 0, 0, 0 };
static cilist io___38 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___41 = { 0, 5, 0, 0, 0 };
static cilist io___43 = { 0, 6, 0, fmt_9999, 0 };
static cilist io___44 = { 0, 5, 0, 0, 0 };
static cilist io___47 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___49 = { 0, 5, 0, 0, 0 };
static cilist io___50 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___51 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___52 = { 0, 5, 0, 0, 0 };
static cilist io___54 = { 0, 6, 0, fmt_9999, 0 };
static cilist io___55 = { 0, 5, 0, 0, 0 };
static cilist io___57 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___60 = { 0, 6, 0, fmt_9998, 0 };
static cilist io___61 = { 0, 6, 0, 0, 0 };
static cilist io___64 = { 0, 6, 0, fmt_9995, 0 };
static cilist io___66 = { 0, 6, 0, fmt_9994, 0 };
static cilist io___68 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___69 = { 0, 6, 0, fmt_9984, 0 };
static cilist io___70 = { 0, 6, 0, 0, 0 };
static cilist io___71 = { 0, 6, 0, 0, 0 };
static cilist io___72 = { 0, 5, 0, 0, 0 };
static cilist io___74 = { 0, 6, 0, fmt_9993, 0 };
static cilist io___75 = { 0, 6, 0, 0, 0 };
static cilist io___76 = { 0, 5, 1, "(A)", 0 };
static cilist io___77 = { 0, 5, 1, "(A)", 0 };
static cilist io___78 = { 0, 6, 0, fmt_9990, 0 };
static cilist io___83 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___84 = { 0, 5, 1, "(A)", 0 };
static cilist io___85 = { 0, 6, 0, fmt_9988, 0 };
static cilist io___89 = { 0, 6, 0, fmt_9987, 0 };
static cilist io___92 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___93 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___94 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___101 = { 0, 6, 0, fmt_9987, 0 };
static cilist io___102 = { 0, 5, 1, "(A)", 0 };
static cilist io___104 = { 0, 6, 0, fmt_9986, 0 };
static cilist io___105 = { 0, 6, 0, fmt_9985, 0 };
#define a_ref(a_1,a_2) a[(a_2)*272384 + a_1 - 272385]
#define b_ref(a_1,a_2) b[(a_2)*272384 + a_1 - 272385]
#define d___ref(a_1,a_2) d__[(a_2)*1024 + a_1 - 1025]
/* -- LAPACK timing routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
June 30, 1999
Purpose
=======
STIMAA is the timing program for the REAL LAPACK
routines. This program collects performance data for the factor,
solve, and inverse routines used in solving systems of linear
equations, and also for the orthogonal factorization and reduction
routines used in solving least squares problems and matrix eigenvalue
problems.
The subprograms call a REAL function SECOND with no
arguments which is assumed to return the central-processor time in
seconds from some fixed starting time.
The program is driven by a short data file, which specifies values
for the matrix dimensions M, N and K, for the blocking parameters
NB and NX, and for the leading array dimension LDA. A minimum time
for each subroutine is included for timing small problems or for
obtaining results on a machine with an inaccurate SECOND function.
The matrix dimensions M, N, and K correspond to the three dimensions
m, n, and k in the Level 3 BLAS. When timing the LAPACK routines for
square matrices, M and N correspond to the matrix dimensions m and n,
and K is the number of right-hand sides (nrhs) for the solves. When
timing the LAPACK routines for band matrices, M is the matrix order
m, N is the half-bandwidth (kl, ku, or kd in the LAPACK notation),
and K is again the number of right-hand sides.
The first 13 records of the data file are read using list-directed
input. The first line of input is printed as the first line of
output and can be used to identify different sets of results. To
assist with debugging an input file, the values are printed out as
they are read in.
The following records are read using the format (A). For these
records, the first 6 characters are reserved for the path or
subroutine name. If a path name is used, the characters after the
path name indicate the routines in the path to be timed, where
'T' or 't' means 'Time this routine'. If the line is blank after the
path name, all routines in the path are timed. If fewer characters
appear than routines in a path, the remaining characters are assumed
to be 'F'. For example, the following 3 lines are equivalent ways of
requesting timing of SGETRF:
SGE T F F
SGE T
SGETRF
An annotated example of a data file can be obtained by deleting the
first 3 characters from the following 30 lines:
LAPACK timing, REAL square matrices
5 Number of values of M
100 200 300 400 500 Values of M (row dimension)
5 Number of values of N
100 200 300 400 500 Values of N (column dimension)
2 Number of values of K
100 400 Values of K
5 Number of values of NB
1 16 32 48 64 Values of NB (blocksize)
0 48 128 128 128 Values of NX (crossover point)
2 Number of values of LDA
512 513 Values of LDA (leading dimension)
0.0 Minimum time in seconds
SGE T T T
SPO T T T
SPP T T T
SSY T T T
SSP T T T
STR T T
STP T T
SQR T T F
SLQ T T F
SQL T T F
SRQ T T F
SQP T
SHR T T F F
STD T T F F
SBR T F F
SLS T T T T T T
The routines are timed for all combinations of applicable values of
M, N, K, NB, NX, and LDA, and for all combinations of options such as
UPLO and TRANS. For Level 2 BLAS timings, values of NB are used for
INCX. Certain subroutines, such as the QR factorization, treat the
values of M and N as ordered pairs and operate on M x N matrices.
Internal Parameters
===================
NMAX INTEGER
The maximum value of M or N for square matrices.
LDAMAX INTEGER
The maximum value of LDA.
NMAXB INTEGER
The maximum value of N for band matrices.
MAXVAL INTEGER
The maximum number of values that can be read in for M, N,
K, NB, or NX.
MXNLDA INTEGER
The maximum number of values that can be read in for LDA.
NIN INTEGER
The unit number for input. Currently set to 5 (std input).
NOUT INTEGER
The unit number for output. Currently set to 6 (std output).
===================================================================== */
s1 = second_();
ldr1 = 6;
ldr2 = 6;
ldr3 = 8;
s_wsfe(&io___5);
e_wsfe();
/* Read the first line. The first four characters must be 'BLAS'
for the BLAS data file format to be used. Otherwise, the LAPACK
data file format is assumed. */
s_rsfe(&io___6);
do_fio(&c__1, line, (ftnlen)80);
e_rsfe();
blas = lsamen_(&c__4, line, "BLAS");
/* Find the last non-blank and print the first line of input as the
first line of output. */
for (l = 80; l >= 1; --l) {
if (*(unsigned char *)&line[l - 1] != ' ') {
goto L20;
}
/* L10: */
}
l = 1;
L20:
s_wsfe(&io___10);
do_fio(&c__1, line, l);
e_wsfe();
s_wsfe(&io___11);
e_wsfe();
/* Read in NM and the values for M. */
s_rsle(&io___12);
do_lio(&c__3, &c__1, (char *)&nm, (ftnlen)sizeof(integer));
e_rsle();
if (nm > 6) {
s_wsfe(&io___14);
do_fio(&c__1, "M", (ftnlen)1);
do_fio(&c__1, "NM", (ftnlen)2);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
nm = 6;
}
s_rsle(&io___15);
i__1 = nm;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&mval[i__ - 1], (ftnlen)sizeof(integer));
}
e_rsle();
s_wsfe(&io___18);
do_fio(&c__1, "M: ", (ftnlen)7);
i__1 = nm;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&mval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
/* Check that M <= NMAXB for all values of M. */
mok = TRUE_;
maxm = 0;
i__1 = nm;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Computing MAX */
i__2 = mval[i__ - 1];
maxm = max(i__2,maxm);
if (mval[i__ - 1] > 5000) {
s_wsfe(&io___21);
do_fio(&c__1, "M", (ftnlen)1);
do_fio(&c__1, (char *)&mval[i__ - 1], (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__5000, (ftnlen)sizeof(integer));
e_wsfe();
mok = FALSE_;
}
/* L30: */
}
if (! mok) {
s_wsle(&io___22);
e_wsle();
}
/* Read in NN and the values for N. */
s_rsle(&io___23);
do_lio(&c__3, &c__1, (char *)&nn, (ftnlen)sizeof(integer));
e_rsle();
if (nn > 6) {
s_wsfe(&io___25);
do_fio(&c__1, "N", (ftnlen)1);
do_fio(&c__1, "NN", (ftnlen)2);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
nn = 6;
}
s_rsle(&io___26);
i__1 = nn;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
}
e_rsle();
s_wsfe(&io___28);
do_fio(&c__1, "N: ", (ftnlen)7);
i__1 = nn;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
/* Check that N <= NMAXB for all values of N. */
nok = TRUE_;
maxn = 0;
i__1 = nn;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Computing MAX */
i__2 = nval[i__ - 1];
maxn = max(i__2,maxn);
if (nval[i__ - 1] > 5000) {
s_wsfe(&io___31);
do_fio(&c__1, "N", (ftnlen)1);
do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__5000, (ftnlen)sizeof(integer));
e_wsfe();
nok = FALSE_;
}
/* L40: */
}
if (! nok) {
s_wsle(&io___32);
e_wsle();
}
/* Read in NK and the values for K. */
s_rsle(&io___33);
do_lio(&c__3, &c__1, (char *)&nk, (ftnlen)sizeof(integer));
e_rsle();
if (nk > 6) {
s_wsfe(&io___35);
do_fio(&c__1, "K", (ftnlen)1);
do_fio(&c__1, "NK", (ftnlen)2);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
nk = 6;
}
s_rsle(&io___36);
i__1 = nk;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&kval[i__ - 1], (ftnlen)sizeof(integer));
}
e_rsle();
s_wsfe(&io___38);
do_fio(&c__1, "K: ", (ftnlen)7);
i__1 = nk;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&kval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
/* Find the maximum value of K (= NRHS). */
maxk = 0;
i__1 = nk;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Computing MAX */
i__2 = kval[i__ - 1];
maxk = max(i__2,maxk);
/* L50: */
}
mkmax = maxm * max(2,maxk);
/* Read in NNB and the values for NB. For the BLAS input files,
NBVAL is used to store values for INCX and INCY. */
s_rsle(&io___41);
do_lio(&c__3, &c__1, (char *)&nnb, (ftnlen)sizeof(integer));
e_rsle();
if (nnb > 6) {
s_wsfe(&io___43);
do_fio(&c__1, "NB", (ftnlen)2);
do_fio(&c__1, "NNB", (ftnlen)3);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
nnb = 6;
}
s_rsle(&io___44);
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&nbval[i__ - 1], (ftnlen)sizeof(integer))
;
}
e_rsle();
/* Find the maximum value of NB. */
maxnb = 0;
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Computing MAX */
i__2 = nbval[i__ - 1];
maxnb = max(i__2,maxnb);
/* L60: */
}
if (blas) {
s_wsfe(&io___47);
do_fio(&c__1, "INCX: ", (ftnlen)7);
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&nbval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
nxval[i__ - 1] = 0;
/* L70: */
}
} else {
/* LAPACK data files: Read in the values for NX. */
s_rsle(&io___49);
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&nxval[i__ - 1], (ftnlen)sizeof(
integer));
}
e_rsle();
s_wsfe(&io___50);
do_fio(&c__1, "NB: ", (ftnlen)7);
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&nbval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
s_wsfe(&io___51);
do_fio(&c__1, "NX: ", (ftnlen)7);
i__1 = nnb;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&nxval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
}
/* Read in NLDA and the values for LDA. */
s_rsle(&io___52);
do_lio(&c__3, &c__1, (char *)&nlda, (ftnlen)sizeof(integer));
e_rsle();
if (nlda > 4) {
s_wsfe(&io___54);
do_fio(&c__1, "LDA", (ftnlen)3);
do_fio(&c__1, "NLDA", (ftnlen)4);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
nlda = 4;
}
s_rsle(&io___55);
i__1 = nlda;
for (i__ = 1; i__ <= i__1; ++i__) {
do_lio(&c__3, &c__1, (char *)&ldaval[i__ - 1], (ftnlen)sizeof(integer)
);
}
e_rsle();
s_wsfe(&io___57);
do_fio(&c__1, "LDA: ", (ftnlen)7);
i__1 = nlda;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&ldaval[i__ - 1], (ftnlen)sizeof(integer));
}
e_wsfe();
/* Check that LDA >= 1 for all values of LDA. */
ldaok = TRUE_;
maxlda = 0;
i__1 = nlda;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Computing MAX */
i__2 = ldaval[i__ - 1];
maxlda = max(i__2,maxlda);
if (ldaval[i__ - 1] <= 0) {
s_wsfe(&io___60);
do_fio(&c__1, (char *)&ldaval[i__ - 1], (ftnlen)sizeof(integer));
e_wsfe();
ldaok = FALSE_;
}
/* L80: */
}
if (! ldaok) {
s_wsle(&io___61);
e_wsle();
}
/* Check that MAXLDA*MAXN <= LA (for the dense routines). */
ldanok = TRUE_;
need = maxlda * maxn;
if (need > 272384) {
s_wsfe(&io___64);
do_fio(&c__1, (char *)&maxlda, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&maxn, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&need, (ftnlen)sizeof(integer));
e_wsfe();
ldanok = FALSE_;
}
/* Check that MAXLDA*MAXM + MAXM*MAXK <= 3*LA (for band routines). */
ldamok = TRUE_;
need = maxlda * maxm + maxm * maxk;
if (need > 817152) {
need = (need + 2) / 3;
s_wsfe(&io___66);
do_fio(&c__1, (char *)&maxlda, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&maxm, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&maxk, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&need, (ftnlen)sizeof(integer));
e_wsfe();
ldamok = FALSE_;
}
/* Check that MAXN*MAXNB (or MAXN*INCX) <= LA. */
nxnbok = TRUE_;
need = maxn * maxnb;
if (need > 272384) {
s_wsfe(&io___68);
do_fio(&c__1, (char *)&maxn, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&maxnb, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&need, (ftnlen)sizeof(integer));
e_wsfe();
nxnbok = FALSE_;
}
if (! (mok && nok && ldaok && ldanok && nxnbok)) {
s_wsfe(&io___69);
e_wsfe();
goto L110;
}
if (! ldamok) {
s_wsle(&io___70);
e_wsle();
}
/* Read the minimum time to time a subroutine. */
s_wsle(&io___71);
e_wsle();
s_rsle(&io___72);
do_lio(&c__4, &c__1, (char *)&timmin, (ftnlen)sizeof(real));
e_rsle();
s_wsfe(&io___74);
do_fio(&c__1, (char *)&timmin, (ftnlen)sizeof(real));
e_wsfe();
s_wsle(&io___75);
e_wsle();
/* Read the first input line. */
i__1 = s_rsfe(&io___76);
if (i__1 != 0) {
goto L100;
}
i__1 = do_fio(&c__1, line, (ftnlen)80);
if (i__1 != 0) {
goto L100;
}
i__1 = e_rsfe();
if (i__1 != 0) {
goto L100;
}
/* If the first record is the special signal 'NONE', then get the
next line but don't time SGEMV and SGEMM. */
if (lsamen_(&c__4, line, "NONE")) {
i__1 = s_rsfe(&io___77);
if (i__1 != 0) {
goto L100;
}
i__1 = do_fio(&c__1, line, (ftnlen)80);
if (i__1 != 0) {
goto L100;
}
i__1 = e_rsfe();
if (i__1 != 0) {
goto L100;
}
} else {
s_wsfe(&io___78);
e_wsfe();
/* If the first record is the special signal 'BAND', then time
the band routine SGBMV and SGEMM with N = K. */
if (lsamen_(&c__4, line, "BAND")) {
if (ldamok) {
if (mkmax > 272384) {
i2 = 544768 - mkmax + 1;
j2 = 2;
} else {
i2 = 272384 - mkmax + 1;
j2 = 3;
}
i__1 = mkmax / 2;
stimmv_("SGBMV ", &nm, mval, &nn, nval, &nlda, ldaval, &
timmin, &a_ref(1, 1), &i__1, &a_ref(i2, j2), &a_ref(
272384 - mkmax / 2 + 1, 3), reslts, &ldr1, &ldr2, &
c__6, (ftnlen)6);
} else {
s_wsfe(&io___83);
do_fio(&c__1, "SGBMV ", (ftnlen)6);
e_wsfe();
}
stimmm_("SGEMM ", "K", &nn, nval, &nlda, ldaval, &timmin, &a_ref(
1, 1), &a_ref(1, 2), &a_ref(1, 3), reslts, &ldr1, &ldr2, &
c__6, (ftnlen)6, (ftnlen)1);
i__1 = s_rsfe(&io___84);
if (i__1 != 0) {
goto L100;
}
i__1 = do_fio(&c__1, line, (ftnlen)80);
if (i__1 != 0) {
goto L100;
}
i__1 = e_rsfe();
if (i__1 != 0) {
goto L100;
}
} else {
/* Otherwise time SGEMV and SGEMM. */
stimmv_("SGEMV ", &nn, nval, &nnb, nbval, &nlda, ldaval, &timmin,
&a_ref(1, 1), &c_b172, &a_ref(1, 2), &a_ref(1, 3), reslts,
&ldr1, &ldr2, &c__6, (ftnlen)6);
stimmm_("SGEMM ", "N", &nn, nval, &nlda, ldaval, &timmin, &a_ref(
1, 1), &a_ref(1, 2), &a_ref(1, 3), reslts, &ldr1, &ldr2, &
c__6, (ftnlen)6, (ftnlen)1);
}
}
/* Call the appropriate timing routine for each input line. */
s_wsfe(&io___85);
e_wsfe();
L90:
*(unsigned char *)c1 = *(unsigned char *)line;
s_copy(c2, line + 1, (ftnlen)2, (ftnlen)2);
s_copy(c3, line + 3, (ftnlen)3, (ftnlen)3);
/* Check first character for correct precision. */
if (! lsame_(c1, "Single precision")) {
s_wsfe(&io___89);
do_fio(&c__1, line, (ftnlen)6);
e_wsfe();
} else if (lsamen_(&c__2, c2, "B2") || lsamen_(&
c__3, c3, "MV ") || lsamen_(&c__3, c3,
"SV ") || lsamen_(&c__3, c3, "R ") || lsamen_(&c__3, c3, "RC ")
|| lsamen_(&c__3, c3, "RU ") || lsamen_(&
c__3, c3, "R2 ")) {
/* Level 2 BLAS */
stimb2_(line, &nm, mval, &nn, nval, &nk, kval, &nnb, nbval, &nlda,
ldaval, &c_b172, &timmin, &a_ref(1, 1), &a_ref(1, 2), &a_ref(
1, 3), reslts, &ldr1, &ldr2, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "B3") || lsamen_(&
c__3, c3, "MM ") || lsamen_(&c__3, c3,
"SM ") || lsamen_(&c__3, c3, "RK ") || lsamen_(&c__3, c3, "R2K"))
{
/* Level 3 BLAS */
stimb3_(line, &nm, mval, &nn, nval, &nk, kval, &nlda, ldaval, &timmin,
&a_ref(1, 1), &a_ref(1, 2), &a_ref(1, 3), reslts, &ldr1, &
ldr2, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "QR") || lsamen_(&
c__2, c3, "QR") || lsamen_(&c__2, c3 + 1,
"QR")) {
/* QR routines */
stimqr_(line, &nn, mval, nval, &nk, kval, &nnb, nbval, nxval, &nlda,
ldaval, &timmin, &a_ref(1, 1), d__, &a_ref(1, 2), &a_ref(1, 3)
, reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "LQ") || lsamen_(&
c__2, c3, "LQ") || lsamen_(&c__2, c3 + 1,
"LQ")) {
/* LQ routines */
stimlq_(line, &nn, mval, nval, &nk, kval, &nnb, nbval, nxval, &nlda,
ldaval, &timmin, &a_ref(1, 1), d__, &a_ref(1, 2), &a_ref(1, 3)
, reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "QL") || lsamen_(&
c__2, c3, "QL") || lsamen_(&c__2, c3 + 1,
"QL")) {
/* QL routines */
stimql_(line, &nn, mval, nval, &nk, kval, &nnb, nbval, nxval, &nlda,
ldaval, &timmin, &a_ref(1, 1), d__, &a_ref(1, 2), &a_ref(1, 3)
, reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "RQ") || lsamen_(&
c__2, c3, "RQ") || lsamen_(&c__2, c3 + 1,
"RQ")) {
/* RQ routines */
stimrq_(line, &nn, mval, nval, &nk, kval, &nnb, nbval, nxval, &nlda,
ldaval, &timmin, &a_ref(1, 1), d__, &a_ref(1, 2), &a_ref(1, 3)
, reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "QP") || lsamen_(&
c__3, c3, "QPF")) {
/* QR with column pivoting */
stimqp_(line, &nm, mval, nval, &nlda, ldaval, &timmin, &a_ref(1, 1), &
a_ref(1, 2), &d___ref(1, 1), &a_ref(1, 3), iwork, reslts, &
ldr1, &ldr2, &c__6, (ftnlen)80);
/* Blas-3 QR with column pivoting */
stimq3_(line, &nm, mval, nval, &nnb, nbval, nxval, &nlda, ldaval, &
timmin, &a_ref(1, 1), &a_ref(1, 2), &d___ref(1, 1), &a_ref(1,
3), iwork, reslts, &ldr1, &ldr2, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "HR") || lsamen_(&
c__3, c3, "HRD") || lsamen_(&c__2, c3 + 1,
"HR")) {
/* Reduction to Hessenberg form */
stimhr_(line, &nn, nval, &nk, kval, &nnb, nbval, nxval, &nlda, ldaval,
&timmin, &a_ref(1, 1), d__, &a_ref(1, 2), &a_ref(1, 3),
reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "TD") || lsamen_(&
c__3, c3, "TRD") || lsamen_(&c__2, c3 + 1,
"TR")) {
/* Reduction to tridiagonal form */
stimtd_(line, &nn, nval, &nk, kval, &nnb, nbval, nxval, &nlda, ldaval,
&timmin, &a_ref(1, 1), &a_ref(1, 2), &d___ref(1, 1), &
d___ref(1, 2), &a_ref(1, 3), reslts, &ldr1, &ldr2, &ldr3, &
c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "BR") || lsamen_(&
c__3, c3, "BRD") || lsamen_(&c__2, c3 + 1,
"BR")) {
/* Reduction to bidiagonal form */
stimbr_(line, &nn, mval, nval, &nk, kval, &nnb, nbval, nxval, &nlda,
ldaval, &timmin, &a_ref(1, 1), &a_ref(1, 2), &d___ref(1, 1), &
d___ref(1, 2), &a_ref(1, 3), reslts, &ldr1, &ldr2, &ldr3, &
c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "GE")) {
/* Routines for general matrices */
stimge_(line, &nn, nval, &nk, kval, &nnb, nbval, &nlda, ldaval, &
timmin, &a_ref(1, 1), &a_ref(1, 2), &a_ref(1, 3), iwork,
reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "GB")) {
/* General band matrices */
if (ldamok) {
stimgb_(line, &nm, mval, &nn, nval, &nk, kval, &nnb, nbval, &nlda,
ldaval, &timmin, &a_ref(1, 1), &a_ref(272384 - mkmax + 1,
3), iwork, reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)
80);
} else {
s_wsfe(&io___92);
do_fio(&c__1, line, (ftnlen)6);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "GT")) {
/* Routines for general tridiagonal matrices */
stimgt_(line, &nn, nval, &nk, kval, &nlda, ldaval, &timmin, &a_ref(1,
1), &a_ref(1, 2), iwork, reslts, &ldr1, &ldr2, &ldr3, &c__6, (
ftnlen)80);
} else if (lsamen_(&c__2, c2, "PO")) {
/* Positive definite matrices */
stimpo_(line, &nn, nval, &nk, kval, &nnb, nbval, &nlda, ldaval, &
timmin, &a_ref(1, 1), &a_ref(1, 2), iwork, reslts, &ldr1, &
ldr2, &ldr3, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "PP")) {
/* Positive definite packed matrices */
stimpp_(line, &nn, nval, &nk, kval, &c_b172, &timmin, &a_ref(1, 1), &
a_ref(1, 2), iwork, reslts, &ldr1, &ldr2, &ldr3, &c__6, (
ftnlen)80);
} else if (lsamen_(&c__2, c2, "PB")) {
/* Positive definite banded matrices */
if (ldamok) {
if (mkmax > 272384) {
j2 = 2;
i2 = 544768 - mkmax + 1;
} else {
j2 = 3;
i2 = 272384 - mkmax + 1;
}
stimpb_(line, &nm, mval, &nn, nval, &nk, kval, &nnb, nbval, &nlda,
ldaval, &timmin, &a_ref(1, 1), &a_ref(i2, j2), iwork,
reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)80);
} else {
s_wsfe(&io___93);
do_fio(&c__1, line, (ftnlen)6);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "PT")) {
/* Routines for positive definite tridiagonal matrices */
stimpt_(line, &nn, nval, &nk, kval, &nlda, ldaval, &timmin, &a_ref(1,
1), &a_ref(1, 2), reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)
80);
} else if (lsamen_(&c__2, c2, "SY")) {
/* Symmetric indefinite matrices */
stimsy_(line, &nn, nval, &nk, kval, &nnb, nbval, &nlda, ldaval, &
timmin, &a_ref(1, 1), &a_ref(1, 2), &a_ref(1, 3), iwork,
reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "SP")) {
/* Symmetric indefinite packed matrices */
stimsp_(line, &nn, nval, &nk, kval, &c_b172, &timmin, &a_ref(1, 1), &
a_ref(1, 2), &a_ref(1, 3), iwork, reslts, &ldr1, &ldr2, &ldr3,
&c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "TR")) {
/* Triangular matrices */
stimtr_(line, &nn, nval, &nk, kval, &nnb, nbval, &nlda, ldaval, &
timmin, &a_ref(1, 1), &a_ref(1, 2), reslts, &ldr1, &ldr2, &
ldr3, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "TP")) {
/* Triangular packed matrices */
stimtp_(line, &nn, nval, &nk, kval, &c_b172, &timmin, &a_ref(1, 1), &
a_ref(1, 2), reslts, &ldr1, &ldr2, &ldr3, &c__6, (ftnlen)80);
} else if (lsamen_(&c__2, c2, "TB")) {
/* Triangular band matrices */
if (ldamok) {
if (mkmax > 272384) {
j2 = 2;
i2 = 544768 - mkmax + 1;
} else {
j2 = 3;
i2 = 272384 - mkmax + 1;
}
stimtb_(line, &nm, mval, &nn, nval, &nk, kval, &nlda, ldaval, &
timmin, &a_ref(1, 1), &a_ref(i2, j2), reslts, &ldr1, &
ldr2, &ldr3, &c__6, (ftnlen)80);
} else {
s_wsfe(&io___94);
do_fio(&c__1, line, (ftnlen)6);
e_wsfe();
}
} else if (lsamen_(&c__2, c2, "LS")) {
/* Least squares drivers */
stimls_(line, &nm, mval, &nn, nval, &nk, kval, &nnb, nbval, nxval, &
nlda, ldaval, &timmin, &a_ref(1, 1), &a_ref(1, 2), &b_ref(1,
1), &b_ref(1, 2), s, &s[512], opctbl, timtbl, flptbl, work,
iwork, &c__6, (ftnlen)80);
} else {
s_wsfe(&io___101);
do_fio(&c__1, line, (ftnlen)6);
e_wsfe();
}
/* Read the next line of the input file. */
i__1 = s_rsfe(&io___102);
if (i__1 != 0) {
goto L100;
}
i__1 = do_fio(&c__1, line, (ftnlen)80);
if (i__1 != 0) {
goto L100;
}
i__1 = e_rsfe();
if (i__1 != 0) {
goto L100;
}
goto L90;
/* Branch to this line when the last record is read. */
L100:
s2 = second_();
s_wsfe(&io___104);
e_wsfe();
s_wsfe(&io___105);
r__1 = s2 - s1;
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
e_wsfe();
L110:
/* End of STIMAA */
return 0;
} /* MAIN__ */
/* 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 derrtz_(char *path, integer *nunit)
{
/* Local variables */
doublereal a[4] /* was [2][2] */, w[2];
char c2[2];
doublereal tau[2];
integer info;
/* 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 */
/* ======= */
/* DERRTZ tests the error exits for DTZRQF and STZRZF. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name for the routines to be tested. */
/* NUNIT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
a[0] = 1.;
a[2] = 2.;
a[3] = 3.;
a[1] = 4.;
w[0] = 0.;
w[1] = 0.;
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "TZ")) {
/* Test error exits for the trapezoidal routines. */
/* DTZRQF */
s_copy(srnamc_1.srnamt, "DTZRQF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
dtzrqf_(&c_n1, &c__0, a, &c__1, tau, &info);
chkxer_("DTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dtzrqf_(&c__1, &c__0, a, &c__1, tau, &info);
chkxer_("DTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dtzrqf_(&c__2, &c__2, a, &c__1, tau, &info);
chkxer_("DTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DTZRZF */
s_copy(srnamc_1.srnamt, "DTZRZF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
dtzrzf_(&c_n1, &c__0, a, &c__1, tau, w, &c__1, &info);
chkxer_("DTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dtzrzf_(&c__1, &c__0, a, &c__1, tau, w, &c__1, &info);
chkxer_("DTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dtzrzf_(&c__2, &c__2, a, &c__1, tau, w, &c__1, &info);
chkxer_("DTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
dtzrzf_(&c__2, &c__2, a, &c__2, tau, w, &c__1, &info);
chkxer_("DTZRZF", &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 DERRTZ */
} /* derrtz_ */
/* Subroutine */ int slatb4_(char *path, integer *imat, integer *m, integer *
n, char *type, integer *kl, integer *ku, real *anorm, integer *mode,
real *cndnum, char *dist)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static real badc1, badc2, large, small;
static char c2[2];
extern /* Subroutine */ int slabad_(real *, real *);
extern doublereal slamch_(char *);
extern logical lsamen_(integer *, char *, char *);
static integer mat;
static real eps;
/* -- LAPACK test routine (version 2.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
February 29, 1992
Purpose
=======
SLATB4 sets parameters for the matrix generator based on the type of
matrix to be generated.
Arguments
=========
PATH (input) CHARACTER*3
The LAPACK path name.
IMAT (input) INTEGER
An integer key describing which matrix to generate for this
path.
M (input) INTEGER
The number of rows in the matrix to be generated.
N (input) INTEGER
The number of columns in the matrix to be generated.
TYPE (output) CHARACTER*1
The type of the matrix to be generated:
= 'S': symmetric matrix
= 'P': symmetric positive (semi)definite matrix
= 'N': nonsymmetric matrix
KL (output) INTEGER
The lower band width of the matrix to be generated.
KU (output) INTEGER
The upper band width of the matrix to be generated.
ANORM (output) REAL
The desired norm of the matrix to be generated. The diagonal
matrix of singular values or eigenvalues is scaled by this
value.
MODE (output) INTEGER
A key indicating how to choose the vector of eigenvalues.
CNDNUM (output) REAL
The desired condition number.
DIST (output) CHARACTER*1
The type of distribution to be used by the random number
generator.
=====================================================================
Set some constants for use in the subroutine. */
if (first) {
first = FALSE_;
eps = slamch_("Precision");
badc2 = .1f / eps;
badc1 = sqrt(badc2);
small = slamch_("Safe minimum");
large = 1.f / small;
/* If it looks like we're on a Cray, take the square root of
SMALL and LARGE to avoid overflow and underflow problems. */
slabad_(&small, &large);
small = small / eps * .25f;
large = 1.f / small;
}
strncpy(c2, path + 1, 2);
/* Set some parameters we don't plan to change. */
*(unsigned char *)dist = 'S';
*mode = 3;
if (lsamen_(&c__2, c2, "QR") || lsamen_(&c__2, c2, "LQ")
|| lsamen_(&c__2, c2, "QL") || lsamen_(&c__2, c2, "RQ")) {
/* xQR, xLQ, xQL, xRQ: Set parameters to generate a general
M x N matrix.
Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type = 'N';
/* Set the lower and upper bandwidths. */
if (*imat == 1) {
*kl = 0;
*ku = 0;
} else if (*imat == 2) {
*kl = 0;
/* Computing MAX */
i__1 = *n - 1;
*ku = max(i__1,0);
} else if (*imat == 3) {
/* Computing MAX */
i__1 = *m - 1;
*kl = max(i__1,0);
*ku = 0;
} else {
/* Computing MAX */
i__1 = *m - 1;
*kl = max(i__1,0);
/* Computing MAX */
i__1 = *n - 1;
*ku = max(i__1,0);
}
/* Set the condition number and norm. */
if (*imat == 5) {
*cndnum = badc1;
} else if (*imat == 6) {
*cndnum = badc2;
} else {
*cndnum = 2.f;
}
if (*imat == 7) {
*anorm = small;
} else if (*imat == 8) {
*anorm = large;
} else {
*anorm = 1.f;
}
} else if (lsamen_(&c__2, c2, "GE")) {
/* xGE: Set parameters to generate a general M x N matrix.
Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type = 'N';
/* Set the lower and upper bandwidths. */
if (*imat == 1) {
*kl = 0;
*ku = 0;
} else if (*imat == 2) {
*kl = 0;
/* Computing MAX */
i__1 = *n - 1;
*ku = max(i__1,0);
} else if (*imat == 3) {
/* Computing MAX */
i__1 = *m - 1;
*kl = max(i__1,0);
*ku = 0;
} else {
/* Computing MAX */
i__1 = *m - 1;
*kl = max(i__1,0);
/* Computing MAX */
i__1 = *n - 1;
*ku = max(i__1,0);
}
/* Set the condition number and norm. */
if (*imat == 8) {
*cndnum = badc1;
} else if (*imat == 9) {
*cndnum = badc2;
} else {
*cndnum = 2.f;
}
if (*imat == 10) {
*anorm = small;
} else if (*imat == 11) {
*anorm = large;
} else {
*anorm = 1.f;
}
} else if (lsamen_(&c__2, c2, "GB")) {
/* xGB: Set parameters to generate a general banded matrix.
Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type = 'N';
/* Set the condition number and norm. */
if (*imat == 5) {
*cndnum = badc1;
} else if (*imat == 6) {
*cndnum = badc2 * .1f;
} else {
*cndnum = 2.f;
}
if (*imat == 7) {
*anorm = small;
} else if (*imat == 8) {
*anorm = large;
} else {
*anorm = 1.f;
}
} else if (lsamen_(&c__2, c2, "GT")) {
/* xGT: Set parameters to generate a general tridiagonal matri
x.
Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type = 'N';
/* Set the lower and upper bandwidths. */
if (*imat == 1) {
*kl = 0;
} else {
*kl = 1;
}
*ku = *kl;
/* Set the condition number and norm. */
if (*imat == 3) {
*cndnum = badc1;
} else if (*imat == 4) {
*cndnum = badc2;
} else {
*cndnum = 2.f;
}
if (*imat == 5 || *imat == 11) {
*anorm = small;
} else if (*imat == 6 || *imat == 12) {
*anorm = large;
} else {
*anorm = 1.f;
}
} else if (lsamen_(&c__2, c2, "PO") || lsamen_(&c__2, c2, "PP") || lsamen_(&c__2, c2, "SY") || lsamen_(&c__2, c2,
"SP")) {
/* xPO, xPP, xSY, xSP: Set parameters to generate a
symmetric matrix.
Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type = *(unsigned char *)c2;
/* Set the lower and upper bandwidths. */
if (*imat == 1) {
*kl = 0;
} else {
/* Computing MAX */
i__1 = *n - 1;
*kl = max(i__1,0);
}
*ku = *kl;
/* Set the condition number and norm. */
if (*imat == 6) {
*cndnum = badc1;
} else if (*imat == 7) {
*cndnum = badc2;
} else {
*cndnum = 2.f;
}
if (*imat == 8) {
*anorm = small;
} else if (*imat == 9) {
*anorm = large;
} else {
*anorm = 1.f;
}
} else if (lsamen_(&c__2, c2, "PB")) {
/* xPB: Set parameters to generate a symmetric band matrix.
Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type = 'P';
/* Set the norm and condition number. */
if (*imat == 5) {
*cndnum = badc1;
} else if (*imat == 6) {
*cndnum = badc2;
} else {
*cndnum = 2.f;
}
if (*imat == 7) {
*anorm = small;
} else if (*imat == 8) {
*anorm = large;
} else {
*anorm = 1.f;
}
} else if (lsamen_(&c__2, c2, "PT")) {
/* xPT: Set parameters to generate a symmetric positive defini
te
tridiagonal matrix. */
*(unsigned char *)type = 'P';
if (*imat == 1) {
*kl = 0;
} else {
*kl = 1;
}
*ku = *kl;
/* Set the condition number and norm. */
if (*imat == 3) {
*cndnum = badc1;
} else if (*imat == 4) {
*cndnum = badc2;
} else {
*cndnum = 2.f;
}
if (*imat == 5 || *imat == 11) {
*anorm = small;
} else if (*imat == 6 || *imat == 12) {
*anorm = large;
} else {
*anorm = 1.f;
}
} else if (lsamen_(&c__2, c2, "TR") || lsamen_(&c__2, c2, "TP")) {
/* xTR, xTP: Set parameters to generate a triangular matrix
Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type = 'N';
/* Set the lower and upper bandwidths. */
mat = abs(*imat);
if (mat == 1 || mat == 7) {
*kl = 0;
*ku = 0;
} else if (*imat < 0) {
/* Computing MAX */
i__1 = *n - 1;
*kl = max(i__1,0);
*ku = 0;
} else {
*kl = 0;
/* Computing MAX */
i__1 = *n - 1;
*ku = max(i__1,0);
}
/* Set the condition number and norm. */
if (mat == 3 || mat == 9) {
*cndnum = badc1;
} else if (mat == 4) {
*cndnum = badc2;
} else if (mat == 10) {
*cndnum = badc2;
} else {
*cndnum = 2.f;
}
if (mat == 5) {
*anorm = small;
} else if (mat == 6) {
*anorm = large;
} else {
*anorm = 1.f;
}
} else if (lsamen_(&c__2, c2, "TB")) {
/* xTB: Set parameters to generate a triangular band matrix.
Set TYPE, the type of matrix to be generated. */
*(unsigned char *)type = 'N';
/* Set the norm and condition number. */
if (*imat == 2 || *imat == 8) {
*cndnum = badc1;
} else if (*imat == 3 || *imat == 9) {
*cndnum = badc2;
} else {
*cndnum = 2.f;
}
if (*imat == 4) {
*anorm = small;
} else if (*imat == 5) {
*anorm = large;
} else {
*anorm = 1.f;
}
}
if (*n <= 1) {
*cndnum = 1.f;
}
return 0;
/* End of SLATB4 */
} /* slatb4_ */
/* Subroutine */ int cebchvxx_(real *thresh, char *path)
{
/* Format strings */
static char fmt_8000[] = "(\002 C\002,a2,\002SVXX: N =\002,i2,\002, INFO"
" = \002,i3,\002, ORCOND = \002,g12.5,\002, real RCOND = \002,g12"
".5)";
static char fmt_9996[] = "(3x,i2,\002: Normwise guaranteed forward erro"
"r\002,/5x,\002Guaranteed case: if norm ( abs( Xc - Xt )\002,\002"
" / norm ( Xt ) .LE. ERRBND( *, nwise_i, bnd_i ), then\002,/5x"
",\002ERRBND( *, nwise_i, bnd_i ) .LE. MAX(SQRT(N), 10) * EPS\002)"
;
static char fmt_9995[] = "(3x,i2,\002: Componentwise guaranteed forward "
"error\002)";
static char fmt_9994[] = "(3x,i2,\002: Backwards error\002)";
static char fmt_9993[] = "(3x,i2,\002: Reciprocal condition number\002)";
static char fmt_9992[] = "(3x,i2,\002: Reciprocal normwise condition num"
"ber\002)";
static char fmt_9991[] = "(3x,i2,\002: Raw normwise error estimate\002)";
static char fmt_9990[] = "(3x,i2,\002: Reciprocal componentwise conditio"
"n number\002)";
static char fmt_9989[] = "(3x,i2,\002: Raw componentwise error estimat"
"e\002)";
static char fmt_9999[] = "(\002 C\002,a2,\002SVXX: N =\002,i2,\002, RHS "
"= \002,i2,\002, NWISE GUAR. = \002,a,\002, CWISE GUAR. = \002,a"
",\002 test(\002,i1,\002) =\002,g12.5)";
static char fmt_9998[] = "(\002 C\002,a2,\002SVXX: \002,i6,\002 out of"
" \002,i6,\002 tests failed to pass the threshold\002)";
static char fmt_9997[] = "(\002 C\002,a2,\002SVXX passed the tests of er"
"ror bounds\002)";
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5, i__6;
real r__1, r__2, r__3, r__4, r__5;
complex q__1, q__2, q__3;
/* Local variables */
real errbnd_c__[18], errbnd_n__[18];
complex a[36] /* was [6][6] */, b[36] /* was [6][6] */;
real c__[6];
integer i__, j, k;
real m;
integer n;
real r__[6], s[6];
complex x[36] /* was [6][6] */;
real cwise_bnd__;
char c2[2];
real nwise_bnd__, cwise_err__, nwise_err__, errthresh;
complex ab[66] /* was [11][6] */, af[36] /* was [6][6] */;
integer kl, ku;
real condthresh;
complex afb[96] /* was [16][6] */;
integer lda;
real eps, cwise_rcond__, nwise_rcond__;
integer n_aux_tests__, ldab;
real diff[36] /* was [6][6] */;
char fact[1];
real berr[6];
integer info, ipiv[6], nrhs;
real rinv[6];
char uplo[1];
complex work[90];
real sumr;
integer ldafb;
real ccond;
integer nfail;
char cguar[3];
real ncond;
char equed[1];
real rcond;
complex acopy[36] /* was [6][6] */;
char nguar[3], trans[1];
real rnorm, normt, sumri, rwork[18];
logical printed_guide__;
complex abcopy[66] /* was [11][6] */;
real params[2], orcond, rinorm, tstrat[6], rpvgrw;
complex invhilb[36] /* was [6][6] */;
real normdif;
/* Fortran I/O blocks */
static cilist io___42 = { 0, 6, 0, fmt_8000, 0 };
static cilist io___66 = { 0, 6, 0, 0, 0 };
static cilist io___67 = { 0, 6, 0, fmt_9996, 0 };
static cilist io___68 = { 0, 6, 0, fmt_9995, 0 };
static cilist io___69 = { 0, 6, 0, fmt_9994, 0 };
static cilist io___70 = { 0, 6, 0, fmt_9993, 0 };
static cilist io___71 = { 0, 6, 0, fmt_9992, 0 };
static cilist io___72 = { 0, 6, 0, fmt_9991, 0 };
static cilist io___73 = { 0, 6, 0, fmt_9990, 0 };
static cilist io___74 = { 0, 6, 0, fmt_9989, 0 };
static cilist io___75 = { 0, 6, 0, 0, 0 };
static cilist io___76 = { 0, 6, 0, fmt_9999, 0 };
static cilist io___77 = { 0, 6, 0, 0, 0 };
static cilist io___78 = { 0, 6, 0, fmt_9998, 0 };
static cilist io___79 = { 0, 6, 0, fmt_9997, 0 };
/* .. Scalar Arguments .. */
/* Purpose */
/* ====== */
/* CEBCHVXX will run CGESVXX on a series of Hilbert matrices and then */
/* compare the error bounds returned by CGESVXX to see if the returned */
/* answer indeed falls within those bounds. */
/* Eight test ratios will be computed. The tests will pass if they are .LT. */
/* THRESH. There are two cases that are determined by 1 / (SQRT( N ) * EPS). */
/* If that value is .LE. to the component wise reciprocal condition number, */
/* it uses the guaranteed case, other wise it uses the unguaranteed case. */
/* Test ratios: */
/* Let Xc be X_computed and Xt be X_truth. */
/* The norm used is the infinity norm. */
/* Let A be the guaranteed case and B be the unguaranteed case. */
/* 1. Normwise guaranteed forward error bound. */
/* A: norm ( abs( Xc - Xt ) / norm ( Xt ) .LE. ERRBND( *, nwise_i, bnd_i ) and */
/* ERRBND( *, nwise_i, bnd_i ) .LE. MAX(SQRT(N),10) * EPS. */
/* If these conditions are met, the test ratio is set to be */
/* ERRBND( *, nwise_i, bnd_i ) / MAX(SQRT(N), 10). Otherwise it is 1/EPS. */
/* B: For this case, CGESVXX should just return 1. If it is less than */
/* one, treat it the same as in 1A. Otherwise it fails. (Set test */
/* ratio to ERRBND( *, nwise_i, bnd_i ) * THRESH?) */
/* 2. Componentwise guaranteed forward error bound. */
/* A: norm ( abs( Xc(j) - Xt(j) ) ) / norm (Xt(j)) .LE. ERRBND( *, cwise_i, bnd_i ) */
/* for all j .AND. ERRBND( *, cwise_i, bnd_i ) .LE. MAX(SQRT(N), 10) * EPS. */
/* If these conditions are met, the test ratio is set to be */
/* ERRBND( *, cwise_i, bnd_i ) / MAX(SQRT(N), 10). Otherwise it is 1/EPS. */
/* B: Same as normwise test ratio. */
/* 3. Backwards error. */
/* A: The test ratio is set to BERR/EPS. */
/* B: Same test ratio. */
/* 4. Reciprocal condition number. */
/* A: A condition number is computed with Xt and compared with the one */
/* returned from CGESVXX. Let RCONDc be the RCOND returned by CGESVXX */
/* and RCONDt be the RCOND from the truth value. Test ratio is set to */
/* MAX(RCONDc/RCONDt, RCONDt/RCONDc). */
/* B: Test ratio is set to 1 / (EPS * RCONDc). */
/* 5. Reciprocal normwise condition number. */
/* A: The test ratio is set to */
/* MAX(ERRBND( *, nwise_i, cond_i ) / NCOND, NCOND / ERRBND( *, nwise_i, cond_i )). */
/* B: Test ratio is set to 1 / (EPS * ERRBND( *, nwise_i, cond_i )). */
/* 6. Reciprocal componentwise condition number. */
/* A: Test ratio is set to */
/* MAX(ERRBND( *, cwise_i, cond_i ) / CCOND, CCOND / ERRBND( *, cwise_i, cond_i )). */
/* B: Test ratio is set to 1 / (EPS * ERRBND( *, cwise_i, cond_i )). */
/* .. Parameters .. */
/* NMAX is determined by the largest number in the inverse of the hilbert */
/* matrix. Precision is exhausted when the largest entry in it is greater */
/* than 2 to the power of the number of bits in the fraction of the data */
/* type used plus one, which is 24 for single precision. */
/* NMAX should be 6 for single and 11 for double. */
/* .. Local Scalars .. */
/* .. Local Arrays .. */
/* .. External Functions .. */
/* .. External Subroutines .. */
/* .. Intrinsic Functions .. */
/* .. Statement Functions .. */
/* .. */
/* .. Statement Function Definitions .. */
/* .. Parameters .. */
/* Create the loop to test out the Hilbert matrices */
*(unsigned char *)fact = 'E';
*(unsigned char *)uplo = 'U';
*(unsigned char *)trans = 'N';
*(unsigned char *)equed = 'N';
eps = slamch_("Epsilon");
nfail = 0;
n_aux_tests__ = 0;
lda = 6;
ldab = 11;
ldafb = 16;
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Main loop to test the different Hilbert Matrices. */
printed_guide__ = FALSE_;
for (n = 1; n <= 6; ++n) {
params[0] = -1.f;
params[1] = -1.f;
kl = n - 1;
ku = n - 1;
nrhs = n;
/* Computing MAX */
r__1 = sqrt((real) n);
m = dmax(r__1,10.f);
/* Generate the Hilbert matrix, its inverse, and the */
/* right hand side, all scaled by the LCM(1,..,2N-1). */
clahilb_(&n, &n, a, &lda, invhilb, &lda, b, &lda, work, &info, path);
/* Copy A into ACOPY. */
clacpy_("ALL", &n, &n, a, &c__6, acopy, &c__6);
/* Store A in band format for GB tests */
i__1 = n;
for (j = 1; j <= i__1; ++j) {
i__2 = kl + ku + 1;
for (i__ = 1; i__ <= i__2; ++i__) {
i__3 = i__ + j * 11 - 12;
ab[i__3].r = 0.f, ab[i__3].i = 0.f;
}
}
i__1 = n;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
i__2 = 1, i__3 = j - ku;
/* Computing MIN */
i__5 = n, i__6 = j + kl;
i__4 = min(i__5,i__6);
for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
i__2 = ku + 1 + i__ - j + j * 11 - 12;
i__3 = i__ + j * 6 - 7;
ab[i__2].r = a[i__3].r, ab[i__2].i = a[i__3].i;
}
}
/* Copy AB into ABCOPY. */
i__1 = n;
for (j = 1; j <= i__1; ++j) {
i__4 = kl + ku + 1;
for (i__ = 1; i__ <= i__4; ++i__) {
i__2 = i__ + j * 11 - 12;
abcopy[i__2].r = 0.f, abcopy[i__2].i = 0.f;
}
}
i__1 = kl + ku + 1;
dlacpy_("ALL", &i__1, &n, ab, &ldab, abcopy, &ldab);
/* Call C**SVXX with default PARAMS and N_ERR_BND = 3. */
if (lsamen_(&c__2, c2, "SY")) {
csysvxx_(fact, uplo, &n, &nrhs, acopy, &lda, af, &lda, ipiv,
equed, s, b, &lda, x, &lda, &orcond, &rpvgrw, berr, &c__3,
errbnd_n__, errbnd_c__, &c__2, params, work, rwork, &
info);
} else if (lsamen_(&c__2, c2, "PO")) {
cposvxx_(fact, uplo, &n, &nrhs, acopy, &lda, af, &lda, equed, s,
b, &lda, x, &lda, &orcond, &rpvgrw, berr, &c__3,
errbnd_n__, errbnd_c__, &c__2, params, work, rwork, &info);
} else if (lsamen_(&c__2, c2, "HE")) {
chesvxx_(fact, uplo, &n, &nrhs, acopy, &lda, af, &lda, ipiv,
equed, s, b, &lda, x, &lda, &orcond, &rpvgrw, berr, &c__3,
errbnd_n__, errbnd_c__, &c__2, params, work, rwork, &
info);
} else if (lsamen_(&c__2, c2, "GB")) {
cgbsvxx_(fact, trans, &n, &kl, &ku, &nrhs, abcopy, &ldab, afb, &
ldafb, ipiv, equed, r__, c__, b, &lda, x, &lda, &orcond, &
rpvgrw, berr, &c__3, errbnd_n__, errbnd_c__, &c__2,
params, work, rwork, &info);
} else {
cgesvxx_(fact, trans, &n, &nrhs, acopy, &lda, af, &lda, ipiv,
equed, r__, c__, b, &lda, x, &lda, &orcond, &rpvgrw, berr,
&c__3, errbnd_n__, errbnd_c__, &c__2, params, work,
rwork, &info);
}
++n_aux_tests__;
if (orcond < eps) {
/* Either factorization failed or the matrix is flagged, and 1 <= */
/* INFO <= N+1. We don't decide based on rcond anymore. */
/* IF (INFO .EQ. 0 .OR. INFO .GT. N+1) THEN */
/* NFAIL = NFAIL + 1 */
/* WRITE (*, FMT=8000) N, INFO, ORCOND, RCOND */
/* END IF */
} else {
/* Either everything succeeded (INFO == 0) or some solution failed */
/* to converge (INFO > N+1). */
if (info > 0 && info <= n + 1) {
++nfail;
s_wsfe(&io___42);
do_fio(&c__1, c2, (ftnlen)2);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&info, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&orcond, (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&rcond, (ftnlen)sizeof(real));
e_wsfe();
}
}
/* Calculating the difference between C**SVXX's X and the true X. */
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
i__4 = nrhs;
for (j = 1; j <= i__4; ++j) {
i__2 = i__ + j * 6 - 7;
i__3 = i__ + j * 6 - 7;
i__5 = i__ + j * 6 - 7;
q__1.r = x[i__3].r - invhilb[i__5].r, q__1.i = x[i__3].i -
invhilb[i__5].i;
diff[i__2] = q__1.r;
}
}
/* Calculating the RCOND */
rnorm = 0.f;
rinorm = 0.f;
if (lsamen_(&c__2, c2, "PO") || lsamen_(&c__2,
c2, "SY") || lsamen_(&c__2, c2, "HE")) {
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
sumr = 0.f;
sumri = 0.f;
i__4 = n;
for (j = 1; j <= i__4; ++j) {
i__2 = i__ + j * 6 - 7;
sumr += s[i__ - 1] * ((r__1 = a[i__2].r, dabs(r__1)) + (
r__2 = r_imag(&a[i__ + j * 6 - 7]), dabs(r__2))) *
s[j - 1];
i__2 = i__ + j * 6 - 7;
sumri += ((r__1 = invhilb[i__2].r, dabs(r__1)) + (r__2 =
r_imag(&invhilb[i__ + j * 6 - 7]), dabs(r__2))) /
(s[j - 1] * s[i__ - 1]);
}
rnorm = dmax(rnorm,sumr);
rinorm = dmax(rinorm,sumri);
}
} else if (lsamen_(&c__2, c2, "GE") || lsamen_(&
c__2, c2, "GB")) {
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
sumr = 0.f;
sumri = 0.f;
i__4 = n;
for (j = 1; j <= i__4; ++j) {
i__2 = i__ + j * 6 - 7;
sumr += r__[i__ - 1] * ((r__1 = a[i__2].r, dabs(r__1)) + (
r__2 = r_imag(&a[i__ + j * 6 - 7]), dabs(r__2))) *
c__[j - 1];
i__2 = i__ + j * 6 - 7;
sumri += ((r__1 = invhilb[i__2].r, dabs(r__1)) + (r__2 =
r_imag(&invhilb[i__ + j * 6 - 7]), dabs(r__2))) /
(r__[j - 1] * c__[i__ - 1]);
}
rnorm = dmax(rnorm,sumr);
rinorm = dmax(rinorm,sumri);
}
}
rnorm /= (r__1 = a[0].r, dabs(r__1)) + (r__2 = r_imag(a), dabs(r__2));
rcond = 1.f / (rnorm * rinorm);
/* Calculating the R for normwise rcond. */
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
rinv[i__ - 1] = 0.f;
}
i__1 = n;
for (j = 1; j <= i__1; ++j) {
i__4 = n;
for (i__ = 1; i__ <= i__4; ++i__) {
i__2 = i__ + j * 6 - 7;
rinv[i__ - 1] += (r__1 = a[i__2].r, dabs(r__1)) + (r__2 =
r_imag(&a[i__ + j * 6 - 7]), dabs(r__2));
}
}
/* Calculating the Normwise rcond. */
rinorm = 0.f;
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
sumri = 0.f;
i__4 = n;
for (j = 1; j <= i__4; ++j) {
i__2 = i__ + j * 6 - 7;
i__3 = j - 1;
q__2.r = rinv[i__3] * invhilb[i__2].r, q__2.i = rinv[i__3] *
invhilb[i__2].i;
q__1.r = q__2.r, q__1.i = q__2.i;
sumri += (r__1 = q__1.r, dabs(r__1)) + (r__2 = r_imag(&q__1),
dabs(r__2));
}
rinorm = dmax(rinorm,sumri);
}
/* invhilb is the inverse *unscaled* Hilbert matrix, so scale its norm */
/* by 1/A(1,1) to make the scaling match A (the scaled Hilbert matrix) */
ncond = ((r__1 = a[0].r, dabs(r__1)) + (r__2 = r_imag(a), dabs(r__2)))
/ rinorm;
condthresh = m * eps;
errthresh = m * eps;
i__1 = nrhs;
for (k = 1; k <= i__1; ++k) {
normt = 0.f;
normdif = 0.f;
cwise_err__ = 0.f;
i__4 = n;
for (i__ = 1; i__ <= i__4; ++i__) {
/* Computing MAX */
i__2 = i__ + k * 6 - 7;
r__3 = (r__1 = invhilb[i__2].r, dabs(r__1)) + (r__2 = r_imag(&
invhilb[i__ + k * 6 - 7]), dabs(r__2));
normt = dmax(r__3,normt);
i__2 = i__ + k * 6 - 7;
i__3 = i__ + k * 6 - 7;
q__2.r = x[i__2].r - invhilb[i__3].r, q__2.i = x[i__2].i -
invhilb[i__3].i;
q__1.r = q__2.r, q__1.i = q__2.i;
/* Computing MAX */
r__3 = (r__1 = q__1.r, dabs(r__1)) + (r__2 = r_imag(&q__1),
dabs(r__2));
normdif = dmax(r__3,normdif);
i__2 = i__ + k * 6 - 7;
if (invhilb[i__2].r != 0.f || invhilb[i__2].i != 0.f) {
i__2 = i__ + k * 6 - 7;
i__3 = i__ + k * 6 - 7;
q__2.r = x[i__2].r - invhilb[i__3].r, q__2.i = x[i__2].i
- invhilb[i__3].i;
q__1.r = q__2.r, q__1.i = q__2.i;
/* Computing MAX */
i__5 = i__ + k * 6 - 7;
r__5 = ((r__1 = q__1.r, dabs(r__1)) + (r__2 = r_imag(&
q__1), dabs(r__2))) / ((r__3 = invhilb[i__5].r,
dabs(r__3)) + (r__4 = r_imag(&invhilb[i__ + k * 6
- 7]), dabs(r__4)));
cwise_err__ = dmax(r__5,cwise_err__);
} else /* if(complicated condition) */ {
i__2 = i__ + k * 6 - 7;
if (x[i__2].r != 0.f || x[i__2].i != 0.f) {
cwise_err__ = slamch_("OVERFLOW");
}
}
}
if (normt != 0.f) {
nwise_err__ = normdif / normt;
} else if (normdif != 0.f) {
nwise_err__ = slamch_("OVERFLOW");
} else {
nwise_err__ = 0.f;
}
i__4 = n;
for (i__ = 1; i__ <= i__4; ++i__) {
rinv[i__ - 1] = 0.f;
}
i__4 = n;
for (j = 1; j <= i__4; ++j) {
i__2 = n;
for (i__ = 1; i__ <= i__2; ++i__) {
i__3 = i__ + j * 6 - 7;
i__5 = j + k * 6 - 7;
q__2.r = a[i__3].r * invhilb[i__5].r - a[i__3].i *
invhilb[i__5].i, q__2.i = a[i__3].r * invhilb[
i__5].i + a[i__3].i * invhilb[i__5].r;
q__1.r = q__2.r, q__1.i = q__2.i;
rinv[i__ - 1] += (r__1 = q__1.r, dabs(r__1)) + (r__2 =
r_imag(&q__1), dabs(r__2));
}
}
rinorm = 0.f;
i__4 = n;
for (i__ = 1; i__ <= i__4; ++i__) {
sumri = 0.f;
i__2 = n;
for (j = 1; j <= i__2; ++j) {
i__3 = i__ + j * 6 - 7;
i__5 = j - 1;
q__3.r = rinv[i__5] * invhilb[i__3].r, q__3.i = rinv[i__5]
* invhilb[i__3].i;
c_div(&q__2, &q__3, &invhilb[i__ + k * 6 - 7]);
q__1.r = q__2.r, q__1.i = q__2.i;
sumri += (r__1 = q__1.r, dabs(r__1)) + (r__2 = r_imag(&
q__1), dabs(r__2));
}
rinorm = dmax(rinorm,sumri);
}
/* invhilb is the inverse *unscaled* Hilbert matrix, so scale its norm */
/* by 1/A(1,1) to make the scaling match A (the scaled Hilbert matrix) */
ccond = ((r__1 = a[0].r, dabs(r__1)) + (r__2 = r_imag(a), dabs(
r__2))) / rinorm;
/* Forward error bound tests */
nwise_bnd__ = errbnd_n__[k + nrhs - 1];
cwise_bnd__ = errbnd_c__[k + nrhs - 1];
nwise_rcond__ = errbnd_n__[k + (nrhs << 1) - 1];
cwise_rcond__ = errbnd_c__[k + (nrhs << 1) - 1];
/* write (*,*) 'nwise : ', n, k, ncond, nwise_rcond, */
/* $ condthresh, ncond.ge.condthresh */
/* write (*,*) 'nwise2: ', k, nwise_bnd, nwise_err, errthresh */
if (ncond >= condthresh) {
s_copy(nguar, "YES", (ftnlen)3, (ftnlen)3);
if (nwise_bnd__ > errthresh) {
tstrat[0] = 1 / (eps * 2.f);
} else {
if (nwise_bnd__ != 0.f) {
tstrat[0] = nwise_err__ / nwise_bnd__;
} else if (nwise_err__ != 0.f) {
tstrat[0] = 1 / (eps * 16.f);
} else {
tstrat[0] = 0.f;
}
if (tstrat[0] > 1.f) {
tstrat[0] = 1 / (eps * 4.f);
}
}
} else {
s_copy(nguar, "NO", (ftnlen)3, (ftnlen)2);
if (nwise_bnd__ < 1.f) {
tstrat[0] = 1 / (eps * 8.f);
} else {
tstrat[0] = 1.f;
}
}
/* write (*,*) 'cwise : ', n, k, ccond, cwise_rcond, */
/* $ condthresh, ccond.ge.condthresh */
/* write (*,*) 'cwise2: ', k, cwise_bnd, cwise_err, errthresh */
if (ccond >= condthresh) {
s_copy(cguar, "YES", (ftnlen)3, (ftnlen)3);
if (cwise_bnd__ > errthresh) {
tstrat[1] = 1 / (eps * 2.f);
} else {
if (cwise_bnd__ != 0.f) {
tstrat[1] = cwise_err__ / cwise_bnd__;
} else if (cwise_err__ != 0.f) {
tstrat[1] = 1 / (eps * 16.f);
} else {
tstrat[1] = 0.f;
}
if (tstrat[1] > 1.f) {
tstrat[1] = 1 / (eps * 4.f);
}
}
} else {
s_copy(cguar, "NO", (ftnlen)3, (ftnlen)2);
if (cwise_bnd__ < 1.f) {
tstrat[1] = 1 / (eps * 8.f);
} else {
tstrat[1] = 1.f;
}
}
/* Backwards error test */
tstrat[2] = berr[k - 1] / eps;
/* Condition number tests */
tstrat[3] = rcond / orcond;
if (rcond >= condthresh && tstrat[3] < 1.f) {
tstrat[3] = 1.f / tstrat[3];
}
tstrat[4] = ncond / nwise_rcond__;
if (ncond >= condthresh && tstrat[4] < 1.f) {
tstrat[4] = 1.f / tstrat[4];
}
tstrat[5] = ccond / nwise_rcond__;
if (ccond >= condthresh && tstrat[5] < 1.f) {
tstrat[5] = 1.f / tstrat[5];
}
for (i__ = 1; i__ <= 6; ++i__) {
if (tstrat[i__ - 1] > *thresh) {
if (! printed_guide__) {
s_wsle(&io___66);
e_wsle();
s_wsfe(&io___67);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___68);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___69);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___70);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___71);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___72);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___73);
do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___74);
do_fio(&c__1, (char *)&c__8, (ftnlen)sizeof(integer));
e_wsfe();
s_wsle(&io___75);
e_wsle();
printed_guide__ = TRUE_;
}
s_wsfe(&io___76);
do_fio(&c__1, c2, (ftnlen)2);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
do_fio(&c__1, nguar, (ftnlen)3);
do_fio(&c__1, cguar, (ftnlen)3);
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&tstrat[i__ - 1], (ftnlen)sizeof(
real));
e_wsfe();
++nfail;
}
}
}
/* $$$ WRITE(*,*) */
/* $$$ WRITE(*,*) 'Normwise Error Bounds' */
/* $$$ WRITE(*,*) 'Guaranteed error bound: ',ERRBND(NRHS,nwise_i,bnd_i) */
/* $$$ WRITE(*,*) 'Reciprocal condition number: ',ERRBND(NRHS,nwise_i,cond_i) */
/* $$$ WRITE(*,*) 'Raw error estimate: ',ERRBND(NRHS,nwise_i,rawbnd_i) */
/* $$$ WRITE(*,*) */
/* $$$ WRITE(*,*) 'Componentwise Error Bounds' */
/* $$$ WRITE(*,*) 'Guaranteed error bound: ',ERRBND(NRHS,cwise_i,bnd_i) */
/* $$$ WRITE(*,*) 'Reciprocal condition number: ',ERRBND(NRHS,cwise_i,cond_i) */
/* $$$ WRITE(*,*) 'Raw error estimate: ',ERRBND(NRHS,cwise_i,rawbnd_i) */
/* $$$ print *, 'Info: ', info */
/* $$$ WRITE(*,*) */
/* WRITE(*,*) 'TSTRAT: ',TSTRAT */
}
s_wsle(&io___77);
e_wsle();
if (nfail > 0) {
s_wsfe(&io___78);
do_fio(&c__1, c2, (ftnlen)2);
do_fio(&c__1, (char *)&nfail, (ftnlen)sizeof(integer));
i__1 = n * 6 + n_aux_tests__;
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
e_wsfe();
} else {
s_wsfe(&io___79);
do_fio(&c__1, c2, (ftnlen)2);
e_wsfe();
}
/* Test ratios. */
return 0;
} /* cebchvxx_ */
/* Subroutine */ int dlarhs_(char *path, char *xtype, char *uplo, char *trans,
integer *m, integer *n, integer *kl, integer *ku, integer *nrhs,
doublereal *a, integer *lda, doublereal *x, integer *ldx, doublereal *
b, integer *ldb, integer *iseed, integer *info)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, x_dim1, x_offset, i__1;
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
static logical band;
static char diag[1];
static logical tran;
static integer j;
extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
integer *, doublereal *, doublereal *, integer *, doublereal *,
integer *, doublereal *, doublereal *, integer *),
dgbmv_(char *, integer *, integer *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *);
extern logical lsame_(char *, char *);
extern /* Subroutine */ int dsbmv_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *), dtbmv_(char *,
char *, char *, integer *, integer *, doublereal *, integer *,
doublereal *, integer *), dtrmm_(char *,
char *, char *, char *, integer *, integer *, doublereal *,
doublereal *, integer *, doublereal *, integer *);
static char c1[1], c2[2];
extern /* Subroutine */ int dspmv_(char *, integer *, doublereal *,
doublereal *, doublereal *, integer *, doublereal *, doublereal *,
integer *), dsymm_(char *, char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *), dtpmv_(
char *, char *, char *, integer *, doublereal *, doublereal *,
integer *);
static integer mb, nx;
extern /* Subroutine */ int dlacpy_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *),
xerbla_(char *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int dlarnv_(integer *, integer *, integer *,
doublereal *);
static logical notran, gen, tri, qrs, sym;
#define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]
#define x_ref(a_1,a_2) x[(a_2)*x_dim1 + a_1]
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
February 29, 1992
Purpose
=======
DLARHS chooses a set of NRHS random solution vectors and sets
up the right hand sides for the linear system
op( A ) * X = B,
where op( A ) may be A or A' (transpose of A).
Arguments
=========
PATH (input) CHARACTER*3
The type of the real matrix A. PATH may be given in any
combination of upper and lower case. Valid types include
xGE: General m x n matrix
xGB: General banded matrix
xPO: Symmetric positive definite, 2-D storage
xPP: Symmetric positive definite packed
xPB: Symmetric positive definite banded
xSY: Symmetric indefinite, 2-D storage
xSP: Symmetric indefinite packed
xSB: Symmetric indefinite banded
xTR: Triangular
xTP: Triangular packed
xTB: Triangular banded
xQR: General m x n matrix
xLQ: General m x n matrix
xQL: General m x n matrix
xRQ: General m x n matrix
where the leading character indicates the precision.
XTYPE (input) CHARACTER*1
Specifies how the exact solution X will be determined:
= 'N': New solution; generate a random X.
= 'C': Computed; use value of X on entry.
UPLO (input) CHARACTER*1
Specifies whether the upper or lower triangular part of the
matrix A is stored, if A is symmetric.
= 'U': Upper triangular
= 'L': Lower triangular
TRANS (input) CHARACTER*1
Specifies the operation applied to the matrix A.
= 'N': System is A * x = b
= 'T': System is A'* x = b
= 'C': System is A'* x = b
M (input) INTEGER
The number or rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
KL (input) INTEGER
Used only if A is a band matrix; specifies the number of
subdiagonals of A if A is a general band matrix or if A is
symmetric or triangular and UPLO = 'L'; specifies the number
of superdiagonals of A if A is symmetric or triangular and
UPLO = 'U'. 0 <= KL <= M-1.
KU (input) INTEGER
Used only if A is a general band matrix or if A is
triangular.
If PATH = xGB, specifies the number of superdiagonals of A,
and 0 <= KU <= N-1.
If PATH = xTR, xTP, or xTB, specifies whether or not the
matrix has unit diagonal:
= 1: matrix has non-unit diagonal (default)
= 2: matrix has unit diagonal
NRHS (input) INTEGER
The number of right hand side vectors in the system A*X = B.
A (input) DOUBLE PRECISION array, dimension (LDA,N)
The test matrix whose type is given by PATH.
LDA (input) INTEGER
The leading dimension of the array A.
If PATH = xGB, LDA >= KL+KU+1.
If PATH = xPB, xSB, xHB, or xTB, LDA >= KL+1.
Otherwise, LDA >= max(1,M).
X (input or output) DOUBLE PRECISION array, dimension(LDX,NRHS)
On entry, if XTYPE = 'C' (for 'Computed'), then X contains
the exact solution to the system of linear equations.
On exit, if XTYPE = 'N' (for 'New'), then X is initialized
with random values.
LDX (input) INTEGER
The leading dimension of the array X. If TRANS = 'N',
LDX >= max(1,N); if TRANS = 'T', LDX >= max(1,M).
B (output) DOUBLE PRECISION array, dimension (LDB,NRHS)
The right hand side vector(s) for the system of equations,
computed from B = op(A) * X, where op(A) is determined by
TRANS.
LDB (input) INTEGER
The leading dimension of the array B. If TRANS = 'N',
LDB >= max(1,M); if TRANS = 'T', LDB >= max(1,N).
ISEED (input/output) INTEGER array, dimension (4)
The seed vector for the random number generator (used in
DLATMS). Modified on exit.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
=====================================================================
Test the input parameters.
Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1 * 1;
a -= a_offset;
x_dim1 = *ldx;
x_offset = 1 + x_dim1 * 1;
x -= x_offset;
b_dim1 = *ldb;
b_offset = 1 + b_dim1 * 1;
b -= b_offset;
--iseed;
/* Function Body */
*info = 0;
*(unsigned char *)c1 = *(unsigned char *)path;
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
tran = lsame_(trans, "T") || lsame_(trans, "C");
notran = ! tran;
gen = lsame_(path + 1, "G");
qrs = lsame_(path + 1, "Q") || lsame_(path + 2,
"Q");
sym = lsame_(path + 1, "P") || lsame_(path + 1,
"S");
tri = lsame_(path + 1, "T");
band = lsame_(path + 2, "B");
if (! lsame_(c1, "Double precision")) {
*info = -1;
} else if (! (lsame_(xtype, "N") || lsame_(xtype,
"C"))) {
*info = -2;
} else if ((sym || tri) && ! (lsame_(uplo, "U") ||
lsame_(uplo, "L"))) {
*info = -3;
} else if ((gen || qrs) && ! (tran || lsame_(trans, "N"))) {
*info = -4;
} else if (*m < 0) {
*info = -5;
} else if (*n < 0) {
*info = -6;
} else if (band && *kl < 0) {
*info = -7;
} else if (band && *ku < 0) {
*info = -8;
} else if (*nrhs < 0) {
*info = -9;
} else if (! band && *lda < max(1,*m) || band && (sym || tri) && *lda < *
kl + 1 || band && gen && *lda < *kl + *ku + 1) {
*info = -11;
} else if (notran && *ldx < max(1,*n) || tran && *ldx < max(1,*m)) {
*info = -13;
} else if (notran && *ldb < max(1,*m) || tran && *ldb < max(1,*n)) {
*info = -15;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("DLARHS", &i__1);
return 0;
}
/* Initialize X to NRHS random vectors unless XTYPE = 'C'. */
if (tran) {
nx = *m;
mb = *n;
} else {
nx = *n;
mb = *m;
}
if (! lsame_(xtype, "C")) {
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
dlarnv_(&c__2, &iseed[1], n, &x_ref(1, j));
/* L10: */
}
}
/* Multiply X by op( A ) using an appropriate
matrix multiply routine. */
if (lsamen_(&c__2, c2, "GE") || lsamen_(&c__2, c2,
"QR") || lsamen_(&c__2, c2, "LQ") || lsamen_(&c__2, c2, "QL") ||
lsamen_(&c__2, c2, "RQ")) {
/* General matrix */
dgemm_(trans, "N", &mb, nrhs, &nx, &c_b32, &a[a_offset], lda, &x[
x_offset], ldx, &c_b33, &b[b_offset], ldb);
} else if (lsamen_(&c__2, c2, "PO") || lsamen_(&
c__2, c2, "SY")) {
/* Symmetric matrix, 2-D storage */
dsymm_("Left", uplo, n, nrhs, &c_b32, &a[a_offset], lda, &x[x_offset],
ldx, &c_b33, &b[b_offset], ldb);
} else if (lsamen_(&c__2, c2, "GB")) {
/* General matrix, band storage */
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
dgbmv_(trans, &mb, &nx, kl, ku, &c_b32, &a[a_offset], lda, &x_ref(
1, j), &c__1, &c_b33, &b_ref(1, j), &c__1);
/* L20: */
}
} else if (lsamen_(&c__2, c2, "PB")) {
/* Symmetric matrix, band storage */
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
dsbmv_(uplo, n, kl, &c_b32, &a[a_offset], lda, &x_ref(1, j), &
c__1, &c_b33, &b_ref(1, j), &c__1);
/* L30: */
}
} else if (lsamen_(&c__2, c2, "PP") || lsamen_(&
c__2, c2, "SP")) {
/* Symmetric matrix, packed storage */
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
dspmv_(uplo, n, &c_b32, &a[a_offset], &x_ref(1, j), &c__1, &c_b33,
&b_ref(1, j), &c__1);
/* L40: */
}
} else if (lsamen_(&c__2, c2, "TR")) {
/* Triangular matrix. Note that for triangular matrices,
KU = 1 => non-unit triangular
KU = 2 => unit triangular */
dlacpy_("Full", n, nrhs, &x[x_offset], ldx, &b[b_offset], ldb);
if (*ku == 2) {
*(unsigned char *)diag = 'U';
} else {
*(unsigned char *)diag = 'N';
}
dtrmm_("Left", uplo, trans, diag, n, nrhs, &c_b32, &a[a_offset], lda,
&b[b_offset], ldb)
;
} else if (lsamen_(&c__2, c2, "TP")) {
/* Triangular matrix, packed storage */
dlacpy_("Full", n, nrhs, &x[x_offset], ldx, &b[b_offset], ldb);
if (*ku == 2) {
*(unsigned char *)diag = 'U';
} else {
*(unsigned char *)diag = 'N';
}
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
dtpmv_(uplo, trans, diag, n, &a[a_offset], &b_ref(1, j), &c__1);
/* L50: */
}
} else if (lsamen_(&c__2, c2, "TB")) {
/* Triangular matrix, banded storage */
dlacpy_("Full", n, nrhs, &x[x_offset], ldx, &b[b_offset], ldb);
if (*ku == 2) {
*(unsigned char *)diag = 'U';
} else {
*(unsigned char *)diag = 'N';
}
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
dtbmv_(uplo, trans, diag, n, kl, &a[a_offset], lda, &b_ref(1, j),
&c__1);
/* L60: */
}
} else {
/* If PATH is none of the above, return with an error code. */
*info = -1;
i__1 = -(*info);
xerbla_("DLARHS", &i__1);
}
return 0;
/* End of DLARHS */
} /* dlarhs_ */
/* Subroutine */ int derrsy_(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 doublereal anrm, a[16] /* was [4][4] */, b[4];
static integer i__, j;
static doublereal w[12], x[4], rcond;
static char c2[2];
static doublereal r1[4], r2[4], af[16] /* was [4][4] */;
extern /* Subroutine */ int dsytf2_(char *, integer *, doublereal *,
integer *, integer *, integer *);
static integer ip[4], iw[4];
extern /* Subroutine */ int alaesm_(char *, logical *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), dspcon_(char *, integer *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, integer *,
integer *), dsycon_(char *, integer *, doublereal *,
integer *, integer *, doublereal *, doublereal *, doublereal *,
integer *, integer *), dsprfs_(char *, integer *, integer
*, doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, integer *, doublereal *, doublereal *, doublereal *
, integer *, integer *), dsptrf_(char *, integer *,
doublereal *, integer *, integer *), dsptri_(char *,
integer *, doublereal *, integer *, doublereal *, integer *), dsyrfs_(char *, integer *, integer *, doublereal *,
integer *, doublereal *, integer *, integer *, doublereal *,
integer *, doublereal *, integer *, doublereal *, doublereal *,
doublereal *, integer *, integer *), dsytrf_(char *,
integer *, doublereal *, integer *, integer *, doublereal *,
integer *, integer *), dsytri_(char *, integer *,
doublereal *, integer *, integer *, doublereal *, integer *), dsptrs_(char *, integer *, integer *, doublereal *,
integer *, doublereal *, integer *, integer *), dsytrs_(
char *, integer *, integer *, doublereal *, integer *, integer *,
doublereal *, 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
=======
DERRSY tests the error exits for the DOUBLE PRECISION routines
for symmetric indefinite 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. / (doublereal) (i__ + j);
af_ref(i__, j) = 1. / (doublereal) (i__ + j);
/* L10: */
}
b[j - 1] = 0.;
r1[j - 1] = 0.;
r2[j - 1] = 0.;
w[j - 1] = 0.;
x[j - 1] = 0.;
ip[j - 1] = j;
iw[j - 1] = j;
/* L20: */
}
anrm = 1.;
rcond = 1.;
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "SY")) {
/* Test error exits of the routines that use the Bunch-Kaufman
factorization of a symmetric indefinite matrix.
DSYTRF */
s_copy(srnamc_1.srnamt, "DSYTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dsytrf_("/", &c__0, a, &c__1, ip, w, &c__1, &info);
chkxer_("DSYTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dsytrf_("U", &c_n1, a, &c__1, ip, w, &c__1, &info);
chkxer_("DSYTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dsytrf_("U", &c__2, a, &c__1, ip, w, &c__4, &info);
chkxer_("DSYTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DSYTF2 */
s_copy(srnamc_1.srnamt, "DSYTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dsytf2_("/", &c__0, a, &c__1, ip, &info);
chkxer_("DSYTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dsytf2_("U", &c_n1, a, &c__1, ip, &info);
chkxer_("DSYTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dsytf2_("U", &c__2, a, &c__1, ip, &info);
chkxer_("DSYTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DSYTRI */
s_copy(srnamc_1.srnamt, "DSYTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dsytri_("/", &c__0, a, &c__1, ip, w, &info);
chkxer_("DSYTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dsytri_("U", &c_n1, a, &c__1, ip, w, &info);
chkxer_("DSYTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dsytri_("U", &c__2, a, &c__1, ip, w, &info);
chkxer_("DSYTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DSYTRS */
s_copy(srnamc_1.srnamt, "DSYTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dsytrs_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dsytrs_("U", &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info);
chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dsytrs_("U", &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info);
chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
dsytrs_("U", &c__2, &c__1, a, &c__1, ip, b, &c__2, &info);
chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
dsytrs_("U", &c__2, &c__1, a, &c__2, ip, b, &c__1, &info);
chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DSYRFS */
s_copy(srnamc_1.srnamt, "DSYRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dsyrfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dsyrfs_("U", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dsyrfs_("U", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
dsyrfs_("U", &c__2, &c__1, a, &c__1, af, &c__2, ip, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
dsyrfs_("U", &c__2, &c__1, a, &c__2, af, &c__1, ip, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
dsyrfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__1, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
dsyrfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__2, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DSYCON */
s_copy(srnamc_1.srnamt, "DSYCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dsycon_("/", &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info);
chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dsycon_("U", &c_n1, a, &c__1, ip, &anrm, &rcond, w, iw, &info);
chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dsycon_("U", &c__2, a, &c__1, ip, &anrm, &rcond, w, iw, &info);
chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
dsycon_("U", &c__1, a, &c__1, ip, &c_b152, &rcond, w, iw, &info);
chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "SP")) {
/* Test error exits of the routines that use the Bunch-Kaufman
factorization of a symmetric indefinite packed matrix.
DSPTRF */
s_copy(srnamc_1.srnamt, "DSPTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dsptrf_("/", &c__0, a, ip, &info);
chkxer_("DSPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dsptrf_("U", &c_n1, a, ip, &info);
chkxer_("DSPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DSPTRI */
s_copy(srnamc_1.srnamt, "DSPTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dsptri_("/", &c__0, a, ip, w, &info);
chkxer_("DSPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dsptri_("U", &c_n1, a, ip, w, &info);
chkxer_("DSPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DSPTRS */
s_copy(srnamc_1.srnamt, "DSPTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dsptrs_("/", &c__0, &c__0, a, ip, b, &c__1, &info);
chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dsptrs_("U", &c_n1, &c__0, a, ip, b, &c__1, &info);
chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dsptrs_("U", &c__0, &c_n1, a, ip, b, &c__1, &info);
chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
dsptrs_("U", &c__2, &c__1, a, ip, b, &c__1, &info);
chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DSPRFS */
s_copy(srnamc_1.srnamt, "DSPRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dsprfs_("/", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, r1, r2, w,
iw, &info);
chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dsprfs_("U", &c_n1, &c__0, a, af, ip, b, &c__1, x, &c__1, r1, r2, w,
iw, &info);
chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dsprfs_("U", &c__0, &c_n1, a, af, ip, b, &c__1, x, &c__1, r1, r2, w,
iw, &info);
chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
dsprfs_("U", &c__2, &c__1, a, af, ip, b, &c__1, x, &c__2, r1, r2, w,
iw, &info);
chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
dsprfs_("U", &c__2, &c__1, a, af, ip, b, &c__2, x, &c__1, r1, r2, w,
iw, &info);
chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* DSPCON */
s_copy(srnamc_1.srnamt, "DSPCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dspcon_("/", &c__0, a, ip, &anrm, &rcond, w, iw, &info);
chkxer_("DSPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dspcon_("U", &c_n1, a, ip, &anrm, &rcond, w, iw, &info);
chkxer_("DSPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
dspcon_("U", &c__1, a, ip, &c_b152, &rcond, w, iw, &info);
chkxer_("DSPCON", &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 DERRSY */
} /* derrsy_ */
/* Subroutine */ int zerrpo_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
doublecomplex z__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
doublecomplex a[16] /* was [4][4] */, b[4];
integer i__, j;
doublereal r__[4];
doublecomplex w[8], x[4];
char c2[2];
doublereal r1[4], r2[4];
doublecomplex af[16] /* was [4][4] */;
integer info;
doublereal anrm, rcond;
extern /* Subroutine */ int zpbtf2_(char *, integer *, integer *,
doublecomplex *, integer *, integer *), zpotf2_(char *,
integer *, doublecomplex *, integer *, integer *),
alaesm_(char *, logical *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), zpbcon_(char *, integer *, integer *,
doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, doublereal *, integer *), zpbequ_(char *,
integer *, integer *, doublecomplex *, integer *, doublereal *,
doublereal *, doublereal *, integer *), zpbrfs_(char *,
integer *, integer *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, doublereal *, integer *), zpbtrf_(char *,
integer *, integer *, doublecomplex *, integer *, integer *), zpocon_(char *, integer *, doublecomplex *, integer *,
doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *), zppcon_(char *, integer *, doublecomplex *,
doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *), zpoequ_(integer *, doublecomplex *, integer *,
doublereal *, doublereal *, doublereal *, integer *), zpbtrs_(
char *, integer *, integer *, integer *, doublecomplex *, integer
*, doublecomplex *, integer *, integer *), zporfs_(char *,
integer *, integer *, doublecomplex *, integer *, doublecomplex *
, integer *, doublecomplex *, integer *, doublecomplex *, integer
*, doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *), zpotrf_(char *, integer *, doublecomplex *,
integer *, integer *), zpotri_(char *, integer *,
doublecomplex *, integer *, integer *), zppequ_(char *,
integer *, doublecomplex *, doublereal *, doublereal *,
doublereal *, integer *), zpprfs_(char *, integer *,
integer *, doublecomplex *, doublecomplex *, doublecomplex *,
integer *, doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, doublereal *, integer *), zpptrf_(char *
, integer *, doublecomplex *, integer *), zpptri_(char *,
integer *, doublecomplex *, integer *), zpotrs_(char *,
integer *, integer *, doublecomplex *, integer *, doublecomplex *,
integer *, integer *), zpptrs_(char *, integer *,
integer *, doublecomplex *, doublecomplex *, 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 */
/* ======= */
/* ZERRPO tests the error exits for the COMPLEX*16 routines */
/* for Hermitian positive definite matrices. */
/* 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__) {
i__1 = i__ + (j << 2) - 5;
d__1 = 1. / (doublereal) (i__ + j);
d__2 = -1. / (doublereal) (i__ + j);
z__1.r = d__1, z__1.i = d__2;
a[i__1].r = z__1.r, a[i__1].i = z__1.i;
i__1 = i__ + (j << 2) - 5;
d__1 = 1. / (doublereal) (i__ + j);
d__2 = -1. / (doublereal) (i__ + j);
z__1.r = d__1, z__1.i = d__2;
af[i__1].r = z__1.r, af[i__1].i = z__1.i;
/* L10: */
}
i__1 = j - 1;
b[i__1].r = 0., b[i__1].i = 0.;
r1[j - 1] = 0.;
r2[j - 1] = 0.;
i__1 = j - 1;
w[i__1].r = 0., w[i__1].i = 0.;
i__1 = j - 1;
x[i__1].r = 0., x[i__1].i = 0.;
/* L20: */
}
anrm = 1.;
infoc_1.ok = TRUE_;
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a Hermitian positive definite matrix. */
if (lsamen_(&c__2, c2, "PO")) {
/* ZPOTRF */
s_copy(srnamc_1.srnamt, "ZPOTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotrf_("/", &c__0, a, &c__1, &info);
chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotrf_("U", &c_n1, a, &c__1, &info);
chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpotrf_("U", &c__2, a, &c__1, &info);
chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOTF2 */
s_copy(srnamc_1.srnamt, "ZPOTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotf2_("/", &c__0, a, &c__1, &info);
chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotf2_("U", &c_n1, a, &c__1, &info);
chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpotf2_("U", &c__2, a, &c__1, &info);
chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOTRI */
s_copy(srnamc_1.srnamt, "ZPOTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotri_("/", &c__0, a, &c__1, &info);
chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotri_("U", &c_n1, a, &c__1, &info);
chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpotri_("U", &c__2, a, &c__1, &info);
chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOTRS */
s_copy(srnamc_1.srnamt, "ZPOTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotrs_("/", &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotrs_("U", &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpotrs_("U", &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpotrs_("U", &c__2, &c__1, a, &c__1, b, &c__2, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zpotrs_("U", &c__2, &c__1, a, &c__2, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPORFS */
s_copy(srnamc_1.srnamt, "ZPORFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zporfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zporfs_("U", &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zporfs_("U", &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zporfs_("U", &c__2, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__1, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__2, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOCON */
s_copy(srnamc_1.srnamt, "ZPOCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpocon_("/", &c__0, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpocon_("U", &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpocon_("U", &c__2, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
d__1 = -anrm;
zpocon_("U", &c__1, a, &c__1, &d__1, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOEQU */
s_copy(srnamc_1.srnamt, "ZPOEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpoequ_(&c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpoequ_(&c__2, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a Hermitian positive definite packed matrix. */
} else if (lsamen_(&c__2, c2, "PP")) {
/* ZPPTRF */
s_copy(srnamc_1.srnamt, "ZPPTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpptrf_("/", &c__0, a, &info);
chkxer_("ZPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpptrf_("U", &c_n1, a, &info);
chkxer_("ZPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPTRI */
s_copy(srnamc_1.srnamt, "ZPPTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpptri_("/", &c__0, a, &info);
chkxer_("ZPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpptri_("U", &c_n1, a, &info);
chkxer_("ZPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPTRS */
s_copy(srnamc_1.srnamt, "ZPPTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpptrs_("/", &c__0, &c__0, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpptrs_("U", &c_n1, &c__0, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpptrs_("U", &c__0, &c_n1, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zpptrs_("U", &c__2, &c__1, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPRFS */
s_copy(srnamc_1.srnamt, "ZPPRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpprfs_("/", &c__0, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpprfs_("U", &c_n1, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpprfs_("U", &c__0, &c_n1, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zpprfs_("U", &c__2, &c__1, a, af, b, &c__1, x, &c__2, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
zpprfs_("U", &c__2, &c__1, a, af, b, &c__2, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPCON */
s_copy(srnamc_1.srnamt, "ZPPCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zppcon_("/", &c__0, a, &anrm, &rcond, w, r__, &info);
chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zppcon_("U", &c_n1, a, &anrm, &rcond, w, r__, &info);
chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
d__1 = -anrm;
zppcon_("U", &c__1, a, &d__1, &rcond, w, r__, &info);
chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPEQU */
s_copy(srnamc_1.srnamt, "ZPPEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zppequ_("/", &c__0, a, r1, &rcond, &anrm, &info);
chkxer_("ZPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zppequ_("U", &c_n1, a, r1, &rcond, &anrm, &info);
chkxer_("ZPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a Hermitian positive definite band matrix. */
} else if (lsamen_(&c__2, c2, "PB")) {
/* ZPBTRF */
s_copy(srnamc_1.srnamt, "ZPBTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbtrf_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbtrf_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbtrf_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbtrf_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBTF2 */
s_copy(srnamc_1.srnamt, "ZPBTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbtf2_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbtf2_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbtf2_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbtf2_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBTRS */
s_copy(srnamc_1.srnamt, "ZPBTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbtrs_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbtrs_("U", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbtrs_("U", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpbtrs_("U", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zpbtrs_("U", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zpbtrs_("U", &c__2, &c__0, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBRFS */
s_copy(srnamc_1.srnamt, "ZPBRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbrfs_("/", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbrfs_("U", &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbrfs_("U", &c__1, &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpbrfs_("U", &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zpbrfs_("U", &c__2, &c__1, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zpbrfs_("U", &c__2, &c__1, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zpbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__1, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
zpbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__2, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBCON */
s_copy(srnamc_1.srnamt, "ZPBCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbcon_("/", &c__0, &c__0, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbcon_("U", &c_n1, &c__0, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbcon_("U", &c__1, &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbcon_("U", &c__2, &c__1, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
d__1 = -anrm;
zpbcon_("U", &c__1, &c__0, a, &c__1, &d__1, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBEQU */
s_copy(srnamc_1.srnamt, "ZPBEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbequ_("/", &c__0, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbequ_("U", &c_n1, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbequ_("U", &c__1, &c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbequ_("U", &c__2, &c__1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &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 ZERRPO */
} /* zerrpo_ */
/* Subroutine */ int derrbd_(char *path, integer *nunit)
{
/* Format strings */
static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e"
"rror exits\002,\002 (\002,i3,\002 tests done)\002)";
static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes"
"ts of the error \002,\002exits ***\002)";
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Local variables */
doublereal a[16] /* was [4][4] */, d__[4], e[4];
integer i__, j;
doublereal q[16] /* was [4][4] */, u[16] /* was [4][4] */, v[16] /*
was [4][4] */, w[4];
char c2[2];
integer iq[16] /* was [4][4] */, iw[4], nt;
doublereal tp[4], tq[4];
integer info;
extern /* Subroutine */ int dgebd2_(integer *, integer *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *), dbdsdc_(char *, char *, integer *,
doublereal *, doublereal *, doublereal *, integer *, doublereal *,
integer *, doublereal *, integer *, doublereal *, integer *,
integer *), dgebrd_(integer *, integer *,
doublereal *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int dbdsqr_(char *, integer *, integer *, integer
*, integer *, doublereal *, doublereal *, doublereal *, integer *,
doublereal *, integer *, doublereal *, integer *, doublereal *,
integer *), dorgbr_(char *, integer *, integer *, integer
*, doublereal *, integer *, doublereal *, doublereal *, integer *,
integer *), chkxer_(char *, integer *, integer *,
logical *, logical *), dormbr_(char *, char *, char *,
integer *, integer *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
static cilist io___18 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___19 = { 0, 0, 0, fmt_9998, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DERRBD tests the error exits for DGEBRD, DORGBR, DORMBR, DBDSQR and */
/* DBDSDC. */
/* 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. / (doublereal) (i__ + j);
/* L10: */
}
/* L20: */
}
infoc_1.ok = TRUE_;
nt = 0;
/* Test error exits of the SVD routines. */
if (lsamen_(&c__2, c2, "BD")) {
/* DGEBRD */
s_copy(srnamc_1.srnamt, "DGEBRD", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgebrd_(&c_n1, &c__0, a, &c__1, d__, e, tq, tp, w, &c__1, &info);
chkxer_("DGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgebrd_(&c__0, &c_n1, a, &c__1, d__, e, tq, tp, w, &c__1, &info);
chkxer_("DGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgebrd_(&c__2, &c__1, a, &c__1, d__, e, tq, tp, w, &c__2, &info);
chkxer_("DGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
dgebrd_(&c__2, &c__1, a, &c__2, d__, e, tq, tp, w, &c__1, &info);
chkxer_("DGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 4;
/* DGEBD2 */
s_copy(srnamc_1.srnamt, "DGEBD2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dgebd2_(&c_n1, &c__0, a, &c__1, d__, e, tq, tp, w, &info);
chkxer_("DGEBD2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dgebd2_(&c__0, &c_n1, a, &c__1, d__, e, tq, tp, w, &info);
chkxer_("DGEBD2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dgebd2_(&c__2, &c__1, a, &c__1, d__, e, tq, tp, w, &info);
chkxer_("DGEBD2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 3;
/* DORGBR */
s_copy(srnamc_1.srnamt, "DORGBR", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dorgbr_("/", &c__0, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info);
chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dorgbr_("Q", &c_n1, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info);
chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dorgbr_("Q", &c__0, &c_n1, &c__0, a, &c__1, tq, w, &c__1, &info);
chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dorgbr_("Q", &c__0, &c__1, &c__0, a, &c__1, tq, w, &c__1, &info);
chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dorgbr_("Q", &c__1, &c__0, &c__1, a, &c__1, tq, w, &c__1, &info);
chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dorgbr_("P", &c__1, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info);
chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dorgbr_("P", &c__0, &c__1, &c__1, a, &c__1, tq, w, &c__1, &info);
chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dorgbr_("Q", &c__0, &c__0, &c_n1, a, &c__1, tq, w, &c__1, &info);
chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
dorgbr_("Q", &c__2, &c__1, &c__1, a, &c__1, tq, w, &c__1, &info);
chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
dorgbr_("Q", &c__2, &c__2, &c__1, a, &c__2, tq, w, &c__1, &info);
chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 10;
/* DORMBR */
s_copy(srnamc_1.srnamt, "DORMBR", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dormbr_("/", "L", "T", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dormbr_("Q", "/", "T", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dormbr_("Q", "L", "/", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dormbr_("Q", "L", "T", &c_n1, &c__0, &c__0, a, &c__1, tq, u, &c__1, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
dormbr_("Q", "L", "T", &c__0, &c_n1, &c__0, a, &c__1, tq, u, &c__1, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
dormbr_("Q", "L", "T", &c__0, &c__0, &c_n1, a, &c__1, tq, u, &c__1, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
dormbr_("Q", "L", "T", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__2, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
dormbr_("Q", "R", "T", &c__0, &c__2, &c__0, a, &c__1, tq, u, &c__1, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
dormbr_("P", "L", "T", &c__2, &c__0, &c__2, a, &c__1, tq, u, &c__2, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
dormbr_("P", "R", "T", &c__0, &c__2, &c__2, a, &c__1, tq, u, &c__1, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
dormbr_("Q", "R", "T", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__1, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
dormbr_("Q", "L", "T", &c__0, &c__2, &c__0, a, &c__1, tq, u, &c__1, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
dormbr_("Q", "R", "T", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__2, w,
&c__1, &info);
chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 13;
/* DBDSQR */
s_copy(srnamc_1.srnamt, "DBDSQR", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dbdsqr_("/", &c__0, &c__0, &c__0, &c__0, d__, e, v, &c__1, u, &c__1,
a, &c__1, w, &info);
chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dbdsqr_("U", &c_n1, &c__0, &c__0, &c__0, d__, e, v, &c__1, u, &c__1,
a, &c__1, w, &info);
chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dbdsqr_("U", &c__0, &c_n1, &c__0, &c__0, d__, e, v, &c__1, u, &c__1,
a, &c__1, w, &info);
chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
dbdsqr_("U", &c__0, &c__0, &c_n1, &c__0, d__, e, v, &c__1, u, &c__1,
a, &c__1, w, &info);
chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
dbdsqr_("U", &c__0, &c__0, &c__0, &c_n1, d__, e, v, &c__1, u, &c__1,
a, &c__1, w, &info);
chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
dbdsqr_("U", &c__2, &c__1, &c__0, &c__0, d__, e, v, &c__1, u, &c__1,
a, &c__1, w, &info);
chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
dbdsqr_("U", &c__0, &c__0, &c__2, &c__0, d__, e, v, &c__1, u, &c__1,
a, &c__1, w, &info);
chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
dbdsqr_("U", &c__2, &c__0, &c__0, &c__1, d__, e, v, &c__1, u, &c__1,
a, &c__1, w, &info);
chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 8;
/* DBDSDC */
s_copy(srnamc_1.srnamt, "DBDSDC", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
dbdsdc_("/", "N", &c__0, d__, e, u, &c__1, v, &c__1, q, iq, w, iw, &
info);
chkxer_("DBDSDC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
dbdsdc_("U", "/", &c__0, d__, e, u, &c__1, v, &c__1, q, iq, w, iw, &
info);
chkxer_("DBDSDC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
dbdsdc_("U", "N", &c_n1, d__, e, u, &c__1, v, &c__1, q, iq, w, iw, &
info);
chkxer_("DBDSDC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
dbdsdc_("U", "I", &c__2, d__, e, u, &c__1, v, &c__1, q, iq, w, iw, &
info);
chkxer_("DBDSDC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
dbdsdc_("U", "I", &c__2, d__, e, u, &c__2, v, &c__1, q, iq, w, iw, &
info);
chkxer_("DBDSDC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
nt += 5;
}
/* Print a summary line. */
if (infoc_1.ok) {
io___18.ciunit = infoc_1.nout;
s_wsfe(&io___18);
do_fio(&c__1, path, (ftnlen)3);
do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
e_wsfe();
} else {
io___19.ciunit = infoc_1.nout;
s_wsfe(&io___19);
do_fio(&c__1, path, (ftnlen)3);
e_wsfe();
}
return 0;
/* End of DERRBD */
} /* derrbd_ */
/* 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_ */
doublereal sopbl2_(char *subnam, integer *m, integer *n, integer *kkl,
integer *kku)
{
/* System generated locals */
integer i__1, i__2, i__3;
real ret_val;
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
static real adds;
extern logical lsame_(char *, char *);
static char c1[1], c2[2], c3[3];
static real mults, ek, em, en, kl, ku;
extern logical lsamen_(integer *, char *, char *);
/* -- LAPACK timing routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
March 31, 1993
Purpose
=======
SOPBL2 computes an approximation of the number of floating point
operations used by a subroutine SUBNAM with the given values
of the parameters M, N, KL, and KU.
This version counts operations for the Level 2 BLAS.
Arguments
=========
SUBNAM (input) CHARACTER*6
The name of the subroutine.
M (input) INTEGER
The number of rows of the coefficient matrix. M >= 0.
N (input) INTEGER
The number of columns of the coefficient matrix.
If the matrix is square (such as in a solve routine) then
N is the number of right hand sides. N >= 0.
KKL (input) INTEGER
The lower band width of the coefficient matrix.
KL is set to max( 0, min( M-1, KKL ) ).
KKU (input) INTEGER
The upper band width of the coefficient matrix.
KU is set to max( 0, min( N-1, KKU ) ).
=====================================================================
Quick return if possible */
if (*m <= 0 || ! (lsame_(subnam, "S") || lsame_(
subnam, "D") || lsame_(subnam, "C") || lsame_(subnam, "Z"))) {
ret_val = 0.f;
return ret_val;
}
*(unsigned char *)c1 = *(unsigned char *)subnam;
s_copy(c2, subnam + 1, (ftnlen)2, (ftnlen)2);
s_copy(c3, subnam + 3, (ftnlen)3, (ftnlen)3);
mults = 0.f;
adds = 0.f;
/* Computing MAX
Computing MIN */
i__3 = *m - 1;
i__1 = 0, i__2 = min(i__3,*kkl);
kl = (real) max(i__1,i__2);
/* Computing MAX
Computing MIN */
i__3 = *n - 1;
i__1 = 0, i__2 = min(i__3,*kku);
ku = (real) max(i__1,i__2);
em = (real) (*m);
en = (real) (*n);
ek = kl;
/* -------------------------------
Matrix-vector multiply routines
------------------------------- */
if (lsamen_(&c__3, c3, "MV ")) {
if (lsamen_(&c__2, c2, "GE")) {
mults = em * (en + 1.f);
adds = em * en;
/* Assume M <= N + KL and KL < M
N <= M + KU and KU < N
so that the zero sections are triangles. */
} else if (lsamen_(&c__2, c2, "GB")) {
mults = em * (en + 1.f) - (em - 1.f - kl) * (em - kl) / 2.f - (en
- 1.f - ku) * (en - ku) / 2.f;
adds = em * (en + 1.f) - (em - 1.f - kl) * (em - kl) / 2.f - (en
- 1.f - ku) * (en - ku) / 2.f;
} else if (lsamen_(&c__2, c2, "SY") || lsamen_(&
c__2, c2, "SP") || lsamen_(&c__3,
subnam, "CHE") || lsamen_(&c__3, subnam,
"ZHE") || lsamen_(&c__3, subnam, "CHP") || lsamen_(&c__3, subnam, "ZHP")) {
mults = em * (em + 1.f);
adds = em * em;
} else if (lsamen_(&c__2, c2, "SB") || lsamen_(&
c__3, subnam, "CHB") || lsamen_(&c__3,
subnam, "ZHB")) {
mults = em * (em + 1.f) - (em - 1.f - ek) * (em - ek);
adds = em * em - (em - 1.f - ek) * (em - ek);
} else if (lsamen_(&c__2, c2, "TR") || lsamen_(&
c__2, c2, "TP")) {
mults = em * (em + 1.f) / 2.f;
adds = (em - 1.f) * em / 2.f;
} else if (lsamen_(&c__2, c2, "TB")) {
mults = em * (em + 1.f) / 2.f - (em - ek - 1.f) * (em - ek) / 2.f;
adds = (em - 1.f) * em / 2.f - (em - ek - 1.f) * (em - ek) / 2.f;
}
/* ---------------------
Matrix solve routines
--------------------- */
} else if (lsamen_(&c__3, c3, "SV ")) {
if (lsamen_(&c__2, c2, "TR") || lsamen_(&c__2,
c2, "TP")) {
mults = em * (em + 1.f) / 2.f;
adds = (em - 1.f) * em / 2.f;
} else if (lsamen_(&c__2, c2, "TB")) {
mults = em * (em + 1.f) / 2.f - (em - ek - 1.f) * (em - ek) / 2.f;
adds = (em - 1.f) * em / 2.f - (em - ek - 1.f) * (em - ek) / 2.f;
}
/* ----------------
Rank-one updates
---------------- */
} else if (lsamen_(&c__3, c3, "R ")) {
if (lsamen_(&c__3, subnam, "SGE") || lsamen_(&
c__3, subnam, "DGE")) {
mults = em * en + dmin(em,en);
adds = em * en;
} else if (lsamen_(&c__2, c2, "SY") || lsamen_(&
c__2, c2, "SP") || lsamen_(&c__3,
subnam, "CHE") || lsamen_(&c__3, subnam,
"CHP") || lsamen_(&c__3, subnam, "ZHE") || lsamen_(&c__3, subnam, "ZHP")) {
mults = em * (em + 1.f) / 2.f + em;
adds = em * (em + 1.f) / 2.f;
}
} else if (lsamen_(&c__3, c3, "RC ") || lsamen_(&
c__3, c3, "RU ")) {
if (lsamen_(&c__3, subnam, "CGE") || lsamen_(&
c__3, subnam, "ZGE")) {
mults = em * en + dmin(em,en);
adds = em * en;
}
/* ----------------
Rank-two updates
---------------- */
} else if (lsamen_(&c__3, c3, "R2 ")) {
if (lsamen_(&c__2, c2, "SY") || lsamen_(&c__2,
c2, "SP") || lsamen_(&c__3, subnam,
"CHE") || lsamen_(&c__3, subnam, "CHP") || lsamen_(&c__3, subnam, "ZHE") || lsamen_(&c__3, subnam, "ZHP")) {
mults = em * (em + 1.f) + em * 2.f;
adds = em * (em + 1.f);
}
}
/* ------------------------------------------------
Compute the total number of operations.
For real and double precision routines, count
1 for each multiply and 1 for each add.
For complex and complex*16 routines, count
6 for each multiply and 2 for each add.
------------------------------------------------ */
if (lsame_(c1, "S") || lsame_(c1, "D")) {
ret_val = mults + adds;
} else {
ret_val = mults * 6 + adds * 2;
}
return ret_val;
/* End of SOPBL2 */
} /* sopbl2_ */
/* Subroutine */ int zerrgt_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
doublecomplex b[2];
doublereal d__[2];
doublecomplex e[2];
integer i__;
doublecomplex w[2], x[2];
char c2[2];
doublereal r1[2], r2[2], df[2];
doublecomplex ef[2], dl[2];
integer ip[2];
doublecomplex du[2];
doublereal rw[2];
doublecomplex du2[2], dlf[2], duf[2];
integer info;
doublereal rcond, anorm;
extern /* Subroutine */ int alaesm_(char *, logical *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), zgtcon_(char *, integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, integer *,
doublereal *, doublereal *, doublecomplex *, integer *),
zptcon_(integer *, doublereal *, doublecomplex *, doublereal *,
doublereal *, doublereal *, integer *), zgtrfs_(char *, integer *,
integer *, doublecomplex *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, integer *, doublecomplex *, integer *, doublecomplex *, integer
*, doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *), zgttrf_(integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, integer *,
integer *), zptrfs_(char *, integer *, integer *, doublereal *,
doublecomplex *, doublereal *, doublecomplex *, doublecomplex *,
integer *, doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, doublereal *, integer *), zpttrf_(
integer *, doublereal *, doublecomplex *, integer *), zgttrs_(
char *, integer *, integer *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, integer *, doublecomplex *,
integer *, integer *), zpttrs_(char *, integer *, integer
*, doublereal *, doublecomplex *, doublecomplex *, 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 */
/* ======= */
/* ZERRGT tests the error exits for the COMPLEX*16 tridiagonal */
/* routines. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name for the routines to be tested. */
/* NUNIT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
for (i__ = 1; i__ <= 2; ++i__) {
d__[i__ - 1] = 1.;
i__1 = i__ - 1;
e[i__1].r = 2., e[i__1].i = 0.;
i__1 = i__ - 1;
dl[i__1].r = 3., dl[i__1].i = 0.;
i__1 = i__ - 1;
du[i__1].r = 4., du[i__1].i = 0.;
/* L10: */
}
anorm = 1.;
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "GT")) {
/* Test error exits for the general tridiagonal routines. */
/* ZGTTRF */
s_copy(srnamc_1.srnamt, "ZGTTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zgttrf_(&c_n1, dl, e, du, du2, ip, &info);
chkxer_("ZGTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZGTTRS */
s_copy(srnamc_1.srnamt, "ZGTTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zgttrs_("/", &c__0, &c__0, dl, e, du, du2, ip, x, &c__1, &info);
chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgttrs_("N", &c_n1, &c__0, dl, e, du, du2, ip, x, &c__1, &info);
chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zgttrs_("N", &c__0, &c_n1, dl, e, du, du2, ip, x, &c__1, &info);
chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zgttrs_("N", &c__2, &c__1, dl, e, du, du2, ip, x, &c__1, &info);
chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZGTRFS */
s_copy(srnamc_1.srnamt, "ZGTRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zgtrfs_("/", &c__0, &c__0, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1,
x, &c__1, r1, r2, w, rw, &info);
chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgtrfs_("N", &c_n1, &c__0, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1,
x, &c__1, r1, r2, w, rw, &info);
chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zgtrfs_("N", &c__0, &c_n1, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1,
x, &c__1, r1, r2, w, rw, &info);
chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 13;
zgtrfs_("N", &c__2, &c__1, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1,
x, &c__2, r1, r2, w, rw, &info);
chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 15;
zgtrfs_("N", &c__2, &c__1, dl, e, du, dlf, ef, duf, du2, ip, b, &c__2,
x, &c__1, r1, r2, w, rw, &info);
chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZGTCON */
s_copy(srnamc_1.srnamt, "ZGTCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zgtcon_("/", &c__0, dl, e, du, du2, ip, &anorm, &rcond, w, &info);
chkxer_("ZGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgtcon_("I", &c_n1, dl, e, du, du2, ip, &anorm, &rcond, w, &info);
chkxer_("ZGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
d__1 = -anorm;
zgtcon_("I", &c__0, dl, e, du, du2, ip, &d__1, &rcond, w, &info);
chkxer_("ZGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "PT")) {
/* Test error exits for the positive definite tridiagonal */
/* routines. */
/* ZPTTRF */
s_copy(srnamc_1.srnamt, "ZPTTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpttrf_(&c_n1, d__, e, &info);
chkxer_("ZPTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPTTRS */
s_copy(srnamc_1.srnamt, "ZPTTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpttrs_("/", &c__1, &c__0, d__, e, x, &c__1, &info);
chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpttrs_("U", &c_n1, &c__0, d__, e, x, &c__1, &info);
chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpttrs_("U", &c__0, &c_n1, d__, e, x, &c__1, &info);
chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zpttrs_("U", &c__2, &c__1, d__, e, x, &c__1, &info);
chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPTRFS */
s_copy(srnamc_1.srnamt, "ZPTRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zptrfs_("/", &c__1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2,
w, rw, &info);
chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zptrfs_("U", &c_n1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2,
w, rw, &info);
chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zptrfs_("U", &c__0, &c_n1, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2,
w, rw, &info);
chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
zptrfs_("U", &c__2, &c__1, d__, e, df, ef, b, &c__1, x, &c__2, r1, r2,
w, rw, &info);
chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
zptrfs_("U", &c__2, &c__1, d__, e, df, ef, b, &c__2, x, &c__1, r1, r2,
w, rw, &info);
chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPTCON */
s_copy(srnamc_1.srnamt, "ZPTCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zptcon_(&c_n1, d__, e, &anorm, &rcond, rw, &info);
chkxer_("ZPTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
d__1 = -anorm;
zptcon_(&c__0, d__, e, &d__1, &rcond, rw, &info);
chkxer_("ZPTCON", &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 ZERRGT */
} /* zerrgt_ */
/* Subroutine */ int dlatb9_(char *path, integer *imat, integer *m, integer *
p, integer *n, char *type__, integer *kla, integer *kua, integer *klb,
integer *kub, doublereal *anorm, doublereal *bnorm, integer *modea,
integer *modeb, doublereal *cndnma, doublereal *cndnmb, char *dista,
char *distb)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static doublereal eps, badc1, badc2, large, small;
extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
extern doublereal dlamch_(char *);
extern logical lsamen_(integer *, char *, char *);
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DLATB9 sets parameters for the matrix generator based on the type of */
/* matrix to be generated. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name. */
/* IMAT (input) INTEGER */
/* An integer key describing which matrix to generate for this */
/* path. */
/* M (input) INTEGER */
/* The number of rows in the matrix to be generated. */
/* N (input) INTEGER */
/* The number of columns in the matrix to be generated. */
/* TYPE (output) CHARACTER*1 */
/* The type of the matrix to be generated: */
/* = 'S': symmetric matrix; */
/* = 'P': symmetric positive (semi)definite matrix; */
/* = 'N': nonsymmetric matrix. */
/* KL (output) INTEGER */
/* The lower band width of the matrix to be generated. */
/* KU (output) INTEGER */
/* The upper band width of the matrix to be generated. */
/* ANORM (output) DOUBLE PRECISION */
/* The desired norm of the matrix to be generated. The diagonal */
/* matrix of singular values or eigenvalues is scaled by this */
/* value. */
/* MODE (output) INTEGER */
/* A key indicating how to choose the vector of eigenvalues. */
/* CNDNUM (output) DOUBLE PRECISION */
/* The desired condition number. */
/* DIST (output) CHARACTER*1 */
/* The type of distribution to be used by the random number */
/* generator. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Save statement .. */
/* .. */
/* .. Data statements .. */
/* .. */
/* .. Executable Statements .. */
/* Set some constants for use in the subroutine. */
if (first) {
first = FALSE_;
eps = dlamch_("Precision");
badc2 = .1 / eps;
badc1 = sqrt(badc2);
small = dlamch_("Safe minimum");
large = 1. / small;
/* If it looks like we're on a Cray, take the square root of */
/* SMALL and LARGE to avoid overflow and underflow problems. */
dlabad_(&small, &large);
small = small / eps * .25;
large = 1. / small;
}
/* Set some parameters we don't plan to change. */
*(unsigned char *)type__ = 'N';
*(unsigned char *)dista = 'S';
*(unsigned char *)distb = 'S';
*modea = 3;
*modeb = 4;
/* Set the lower and upper bandwidths. */
if (lsamen_(&c__3, path, "GRQ") || lsamen_(&c__3,
path, "LSE") || lsamen_(&c__3, path, "GSV")) {
/* A: M by N, B: P by N */
if (*imat == 1) {
/* A: diagonal, B: upper triangular */
*kla = 0;
*kua = 0;
*klb = 0;
/* Computing MAX */
i__1 = *n - 1;
*kub = max(i__1,0);
} else if (*imat == 2) {
/* A: upper triangular, B: upper triangular */
*kla = 0;
/* Computing MAX */
i__1 = *n - 1;
*kua = max(i__1,0);
*klb = 0;
/* Computing MAX */
i__1 = *n - 1;
*kub = max(i__1,0);
} else if (*imat == 3) {
/* A: lower triangular, B: upper triangular */
/* Computing MAX */
i__1 = *m - 1;
*kla = max(i__1,0);
*kua = 0;
*klb = 0;
/* Computing MAX */
i__1 = *n - 1;
*kub = max(i__1,0);
} else {
/* A: general dense, B: general dense */
/* Computing MAX */
i__1 = *m - 1;
*kla = max(i__1,0);
/* Computing MAX */
i__1 = *n - 1;
*kua = max(i__1,0);
/* Computing MAX */
i__1 = *p - 1;
*klb = max(i__1,0);
/* Computing MAX */
i__1 = *n - 1;
*kub = max(i__1,0);
}
} else if (lsamen_(&c__3, path, "GQR") || lsamen_(&
c__3, path, "GLM")) {
/* A: N by M, B: N by P */
if (*imat == 1) {
/* A: diagonal, B: lower triangular */
*kla = 0;
*kua = 0;
/* Computing MAX */
i__1 = *n - 1;
*klb = max(i__1,0);
*kub = 0;
} else if (*imat == 2) {
/* A: lower triangular, B: diagonal */
/* Computing MAX */
i__1 = *n - 1;
*kla = max(i__1,0);
*kua = 0;
*klb = 0;
*kub = 0;
} else if (*imat == 3) {
/* A: lower triangular, B: upper triangular */
/* Computing MAX */
i__1 = *n - 1;
*kla = max(i__1,0);
*kua = 0;
*klb = 0;
/* Computing MAX */
i__1 = *p - 1;
*kub = max(i__1,0);
} else {
/* A: general dense, B: general dense */
/* Computing MAX */
i__1 = *n - 1;
*kla = max(i__1,0);
/* Computing MAX */
i__1 = *m - 1;
*kua = max(i__1,0);
/* Computing MAX */
i__1 = *n - 1;
*klb = max(i__1,0);
/* Computing MAX */
i__1 = *p - 1;
*kub = max(i__1,0);
}
}
/* Set the condition number and norm. */
*cndnma = 100.;
*cndnmb = 10.;
if (lsamen_(&c__3, path, "GQR") || lsamen_(&c__3,
path, "GRQ") || lsamen_(&c__3, path, "GSV")) {
if (*imat == 5) {
*cndnma = badc1;
*cndnmb = badc1;
} else if (*imat == 6) {
*cndnma = badc2;
*cndnmb = badc2;
} else if (*imat == 7) {
*cndnma = badc1;
*cndnmb = badc2;
} else if (*imat == 8) {
*cndnma = badc2;
*cndnmb = badc1;
}
}
*anorm = 10.;
*bnorm = 1e3;
if (lsamen_(&c__3, path, "GQR") || lsamen_(&c__3,
path, "GRQ")) {
if (*imat == 7) {
*anorm = small;
*bnorm = large;
} else if (*imat == 8) {
*anorm = large;
*bnorm = small;
}
}
if (*n <= 1) {
*cndnma = 1.;
*cndnmb = 1.;
}
return 0;
/* End of DLATB9 */
} /* dlatb9_ */
/* Subroutine */ int serrpo_(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];
integer i__, j;
real w[12], x[4];
char c2[2];
real r1[4], r2[4], af[16] /* was [4][4] */;
integer iw[4], info;
real anrm, rcond;
extern /* Subroutine */ int spbtf2_(char *, integer *, integer *, real *,
integer *, integer *), spotf2_(char *, integer *, real *,
integer *, integer *), alaesm_(char *, logical *, integer
*);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), spbcon_(char *, integer *, integer *, real
*, integer *, real *, real *, real *, integer *, integer *), spbequ_(char *, integer *, integer *, real *, integer *,
real *, real *, real *, integer *), spbrfs_(char *,
integer *, integer *, integer *, real *, integer *, real *,
integer *, real *, integer *, real *, integer *, real *, real *,
real *, integer *, integer *), spbtrf_(char *, integer *,
integer *, real *, integer *, integer *), spocon_(char *,
integer *, real *, integer *, real *, real *, real *, integer *,
integer *), sppcon_(char *, integer *, real *, real *,
real *, real *, integer *, integer *), spoequ_(integer *,
real *, integer *, real *, real *, real *, integer *), spbtrs_(
char *, integer *, integer *, integer *, real *, integer *, real *
, integer *, integer *), sporfs_(char *, integer *,
integer *, real *, integer *, real *, integer *, real *, integer *
, real *, integer *, real *, real *, real *, integer *, integer *), spotrf_(char *, integer *, real *, integer *, integer *), spotri_(char *, integer *, real *, integer *, integer *), sppequ_(char *, integer *, real *, real *, real *, real
*, integer *), spprfs_(char *, integer *, integer *, real
*, real *, real *, integer *, real *, integer *, real *, real *,
real *, integer *, integer *), spptrf_(char *, integer *,
real *, integer *), spptri_(char *, integer *, real *,
integer *), spotrs_(char *, integer *, integer *, real *,
integer *, real *, integer *, integer *), spptrs_(char *,
integer *, 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 */
/* ======= */
/* SERRPO tests the error exits for the REAL routines */
/* for symmetric positive definite matrices. */
/* 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;
iw[j - 1] = j;
/* L20: */
}
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "PO")) {
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a symmetric positive definite matrix. */
/* SPOTRF */
s_copy(srnamc_1.srnamt, "SPOTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spotrf_("/", &c__0, a, &c__1, &info);
chkxer_("SPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spotrf_("U", &c_n1, a, &c__1, &info);
chkxer_("SPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spotrf_("U", &c__2, a, &c__1, &info);
chkxer_("SPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPOTF2 */
s_copy(srnamc_1.srnamt, "SPOTF2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spotf2_("/", &c__0, a, &c__1, &info);
chkxer_("SPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spotf2_("U", &c_n1, a, &c__1, &info);
chkxer_("SPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spotf2_("U", &c__2, a, &c__1, &info);
chkxer_("SPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPOTRI */
s_copy(srnamc_1.srnamt, "SPOTRI", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spotri_("/", &c__0, a, &c__1, &info);
chkxer_("SPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spotri_("U", &c_n1, a, &c__1, &info);
chkxer_("SPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spotri_("U", &c__2, a, &c__1, &info);
chkxer_("SPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPOTRS */
s_copy(srnamc_1.srnamt, "SPOTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spotrs_("/", &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("SPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spotrs_("U", &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("SPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spotrs_("U", &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("SPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
spotrs_("U", &c__2, &c__1, a, &c__1, b, &c__2, &info);
chkxer_("SPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
spotrs_("U", &c__2, &c__1, a, &c__2, b, &c__1, &info);
chkxer_("SPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPORFS */
s_copy(srnamc_1.srnamt, "SPORFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sporfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sporfs_("U", &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sporfs_("U", &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sporfs_("U", &c__2, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &c__2,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sporfs_("U", &c__2, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &c__2,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
sporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__1, x, &c__2,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
sporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__2, x, &c__1,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPOCON */
s_copy(srnamc_1.srnamt, "SPOCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spocon_("/", &c__0, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spocon_("U", &c_n1, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spocon_("U", &c__2, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPOEQU */
s_copy(srnamc_1.srnamt, "SPOEQU", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spoequ_(&c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spoequ_(&c__2, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "PP")) {
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a symmetric positive definite packed matrix. */
/* SPPTRF */
s_copy(srnamc_1.srnamt, "SPPTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spptrf_("/", &c__0, a, &info);
chkxer_("SPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spptrf_("U", &c_n1, a, &info);
chkxer_("SPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPPTRI */
s_copy(srnamc_1.srnamt, "SPPTRI", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spptri_("/", &c__0, a, &info);
chkxer_("SPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spptri_("U", &c_n1, a, &info);
chkxer_("SPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPPTRS */
s_copy(srnamc_1.srnamt, "SPPTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spptrs_("/", &c__0, &c__0, a, b, &c__1, &info);
chkxer_("SPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spptrs_("U", &c_n1, &c__0, a, b, &c__1, &info);
chkxer_("SPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spptrs_("U", &c__0, &c_n1, a, b, &c__1, &info);
chkxer_("SPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
spptrs_("U", &c__2, &c__1, a, b, &c__1, &info);
chkxer_("SPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPPRFS */
s_copy(srnamc_1.srnamt, "SPPRFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spprfs_("/", &c__0, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, iw, &
info);
chkxer_("SPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spprfs_("U", &c_n1, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, iw, &
info);
chkxer_("SPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spprfs_("U", &c__0, &c_n1, a, af, b, &c__1, x, &c__1, r1, r2, w, iw, &
info);
chkxer_("SPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
spprfs_("U", &c__2, &c__1, a, af, b, &c__1, x, &c__2, r1, r2, w, iw, &
info);
chkxer_("SPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
spprfs_("U", &c__2, &c__1, a, af, b, &c__2, x, &c__1, r1, r2, w, iw, &
info);
chkxer_("SPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPPCON */
s_copy(srnamc_1.srnamt, "SPPCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sppcon_("/", &c__0, a, &anrm, &rcond, w, iw, &info);
chkxer_("SPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sppcon_("U", &c_n1, a, &anrm, &rcond, w, iw, &info);
chkxer_("SPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPPEQU */
s_copy(srnamc_1.srnamt, "SPPEQU", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sppequ_("/", &c__0, a, r1, &rcond, &anrm, &info);
chkxer_("SPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sppequ_("U", &c_n1, a, r1, &rcond, &anrm, &info);
chkxer_("SPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "PB")) {
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a symmetric positive definite band matrix. */
/* SPBTRF */
s_copy(srnamc_1.srnamt, "SPBTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spbtrf_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("SPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbtrf_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("SPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbtrf_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("SPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
spbtrf_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("SPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPBTF2 */
s_copy(srnamc_1.srnamt, "SPBTF2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spbtf2_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("SPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbtf2_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("SPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbtf2_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("SPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
spbtf2_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("SPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPBTRS */
s_copy(srnamc_1.srnamt, "SPBTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spbtrs_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbtrs_("U", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbtrs_("U", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spbtrs_("U", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
spbtrs_("U", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
spbtrs_("U", &c__2, &c__0, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPBRFS */
s_copy(srnamc_1.srnamt, "SPBRFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spbrfs_("/", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbrfs_("U", &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbrfs_("U", &c__1, &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spbrfs_("U", &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
spbrfs_("U", &c__2, &c__1, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
spbrfs_("U", &c__2, &c__1, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
spbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__1, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
spbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__2, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPBCON */
s_copy(srnamc_1.srnamt, "SPBCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spbcon_("/", &c__0, &c__0, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbcon_("U", &c_n1, &c__0, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbcon_("U", &c__1, &c_n1, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
spbcon_("U", &c__2, &c__1, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPBEQU */
s_copy(srnamc_1.srnamt, "SPBEQU", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spbequ_("/", &c__0, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbequ_("U", &c_n1, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbequ_("U", &c__1, &c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
spbequ_("U", &c__2, &c__1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPBEQU", &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 SERRPO */
} /* serrpo_ */
