/* 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 cerrqr_(char *path, integer *nunit) { /* 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); /* Local variables */ complex a[4] /* was [2][2] */, b[2]; integer i__, j; complex w[2], x[2], af[4] /* was [2][2] */; integer info; extern /* Subroutine */ int cgeqr2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), cung2r_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), cunm2r_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), alaesm_(char *, logical *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cgeqrs_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), cungqr_( integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cunmqr_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, 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 */ /* ======= */ /* CERRQR tests the error exits for the COMPLEX routines */ /* that use the QR decomposition of a general matrix. */ /* 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 .. */ /* .. */ /* .. 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(); /* Set the variables to innocuous values. */ for (j = 1; j <= 2; ++j) { for (i__ = 1; i__ <= 2; ++i__) { i__1 = i__ + (j << 1) - 3; 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 << 1) - 3; 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; 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; /* L20: */ } infoc_1.ok = TRUE_; /* Error exits for QR factorization */ /* CGEQRF */ s_copy(srnamc_1.srnamt, "CGEQRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cgeqrf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info); chkxer_("CGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgeqrf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info); chkxer_("CGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgeqrf_(&c__2, &c__1, a, &c__1, b, w, &c__1, &info); chkxer_("CGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cgeqrf_(&c__1, &c__2, a, &c__1, b, w, &c__1, &info); chkxer_("CGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGEQR2 */ s_copy(srnamc_1.srnamt, "CGEQR2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cgeqr2_(&c_n1, &c__0, a, &c__1, b, w, &info); chkxer_("CGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgeqr2_(&c__0, &c_n1, a, &c__1, b, w, &info); chkxer_("CGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgeqr2_(&c__2, &c__1, a, &c__1, b, w, &info); chkxer_("CGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGEQRS */ s_copy(srnamc_1.srnamt, "CGEQRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cgeqrs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgeqrs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgeqrs_(&c__1, &c__2, &c__0, a, &c__2, x, b, &c__2, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cgeqrs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cgeqrs_(&c__2, &c__1, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; cgeqrs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; cgeqrs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CUNGQR */ s_copy(srnamc_1.srnamt, "CUNGQR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cungqr_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cungqr_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cungqr_(&c__1, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cungqr_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cungqr_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cungqr_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; cungqr_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CUNG2R */ s_copy(srnamc_1.srnamt, "CUNG2R", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cung2r_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cung2r_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cung2r_(&c__1, &c__2, &c__0, a, &c__1, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cung2r_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cung2r_(&c__2, &c__1, &c__2, a, &c__2, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cung2r_(&c__2, &c__1, &c__0, a, &c__1, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CUNMQR */ s_copy(srnamc_1.srnamt, "CUNMQR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cunmqr_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cunmqr_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cunmqr_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cunmqr_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunmqr_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunmqr_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunmqr_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cunmqr_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cunmqr_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; cunmqr_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; cunmqr_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; cunmqr_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CUNM2R */ s_copy(srnamc_1.srnamt, "CUNM2R", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cunm2r_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cunm2r_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cunm2r_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cunm2r_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunm2r_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunm2r_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunm2r_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cunm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cunm2r_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; cunm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info); chkxer_("CUNM2R", &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 CERRQR */ } /* cerrqr_ */
/* 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_ */
/* Subroutine */ int derrqr_(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[4] /* was [2][2] */, b[2]; integer i__, j; doublereal w[2], x[2], af[4] /* was [2][2] */; integer info; extern /* Subroutine */ int dgeqr2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorg2r_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorm2r_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), alaesm_(char *, logical *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), dgeqrs_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), dorgqr_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dormqr_(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 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* DERRQR tests the error exits for the DOUBLE PRECISION routines */ /* that use the QR decomposition of a general matrix. */ /* 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 .. */ /* .. */ /* .. 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(); /* Set the variables to innocuous values. */ for (j = 1; j <= 2; ++j) { for (i__ = 1; i__ <= 2; ++i__) { a[i__ + (j << 1) - 3] = 1. / (doublereal) (i__ + j); af[i__ + (j << 1) - 3] = 1. / (doublereal) (i__ + j); /* L10: */ } b[j - 1] = 0.; w[j - 1] = 0.; x[j - 1] = 0.; /* L20: */ } infoc_1.ok = TRUE_; /* Error exits for QR factorization */ /* DGEQRF */ s_copy(srnamc_1.srnamt, "DGEQRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgeqrf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info); chkxer_("DGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgeqrf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info); chkxer_("DGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgeqrf_(&c__2, &c__1, a, &c__1, b, w, &c__1, &info); chkxer_("DGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dgeqrf_(&c__1, &c__2, a, &c__1, b, w, &c__1, &info); chkxer_("DGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGEQR2 */ s_copy(srnamc_1.srnamt, "DGEQR2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgeqr2_(&c_n1, &c__0, a, &c__1, b, w, &info); chkxer_("DGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgeqr2_(&c__0, &c_n1, a, &c__1, b, w, &info); chkxer_("DGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgeqr2_(&c__2, &c__1, a, &c__1, b, w, &info); chkxer_("DGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGEQRS */ s_copy(srnamc_1.srnamt, "DGEQRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgeqrs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgeqrs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgeqrs_(&c__1, &c__2, &c__0, a, &c__2, x, b, &c__2, w, &c__1, &info); chkxer_("DGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgeqrs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgeqrs_(&c__2, &c__1, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info); chkxer_("DGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dgeqrs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dgeqrs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORGQR */ s_copy(srnamc_1.srnamt, "DORGQR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dorgqr_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("DORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorgqr_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("DORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorgqr_(&c__1, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("DORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgqr_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info); chkxer_("DORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgqr_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info); chkxer_("DORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorgqr_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("DORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dorgqr_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info); chkxer_("DORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORG2R */ s_copy(srnamc_1.srnamt, "DORG2R", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dorg2r_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info); chkxer_("DORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorg2r_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info); chkxer_("DORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorg2r_(&c__1, &c__2, &c__0, a, &c__1, x, w, &info); chkxer_("DORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorg2r_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info); chkxer_("DORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorg2r_(&c__2, &c__1, &c__2, a, &c__2, x, w, &info); chkxer_("DORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorg2r_(&c__2, &c__1, &c__0, a, &c__1, x, w, &info); chkxer_("DORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORMQR */ s_copy(srnamc_1.srnamt, "DORMQR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dormqr_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dormqr_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dormqr_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dormqr_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dormqr_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dormqr_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dormqr_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dormqr_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dormqr_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dormqr_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dormqr_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dormqr_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("DORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORM2R */ s_copy(srnamc_1.srnamt, "DORM2R", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dorm2r_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorm2r_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorm2r_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dorm2r_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorm2r_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorm2r_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorm2r_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dorm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &info); chkxer_("DORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dorm2r_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dorm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info); chkxer_("DORM2R", &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 DERRQR */ } /* derrqr_ */
/* Subroutine */ int derrls_(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[4] /* was [2][2] */, b[4] /* was [2][2] */, s[2], w[2]; char c2[2]; integer ip[2], info, irnk; extern /* Subroutine */ int dgels_(char *, integer *, integer *, integer * , doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); doublereal rcond; extern /* Subroutine */ int alaesm_(char *, logical *, integer *), dgelsd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int dgelss_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), dgelsx_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dgelsy_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, 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 */ /* ======= */ /* DERRLS tests the error exits for the DOUBLE PRECISION least squares */ /* driver routines (DGELS, SGELSS, SGELSX, SGELSY, SGELSD). */ /* 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.; infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "LS")) { /* Test error exits for the least squares driver routines. */ /* DGELS */ s_copy(srnamc_1.srnamt, "DGELS ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgels_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, w, &c__1, &info); chkxer_("DGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgels_("N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, w, &c__1, &info); chkxer_("DGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgels_("N", &c__0, &c_n1, &c__0, a, &c__1, b, &c__1, w, &c__1, &info); chkxer_("DGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgels_("N", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, w, &c__1, &info); chkxer_("DGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; dgels_("N", &c__2, &c__0, &c__0, a, &c__1, b, &c__2, w, &c__2, &info); chkxer_("DGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dgels_("N", &c__2, &c__0, &c__0, a, &c__2, b, &c__1, w, &c__2, &info); chkxer_("DGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dgels_("N", &c__1, &c__1, &c__0, a, &c__1, b, &c__1, w, &c__1, &info); chkxer_("DGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGELSS */ s_copy(srnamc_1.srnamt, "DGELSS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgelss_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__1, &info); chkxer_("DGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgelss_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__1, &info); chkxer_("DGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgelss_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__1, &info); chkxer_("DGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgelss_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, s, &rcond, &irnk, w, &c__2, &info); chkxer_("DGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dgelss_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, s, &rcond, &irnk, w, &c__2, &info); chkxer_("DGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGELSX */ s_copy(srnamc_1.srnamt, "DGELSX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgelsx_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, &info); chkxer_("DGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgelsx_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, &info); chkxer_("DGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgelsx_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, &info); chkxer_("DGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgelsx_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, ip, &rcond, &irnk, w, &info); chkxer_("DGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dgelsx_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, ip, &rcond, &irnk, w, &info); chkxer_("DGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGELSY */ s_copy(srnamc_1.srnamt, "DGELSY", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgelsy_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, &c__10, &info); chkxer_("DGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgelsy_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, &c__10, &info); chkxer_("DGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgelsy_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, &c__10, &info); chkxer_("DGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgelsy_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, ip, &rcond, &irnk, w, &c__10, &info); chkxer_("DGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dgelsy_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, ip, &rcond, &irnk, w, &c__10, &info); chkxer_("DGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dgelsy_(&c__2, &c__2, &c__1, a, &c__2, b, &c__2, ip, &rcond, &irnk, w, &c__1, &info); chkxer_("DGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGELSD */ s_copy(srnamc_1.srnamt, "DGELSD", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgelsd_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__10, ip, &info); chkxer_("DGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgelsd_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__10, ip, &info); chkxer_("DGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgelsd_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__10, ip, &info); chkxer_("DGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgelsd_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, s, &rcond, &irnk, w, &c__10, ip, &info); chkxer_("DGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dgelsd_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, s, &rcond, &irnk, w, &c__10, ip, &info); chkxer_("DGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dgelsd_(&c__2, &c__2, &c__1, a, &c__2, b, &c__2, s, &rcond, &irnk, w, &c__1, ip, &info); chkxer_("DGELSD", &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 DERRLS */ } /* derrls_ */
/* Subroutine */ int derrtz_(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[4] /* was [2][2] */, w[2]; char c2[2]; doublereal 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 *), dtzrqf_(integer *, integer *, doublereal *, integer *, doublereal *, integer *), dtzrzf_(integer *, integer * , doublereal *, integer *, doublereal *, 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 */ /* ======= */ /* 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 zerrls_(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, irnk; static doublecomplex a[4] /* was [2][2] */, b[4] /* was [2][2] */; static doublereal s[2]; static doublecomplex w[2]; static doublereal rcond; extern /* Subroutine */ int zgels_(char *, integer *, integer *, integer * , doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); static char c2[2]; static integer ip[2]; extern /* Subroutine */ int alaesm_(char *, logical *, integer *); static doublereal rw[2]; extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), zgelsd_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, integer *, doublecomplex *, integer *, doublereal *, integer *, integer *), zgelss_(integer *, integer * , integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, integer *, doublecomplex *, integer *, doublereal *, integer *), zgelsx_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer * , integer *, doublereal *, integer *, doublecomplex *, doublereal *, integer *), zgelsy_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublereal *, integer *, doublecomplex *, integer *, doublereal * , integer *); /* Fortran I/O blocks */ static cilist io___3 = { 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 ======= ZERRLS tests the error exits for the COMPLEX*16 least squares driver routines (ZGELS, CGELSS, CGELSX, CGELSY, CGELSD). 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); i__1 = a_subscr(1, 1); a[i__1].r = 1., a[i__1].i = 0.; i__1 = a_subscr(1, 2); a[i__1].r = 2., a[i__1].i = 0.; i__1 = a_subscr(2, 2); a[i__1].r = 3., a[i__1].i = 0.; i__1 = a_subscr(2, 1); a[i__1].r = 4., a[i__1].i = 0.; infoc_1.ok = TRUE_; io___3.ciunit = infoc_1.nout; s_wsle(&io___3); e_wsle(); /* Test error exits for the least squares driver routines. */ if (lsamen_(&c__2, c2, "LS")) { /* ZGELS */ s_copy(srnamc_1.srnamt, "ZGELS ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgels_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, w, &c__1, &info); chkxer_("ZGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgels_("N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, w, &c__1, &info); chkxer_("ZGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgels_("N", &c__0, &c_n1, &c__0, a, &c__1, b, &c__1, w, &c__1, &info); chkxer_("ZGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgels_("N", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, w, &c__1, &info); chkxer_("ZGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgels_("N", &c__2, &c__0, &c__0, a, &c__1, b, &c__2, w, &c__2, &info); chkxer_("ZGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zgels_("N", &c__2, &c__0, &c__0, a, &c__2, b, &c__1, w, &c__2, &info); chkxer_("ZGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgels_("N", &c__1, &c__1, &c__0, a, &c__1, b, &c__1, w, &c__1, &info); chkxer_("ZGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGELSS */ s_copy(srnamc_1.srnamt, "ZGELSS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgelss_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__1, rw, &info); chkxer_("ZGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgelss_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__1, rw, &info); chkxer_("ZGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgelss_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__1, rw, &info); chkxer_("ZGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgelss_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, s, &rcond, &irnk, w, &c__2, rw, &info); chkxer_("ZGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgelss_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, s, &rcond, &irnk, w, &c__2, rw, &info); chkxer_("ZGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGELSX */ s_copy(srnamc_1.srnamt, "ZGELSX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgelsx_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, rw, &info); chkxer_("ZGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgelsx_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, rw, &info); chkxer_("ZGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgelsx_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, rw, &info); chkxer_("ZGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgelsx_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, ip, &rcond, &irnk, w, rw, &info); chkxer_("ZGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgelsx_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, ip, &rcond, &irnk, w, rw, &info); chkxer_("ZGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGELSY */ s_copy(srnamc_1.srnamt, "ZGELSY", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgelsy_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, &c__10, rw, &info); chkxer_("ZGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgelsy_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, &c__10, rw, &info); chkxer_("ZGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgelsy_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, &c__10, rw, &info); chkxer_("ZGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgelsy_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, ip, &rcond, &irnk, w, &c__10, rw, &info); chkxer_("ZGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgelsy_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, ip, &rcond, &irnk, w, &c__10, rw, &info); chkxer_("ZGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zgelsy_(&c__0, &c__3, &c__0, a, &c__1, b, &c__3, ip, &rcond, &irnk, w, &c__1, rw, &info); chkxer_("ZGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGELSD */ s_copy(srnamc_1.srnamt, "ZGELSD", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgelsd_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__10, rw, ip, &info); chkxer_("ZGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgelsd_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__10, rw, ip, &info); chkxer_("ZGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgelsd_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, s, &rcond, &irnk, w, &c__10, rw, ip, &info); chkxer_("ZGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgelsd_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, s, &rcond, &irnk, w, &c__10, rw, ip, &info); chkxer_("ZGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgelsd_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, s, &rcond, &irnk, w, &c__10, rw, ip, &info); chkxer_("ZGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zgelsd_(&c__2, &c__2, &c__1, a, &c__2, b, &c__2, s, &rcond, &irnk, w, &c__1, rw, ip, &info); chkxer_("ZGELSD", &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 ZERRLS */ } /* zerrls_ */
/* Subroutine */ int serrqr_(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 a[4] /* was [2][2] */, b[2]; static integer i__, j; static real w[2], x[2]; extern /* Subroutine */ int sgeqr2_(integer *, integer *, real *, integer *, real *, real *, integer *); static real af[4] /* was [2][2] */; extern /* Subroutine */ int sorg2r_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), sorm2r_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real * , integer *, real *, integer *), alaesm_(char *, logical *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), sgeqrs_( integer *, integer *, integer *, real *, integer *, real *, real * , integer *, real *, integer *, integer *), sorgqr_(integer *, integer *, integer *, real *, integer *, real *, real *, integer * , integer *), sormqr_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, 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)*2 + a_1 - 3] #define af_ref(a_1,a_2) af[(a_2)*2 + a_1 - 3] /* -- 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 ======= SERRQR tests the error exits for the REAL routines that use the QR decomposition of a general matrix. 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(); /* Set the variables to innocuous values. */ for (j = 1; j <= 2; ++j) { for (i__ = 1; i__ <= 2; ++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; w[j - 1] = 0.f; x[j - 1] = 0.f; /* L20: */ } infoc_1.ok = TRUE_; /* Error exits for QR factorization SGEQRF */ s_copy(srnamc_1.srnamt, "SGEQRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgeqrf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info); chkxer_("SGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgeqrf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info); chkxer_("SGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgeqrf_(&c__2, &c__1, a, &c__1, b, w, &c__1, &info); chkxer_("SGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgeqrf_(&c__1, &c__2, a, &c__1, b, w, &c__1, &info); chkxer_("SGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGEQR2 */ s_copy(srnamc_1.srnamt, "SGEQR2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgeqr2_(&c_n1, &c__0, a, &c__1, b, w, &info); chkxer_("SGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgeqr2_(&c__0, &c_n1, a, &c__1, b, w, &info); chkxer_("SGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgeqr2_(&c__2, &c__1, a, &c__1, b, w, &info); chkxer_("SGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGEQRS */ s_copy(srnamc_1.srnamt, "SGEQRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgeqrs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("SGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgeqrs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("SGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgeqrs_(&c__1, &c__2, &c__0, a, &c__2, x, b, &c__2, w, &c__1, &info); chkxer_("SGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgeqrs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("SGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgeqrs_(&c__2, &c__1, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info); chkxer_("SGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sgeqrs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info); chkxer_("SGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sgeqrs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("SGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SORGQR */ s_copy(srnamc_1.srnamt, "SORGQR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sorgqr_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("SORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sorgqr_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("SORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sorgqr_(&c__1, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("SORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sorgqr_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info); chkxer_("SORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sorgqr_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info); chkxer_("SORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sorgqr_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("SORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sorgqr_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info); chkxer_("SORGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SORG2R */ s_copy(srnamc_1.srnamt, "SORG2R", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sorg2r_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info); chkxer_("SORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sorg2r_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info); chkxer_("SORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sorg2r_(&c__1, &c__2, &c__0, a, &c__1, x, w, &info); chkxer_("SORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sorg2r_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info); chkxer_("SORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sorg2r_(&c__2, &c__1, &c__2, a, &c__2, x, w, &info); chkxer_("SORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sorg2r_(&c__2, &c__1, &c__0, a, &c__1, x, w, &info); chkxer_("SORG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SORMQR */ s_copy(srnamc_1.srnamt, "SORMQR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sormqr_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sormqr_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sormqr_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sormqr_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sormqr_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sormqr_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sormqr_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sormqr_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sormqr_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sormqr_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sormqr_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sormqr_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("SORMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SORM2R */ s_copy(srnamc_1.srnamt, "SORM2R", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sorm2r_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sorm2r_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sorm2r_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sorm2r_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sorm2r_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sorm2r_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sorm2r_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sorm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &info); chkxer_("SORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sorm2r_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sorm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info); chkxer_("SORM2R", &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 SERRQR */ } /* serrqr_ */
/* Subroutine */ int derrgt_(char *path, integer *nunit) { /* System generated locals */ doublereal d__1; /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ static integer info; static doublereal b[2], c__[2], d__[2], e[2], f[2], w[2], x[2], rcond, anorm; static char c2[2]; static doublereal r1[2], r2[2], cf[2], df[2], ef[2]; static integer ip[2], iw[2]; extern /* Subroutine */ int alaesm_(char *, logical *, integer *), dgtcon_(char *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), dptcon_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *) , dgtrfs_(char *, integer *, integer *, doublereal *, doublereal * , doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgttrf_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dptrfs_( integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), dpttrf_( integer *, doublereal *, doublereal *, integer *), dgttrs_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), dpttrs_(integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; /* -- 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 ======= DERRGT tests the error exits for the DOUBLE PRECISION 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. ===================================================================== */ 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.; d__[1] = 2.; df[0] = 1.; df[1] = 2.; e[0] = 3.; e[1] = 4.; ef[0] = 3.; ef[1] = 4.; anorm = 1.; infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "GT")) { /* Test error exits for the general tridiagonal routines. DGTTRF */ s_copy(srnamc_1.srnamt, "DGTTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgttrf_(&c_n1, c__, d__, e, f, ip, &info); chkxer_("DGTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGTTRS */ s_copy(srnamc_1.srnamt, "DGTTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgttrs_("/", &c__0, &c__0, c__, d__, e, f, ip, x, &c__1, &info); chkxer_("DGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgttrs_("N", &c_n1, &c__0, c__, d__, e, f, ip, x, &c__1, &info); chkxer_("DGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgttrs_("N", &c__0, &c_n1, c__, d__, e, f, ip, x, &c__1, &info); chkxer_("DGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dgttrs_("N", &c__2, &c__1, c__, d__, e, f, ip, x, &c__1, &info); chkxer_("DGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGTRFS */ s_copy(srnamc_1.srnamt, "DGTRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgtrfs_("/", &c__0, &c__0, c__, d__, e, cf, df, ef, f, ip, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("DGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgtrfs_("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_("DGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgtrfs_("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_("DGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; dgtrfs_("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_("DGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; dgtrfs_("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_("DGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGTCON */ s_copy(srnamc_1.srnamt, "DGTCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgtcon_("/", &c__0, c__, d__, e, f, ip, &anorm, &rcond, w, iw, &info); chkxer_("DGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgtcon_("I", &c_n1, c__, d__, e, f, ip, &anorm, &rcond, w, iw, &info); chkxer_("DGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; d__1 = -anorm; dgtcon_("I", &c__0, c__, d__, e, f, ip, &d__1, &rcond, w, iw, &info); chkxer_("DGTCON", &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. DPTTRF */ s_copy(srnamc_1.srnamt, "DPTTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dpttrf_(&c_n1, d__, e, &info); chkxer_("DPTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DPTTRS */ s_copy(srnamc_1.srnamt, "DPTTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dpttrs_(&c_n1, &c__0, d__, e, x, &c__1, &info); chkxer_("DPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dpttrs_(&c__0, &c_n1, d__, e, x, &c__1, &info); chkxer_("DPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; dpttrs_(&c__2, &c__1, d__, e, x, &c__1, &info); chkxer_("DPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DPTRFS */ s_copy(srnamc_1.srnamt, "DPTRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dptrfs_(&c_n1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, & info); chkxer_("DPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dptrfs_(&c__0, &c_n1, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, & info); chkxer_("DPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dptrfs_(&c__2, &c__1, d__, e, df, ef, b, &c__1, x, &c__2, r1, r2, w, & info); chkxer_("DPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dptrfs_(&c__2, &c__1, d__, e, df, ef, b, &c__2, x, &c__1, r1, r2, w, & info); chkxer_("DPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DPTCON */ s_copy(srnamc_1.srnamt, "DPTCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dptcon_(&c_n1, d__, e, &anorm, &rcond, w, &info); chkxer_("DPTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; d__1 = -anorm; dptcon_(&c__0, d__, e, &d__1, &rcond, w, &info); chkxer_("DPTCON", &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 DERRGT */ } /* derrgt_ */
/* Subroutine */ int zerrql_(char *path, integer *nunit) { /* System generated locals */ integer i__1; doublereal d__1, d__2; doublecomplex z__1; /* Local variables */ doublecomplex a[4] /* was [2][2] */, b[2]; integer i__, j; doublecomplex w[2], x[2], af[4] /* was [2][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 */ /* ======= */ /* ZERRQL tests the error exits for the COMPLEX*16 routines */ /* that use the QL decomposition of a general matrix. */ /* 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 .. */ /* .. */ /* .. 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(); /* Set the variables to innocuous values. */ for (j = 1; j <= 2; ++j) { for (i__ = 1; i__ <= 2; ++i__) { i__1 = i__ + (j << 1) - 3; 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 << 1) - 3; 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.; 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: */ } infoc_1.ok = TRUE_; /* Error exits for QL factorization */ /* ZGEQLF */ s_copy(srnamc_1.srnamt, "ZGEQLF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgeqlf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info); chkxer_("ZGEQLF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgeqlf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info); chkxer_("ZGEQLF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgeqlf_(&c__2, &c__1, a, &c__1, b, w, &c__1, &info); chkxer_("ZGEQLF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgeqlf_(&c__1, &c__2, a, &c__1, b, w, &c__1, &info); chkxer_("ZGEQLF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGEQL2 */ s_copy(srnamc_1.srnamt, "ZGEQL2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgeql2_(&c_n1, &c__0, a, &c__1, b, w, &info); chkxer_("ZGEQL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgeql2_(&c__0, &c_n1, a, &c__1, b, w, &info); chkxer_("ZGEQL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgeql2_(&c__2, &c__1, a, &c__1, b, w, &info); chkxer_("ZGEQL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGEQLS */ s_copy(srnamc_1.srnamt, "ZGEQLS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgeqls_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("ZGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgeqls_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("ZGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgeqls_(&c__1, &c__2, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("ZGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgeqls_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("ZGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgeqls_(&c__2, &c__1, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info); chkxer_("ZGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zgeqls_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info); chkxer_("ZGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgeqls_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("ZGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZUNGQL */ s_copy(srnamc_1.srnamt, "ZUNGQL", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zungql_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("ZUNGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zungql_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("ZUNGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zungql_(&c__1, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("ZUNGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zungql_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info); chkxer_("ZUNGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zungql_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info); chkxer_("ZUNGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zungql_(&c__2, &c__1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("ZUNGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zungql_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info); chkxer_("ZUNGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZUNG2L */ s_copy(srnamc_1.srnamt, "ZUNG2L", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zung2l_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info); chkxer_("ZUNG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zung2l_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info); chkxer_("ZUNG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zung2l_(&c__1, &c__2, &c__0, a, &c__1, x, w, &info); chkxer_("ZUNG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zung2l_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info); chkxer_("ZUNG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zung2l_(&c__2, &c__1, &c__2, a, &c__2, x, w, &info); chkxer_("ZUNG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zung2l_(&c__2, &c__1, &c__0, a, &c__1, x, w, &info); chkxer_("ZUNG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZUNMQL */ s_copy(srnamc_1.srnamt, "ZUNMQL", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zunmql_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zunmql_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zunmql_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zunmql_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmql_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmql_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmql_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zunmql_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zunmql_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zunmql_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zunmql_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zunmql_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("ZUNMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZUNM2L */ s_copy(srnamc_1.srnamt, "ZUNM2L", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zunm2l_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zunm2l_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zunm2l_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zunm2l_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunm2l_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunm2l_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunm2l_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zunm2l_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &info); chkxer_("ZUNM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zunm2l_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zunm2l_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info); chkxer_("ZUNM2L", &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 ZERRQL */ } /* zerrql_ */
/* Subroutine */ int cerrqr_(char *path, integer *nunit) { /* 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); /* Local variables */ static integer info; static complex a[4] /* was [2][2] */, b[2]; static integer i__, j; static complex w[2], x[2]; extern /* Subroutine */ int cgeqr2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), cung2r_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), cunm2r_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *); static complex af[4] /* was [2][2] */; extern /* Subroutine */ int alaesm_(char *, logical *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cgeqrs_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), cungqr_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cunmqr_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 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)] #define af_subscr(a_1,a_2) (a_2)*2 + a_1 - 3 #define af_ref(a_1,a_2) af[af_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 February 29, 1992 Purpose ======= CERRQR tests the error exits for the COMPLEX routines that use the QR decomposition of a general matrix. 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(); /* Set the variables to innocuous values. */ for (j = 1; j <= 2; ++j) { for (i__ = 1; i__ <= 2; ++i__) { i__1 = a_subscr(i__, j); 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 = af_subscr(i__, j); 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; 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; /* L20: */ } infoc_1.ok = TRUE_; /* Error exits for QR factorization CGEQRF */ s_copy(srnamc_1.srnamt, "CGEQRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cgeqrf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info); chkxer_("CGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgeqrf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info); chkxer_("CGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgeqrf_(&c__2, &c__1, a, &c__1, b, w, &c__1, &info); chkxer_("CGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cgeqrf_(&c__1, &c__2, a, &c__1, b, w, &c__1, &info); chkxer_("CGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGEQR2 */ s_copy(srnamc_1.srnamt, "CGEQR2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cgeqr2_(&c_n1, &c__0, a, &c__1, b, w, &info); chkxer_("CGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgeqr2_(&c__0, &c_n1, a, &c__1, b, w, &info); chkxer_("CGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgeqr2_(&c__2, &c__1, a, &c__1, b, w, &info); chkxer_("CGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGEQRS */ s_copy(srnamc_1.srnamt, "CGEQRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cgeqrs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgeqrs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgeqrs_(&c__1, &c__2, &c__0, a, &c__2, x, b, &c__2, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cgeqrs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cgeqrs_(&c__2, &c__1, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; cgeqrs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; cgeqrs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("CGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CUNGQR */ s_copy(srnamc_1.srnamt, "CUNGQR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cungqr_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cungqr_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cungqr_(&c__1, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cungqr_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cungqr_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cungqr_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; cungqr_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info); chkxer_("CUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CUNG2R */ s_copy(srnamc_1.srnamt, "CUNG2R", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cung2r_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cung2r_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cung2r_(&c__1, &c__2, &c__0, a, &c__1, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cung2r_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cung2r_(&c__2, &c__1, &c__2, a, &c__2, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cung2r_(&c__2, &c__1, &c__0, a, &c__1, x, w, &info); chkxer_("CUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CUNMQR */ s_copy(srnamc_1.srnamt, "CUNMQR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cunmqr_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cunmqr_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cunmqr_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cunmqr_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunmqr_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunmqr_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunmqr_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cunmqr_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cunmqr_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; cunmqr_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; cunmqr_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; cunmqr_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("CUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CUNM2R */ s_copy(srnamc_1.srnamt, "CUNM2R", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; cunm2r_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cunm2r_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cunm2r_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cunm2r_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunm2r_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunm2r_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cunm2r_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cunm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cunm2r_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("CUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; cunm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info); chkxer_("CUNM2R", &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 CERRQR */ } /* cerrqr_ */
/* Subroutine */ int derrlq_(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 a[4] /* was [2][2] */, b[2]; static integer i__, j; static doublereal w[2], x[2]; extern /* Subroutine */ int dgelq2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorgl2_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorml2_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); static doublereal af[4] /* was [2][2] */; extern /* Subroutine */ int alaesm_(char *, logical *, integer *), dgelqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dgelqs_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), dorglq_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dormlq_(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 }; #define a_ref(a_1,a_2) a[(a_2)*2 + a_1 - 3] #define af_ref(a_1,a_2) af[(a_2)*2 + a_1 - 3] /* -- 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 ======= DERRLQ tests the error exits for the DOUBLE PRECISION routines that use the LQ decomposition of a general matrix. 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(); /* Set the variables to innocuous values. */ for (j = 1; j <= 2; ++j) { for (i__ = 1; i__ <= 2; ++i__) { a_ref(i__, j) = 1. / (doublereal) (i__ + j); af_ref(i__, j) = 1. / (doublereal) (i__ + j); /* L10: */ } b[j - 1] = 0.; w[j - 1] = 0.; x[j - 1] = 0.; /* L20: */ } infoc_1.ok = TRUE_; /* Error exits for LQ factorization DGELQF */ s_copy(srnamc_1.srnamt, "DGELQF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgelqf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info); chkxer_("DGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgelqf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info); chkxer_("DGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgelqf_(&c__2, &c__1, a, &c__1, b, w, &c__2, &info); chkxer_("DGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dgelqf_(&c__2, &c__1, a, &c__2, b, w, &c__1, &info); chkxer_("DGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGELQ2 */ s_copy(srnamc_1.srnamt, "DGELQ2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgelq2_(&c_n1, &c__0, a, &c__1, b, w, &info); chkxer_("DGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgelq2_(&c__0, &c_n1, a, &c__1, b, w, &info); chkxer_("DGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgelq2_(&c__2, &c__1, a, &c__1, b, w, &info); chkxer_("DGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGELQS */ s_copy(srnamc_1.srnamt, "DGELQS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgelqs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgelqs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgelqs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info); chkxer_("DGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgelqs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgelqs_(&c__2, &c__2, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info); chkxer_("DGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dgelqs_(&c__1, &c__2, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dgelqs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORGLQ */ s_copy(srnamc_1.srnamt, "DORGLQ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dorglq_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("DORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorglq_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("DORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorglq_(&c__2, &c__1, &c__0, a, &c__2, x, w, &c__2, &info); chkxer_("DORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorglq_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info); chkxer_("DORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorglq_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info); chkxer_("DORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorglq_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("DORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dorglq_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info); chkxer_("DORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORGL2 */ s_copy(srnamc_1.srnamt, "DORGL2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dorgl2_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info); chkxer_("DORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorgl2_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info); chkxer_("DORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorgl2_(&c__2, &c__1, &c__0, a, &c__2, x, w, &info); chkxer_("DORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgl2_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info); chkxer_("DORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgl2_(&c__1, &c__1, &c__2, a, &c__1, x, w, &info); chkxer_("DORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorgl2_(&c__2, &c__2, &c__0, a, &c__1, x, w, &info); chkxer_("DORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORMLQ */ s_copy(srnamc_1.srnamt, "DORMLQ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dormlq_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dormlq_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dormlq_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dormlq_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dormlq_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dormlq_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dormlq_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dormlq_("L", "N", &c__2, &c__0, &c__2, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dormlq_("R", "N", &c__0, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dormlq_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dormlq_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dormlq_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("DORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORML2 */ s_copy(srnamc_1.srnamt, "DORML2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dorml2_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorml2_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorml2_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dorml2_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorml2_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorml2_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorml2_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dorml2_("L", "N", &c__2, &c__1, &c__2, a, &c__1, x, af, &c__2, w, &info); chkxer_("DORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dorml2_("R", "N", &c__1, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dorml2_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info); chkxer_("DORML2", &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 DERRLQ */ } /* derrlq_ */
/* Subroutine */ int cerrgt_(char *path, integer *nunit) { /* System generated locals */ integer i__1; real r__1; /* Local variables */ complex b[2]; real d__[2]; complex e[2]; integer i__; complex w[2], x[2]; char c2[2]; real r1[2], r2[2], df[2]; complex ef[2], dl[2]; integer ip[2]; complex du[2]; real rw[2]; complex du2[2], dlf[2], duf[2]; integer info; real rcond, anorm; /* 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 */ /* ======= */ /* CERRGT tests the error exits for the COMPLEX 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.f; i__1 = i__ - 1; e[i__1].r = 2.f, e[i__1].i = 0.f; i__1 = i__ - 1; dl[i__1].r = 3.f, dl[i__1].i = 0.f; i__1 = i__ - 1; du[i__1].r = 4.f, du[i__1].i = 0.f; /* L10: */ } anorm = 1.f; infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "GT")) { /* Test error exits for the general tridiagonal routines. */ /* CGTTRF */ s_copy(srnamc_1.srnamt, "CGTTRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgttrf_(&c_n1, dl, e, du, du2, ip, &info); chkxer_("CGTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGTTRS */ s_copy(srnamc_1.srnamt, "CGTTRS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgttrs_("/", &c__0, &c__0, dl, e, du, du2, ip, x, &c__1, &info); chkxer_("CGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgttrs_("N", &c_n1, &c__0, dl, e, du, du2, ip, x, &c__1, &info); chkxer_("CGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cgttrs_("N", &c__0, &c_n1, dl, e, du, du2, ip, x, &c__1, &info); chkxer_("CGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; cgttrs_("N", &c__2, &c__1, dl, e, du, du2, ip, x, &c__1, &info); chkxer_("CGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGTRFS */ s_copy(srnamc_1.srnamt, "CGTRFS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgtrfs_("/", &c__0, &c__0, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1, x, &c__1, r1, r2, w, rw, &info); chkxer_("CGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgtrfs_("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_("CGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cgtrfs_("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_("CGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; cgtrfs_("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_("CGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; cgtrfs_("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_("CGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGTCON */ s_copy(srnamc_1.srnamt, "CGTCON", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgtcon_("/", &c__0, dl, e, du, du2, ip, &anorm, &rcond, w, &info); chkxer_("CGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgtcon_("I", &c_n1, dl, e, du, du2, ip, &anorm, &rcond, w, &info); chkxer_("CGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; r__1 = -anorm; cgtcon_("I", &c__0, dl, e, du, du2, ip, &r__1, &rcond, w, &info); chkxer_("CGTCON", &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. */ /* CPTTRF */ s_copy(srnamc_1.srnamt, "CPTTRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cpttrf_(&c_n1, d__, e, &info); chkxer_("CPTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CPTTRS */ s_copy(srnamc_1.srnamt, "CPTTRS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cpttrs_("/", &c__1, &c__0, d__, e, x, &c__1, &info); chkxer_("CPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cpttrs_("U", &c_n1, &c__0, d__, e, x, &c__1, &info); chkxer_("CPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cpttrs_("U", &c__0, &c_n1, d__, e, x, &c__1, &info); chkxer_("CPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cpttrs_("U", &c__2, &c__1, d__, e, x, &c__1, &info); chkxer_("CPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CPTRFS */ s_copy(srnamc_1.srnamt, "CPTRFS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cptrfs_("/", &c__1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, rw, &info); chkxer_("CPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cptrfs_("U", &c_n1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, rw, &info); chkxer_("CPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cptrfs_("U", &c__0, &c_n1, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, rw, &info); chkxer_("CPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; cptrfs_("U", &c__2, &c__1, d__, e, df, ef, b, &c__1, x, &c__2, r1, r2, w, rw, &info); chkxer_("CPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; cptrfs_("U", &c__2, &c__1, d__, e, df, ef, b, &c__2, x, &c__1, r1, r2, w, rw, &info); chkxer_("CPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CPTCON */ s_copy(srnamc_1.srnamt, "CPTCON", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cptcon_(&c_n1, d__, e, &anorm, &rcond, rw, &info); chkxer_("CPTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; r__1 = -anorm; cptcon_(&c__0, d__, e, &r__1, &rcond, rw, &info); chkxer_("CPTCON", &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 CERRGT */ } /* cerrgt_ */
/* Subroutine */ int zerrps_(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 a[16] /* was [4][4] */; integer i__, j, piv[4], info; doublereal rwork[8]; extern /* Subroutine */ int zpstf2_(char *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, integer *), alaesm_(char *, logical *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), zpstrf_(char *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Craig Lucas, University of Manchester / NAG Ltd. */ /* October, 2008 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZERRPS tests the error exits for the COMPLEX routines */ /* for ZPSTRF. */ /* 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 .. */ /* .. */ /* .. 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(); /* 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); a[i__1].r = d__1, a[i__1].i = 0.; /* L100: */ } piv[j - 1] = j; rwork[j - 1] = 0.; rwork[j + 3] = 0.; /* L110: */ } infoc_1.ok = TRUE_; /* Test error exits of the routines that use the Cholesky */ /* decomposition of an Hermitian positive semidefinite matrix. */ /* ZPSTRF */ s_copy(srnamc_1.srnamt, "ZPSTRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zpstrf_("/", &c__0, a, &c__1, piv, &c__1, &c_b9, rwork, &info); chkxer_("ZPSTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpstrf_("U", &c_n1, a, &c__1, piv, &c__1, &c_b9, rwork, &info); chkxer_("ZPSTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpstrf_("U", &c__2, a, &c__1, piv, &c__1, &c_b9, rwork, &info); chkxer_("ZPSTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPSTF2 */ s_copy(srnamc_1.srnamt, "ZPSTF2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zpstf2_("/", &c__0, a, &c__1, piv, &c__1, &c_b9, rwork, &info); chkxer_("ZPSTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpstf2_("U", &c_n1, a, &c__1, piv, &c__1, &c_b9, rwork, &info); chkxer_("ZPSTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpstf2_("U", &c__2, a, &c__1, piv, &c__1, &c_b9, rwork, &info); chkxer_("ZPSTF2", &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 ZERRPS */ } /* zerrps_ */
/* Subroutine */ int zerrge_(char *path, integer *nunit) { /* System generated locals */ integer i__1; doublereal d__1, d__2; doublecomplex z__1; /* 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 ip[4], info; doublereal anrm, ccond, 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 */ /* ======= */ /* ZERRGE tests the error exits for the COMPLEX*16 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__) { 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.; ip[j - 1] = j; /* L20: */ } infoc_1.ok = TRUE_; /* Test error exits of the routines that use the LU decomposition */ /* of a general matrix. */ if (lsamen_(&c__2, c2, "GE")) { /* ZGETRF */ s_copy(srnamc_1.srnamt, "ZGETRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgetrf_(&c_n1, &c__0, a, &c__1, ip, &info); chkxer_("ZGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgetrf_(&c__0, &c_n1, a, &c__1, ip, &info); chkxer_("ZGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgetrf_(&c__2, &c__1, a, &c__1, ip, &info); chkxer_("ZGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGETF2 */ s_copy(srnamc_1.srnamt, "ZGETF2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgetf2_(&c_n1, &c__0, a, &c__1, ip, &info); chkxer_("ZGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgetf2_(&c__0, &c_n1, a, &c__1, ip, &info); chkxer_("ZGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgetf2_(&c__2, &c__1, a, &c__1, ip, &info); chkxer_("ZGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGETRI */ s_copy(srnamc_1.srnamt, "ZGETRI", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgetri_(&c_n1, a, &c__1, ip, w, &c__1, &info); chkxer_("ZGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgetri_(&c__2, a, &c__1, ip, w, &c__2, &info); chkxer_("ZGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgetri_(&c__2, a, &c__2, ip, w, &c__1, &info); chkxer_("ZGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGETRS */ s_copy(srnamc_1.srnamt, "ZGETRS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgetrs_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("ZGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgetrs_("N", &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("ZGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgetrs_("N", &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info); chkxer_("ZGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgetrs_("N", &c__2, &c__1, a, &c__1, ip, b, &c__2, &info); chkxer_("ZGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zgetrs_("N", &c__2, &c__1, a, &c__2, ip, b, &c__1, &info); chkxer_("ZGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGERFS */ s_copy(srnamc_1.srnamt, "ZGERFS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgerfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, r__, &info); chkxer_("ZGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgerfs_("N", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, r__, &info); chkxer_("ZGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgerfs_("N", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, r__, &info); chkxer_("ZGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgerfs_("N", &c__2, &c__1, a, &c__1, af, &c__2, ip, b, &c__2, x, & c__2, r1, r2, w, r__, &info); chkxer_("ZGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__1, ip, b, &c__2, x, & c__2, r1, r2, w, r__, &info); chkxer_("ZGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__1, x, & c__2, r1, r2, w, r__, &info); chkxer_("ZGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__2, x, & c__1, r1, r2, w, r__, &info); chkxer_("ZGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGECON */ s_copy(srnamc_1.srnamt, "ZGECON", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgecon_("/", &c__0, a, &c__1, &anrm, &rcond, w, r__, &info) ; chkxer_("ZGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgecon_("1", &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info) ; chkxer_("ZGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgecon_("1", &c__2, a, &c__1, &anrm, &rcond, w, r__, &info) ; chkxer_("ZGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGEEQU */ s_copy(srnamc_1.srnamt, "ZGEEQU", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgeequ_(&c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("ZGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgeequ_(&c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("ZGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgeequ_(&c__2, &c__2, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("ZGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* Test error exits of the routines that use the LU decomposition */ /* of a general band matrix. */ } else if (lsamen_(&c__2, c2, "GB")) { /* ZGBTRF */ s_copy(srnamc_1.srnamt, "ZGBTRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgbtrf_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("ZGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgbtrf_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("ZGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgbtrf_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info); chkxer_("ZGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgbtrf_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info); chkxer_("ZGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgbtrf_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info); chkxer_("ZGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGBTF2 */ s_copy(srnamc_1.srnamt, "ZGBTF2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgbtf2_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("ZGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgbtf2_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("ZGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgbtf2_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info); chkxer_("ZGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgbtf2_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info); chkxer_("ZGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgbtf2_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info); chkxer_("ZGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGBTRS */ s_copy(srnamc_1.srnamt, "ZGBTRS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgbtrs_("/", &c__0, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("ZGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgbtrs_("N", &c_n1, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("ZGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgbtrs_("N", &c__1, &c_n1, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("ZGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgbtrs_("N", &c__1, &c__0, &c_n1, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("ZGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgbtrs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, ip, b, &c__1, & info); chkxer_("ZGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgbtrs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, ip, b, &c__2, & info); chkxer_("ZGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgbtrs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("ZGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGBRFS */ s_copy(srnamc_1.srnamt, "ZGBRFS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgbrfs_("/", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, r__, &info); chkxer_("ZGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgbrfs_("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, r__, &info); chkxer_("ZGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgbrfs_("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, r__, &info); chkxer_("ZGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgbrfs_("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, r__, &info); chkxer_("ZGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgbrfs_("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, r__, &info); chkxer_("ZGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgbrfs_("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, r__, &info); chkxer_("ZGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zgbrfs_("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, r__, &info); chkxer_("ZGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zgbrfs_("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, r__, &info); chkxer_("ZGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; zgbrfs_("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, r__, &info); chkxer_("ZGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGBCON */ s_copy(srnamc_1.srnamt, "ZGBCON", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgbcon_("/", &c__0, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, r__, &info); chkxer_("ZGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgbcon_("1", &c_n1, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, r__, &info); chkxer_("ZGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgbcon_("1", &c__1, &c_n1, &c__0, a, &c__1, ip, &anrm, &rcond, w, r__, &info); chkxer_("ZGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgbcon_("1", &c__1, &c__0, &c_n1, a, &c__1, ip, &anrm, &rcond, w, r__, &info); chkxer_("ZGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgbcon_("1", &c__2, &c__1, &c__1, a, &c__3, ip, &anrm, &rcond, w, r__, &info); chkxer_("ZGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGBEQU */ s_copy(srnamc_1.srnamt, "ZGBEQU", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgbequ_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("ZGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgbequ_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("ZGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgbequ_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("ZGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgbequ_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("ZGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgbequ_(&c__2, &c__2, &c__1, &c__1, a, &c__2, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("ZGBEQU", &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 ZERRGE */ } /* zerrge_ */
/* 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 */ static integer info; static real anrm, a[16] /* was [4][4] */, b[4]; static integer i__, j; static real w[12], x[4], rcond; static char c2[2]; static real r1[4], r2[4]; extern /* Subroutine */ int spbtf2_(char *, integer *, integer *, real *, integer *, integer *); static real af[16] /* was [4][4] */; extern /* Subroutine */ int spotf2_(char *, integer *, real *, integer *, integer *); static integer iw[4]; extern /* Subroutine */ int 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 }; #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 ======= 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. ===================================================================== */ 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; 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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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)6, (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_ */
/* 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 */ static integer info; static doublereal anrm; static doublecomplex a[16] /* was [4][4] */, b[4]; static integer i__, j; static doublereal r__[4]; static doublecomplex w[8], x[4]; static doublereal rcond; static char c2[2]; static doublereal r1[4], r2[4]; static doublecomplex af[16] /* was [4][4] */; 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 }; #define a_subscr(a_1,a_2) (a_2)*4 + a_1 - 5 #define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)] #define af_subscr(a_1,a_2) (a_2)*4 + a_1 - 5 #define af_ref(a_1,a_2) af[af_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 February 29, 1992 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. ===================================================================== */ 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 = a_subscr(i__, j); 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 = af_subscr(i__, j); 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 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 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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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_ */