/* 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 zerrab_(integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a6,\002 drivers passed the tests of the er" "ror exits\002)"; static char fmt_9998[] = "(\002 *** \002,a6,\002 drivers failed the test" "s of the error \002,\002exits ***\002)"; /* 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); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ doublecomplex a[16] /* was [4][4] */, b[4], c__[4]; integer i__, j; doublecomplex r__[4], w[8], x[4], r1[4], r2[4], af[16] /* was [4][4] */; integer ip[4], info, iter; doublecomplex work[1]; doublereal rwork[1]; complex swork[1]; extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), zcgesv_(integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, complex *, doublereal *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; static cilist io___19 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___20 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.1.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* January 2007 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* DERRAB tests the error exits for ZCGESV. */ /* Arguments */ /* ========= */ /* 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(); /* 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.; i__1 = i__ + (j << 2) - 5; d__1 = 1. / (doublereal) (i__ + j); af[i__1].r = d__1, af[i__1].i = 0.; /* L10: */ } i__1 = j - 1; b[i__1].r = 0., b[i__1].i = 0.; i__1 = j - 1; r1[i__1].r = 0., r1[i__1].i = 0.; i__1 = j - 1; r2[i__1].r = 0., r2[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.; i__1 = j - 1; c__[i__1].r = 0., c__[i__1].i = 0.; i__1 = j - 1; r__[i__1].r = 0., r__[i__1].i = 0.; ip[j - 1] = j; /* L20: */ } infoc_1.ok = TRUE_; s_copy(srnamc_1.srnamt, "ZCGESV", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zcgesv_(&c_n1, &c__0, a, &c__1, ip, b, &c__1, x, &c__1, work, swork, rwork, &iter, &info); chkxer_("ZCGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zcgesv_(&c__0, &c_n1, a, &c__1, ip, b, &c__1, x, &c__1, work, swork, rwork, &iter, &info); chkxer_("ZCGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zcgesv_(&c__2, &c__1, a, &c__1, ip, b, &c__2, x, &c__2, work, swork, rwork, &iter, &info); chkxer_("ZCGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zcgesv_(&c__2, &c__1, a, &c__2, ip, b, &c__1, x, &c__2, work, swork, rwork, &iter, &info); chkxer_("ZCGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zcgesv_(&c__2, &c__1, a, &c__2, ip, b, &c__2, x, &c__1, work, swork, rwork, &iter, &info); chkxer_("ZCGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* Print a summary line. */ if (infoc_1.ok) { io___19.ciunit = infoc_1.nout; s_wsfe(&io___19); do_fio(&c__1, "ZCGESV", (ftnlen)6); e_wsfe(); } else { io___20.ciunit = infoc_1.nout; s_wsfe(&io___20); do_fio(&c__1, "ZCGESV", (ftnlen)6); e_wsfe(); } return 0; /* End of ZERRAB */ } /* zerrab_ */
/* Subroutine */ int derrab_(integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a6,\002 drivers passed the tests of the er" "ror exits\002)"; static char fmt_9998[] = "(\002 *** \002,a6,\002 drivers failed the test" "s of the error \002,\002exits ***\002)"; /* Local variables */ doublereal a[16] /* was [4][4] */, b[4], c__[4]; integer i__, j; doublereal r__[4], w[8], x[4], r1[4], r2[4], af[16] /* was [4][4] */; integer ip[4], info, iter; doublereal work[1]; real swork[1]; /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; static cilist io___18 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___19 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.1.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* January 2007 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* DERRAB tests the error exits for DSGESV. */ /* Arguments */ /* ========= */ /* 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__) { a[i__ + (j << 2) - 5] = 1. / (doublereal) (i__ + j); af[i__ + (j << 2) - 5] = 1. / (doublereal) (i__ + j); /* L10: */ } b[j - 1] = 0.; r1[j - 1] = 0.; r2[j - 1] = 0.; w[j - 1] = 0.; x[j - 1] = 0.; c__[j - 1] = 0.; r__[j - 1] = 0.; ip[j - 1] = j; /* L20: */ } infoc_1.ok = TRUE_; s_copy(srnamc_1.srnamt, "DSGESV", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; dsgesv_(&c_n1, &c__0, a, &c__1, ip, b, &c__1, x, &c__1, work, swork, & iter, &info); chkxer_("DSGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsgesv_(&c__0, &c_n1, a, &c__1, ip, b, &c__1, x, &c__1, work, swork, & iter, &info); chkxer_("DSGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dsgesv_(&c__2, &c__1, a, &c__1, ip, b, &c__2, x, &c__2, work, swork, & iter, &info); chkxer_("DSGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dsgesv_(&c__2, &c__1, a, &c__2, ip, b, &c__1, x, &c__2, work, swork, & iter, &info); chkxer_("DSGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; dsgesv_(&c__2, &c__1, a, &c__2, ip, b, &c__2, x, &c__1, work, swork, & iter, &info); chkxer_("DSGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* Print a summary line. */ if (infoc_1.ok) { io___18.ciunit = infoc_1.nout; s_wsfe(&io___18); do_fio(&c__1, "DSGESV", (ftnlen)6); e_wsfe(); } else { io___19.ciunit = infoc_1.nout; s_wsfe(&io___19); do_fio(&c__1, "DSGESV", (ftnlen)6); e_wsfe(); } return 0; /* End of DERRAB */ } /* derrab_ */
/* Subroutine */ int serrlq_(char *path, integer *nunit) { /* Local variables */ real a[4] /* was [2][2] */, b[2]; integer i__, j; real 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 */ /* ======= */ /* SERRLQ tests the error exits for the REAL 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. */ /* ===================================================================== */ /* .. 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.f / (real) (i__ + j); af[i__ + (j << 1) - 3] = 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 LQ factorization */ /* SGELQF */ s_copy(srnamc_1.srnamt, "SGELQF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgelqf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info); chkxer_("SGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgelqf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info); chkxer_("SGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgelqf_(&c__2, &c__1, a, &c__1, b, w, &c__2, &info); chkxer_("SGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgelqf_(&c__2, &c__1, a, &c__2, b, w, &c__1, &info); chkxer_("SGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGELQ2 */ s_copy(srnamc_1.srnamt, "SGELQ2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgelq2_(&c_n1, &c__0, a, &c__1, b, w, &info); chkxer_("SGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgelq2_(&c__0, &c_n1, a, &c__1, b, w, &info); chkxer_("SGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgelq2_(&c__2, &c__1, a, &c__1, b, w, &info); chkxer_("SGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGELQS */ s_copy(srnamc_1.srnamt, "SGELQS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgelqs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("SGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgelqs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("SGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgelqs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info); chkxer_("SGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgelqs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("SGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgelqs_(&c__2, &c__2, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info); chkxer_("SGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sgelqs_(&c__1, &c__2, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("SGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sgelqs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("SGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SORGLQ */ s_copy(srnamc_1.srnamt, "SORGLQ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sorglq_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("SORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sorglq_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("SORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sorglq_(&c__2, &c__1, &c__0, a, &c__2, x, w, &c__2, &info); chkxer_("SORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sorglq_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info); chkxer_("SORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sorglq_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info); chkxer_("SORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sorglq_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("SORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sorglq_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info); chkxer_("SORGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SORGL2 */ s_copy(srnamc_1.srnamt, "SORGL2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sorgl2_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info); chkxer_("SORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sorgl2_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info); chkxer_("SORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sorgl2_(&c__2, &c__1, &c__0, a, &c__2, x, w, &info); chkxer_("SORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sorgl2_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info); chkxer_("SORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sorgl2_(&c__1, &c__1, &c__2, a, &c__1, x, w, &info); chkxer_("SORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sorgl2_(&c__2, &c__2, &c__0, a, &c__1, x, w, &info); chkxer_("SORGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SORMLQ */ s_copy(srnamc_1.srnamt, "SORMLQ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sormlq_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sormlq_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sormlq_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sormlq_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sormlq_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sormlq_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sormlq_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sormlq_("L", "N", &c__2, &c__0, &c__2, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sormlq_("R", "N", &c__0, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sormlq_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sormlq_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sormlq_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("SORMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SORML2 */ s_copy(srnamc_1.srnamt, "SORML2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sorml2_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sorml2_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sorml2_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sorml2_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sorml2_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sorml2_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sorml2_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sorml2_("L", "N", &c__2, &c__1, &c__2, a, &c__1, x, af, &c__2, w, &info); chkxer_("SORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sorml2_("R", "N", &c__1, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &info); chkxer_("SORML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sorml2_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info); chkxer_("SORML2", &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 SERRLQ */ } /* serrlq_ */
/* Subroutine */ int serrgt_(char *path, integer *nunit) { /* System generated locals */ real r__1; /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ real b[2], c__[2], d__[2], e[2], f[2], w[2], x[2]; char c2[2]; real r1[2], r2[2], cf[2], df[2], ef[2]; integer ip[2], iw[2], info; real rcond, anorm; extern /* Subroutine */ int alaesm_(char *, logical *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), sgtcon_(char *, integer *, real *, real *, real *, real *, integer *, real *, real *, real *, integer *, integer *), sptcon_(integer *, real *, real *, real *, real *, real *, integer *), sgtrfs_(char *, integer *, integer *, real *, real *, real *, real *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, real *, real *, integer *, integer *), sgttrf_(integer *, real *, real *, real *, real *, integer *, integer *), sptrfs_(integer *, integer *, real *, real *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, integer *), spttrf_(integer *, real *, real *, integer *), sgttrs_(char *, integer *, integer *, real *, real *, real *, real *, integer *, real *, integer *, integer *), spttrs_(integer *, integer *, real *, real *, real *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SERRGT tests the error exits for the REAL tridiagonal */ /* routines. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); d__[0] = 1.f; d__[1] = 2.f; df[0] = 1.f; df[1] = 2.f; e[0] = 3.f; e[1] = 4.f; ef[0] = 3.f; ef[1] = 4.f; anorm = 1.f; infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "GT")) { /* Test error exits for the general tridiagonal routines. */ /* SGTTRF */ s_copy(srnamc_1.srnamt, "SGTTRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgttrf_(&c_n1, c__, d__, e, f, ip, &info); chkxer_("SGTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGTTRS */ s_copy(srnamc_1.srnamt, "SGTTRS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgttrs_("/", &c__0, &c__0, c__, d__, e, f, ip, x, &c__1, &info); chkxer_("SGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgttrs_("N", &c_n1, &c__0, c__, d__, e, f, ip, x, &c__1, &info); chkxer_("SGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgttrs_("N", &c__0, &c_n1, c__, d__, e, f, ip, x, &c__1, &info); chkxer_("SGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sgttrs_("N", &c__2, &c__1, c__, d__, e, f, ip, x, &c__1, &info); chkxer_("SGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGTRFS */ s_copy(srnamc_1.srnamt, "SGTRFS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgtrfs_("/", &c__0, &c__0, c__, d__, e, cf, df, ef, f, ip, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgtrfs_("N", &c_n1, &c__0, c__, d__, e, cf, df, ef, f, ip, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgtrfs_("N", &c__0, &c_n1, c__, d__, e, cf, df, ef, f, ip, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; sgtrfs_("N", &c__2, &c__1, c__, d__, e, cf, df, ef, f, ip, b, &c__1, x, &c__2, r1, r2, w, iw, &info); chkxer_("SGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; sgtrfs_("N", &c__2, &c__1, c__, d__, e, cf, df, ef, f, ip, b, &c__2, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGTCON */ s_copy(srnamc_1.srnamt, "SGTCON", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgtcon_("/", &c__0, c__, d__, e, f, ip, &anorm, &rcond, w, iw, &info); chkxer_("SGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgtcon_("I", &c_n1, c__, d__, e, f, ip, &anorm, &rcond, w, iw, &info); chkxer_("SGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; r__1 = -anorm; sgtcon_("I", &c__0, c__, d__, e, f, ip, &r__1, &rcond, w, iw, &info); chkxer_("SGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "PT")) { /* Test error exits for the positive definite tridiagonal */ /* routines. */ /* SPTTRF */ s_copy(srnamc_1.srnamt, "SPTTRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; spttrf_(&c_n1, d__, e, &info); chkxer_("SPTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SPTTRS */ s_copy(srnamc_1.srnamt, "SPTTRS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; spttrs_(&c_n1, &c__0, d__, e, x, &c__1, &info); chkxer_("SPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; spttrs_(&c__0, &c_n1, d__, e, x, &c__1, &info); chkxer_("SPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; spttrs_(&c__2, &c__1, d__, e, x, &c__1, &info); chkxer_("SPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SPTRFS */ s_copy(srnamc_1.srnamt, "SPTRFS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sptrfs_(&c_n1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, & info); chkxer_("SPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sptrfs_(&c__0, &c_n1, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, & info); chkxer_("SPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sptrfs_(&c__2, &c__1, d__, e, df, ef, b, &c__1, x, &c__2, r1, r2, w, & info); chkxer_("SPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sptrfs_(&c__2, &c__1, d__, e, df, ef, b, &c__2, x, &c__1, r1, r2, w, & info); chkxer_("SPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SPTCON */ s_copy(srnamc_1.srnamt, "SPTCON", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sptcon_(&c_n1, d__, e, &anorm, &rcond, w, &info); chkxer_("SPTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; r__1 = -anorm; sptcon_(&c__0, d__, e, &r__1, &rcond, w, &info); chkxer_("SPTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of SERRGT */ } /* serrgt_ */
/* Subroutine */ int derrsy_(char *path, integer *nunit) { /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ static integer info; static doublereal anrm, a[16] /* was [4][4] */, b[4]; static integer i__, j; static doublereal w[12], x[4], rcond; static char c2[2]; static doublereal r1[4], r2[4], af[16] /* was [4][4] */; extern /* Subroutine */ int dsytf2_(char *, integer *, doublereal *, integer *, integer *, integer *); static integer ip[4], iw[4]; extern /* Subroutine */ int alaesm_(char *, logical *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), dspcon_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dsycon_(char *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dsprfs_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal * , integer *, integer *), dsptrf_(char *, integer *, doublereal *, integer *, integer *), dsptri_(char *, integer *, doublereal *, integer *, doublereal *, integer *), dsyrfs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dsytrf_(char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dsytri_(char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *), dsptrs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dsytrs_( char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; #define a_ref(a_1,a_2) a[(a_2)*4 + a_1 - 5] #define af_ref(a_1,a_2) af[(a_2)*4 + a_1 - 5] /* -- LAPACK test routine (version 3.0) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University February 29, 1992 Purpose ======= DERRSY tests the error exits for the DOUBLE PRECISION routines for symmetric indefinite matrices. Arguments ========= PATH (input) CHARACTER*3 The LAPACK path name for the routines to be tested. NUNIT (input) INTEGER The unit number for output. ===================================================================== */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Set the variables to innocuous values. */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { a_ref(i__, j) = 1. / (doublereal) (i__ + j); af_ref(i__, j) = 1. / (doublereal) (i__ + j); /* L10: */ } b[j - 1] = 0.; r1[j - 1] = 0.; r2[j - 1] = 0.; w[j - 1] = 0.; x[j - 1] = 0.; ip[j - 1] = j; iw[j - 1] = j; /* L20: */ } anrm = 1.; rcond = 1.; infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "SY")) { /* Test error exits of the routines that use the Bunch-Kaufman factorization of a symmetric indefinite matrix. DSYTRF */ s_copy(srnamc_1.srnamt, "DSYTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dsytrf_("/", &c__0, a, &c__1, ip, w, &c__1, &info); chkxer_("DSYTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsytrf_("U", &c_n1, a, &c__1, ip, w, &c__1, &info); chkxer_("DSYTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dsytrf_("U", &c__2, a, &c__1, ip, w, &c__4, &info); chkxer_("DSYTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DSYTF2 */ s_copy(srnamc_1.srnamt, "DSYTF2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dsytf2_("/", &c__0, a, &c__1, ip, &info); chkxer_("DSYTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsytf2_("U", &c_n1, a, &c__1, ip, &info); chkxer_("DSYTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dsytf2_("U", &c__2, a, &c__1, ip, &info); chkxer_("DSYTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DSYTRI */ s_copy(srnamc_1.srnamt, "DSYTRI", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dsytri_("/", &c__0, a, &c__1, ip, w, &info); chkxer_("DSYTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsytri_("U", &c_n1, a, &c__1, ip, w, &info); chkxer_("DSYTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dsytri_("U", &c__2, a, &c__1, ip, w, &info); chkxer_("DSYTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DSYTRS */ s_copy(srnamc_1.srnamt, "DSYTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dsytrs_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsytrs_("U", &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dsytrs_("U", &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info); chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dsytrs_("U", &c__2, &c__1, a, &c__1, ip, b, &c__2, &info); chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dsytrs_("U", &c__2, &c__1, a, &c__2, ip, b, &c__1, &info); chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DSYRFS */ s_copy(srnamc_1.srnamt, "DSYRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dsyrfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsyrfs_("U", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dsyrfs_("U", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dsyrfs_("U", &c__2, &c__1, a, &c__1, af, &c__2, ip, b, &c__2, x, & c__2, r1, r2, w, iw, &info); chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dsyrfs_("U", &c__2, &c__1, a, &c__2, af, &c__1, ip, b, &c__2, x, & c__2, r1, r2, w, iw, &info); chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dsyrfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__1, x, & c__2, r1, r2, w, iw, &info); chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dsyrfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__2, x, & c__1, r1, r2, w, iw, &info); chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DSYCON */ s_copy(srnamc_1.srnamt, "DSYCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dsycon_("/", &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsycon_("U", &c_n1, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dsycon_("U", &c__2, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; dsycon_("U", &c__1, a, &c__1, ip, &c_b152, &rcond, w, iw, &info); chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "SP")) { /* Test error exits of the routines that use the Bunch-Kaufman factorization of a symmetric indefinite packed matrix. DSPTRF */ s_copy(srnamc_1.srnamt, "DSPTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dsptrf_("/", &c__0, a, ip, &info); chkxer_("DSPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsptrf_("U", &c_n1, a, ip, &info); chkxer_("DSPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DSPTRI */ s_copy(srnamc_1.srnamt, "DSPTRI", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dsptri_("/", &c__0, a, ip, w, &info); chkxer_("DSPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsptri_("U", &c_n1, a, ip, w, &info); chkxer_("DSPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DSPTRS */ s_copy(srnamc_1.srnamt, "DSPTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dsptrs_("/", &c__0, &c__0, a, ip, b, &c__1, &info); chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsptrs_("U", &c_n1, &c__0, a, ip, b, &c__1, &info); chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dsptrs_("U", &c__0, &c_n1, a, ip, b, &c__1, &info); chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dsptrs_("U", &c__2, &c__1, a, ip, b, &c__1, &info); chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DSPRFS */ s_copy(srnamc_1.srnamt, "DSPRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dsprfs_("/", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dsprfs_("U", &c_n1, &c__0, a, af, ip, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dsprfs_("U", &c__0, &c_n1, a, af, ip, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dsprfs_("U", &c__2, &c__1, a, af, ip, b, &c__1, x, &c__2, r1, r2, w, iw, &info); chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dsprfs_("U", &c__2, &c__1, a, af, ip, b, &c__2, x, &c__1, r1, r2, w, iw, &info); chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DSPCON */ s_copy(srnamc_1.srnamt, "DSPCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dspcon_("/", &c__0, a, ip, &anrm, &rcond, w, iw, &info); chkxer_("DSPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dspcon_("U", &c_n1, a, ip, &anrm, &rcond, w, iw, &info); chkxer_("DSPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dspcon_("U", &c__1, a, ip, &c_b152, &rcond, w, iw, &info); chkxer_("DSPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of DERRSY */ } /* derrsy_ */
/* Subroutine */ int zerrlq_(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[4] /* was [2][2] */, b[2]; integer i__, j; doublecomplex w[2], x[2], af[4] /* was [2][2] */; integer info; extern /* Subroutine */ int zgelq2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zungl2_( integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zunml2_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), alaesm_(char *, logical *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), zgelqf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *) , zgelqs_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zunglq_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), zunmlq_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, 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 */ /* ======= */ /* ZERRLQ tests the error exits for the COMPLEX*16 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. */ /* ===================================================================== */ /* .. 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 LQ factorization */ /* ZGELQF */ s_copy(srnamc_1.srnamt, "ZGELQF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgelqf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info); chkxer_("ZGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgelqf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info); chkxer_("ZGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgelqf_(&c__2, &c__1, a, &c__1, b, w, &c__2, &info); chkxer_("ZGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgelqf_(&c__2, &c__1, a, &c__2, b, w, &c__1, &info); chkxer_("ZGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGELQ2 */ s_copy(srnamc_1.srnamt, "ZGELQ2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgelq2_(&c_n1, &c__0, a, &c__1, b, w, &info); chkxer_("ZGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgelq2_(&c__0, &c_n1, a, &c__1, b, w, &info); chkxer_("ZGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgelq2_(&c__2, &c__1, a, &c__1, b, w, &info); chkxer_("ZGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGELQS */ s_copy(srnamc_1.srnamt, "ZGELQS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgelqs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgelqs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgelqs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info); chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgelqs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgelqs_(&c__2, &c__2, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info); chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zgelqs_(&c__1, &c__2, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgelqs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZUNGLQ */ s_copy(srnamc_1.srnamt, "ZUNGLQ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zunglq_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zunglq_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zunglq_(&c__2, &c__1, &c__0, a, &c__2, x, w, &c__2, &info); chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zunglq_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info); chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zunglq_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info); chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunglq_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zunglq_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info); chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZUNGL2 */ s_copy(srnamc_1.srnamt, "ZUNGL2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zungl2_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info); chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zungl2_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info); chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zungl2_(&c__2, &c__1, &c__0, a, &c__2, x, w, &info); chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zungl2_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info); chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zungl2_(&c__1, &c__1, &c__2, a, &c__1, x, w, &info); chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zungl2_(&c__2, &c__2, &c__0, a, &c__1, x, w, &info); chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZUNMLQ */ s_copy(srnamc_1.srnamt, "ZUNMLQ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zunmlq_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zunmlq_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zunmlq_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zunmlq_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmlq_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmlq_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmlq_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zunmlq_("L", "N", &c__2, &c__0, &c__2, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zunmlq_("R", "N", &c__0, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zunmlq_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zunmlq_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zunmlq_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZUNML2 */ s_copy(srnamc_1.srnamt, "ZUNML2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zunml2_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zunml2_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zunml2_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zunml2_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunml2_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunml2_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunml2_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zunml2_("L", "N", &c__2, &c__1, &c__2, a, &c__1, x, af, &c__2, w, &info); chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zunml2_("R", "N", &c__1, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &info); chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zunml2_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info); chkxer_("ZUNML2", &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 ZERRLQ */ } /* zerrlq_ */
/* Subroutine */ int derrql_(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 dgeql2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorg2l_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorm2l_(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 *), dgeqlf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dgeqls_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), dorgql_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dormql_(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 ======= DERRQL tests the error exits for the DOUBLE PRECISION 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. ===================================================================== */ 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 QL factorization DGEQLF */ s_copy(srnamc_1.srnamt, "DGEQLF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgeqlf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info); chkxer_("DGEQLF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgeqlf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info); chkxer_("DGEQLF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgeqlf_(&c__2, &c__1, a, &c__1, b, w, &c__1, &info); chkxer_("DGEQLF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dgeqlf_(&c__1, &c__2, a, &c__1, b, w, &c__1, &info); chkxer_("DGEQLF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGEQL2 */ s_copy(srnamc_1.srnamt, "DGEQL2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgeql2_(&c_n1, &c__0, a, &c__1, b, w, &info); chkxer_("DGEQL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgeql2_(&c__0, &c_n1, a, &c__1, b, w, &info); chkxer_("DGEQL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgeql2_(&c__2, &c__1, a, &c__1, b, w, &info); chkxer_("DGEQL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGEQLS */ s_copy(srnamc_1.srnamt, "DGEQLS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgeqls_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgeqls_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgeqls_(&c__1, &c__2, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgeqls_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgeqls_(&c__2, &c__1, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info); chkxer_("DGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dgeqls_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dgeqls_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info); chkxer_("DGEQLS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORGQL */ s_copy(srnamc_1.srnamt, "DORGQL", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dorgql_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("DORGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorgql_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("DORGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorgql_(&c__1, &c__2, &c__0, a, &c__1, x, w, &c__2, &info); chkxer_("DORGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgql_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info); chkxer_("DORGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgql_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info); chkxer_("DORGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorgql_(&c__2, &c__1, &c__0, a, &c__1, x, w, &c__1, &info); chkxer_("DORGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dorgql_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info); chkxer_("DORGQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORG2L */ s_copy(srnamc_1.srnamt, "DORG2L", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dorg2l_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info); chkxer_("DORG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorg2l_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info); chkxer_("DORG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorg2l_(&c__1, &c__2, &c__0, a, &c__1, x, w, &info); chkxer_("DORG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorg2l_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info); chkxer_("DORG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorg2l_(&c__2, &c__1, &c__2, a, &c__2, x, w, &info); chkxer_("DORG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorg2l_(&c__2, &c__1, &c__0, a, &c__1, x, w, &info); chkxer_("DORG2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORMQL */ s_copy(srnamc_1.srnamt, "DORMQL", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dormql_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dormql_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dormql_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dormql_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dormql_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dormql_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dormql_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dormql_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dormql_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dormql_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dormql_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dormql_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, & info); chkxer_("DORMQL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DORM2L */ s_copy(srnamc_1.srnamt, "DORM2L", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dorm2l_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorm2l_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorm2l_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dorm2l_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorm2l_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorm2l_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dorm2l_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dorm2l_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &info); chkxer_("DORM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dorm2l_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &info); chkxer_("DORM2L", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dorm2l_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info); chkxer_("DORM2L", &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 DERRQL */ } /* derrql_ */
/* Subroutine */ int zerred_(char *path, integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a,\002 passed the tests of the error exits" " (\002,i3,\002 tests done)\002)"; static char fmt_9998[] = "(\002 *** \002,a,\002 failed the tests of the " "error exits ***\002)"; /* System generated locals */ integer i__1; /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), i_len_trim(char *, ftnlen), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ doublecomplex a[16] /* was [4][4] */; logical b[4]; integer i__, j; doublereal s[4]; doublecomplex u[16] /* was [4][4] */, w[16], x[4]; char c2[2]; doublereal r1[4], r2[4]; integer iw[16], nt; doublecomplex vl[16] /* was [4][4] */, vr[16] /* was [4][4] */; doublereal rw[20]; doublecomplex vt[16] /* was [4][4] */; integer ihi, ilo, info, sdim; doublereal abnrm; extern /* Subroutine */ int zgees_(char *, char *, L_fp, integer *, doublecomplex *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, logical *, integer *), zgeev_(char * , char *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int zgesdd_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), zgesvd_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *); extern logical zslect_(); extern /* Subroutine */ int zgeesx_(char *, char *, L_fp, char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublereal *, logical *, integer *), zgeevx_(char *, char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal * , doublecomplex *, integer *, doublereal *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; static cilist io___23 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___24 = { 0, 0, 0, fmt_9998, 0 }; static cilist io___26 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___27 = { 0, 0, 0, fmt_9998, 0 }; static cilist io___28 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___29 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZERRED tests the error exits for the eigenvalue driver routines for */ /* DOUBLE PRECISION matrices: */ /* PATH driver description */ /* ---- ------ ----------- */ /* ZEV ZGEEV find eigenvalues/eigenvectors for nonsymmetric A */ /* ZES ZGEES find eigenvalues/Schur form for nonsymmetric A */ /* ZVX ZGEEVX ZGEEV + balancing and condition estimation */ /* ZSX ZGEESX ZGEES + balancing and condition estimation */ /* ZBD ZGESVD compute SVD of an M-by-N matrix A */ /* ZGESDD compute SVD of an M-by-N matrix A(by divide and */ /* conquer) */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Arrays in Common .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Initialize A */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { i__1 = i__ + (j << 2) - 5; a[i__1].r = 0., a[i__1].i = 0.; /* L10: */ } /* L20: */ } for (i__ = 1; i__ <= 4; ++i__) { i__1 = i__ + (i__ << 2) - 5; a[i__1].r = 1., a[i__1].i = 0.; /* L30: */ } infoc_1.ok = TRUE_; nt = 0; if (lsamen_(&c__2, c2, "EV")) { /* Test ZGEEV */ s_copy(srnamc_1.srnamt, "ZGEEV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgeev_("X", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1, rw, &info); chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgeev_("N", "X", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1, rw, &info); chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgeev_("N", "N", &c_n1, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1, rw, &info); chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgeev_("N", "N", &c__2, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__4, rw, &info); chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zgeev_("V", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, w, &c__4, rw, &info); chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgeev_("N", "V", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, w, &c__4, rw, &info); chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zgeev_("V", "V", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1, rw, &info); chkxer_("ZGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 7; } else if (lsamen_(&c__2, c2, "ES")) { /* Test ZGEES */ s_copy(srnamc_1.srnamt, "ZGEES ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgees_("X", "N", (L_fp)zslect_, &c__0, a, &c__1, &sdim, x, vl, &c__1, w, &c__1, rw, b, &info); chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgees_("N", "X", (L_fp)zslect_, &c__0, a, &c__1, &sdim, x, vl, &c__1, w, &c__1, rw, b, &info); chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgees_("N", "S", (L_fp)zslect_, &c_n1, a, &c__1, &sdim, x, vl, &c__1, w, &c__1, rw, b, &info); chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgees_("N", "S", (L_fp)zslect_, &c__2, a, &c__1, &sdim, x, vl, &c__1, w, &c__4, rw, b, &info); chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgees_("V", "S", (L_fp)zslect_, &c__2, a, &c__2, &sdim, x, vl, &c__1, w, &c__4, rw, b, &info); chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zgees_("N", "S", (L_fp)zslect_, &c__1, a, &c__1, &sdim, x, vl, &c__1, w, &c__1, rw, b, &info); chkxer_("ZGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 6; } else if (lsamen_(&c__2, c2, "VX")) { /* Test ZGEEVX */ s_copy(srnamc_1.srnamt, "ZGEEVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgeevx_("X", "N", "N", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info); chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgeevx_("N", "X", "N", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info); chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgeevx_("N", "N", "X", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info); chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgeevx_("N", "N", "N", "X", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info); chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgeevx_("N", "N", "N", "N", &c_n1, a, &c__1, x, vl, &c__1, vr, &c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info); chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgeevx_("N", "N", "N", "N", &c__2, a, &c__1, x, vl, &c__1, vr, &c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info); chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgeevx_("N", "V", "N", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info); chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zgeevx_("N", "N", "V", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info); chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 20; zgeevx_("N", "N", "N", "N", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info); chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 20; zgeevx_("N", "N", "V", "V", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__2, rw, &info); chkxer_("ZGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 10; } else if (lsamen_(&c__2, c2, "SX")) { /* Test ZGEESX */ s_copy(srnamc_1.srnamt, "ZGEESX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgeesx_("X", "N", (L_fp)zslect_, "N", &c__0, a, &c__1, &sdim, x, vl, & c__1, r1, r2, w, &c__1, rw, b, &info); chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgeesx_("N", "X", (L_fp)zslect_, "N", &c__0, a, &c__1, &sdim, x, vl, & c__1, r1, r2, w, &c__1, rw, b, &info); chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgeesx_("N", "N", (L_fp)zslect_, "X", &c__0, a, &c__1, &sdim, x, vl, & c__1, r1, r2, w, &c__1, rw, b, &info); chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgeesx_("N", "N", (L_fp)zslect_, "N", &c_n1, a, &c__1, &sdim, x, vl, & c__1, r1, r2, w, &c__1, rw, b, &info); chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgeesx_("N", "N", (L_fp)zslect_, "N", &c__2, a, &c__1, &sdim, x, vl, & c__1, r1, r2, w, &c__4, rw, b, &info); chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zgeesx_("V", "N", (L_fp)zslect_, "N", &c__2, a, &c__2, &sdim, x, vl, & c__1, r1, r2, w, &c__4, rw, b, &info); chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; zgeesx_("N", "N", (L_fp)zslect_, "N", &c__1, a, &c__1, &sdim, x, vl, & c__1, r1, r2, w, &c__1, rw, b, &info); chkxer_("ZGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 7; } else if (lsamen_(&c__2, c2, "BD")) { /* Test ZGESVD */ s_copy(srnamc_1.srnamt, "ZGESVD", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgesvd_("X", "N", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__1, rw, &info); chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgesvd_("N", "X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__1, rw, &info); chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgesvd_("O", "O", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__1, rw, &info); chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgesvd_("N", "N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__1, rw, &info); chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgesvd_("N", "N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__1, rw, &info); chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgesvd_("N", "N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__5, rw, &info); chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zgesvd_("A", "N", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, & c__5, rw, &info); chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zgesvd_("N", "A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__5, rw, &info); chkxer_("ZGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; if (infoc_1.ok) { io___23.ciunit = infoc_1.nout; s_wsfe(&io___23); do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, ( ftnlen)32)); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___24.ciunit = infoc_1.nout; s_wsfe(&io___24); e_wsfe(); } /* Test ZGESDD */ s_copy(srnamc_1.srnamt, "ZGESDD", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgesdd_("X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1, rw, iw, &info); chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgesdd_("N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1, rw, iw, &info); chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgesdd_("N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1, rw, iw, &info); chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgesdd_("N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5, rw, iw, &info); chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zgesdd_("A", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, &c__5, rw, iw, &info); chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgesdd_("A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5, rw, iw, &info); chkxer_("ZGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += -2; if (infoc_1.ok) { io___26.ciunit = infoc_1.nout; s_wsfe(&io___26); do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, ( ftnlen)32)); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___27.ciunit = infoc_1.nout; s_wsfe(&io___27); e_wsfe(); } } /* Print a summary line. */ if (! lsamen_(&c__2, c2, "BD")) { if (infoc_1.ok) { io___28.ciunit = infoc_1.nout; s_wsfe(&io___28); do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, ( ftnlen)32)); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___29.ciunit = infoc_1.nout; s_wsfe(&io___29); e_wsfe(); } } return 0; /* End of ZERRED */ } /* zerred_ */
/* Subroutine */ int zerrrfp_(integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,\002COMPLEX*16 RFP routines passed the tes" "ts of the \002,\002error exits\002)"; static char fmt_9998[] = "(\002 *** RFP routines failed the tests of the" " error \002,\002exits ***\002)"; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), e_wsfe(void); /* Local variables */ doublecomplex a[1] /* was [1][1] */, b[1] /* was [1][1] */, beta; integer info; doublecomplex alpha; extern /* Subroutine */ int zhfrk_(char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *), ztfsm_( char *, char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), chkxer_(char *, integer * , integer *, logical *, logical *), zpftrf_(char *, char * , integer *, doublecomplex *, integer *), zpftri_( char *, char *, integer *, doublecomplex *, integer *), ztftri_(char *, char *, char *, integer *, doublecomplex *, integer *), zpftrs_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), ztfttp_(char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), ztpttf_(char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), ztfttr_(char *, char *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), ztrttf_(char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztpttr_( char *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), ztrttp_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); /* Fortran I/O blocks */ static cilist io___6 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___7 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.2.0) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2008 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZERRRFP tests the error exits for the COMPLEX*16 driver routines */ /* for solving linear systems of equations. */ /* ZDRVRFP tests the COMPLEX*16 LAPACK RFP routines: */ /* ZTFSM, ZTFTRI, ZHFRK, ZTFTTP, ZTFTTR, ZPFTRF, ZPFTRS, ZTPTTF, */ /* ZTPTTR, ZTRTTF, and ZTRTTP */ /* Arguments */ /* ========= */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; infoc_1.ok = TRUE_; a[0].r = 1., a[0].i = 1.; b[0].r = 1., b[0].i = 1.; alpha.r = 1., alpha.i = 1.; beta.r = 1., beta.i = 1.; s_copy(srnamc_1.srnamt, "ZPFTRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zpftrf_("/", "U", &c__0, a, &info); chkxer_("ZPFTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpftrf_("N", "/", &c__0, a, &info); chkxer_("ZPFTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpftrf_("N", "U", &c_n1, a, &info); chkxer_("ZPFTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZPFTRS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zpftrs_("/", "U", &c__0, &c__0, a, b, &c__1, &info); chkxer_("ZPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpftrs_("N", "/", &c__0, &c__0, a, b, &c__1, &info); chkxer_("ZPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpftrs_("N", "U", &c_n1, &c__0, a, b, &c__1, &info); chkxer_("ZPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpftrs_("N", "U", &c__0, &c_n1, a, b, &c__1, &info); chkxer_("ZPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zpftrs_("N", "U", &c__0, &c__0, a, b, &c__0, &info); chkxer_("ZPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZPFTRI", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zpftri_("/", "U", &c__0, a, &info); chkxer_("ZPFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpftri_("N", "/", &c__0, a, &info); chkxer_("ZPFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpftri_("N", "U", &c_n1, a, &info); chkxer_("ZPFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZTFSM ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; ztfsm_("/", "L", "U", "C", "U", &c__0, &c__0, &alpha, a, b, &c__1); chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztfsm_("N", "/", "U", "C", "U", &c__0, &c__0, &alpha, a, b, &c__1); chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; ztfsm_("N", "L", "/", "C", "U", &c__0, &c__0, &alpha, a, b, &c__1); chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; ztfsm_("N", "L", "U", "/", "U", &c__0, &c__0, &alpha, a, b, &c__1); chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; ztfsm_("N", "L", "U", "C", "/", &c__0, &c__0, &alpha, a, b, &c__1); chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; ztfsm_("N", "L", "U", "C", "U", &c_n1, &c__0, &alpha, a, b, &c__1); chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; ztfsm_("N", "L", "U", "C", "U", &c__0, &c_n1, &alpha, a, b, &c__1); chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; ztfsm_("N", "L", "U", "C", "U", &c__0, &c__0, &alpha, a, b, &c__0); chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZTFTRI", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; ztftri_("/", "L", "N", &c__0, a, &info); chkxer_("ZTFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztftri_("N", "/", "N", &c__0, a, &info); chkxer_("ZTFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; ztftri_("N", "L", "/", &c__0, a, &info); chkxer_("ZTFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; ztftri_("N", "L", "N", &c_n1, a, &info); chkxer_("ZTFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZTFTTR", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; ztfttr_("/", "U", &c__0, a, b, &c__1, &info); chkxer_("ZTFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztfttr_("N", "/", &c__0, a, b, &c__1, &info); chkxer_("ZTFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; ztfttr_("N", "U", &c_n1, a, b, &c__1, &info); chkxer_("ZTFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; ztfttr_("N", "U", &c__0, a, b, &c__0, &info); chkxer_("ZTFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZTRTTF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; ztrttf_("/", "U", &c__0, a, &c__1, b, &info); chkxer_("ZTRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztrttf_("N", "/", &c__0, a, &c__1, b, &info); chkxer_("ZTRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; ztrttf_("N", "U", &c_n1, a, &c__1, b, &info); chkxer_("ZTRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; ztrttf_("N", "U", &c__0, a, &c__0, b, &info); chkxer_("ZTRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZTFTTP", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; ztfttp_("/", "U", &c__0, a, b, &info); chkxer_("ZTFTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztfttp_("N", "/", &c__0, a, b, &info); chkxer_("ZTFTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; ztfttp_("N", "U", &c_n1, a, b, &info); chkxer_("ZTFTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZTPTTF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; ztpttf_("/", "U", &c__0, a, b, &info); chkxer_("ZTPTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztpttf_("N", "/", &c__0, a, b, &info); chkxer_("ZTPTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; ztpttf_("N", "U", &c_n1, a, b, &info); chkxer_("ZTPTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZTRTTP", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; ztrttp_("/", &c__0, a, &c__1, b, &info); chkxer_("ZTRTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztrttp_("U", &c_n1, a, &c__1, b, &info); chkxer_("ZTRTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; ztrttp_("U", &c__0, a, &c__0, b, &info); chkxer_("ZTRTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZTPTTR", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; ztpttr_("/", &c__0, a, b, &c__1, &info); chkxer_("ZTPTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztpttr_("U", &c_n1, a, b, &c__1, &info); chkxer_("ZTPTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; ztpttr_("U", &c__0, a, b, &c__0, &info); chkxer_("ZTPTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); s_copy(srnamc_1.srnamt, "ZHFRK ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zhfrk_("/", "U", "N", &c__0, &c__0, &alpha, a, &c__1, &beta, b); chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zhfrk_("N", "/", "N", &c__0, &c__0, &alpha, a, &c__1, &beta, b); chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zhfrk_("N", "U", "/", &c__0, &c__0, &alpha, a, &c__1, &beta, b); chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zhfrk_("N", "U", "N", &c_n1, &c__0, &alpha, a, &c__1, &beta, b); chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zhfrk_("N", "U", "N", &c__0, &c_n1, &alpha, a, &c__1, &beta, b); chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zhfrk_("N", "U", "N", &c__0, &c__0, &alpha, a, &c__0, &beta, b); chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* Print a summary line. */ if (infoc_1.ok) { io___6.ciunit = infoc_1.nout; s_wsfe(&io___6); e_wsfe(); } else { io___7.ciunit = infoc_1.nout; s_wsfe(&io___7); e_wsfe(); } return 0; /* End of ZERRRFP */ } /* zerrrfp_ */
/* 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 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 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 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 derrtz_(char *path, integer *nunit) { /* Local variables */ doublereal a[4] /* was [2][2] */, w[2]; char c2[2]; doublereal tau[2]; integer info; /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* DERRTZ tests the error exits for DTZRQF and STZRZF. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); a[0] = 1.; a[2] = 2.; a[3] = 3.; a[1] = 4.; w[0] = 0.; w[1] = 0.; infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "TZ")) { /* Test error exits for the trapezoidal routines. */ /* DTZRQF */ s_copy(srnamc_1.srnamt, "DTZRQF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; dtzrqf_(&c_n1, &c__0, a, &c__1, tau, &info); chkxer_("DTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dtzrqf_(&c__1, &c__0, a, &c__1, tau, &info); chkxer_("DTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dtzrqf_(&c__2, &c__2, a, &c__1, tau, &info); chkxer_("DTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DTZRZF */ s_copy(srnamc_1.srnamt, "DTZRZF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; dtzrzf_(&c_n1, &c__0, a, &c__1, tau, w, &c__1, &info); chkxer_("DTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dtzrzf_(&c__1, &c__0, a, &c__1, tau, w, &c__1, &info); chkxer_("DTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dtzrzf_(&c__2, &c__2, a, &c__1, tau, w, &c__1, &info); chkxer_("DTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dtzrzf_(&c__2, &c__2, a, &c__2, tau, w, &c__1, &info); chkxer_("DTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of DERRTZ */ } /* derrtz_ */
/* Subroutine */ int serred_(char *path, integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e" "rror exits (\002,i3,\002 tests done)\002)"; static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes" "ts of the error ex\002,\002its ***\002)"; /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ static integer info, sdim; static real a[16] /* was [4][4] */; static logical b[4]; static integer i__, j; static real s[4], u[16] /* was [4][4] */, w[16], abnrm; extern /* Subroutine */ int sgees_(char *, char *, L_fp, integer *, real * , integer *, integer *, real *, real *, real *, integer *, real *, integer *, logical *, integer *), sgeev_(char *, char *, integer *, real *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, integer *); static char c2[2]; static real r1[4], r2[4]; static integer iw[8]; static real wi[4]; static integer nt; static real vl[16] /* was [4][4] */, vr[16] /* was [4][4] */, wr[ 4], vt[16] /* was [4][4] */; extern /* Subroutine */ int sgesdd_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), sgesvd_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer * , real *, integer *, integer *); extern logical sslect_(); extern /* Subroutine */ int sgeesx_(char *, char *, L_fp, char *, integer *, real *, integer *, integer *, real *, real *, real *, integer * , real *, real *, real *, integer *, integer *, integer *, logical *, integer *), sgeevx_(char *, char *, char *, char *, integer *, real *, integer *, real *, real *, real *, integer *, real *, integer *, integer *, integer * , real *, real *, real *, real *, real *, integer *, integer *, integer *); static integer ihi, ilo; /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; static cilist io___24 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___25 = { 0, 0, 0, fmt_9998, 0 }; #define a_ref(a_1,a_2) a[(a_2)*4 + a_1 - 5] /* -- LAPACK test routine (version 3.0) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University December 22, 1999 Purpose ======= SERRED tests the error exits for the eigenvalue driver routines for REAL matrices: PATH driver description ---- ------ ----------- SEV SGEEV find eigenvalues/eigenvectors for nonsymmetric A SES SGEES find eigenvalues/Schur form for nonsymmetric A SVX SGEEVX SGEEV + balancing and condition estimation SSX SGEESX SGEES + balancing and condition estimation SBD SGESVD compute SVD of an M-by-N matrix A SGESDD compute SVD of an M-by-N matrix A (by divide and conquer) Arguments ========= PATH (input) CHARACTER*3 The LAPACK path name for the routines to be tested. NUNIT (input) INTEGER The unit number for output. ===================================================================== */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Initialize A */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { a_ref(i__, j) = 0.f; /* L10: */ } /* L20: */ } for (i__ = 1; i__ <= 4; ++i__) { a_ref(i__, i__) = 1.f; /* L30: */ } infoc_1.ok = TRUE_; nt = 0; if (lsamen_(&c__2, c2, "EV")) { /* Test SGEEV */ s_copy(srnamc_1.srnamt, "SGEEV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgeev_("X", "N", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, &c__1, w, & c__1, &info); chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgeev_("N", "X", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, &c__1, w, & c__1, &info); chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgeev_("N", "N", &c_n1, a, &c__1, wr, wi, vl, &c__1, vr, &c__1, w, & c__1, &info); chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgeev_("N", "N", &c__2, a, &c__1, wr, wi, vl, &c__1, vr, &c__1, w, & c__6, &info); chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; sgeev_("V", "N", &c__2, a, &c__2, wr, wi, vl, &c__1, vr, &c__1, w, & c__8, &info); chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; sgeev_("N", "V", &c__2, a, &c__2, wr, wi, vl, &c__1, vr, &c__1, w, & c__8, &info); chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; sgeev_("V", "V", &c__1, a, &c__1, wr, wi, vl, &c__1, vr, &c__1, w, & c__3, &info); chkxer_("SGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 7; } else if (lsamen_(&c__2, c2, "ES")) { /* Test SGEES */ s_copy(srnamc_1.srnamt, "SGEES ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgees_("X", "N", (L_fp)sslect_, &c__0, a, &c__1, &sdim, wr, wi, vl, & c__1, w, &c__1, b, &info); chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgees_("N", "X", (L_fp)sslect_, &c__0, a, &c__1, &sdim, wr, wi, vl, & c__1, w, &c__1, b, &info); chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgees_("N", "S", (L_fp)sslect_, &c_n1, a, &c__1, &sdim, wr, wi, vl, & c__1, w, &c__1, b, &info); chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgees_("N", "S", (L_fp)sslect_, &c__2, a, &c__1, &sdim, wr, wi, vl, & c__1, w, &c__6, b, &info); chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; sgees_("V", "S", (L_fp)sslect_, &c__2, a, &c__2, &sdim, wr, wi, vl, & c__1, w, &c__6, b, &info); chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; sgees_("N", "S", (L_fp)sslect_, &c__1, a, &c__1, &sdim, wr, wi, vl, & c__1, w, &c__2, b, &info); chkxer_("SGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 6; } else if (lsamen_(&c__2, c2, "VX")) { /* Test SGEEVX */ s_copy(srnamc_1.srnamt, "SGEEVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgeevx_("X", "N", "N", "N", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgeevx_("N", "X", "N", "N", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgeevx_("N", "N", "X", "N", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgeevx_("N", "N", "N", "X", &c__0, a, &c__1, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgeevx_("N", "N", "N", "N", &c_n1, a, &c__1, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgeevx_("N", "N", "N", "N", &c__2, a, &c__1, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; sgeevx_("N", "V", "N", "N", &c__2, a, &c__2, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__6, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; sgeevx_("N", "N", "V", "N", &c__2, a, &c__2, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__6, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 21; sgeevx_("N", "N", "N", "N", &c__1, a, &c__1, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 21; sgeevx_("N", "V", "N", "N", &c__1, a, &c__1, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__2, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 21; sgeevx_("N", "N", "V", "V", &c__1, a, &c__1, wr, wi, vl, &c__1, vr, & c__1, &ilo, &ihi, s, &abnrm, r1, r2, w, &c__3, iw, &info); chkxer_("SGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 11; } else if (lsamen_(&c__2, c2, "SX")) { /* Test SGEESX */ s_copy(srnamc_1.srnamt, "SGEESX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgeesx_("X", "N", (L_fp)sslect_, "N", &c__0, a, &c__1, &sdim, wr, wi, vl, &c__1, r1, r2, w, &c__1, iw, &c__1, b, &info); chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgeesx_("N", "X", (L_fp)sslect_, "N", &c__0, a, &c__1, &sdim, wr, wi, vl, &c__1, r1, r2, w, &c__1, iw, &c__1, b, &info); chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgeesx_("N", "N", (L_fp)sslect_, "X", &c__0, a, &c__1, &sdim, wr, wi, vl, &c__1, r1, r2, w, &c__1, iw, &c__1, b, &info); chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgeesx_("N", "N", (L_fp)sslect_, "N", &c_n1, a, &c__1, &sdim, wr, wi, vl, &c__1, r1, r2, w, &c__1, iw, &c__1, b, &info); chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgeesx_("N", "N", (L_fp)sslect_, "N", &c__2, a, &c__1, &sdim, wr, wi, vl, &c__1, r1, r2, w, &c__6, iw, &c__1, b, &info); chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sgeesx_("V", "N", (L_fp)sslect_, "N", &c__2, a, &c__2, &sdim, wr, wi, vl, &c__1, r1, r2, w, &c__6, iw, &c__1, b, &info); chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; sgeesx_("N", "N", (L_fp)sslect_, "N", &c__1, a, &c__1, &sdim, wr, wi, vl, &c__1, r1, r2, w, &c__2, iw, &c__1, b, &info); chkxer_("SGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 7; } else if (lsamen_(&c__2, c2, "BD")) { /* Test SGESVD */ s_copy(srnamc_1.srnamt, "SGESVD", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgesvd_("X", "N", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__1, &info); chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgesvd_("N", "X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__1, &info); chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgesvd_("O", "O", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__1, &info); chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgesvd_("N", "N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__1, &info); chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgesvd_("N", "N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__1, &info); chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgesvd_("N", "N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__5, &info); chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; sgesvd_("A", "N", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, & c__5, &info); chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; sgesvd_("N", "A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, & c__5, &info); chkxer_("SGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* Test SGESDD */ s_copy(srnamc_1.srnamt, "SGESDD", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgesdd_("X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1, iw, &info); chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgesdd_("N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1, iw, &info); chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgesdd_("N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1, iw, &info); chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgesdd_("N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5, iw, &info); chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sgesdd_("A", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, &c__5, iw, &info); chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sgesdd_("A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5, iw, &info); chkxer_("SGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 6; } /* Print a summary line. */ if (! lsamen_(&c__2, c2, "BD")) { if (infoc_1.ok) { io___24.ciunit = infoc_1.nout; s_wsfe(&io___24); do_fio(&c__1, path, (ftnlen)3); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___25.ciunit = infoc_1.nout; s_wsfe(&io___25); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } } return 0; /* End of SERRED */ } /* serred_ */
/* Subroutine */ int cerrqp_(char *path, integer *nunit) { /* System generated locals */ integer i__1; /* Local variables */ complex a[9] /* was [3][3] */, w[15]; char c2[2]; integer ip[3], lw; real rw[6]; complex tau[3]; integer info; /* Fortran I/O blocks */ static cilist io___4 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* CERRQP tests the error exits for CGEQPF and CGEQP3. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); lw = 4; a[0].r = 1.f, a[0].i = -1.f; a[3].r = 2.f, a[3].i = -2.f; a[4].r = 3.f, a[4].i = -3.f; a[1].r = 4.f, a[1].i = -4.f; infoc_1.ok = TRUE_; io___4.ciunit = infoc_1.nout; s_wsle(&io___4); e_wsle(); /* Test error exits for QR factorization with pivoting */ if (lsamen_(&c__2, c2, "QP")) { /* CGEQPF */ s_copy(srnamc_1.srnamt, "CGEQPF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgeqpf_(&c_n1, &c__0, a, &c__1, ip, tau, w, rw, &info); chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgeqpf_(&c__0, &c_n1, a, &c__1, ip, tau, w, rw, &info); chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgeqpf_(&c__2, &c__0, a, &c__1, ip, tau, w, rw, &info); chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGEQP3 */ s_copy(srnamc_1.srnamt, "CGEQP3", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgeqp3_(&c_n1, &c__0, a, &c__1, ip, tau, w, &lw, rw, &info); chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgeqp3_(&c__1, &c_n1, a, &c__1, ip, tau, w, &lw, rw, &info); chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgeqp3_(&c__2, &c__3, a, &c__1, ip, tau, w, &lw, rw, &info); chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; i__1 = lw - 10; cgeqp3_(&c__2, &c__2, a, &c__2, ip, tau, w, &i__1, rw, &info); chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of CERRQP */ } /* cerrqp_ */
/* Subroutine */ int cerrvx_(char *path, integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a3,\002 drivers passed the tests of the er" "ror exits\002)"; static char fmt_9998[] = "(\002 *** \002,a3,\002 drivers failed the test" "s of the error \002,\002exits ***\002)"; /* System generated locals */ integer i__1; real r__1, r__2; complex q__1; /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ complex a[16] /* was [4][4] */, b[4]; real c__[4]; integer i__, j; real r__[4]; complex w[8], x[4]; char c2[2]; real r1[4], r2[4]; complex af[16] /* was [4][4] */; char eq[1]; real rf[4]; integer ip[4]; real rw[4]; integer info; extern /* Subroutine */ int cgbsv_(integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); real rcond; extern /* Subroutine */ int cgesv_(integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), chesv_( char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, integer *, integer *), cpbsv_(char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *), chpsv_(char * , integer *, integer *, complex *, integer *, complex *, integer * , integer *), cgtsv_(integer *, integer *, complex *, complex *, complex *, complex *, integer *, integer *), cposv_( char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *), cppsv_(char *, integer *, integer * , complex *, complex *, integer *, integer *), cspsv_( char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *), cptsv_(integer *, integer *, real * , complex *, complex *, integer *, integer *), csysv_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), cgbsvx_(char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, char *, real *, real *, complex *, integer *, complex *, integer *, real *, real *, real *, complex *, real *, integer *), cgesvx_(char *, char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, char *, real *, real *, complex *, integer *, complex * , integer *, real *, real *, real *, complex *, real *, integer *), chesvx_(char *, char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, real * , complex *, integer *, real *, integer *), cpbsvx_(char *, char *, integer *, integer *, integer *, complex * , integer *, complex *, integer *, char *, real *, complex *, integer *, complex *, integer *, real *, real *, real *, complex * , real *, integer *), chpsvx_(char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, real * , complex *, real *, integer *), cgtsvx_(char *, char *, integer *, integer *, complex *, complex *, complex *, complex *, complex *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, real *, complex * , real *, integer *), cposvx_(char *, char *, integer *, integer *, complex *, integer *, complex *, integer *, char *, real *, complex *, integer *, complex *, integer *, real * , real *, real *, complex *, real *, integer *), cppsvx_(char *, char *, integer *, integer *, complex *, complex *, char *, real *, complex *, integer *, complex *, integer *, real *, real *, real *, complex *, real *, integer *), cspsvx_(char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, real *, complex *, real *, integer *), cptsvx_(char *, integer *, integer *, real *, complex *, real *, complex *, complex *, integer *, complex *, integer *, real *, real *, real *, complex *, real *, integer *), csysvx_(char *, char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, real *, complex * , integer *, real *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; static cilist io___20 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___21 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.1.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* January 2007 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* CERRVX tests the error exits for the COMPLEX driver routines */ /* for solving linear systems of equations. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Set the variables to innocuous values. */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { i__1 = i__ + (j << 2) - 5; r__1 = 1.f / (real) (i__ + j); r__2 = -1.f / (real) (i__ + j); q__1.r = r__1, q__1.i = r__2; a[i__1].r = q__1.r, a[i__1].i = q__1.i; i__1 = i__ + (j << 2) - 5; r__1 = 1.f / (real) (i__ + j); r__2 = -1.f / (real) (i__ + j); q__1.r = r__1, q__1.i = r__2; af[i__1].r = q__1.r, af[i__1].i = q__1.i; /* L10: */ } i__1 = j - 1; b[i__1].r = 0.f, b[i__1].i = 0.f; r1[j - 1] = 0.f; r2[j - 1] = 0.f; i__1 = j - 1; w[i__1].r = 0.f, w[i__1].i = 0.f; i__1 = j - 1; x[i__1].r = 0.f, x[i__1].i = 0.f; c__[j - 1] = 0.f; r__[j - 1] = 0.f; ip[j - 1] = j; /* L20: */ } *(unsigned char *)eq = ' '; infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "GE")) { /* CGESV */ s_copy(srnamc_1.srnamt, "CGESV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgesv_(&c_n1, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("CGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgesv_(&c__0, &c_n1, a, &c__1, ip, b, &c__1, &info); chkxer_("CGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgesv_(&c__2, &c__1, a, &c__1, ip, b, &c__2, &info); chkxer_("CGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cgesv_(&c__2, &c__1, a, &c__2, ip, b, &c__1, &info); chkxer_("CGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGESVX */ s_copy(srnamc_1.srnamt, "CGESVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgesvx_("/", "N", &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgesvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cgesvx_("N", "N", &c_n1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgesvx_("N", "N", &c__0, &c_n1, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; cgesvx_("N", "N", &c__2, &c__1, a, &c__1, af, &c__2, ip, eq, r__, c__, b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; cgesvx_("N", "N", &c__2, &c__1, a, &c__2, af, &c__1, ip, eq, r__, c__, b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; *(unsigned char *)eq = '/'; cgesvx_("F", "N", &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; *(unsigned char *)eq = 'R'; cgesvx_("F", "N", &c__1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; *(unsigned char *)eq = 'C'; cgesvx_("F", "N", &c__1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; cgesvx_("N", "N", &c__2, &c__1, a, &c__2, af, &c__2, ip, eq, r__, c__, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; cgesvx_("N", "N", &c__2, &c__1, a, &c__2, af, &c__2, ip, eq, r__, c__, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "GB")) { /* CGBSV */ s_copy(srnamc_1.srnamt, "CGBSV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgbsv_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgbsv_(&c__1, &c_n1, &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cgbsv_(&c__1, &c__0, &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgbsv_(&c__0, &c__0, &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info); chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; cgbsv_(&c__1, &c__1, &c__1, &c__0, a, &c__3, ip, b, &c__1, &info); chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; cgbsv_(&c__2, &c__0, &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("CGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGBSVX */ s_copy(srnamc_1.srnamt, "CGBSVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgbsvx_("/", "N", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgbsvx_("N", "/", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cgbsvx_("N", "N", &c_n1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgbsvx_("N", "N", &c__1, &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cgbsvx_("N", "N", &c__1, &c__0, &c_n1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; cgbsvx_("N", "N", &c__0, &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; cgbsvx_("N", "N", &c__1, &c__1, &c__1, &c__0, a, &c__2, af, &c__4, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; cgbsvx_("N", "N", &c__1, &c__1, &c__1, &c__0, a, &c__3, af, &c__3, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; *(unsigned char *)eq = '/'; cgbsvx_("F", "N", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; *(unsigned char *)eq = 'R'; cgbsvx_("F", "N", &c__1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; *(unsigned char *)eq = 'C'; cgbsvx_("F", "N", &c__1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; cgbsvx_("N", "N", &c__2, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; cgbsvx_("N", "N", &c__2, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("CGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "GT")) { /* CGTSV */ s_copy(srnamc_1.srnamt, "CGTSV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgtsv_(&c_n1, &c__0, a, &a[4], &a[8], b, &c__1, &info); chkxer_("CGTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgtsv_(&c__0, &c_n1, a, &a[4], &a[8], b, &c__1, &info); chkxer_("CGTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cgtsv_(&c__2, &c__0, a, &a[4], &a[8], b, &c__1, &info); chkxer_("CGTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CGTSVX */ s_copy(srnamc_1.srnamt, "CGTSVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cgtsvx_("/", "N", &c__0, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cgtsvx_("N", "/", &c__0, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cgtsvx_("N", "N", &c_n1, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cgtsvx_("N", "N", &c__0, &c_n1, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; cgtsvx_("N", "N", &c__2, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; cgtsvx_("N", "N", &c__2, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "PO")) { /* CPOSV */ s_copy(srnamc_1.srnamt, "CPOSV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cposv_("/", &c__0, &c__0, a, &c__1, b, &c__1, &info); chkxer_("CPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cposv_("U", &c_n1, &c__0, a, &c__1, b, &c__1, &info); chkxer_("CPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cposv_("U", &c__0, &c_n1, a, &c__1, b, &c__1, &info); chkxer_("CPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cposv_("U", &c__2, &c__0, a, &c__1, b, &c__2, &info); chkxer_("CPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cposv_("U", &c__2, &c__0, a, &c__2, b, &c__1, &info); chkxer_("CPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CPOSVX */ s_copy(srnamc_1.srnamt, "CPOSVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cposvx_("/", "U", &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cposvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cposvx_("N", "U", &c_n1, &c__0, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cposvx_("N", "U", &c__0, &c_n1, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; cposvx_("N", "U", &c__2, &c__0, a, &c__1, af, &c__2, eq, c__, b, & c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; cposvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__1, eq, c__, b, & c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; *(unsigned char *)eq = '/'; cposvx_("F", "U", &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; *(unsigned char *)eq = 'Y'; cposvx_("F", "U", &c__1, &c__0, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; cposvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, eq, c__, b, & c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; cposvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, eq, c__, b, & c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "PP")) { /* CPPSV */ s_copy(srnamc_1.srnamt, "CPPSV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cppsv_("/", &c__0, &c__0, a, b, &c__1, &info); chkxer_("CPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cppsv_("U", &c_n1, &c__0, a, b, &c__1, &info); chkxer_("CPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cppsv_("U", &c__0, &c_n1, a, b, &c__1, &info); chkxer_("CPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; cppsv_("U", &c__2, &c__0, a, b, &c__1, &info); chkxer_("CPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CPPSVX */ s_copy(srnamc_1.srnamt, "CPPSVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cppsvx_("/", "U", &c__0, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cppsvx_("N", "/", &c__0, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cppsvx_("N", "U", &c_n1, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cppsvx_("N", "U", &c__0, &c_n1, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; *(unsigned char *)eq = '/'; cppsvx_("F", "U", &c__0, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; *(unsigned char *)eq = 'Y'; cppsvx_("F", "U", &c__1, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; cppsvx_("N", "U", &c__2, &c__0, a, af, eq, c__, b, &c__1, x, &c__2, & rcond, r1, r2, w, rw, &info); chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; cppsvx_("N", "U", &c__2, &c__0, a, af, eq, c__, b, &c__2, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("CPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "PB")) { /* CPBSV */ s_copy(srnamc_1.srnamt, "CPBSV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cpbsv_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &info) ; chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cpbsv_("U", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &info) ; chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cpbsv_("U", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, &info) ; chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cpbsv_("U", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &info) ; chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; cpbsv_("U", &c__1, &c__1, &c__0, a, &c__1, b, &c__2, &info) ; chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; cpbsv_("U", &c__2, &c__0, &c__0, a, &c__1, b, &c__1, &info) ; chkxer_("CPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CPBSVX */ s_copy(srnamc_1.srnamt, "CPBSVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cpbsvx_("/", "U", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cpbsvx_("N", "/", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cpbsvx_("N", "U", &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cpbsvx_("N", "U", &c__1, &c_n1, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; cpbsvx_("N", "U", &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cpbsvx_("N", "U", &c__1, &c__1, &c__0, a, &c__1, af, &c__2, eq, c__, b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; cpbsvx_("N", "U", &c__1, &c__1, &c__0, a, &c__2, af, &c__1, eq, c__, b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; *(unsigned char *)eq = '/'; cpbsvx_("F", "U", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; *(unsigned char *)eq = 'Y'; cpbsvx_("F", "U", &c__1, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; cpbsvx_("N", "U", &c__2, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; cpbsvx_("N", "U", &c__2, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "PT")) { /* CPTSV */ s_copy(srnamc_1.srnamt, "CPTSV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cptsv_(&c_n1, &c__0, r__, a, b, &c__1, &info); chkxer_("CPTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cptsv_(&c__0, &c_n1, r__, a, b, &c__1, &info); chkxer_("CPTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; cptsv_(&c__2, &c__0, r__, a, b, &c__1, &info); chkxer_("CPTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CPTSVX */ s_copy(srnamc_1.srnamt, "CPTSVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cptsvx_("/", &c__0, &c__0, r__, a, rf, af, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cptsvx_("N", &c_n1, &c__0, r__, a, rf, af, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cptsvx_("N", &c__0, &c_n1, r__, a, rf, af, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; cptsvx_("N", &c__2, &c__0, r__, a, rf, af, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; cptsvx_("N", &c__2, &c__0, r__, a, rf, af, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "HE")) { /* CHESV */ s_copy(srnamc_1.srnamt, "CHESV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; chesv_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("CHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; chesv_("U", &c_n1, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("CHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; chesv_("U", &c__0, &c_n1, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("CHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; chesv_("U", &c__2, &c__0, a, &c__1, ip, b, &c__2, w, &c__1, &info); chkxer_("CHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; chesv_("U", &c__2, &c__0, a, &c__2, ip, b, &c__1, w, &c__1, &info); chkxer_("CHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CHESVX */ s_copy(srnamc_1.srnamt, "CHESVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; chesvx_("/", "U", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; chesvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; chesvx_("N", "U", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; chesvx_("N", "U", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; chesvx_("N", "U", &c__2, &c__0, a, &c__1, af, &c__2, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; chesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__1, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; chesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; chesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; chesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__3, rw, &info); chkxer_("CHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "HP")) { /* CHPSV */ s_copy(srnamc_1.srnamt, "CHPSV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; chpsv_("/", &c__0, &c__0, a, ip, b, &c__1, &info); chkxer_("CHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; chpsv_("U", &c_n1, &c__0, a, ip, b, &c__1, &info); chkxer_("CHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; chpsv_("U", &c__0, &c_n1, a, ip, b, &c__1, &info); chkxer_("CHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; chpsv_("U", &c__2, &c__0, a, ip, b, &c__1, &info); chkxer_("CHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CHPSVX */ s_copy(srnamc_1.srnamt, "CHPSVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; chpsvx_("/", "U", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; chpsvx_("N", "/", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; chpsvx_("N", "U", &c_n1, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; chpsvx_("N", "U", &c__0, &c_n1, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; chpsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; chpsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "SY")) { /* CSYSV */ s_copy(srnamc_1.srnamt, "CSYSV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; csysv_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("CSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; csysv_("U", &c_n1, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("CSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; csysv_("U", &c__0, &c_n1, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("CSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; csysv_("U", &c__2, &c__0, a, &c__2, ip, b, &c__1, w, &c__1, &info); chkxer_("CSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CSYSVX */ s_copy(srnamc_1.srnamt, "CSYSVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; csysvx_("/", "U", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; csysvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; csysvx_("N", "U", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; csysvx_("N", "U", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; csysvx_("N", "U", &c__2, &c__0, a, &c__1, af, &c__2, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; csysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__1, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; csysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; csysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; csysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__3, rw, &info); chkxer_("CSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "SP")) { /* CSPSV */ s_copy(srnamc_1.srnamt, "CSPSV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cspsv_("/", &c__0, &c__0, a, ip, b, &c__1, &info); chkxer_("CSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cspsv_("U", &c_n1, &c__0, a, ip, b, &c__1, &info); chkxer_("CSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cspsv_("U", &c__0, &c_n1, a, ip, b, &c__1, &info); chkxer_("CSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; cspsv_("U", &c__2, &c__0, a, ip, b, &c__1, &info); chkxer_("CSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* CSPSVX */ s_copy(srnamc_1.srnamt, "CSPSVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; cspsvx_("/", "U", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; cspsvx_("N", "/", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; cspsvx_("N", "U", &c_n1, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; cspsvx_("N", "U", &c__0, &c_n1, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; cspsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; cspsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("CSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ if (infoc_1.ok) { io___20.ciunit = infoc_1.nout; s_wsfe(&io___20); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } else { io___21.ciunit = infoc_1.nout; s_wsfe(&io___21); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } return 0; /* End of CERRVX */ } /* cerrvx_ */
/* Subroutine */ int derrge_(char *path, integer *nunit) { /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ doublereal a[16] /* was [4][4] */, b[4]; integer i__, j; doublereal w[12], x[4]; char c2[2]; doublereal r1[4], r2[4], af[16] /* was [4][4] */; integer ip[4], iw[4], info; doublereal anrm, ccond, rcond; extern /* Subroutine */ int dgbtf2_(integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *), dgetf2_(integer *, integer *, doublereal *, integer *, integer *, integer *), dgbcon_(char *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgecon_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), alaesm_(char *, logical *, integer *), dgbequ_(integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *) , dgbrfs_(char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgbtrf_(integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *), dgeequ_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dgerfs_(char *, integer * , integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), dgetri_(integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), dgbtrs_(char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgetrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* DERRGE tests the error exits for the DOUBLE PRECISION routines */ /* for general matrices. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Set the variables to innocuous values. */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { a[i__ + (j << 2) - 5] = 1. / (doublereal) (i__ + j); af[i__ + (j << 2) - 5] = 1. / (doublereal) (i__ + j); /* L10: */ } b[j - 1] = 0.; r1[j - 1] = 0.; r2[j - 1] = 0.; w[j - 1] = 0.; x[j - 1] = 0.; ip[j - 1] = j; iw[j - 1] = j; /* L20: */ } infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "GE")) { /* Test error exits of the routines that use the LU decomposition */ /* of a general matrix. */ /* DGETRF */ s_copy(srnamc_1.srnamt, "DGETRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgetrf_(&c_n1, &c__0, a, &c__1, ip, &info); chkxer_("DGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgetrf_(&c__0, &c_n1, a, &c__1, ip, &info); chkxer_("DGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgetrf_(&c__2, &c__1, a, &c__1, ip, &info); chkxer_("DGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGETF2 */ s_copy(srnamc_1.srnamt, "DGETF2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgetf2_(&c_n1, &c__0, a, &c__1, ip, &info); chkxer_("DGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgetf2_(&c__0, &c_n1, a, &c__1, ip, &info); chkxer_("DGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgetf2_(&c__2, &c__1, a, &c__1, ip, &info); chkxer_("DGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGETRI */ s_copy(srnamc_1.srnamt, "DGETRI", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgetri_(&c_n1, a, &c__1, ip, w, &c__12, &info); chkxer_("DGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgetri_(&c__2, a, &c__1, ip, w, &c__12, &info); chkxer_("DGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGETRS */ s_copy(srnamc_1.srnamt, "DGETRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgetrs_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("DGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgetrs_("N", &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("DGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgetrs_("N", &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info); chkxer_("DGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgetrs_("N", &c__2, &c__1, a, &c__1, ip, b, &c__2, &info); chkxer_("DGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dgetrs_("N", &c__2, &c__1, a, &c__2, ip, b, &c__1, &info); chkxer_("DGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGERFS */ s_copy(srnamc_1.srnamt, "DGERFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgerfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgerfs_("N", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgerfs_("N", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgerfs_("N", &c__2, &c__1, a, &c__1, af, &c__2, ip, b, &c__2, x, & c__2, r1, r2, w, iw, &info); chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__1, ip, b, &c__2, x, & c__2, r1, r2, w, iw, &info); chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__1, x, & c__2, r1, r2, w, iw, &info); chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__2, x, & c__1, r1, r2, w, iw, &info); chkxer_("DGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGECON */ s_copy(srnamc_1.srnamt, "DGECON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgecon_("/", &c__0, a, &c__1, &anrm, &rcond, w, iw, &info); chkxer_("DGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgecon_("1", &c_n1, a, &c__1, &anrm, &rcond, w, iw, &info); chkxer_("DGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgecon_("1", &c__2, a, &c__1, &anrm, &rcond, w, iw, &info); chkxer_("DGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGEEQU */ s_copy(srnamc_1.srnamt, "DGEEQU", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgeequ_(&c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("DGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgeequ_(&c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("DGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgeequ_(&c__2, &c__2, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("DGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "GB")) { /* Test error exits of the routines that use the LU decomposition */ /* of a general band matrix. */ /* DGBTRF */ s_copy(srnamc_1.srnamt, "DGBTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgbtrf_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("DGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgbtrf_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("DGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgbtrf_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info); chkxer_("DGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgbtrf_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info); chkxer_("DGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; dgbtrf_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info); chkxer_("DGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGBTF2 */ s_copy(srnamc_1.srnamt, "DGBTF2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgbtf2_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("DGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgbtf2_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("DGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgbtf2_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info); chkxer_("DGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgbtf2_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info); chkxer_("DGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; dgbtf2_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info); chkxer_("DGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGBTRS */ s_copy(srnamc_1.srnamt, "DGBTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgbtrs_("/", &c__0, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgbtrs_("N", &c_n1, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgbtrs_("N", &c__1, &c_n1, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgbtrs_("N", &c__1, &c__0, &c_n1, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgbtrs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, ip, b, &c__1, & info); chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dgbtrs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, ip, b, &c__2, & info); chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dgbtrs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("DGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGBRFS */ s_copy(srnamc_1.srnamt, "DGBRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgbrfs_("/", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgbrfs_("N", &c_n1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgbrfs_("N", &c__1, &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgbrfs_("N", &c__1, &c__0, &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dgbrfs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dgbrfs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__2, af, &c__4, ip, b, & c__2, x, &c__2, r1, r2, w, iw, &info); chkxer_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; dgbrfs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__3, ip, b, & c__2, x, &c__2, r1, r2, w, iw, &info); chkxer_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; dgbrfs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__2, r1, r2, w, iw, &info); chkxer_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; dgbrfs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, af, &c__1, ip, b, & c__2, x, &c__1, r1, r2, w, iw, &info); chkxer_("DGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGBCON */ s_copy(srnamc_1.srnamt, "DGBCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgbcon_("/", &c__0, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("DGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgbcon_("1", &c_n1, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("DGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgbcon_("1", &c__1, &c_n1, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("DGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgbcon_("1", &c__1, &c__0, &c_n1, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("DGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; dgbcon_("1", &c__2, &c__1, &c__1, a, &c__3, ip, &anrm, &rcond, w, iw, &info); chkxer_("DGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* DGBEQU */ s_copy(srnamc_1.srnamt, "DGBEQU", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgbequ_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("DGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgbequ_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("DGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dgbequ_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("DGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgbequ_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("DGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; dgbequ_(&c__2, &c__2, &c__1, &c__1, a, &c__2, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("DGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of DERRGE */ } /* derrge_ */
/* Subroutine */ int serrge_(char *path, integer *nunit) { /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ real a[16] /* was [4][4] */, b[4], c__[4]; integer i__, j; real r__[4], w[12], x[4]; char c2[2]; real r1[4], r2[4], af[16] /* was [4][4] */; char eq[1]; integer ip[4], iw[4]; real err_bnds_c__[12] /* was [4][3] */; integer n_err_bnds__; real err_bnds_n__[12] /* was [4][3] */, berr; integer info; real anrm, ccond, rcond; extern /* Subroutine */ int sgbtf2_(integer *, integer *, integer *, integer *, real *, integer *, integer *, integer *), sgetf2_( integer *, integer *, real *, integer *, integer *, integer *), alaesm_(char *, logical *, integer *), sgbcon_(char *, integer *, integer *, integer *, real *, integer *, integer *, real *, real *, real *, integer *, integer *), sgecon_( char *, integer *, real *, integer *, real *, real *, real *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); real params[1]; extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), sgbequ_(integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *), sgbrfs_(char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, integer *, integer *), sgbtrf_(integer *, integer *, integer *, integer *, real *, integer *, integer *, integer *), sgeequ_(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *), sgerfs_(char *, integer *, integer *, real *, integer *, real *, integer *, integer *, real * , integer *, real *, integer *, real *, real *, real *, integer *, integer *), sgetrf_(integer *, integer *, real *, integer *, integer *, integer *), sgetri_(integer *, real *, integer *, integer *, real *, integer *, integer *), sgbtrs_(char *, integer *, integer *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *), sgetrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *), sgbequb_(integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *), sgeequb_(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *); integer nparams; extern /* Subroutine */ int sgbrfsx_(char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, real *, integer *, real *, real *, integer *, real *, real *, integer *, integer *), sgerfsx_(char *, char *, integer *, integer *, real *, integer *, real *, integer * , integer *, real *, real *, real *, integer *, real *, integer *, real *, real *, integer *, real *, real *, integer *, real *, real *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SERRGE tests the error exits for the REAL routines */ /* for general matrices. */ /* Note that this file is used only when the XBLAS are available, */ /* otherwise serrge.f defines this subroutine. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Set the variables to innocuous values. */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { a[i__ + (j << 2) - 5] = 1.f / (real) (i__ + j); af[i__ + (j << 2) - 5] = 1.f / (real) (i__ + j); /* L10: */ } b[j - 1] = 0.f; r1[j - 1] = 0.f; r2[j - 1] = 0.f; w[j - 1] = 0.f; x[j - 1] = 0.f; c__[j - 1] = 0.f; r__[j - 1] = 0.f; ip[j - 1] = j; iw[j - 1] = j; /* L20: */ } infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "GE")) { /* Test error exits of the routines that use the LU decomposition */ /* of a general matrix. */ /* SGETRF */ s_copy(srnamc_1.srnamt, "SGETRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgetrf_(&c_n1, &c__0, a, &c__1, ip, &info); chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgetrf_(&c__0, &c_n1, a, &c__1, ip, &info); chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgetrf_(&c__2, &c__1, a, &c__1, ip, &info); chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGETF2 */ s_copy(srnamc_1.srnamt, "SGETF2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgetf2_(&c_n1, &c__0, a, &c__1, ip, &info); chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgetf2_(&c__0, &c_n1, a, &c__1, ip, &info); chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgetf2_(&c__2, &c__1, a, &c__1, ip, &info); chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGETRI */ s_copy(srnamc_1.srnamt, "SGETRI", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgetri_(&c_n1, a, &c__1, ip, w, &c__12, &info); chkxer_("SGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgetri_(&c__2, a, &c__1, ip, w, &c__12, &info); chkxer_("SGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGETRS */ s_copy(srnamc_1.srnamt, "SGETRS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgetrs_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgetrs_("N", &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgetrs_("N", &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info); chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgetrs_("N", &c__2, &c__1, a, &c__1, ip, b, &c__2, &info); chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sgetrs_("N", &c__2, &c__1, a, &c__2, ip, b, &c__1, &info); chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGERFS */ s_copy(srnamc_1.srnamt, "SGERFS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgerfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgerfs_("N", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgerfs_("N", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgerfs_("N", &c__2, &c__1, a, &c__1, af, &c__2, ip, b, &c__2, x, & c__2, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__1, ip, b, &c__2, x, & c__2, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__1, x, & c__2, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__2, x, & c__1, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGERFSX */ n_err_bnds__ = 3; nparams = 0; s_copy(srnamc_1.srnamt, "SGERFSX", (ftnlen)32, (ftnlen)7); infoc_1.infot = 1; sgerfsx_("/", eq, &c__0, &c__0, a, &c__1, af, &c__1, ip, r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; *(unsigned char *)eq = '/'; sgerfsx_("N", eq, &c__2, &c__1, a, &c__1, af, &c__2, ip, r__, c__, b, &c__2, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; *(unsigned char *)eq = 'R'; sgerfsx_("N", eq, &c_n1, &c__0, a, &c__1, af, &c__1, ip, r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgerfsx_("N", eq, &c__0, &c_n1, a, &c__1, af, &c__1, ip, r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgerfsx_("N", eq, &c__2, &c__1, a, &c__1, af, &c__2, ip, r__, c__, b, &c__2, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sgerfsx_("N", eq, &c__2, &c__1, a, &c__2, af, &c__1, ip, r__, c__, b, &c__2, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; *(unsigned char *)eq = 'C'; sgerfsx_("N", eq, &c__2, &c__1, a, &c__2, af, &c__2, ip, r__, c__, b, &c__1, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; sgerfsx_("N", eq, &c__2, &c__1, a, &c__2, af, &c__2, ip, r__, c__, b, &c__2, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGERFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGECON */ s_copy(srnamc_1.srnamt, "SGECON", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgecon_("/", &c__0, a, &c__1, &anrm, &rcond, w, iw, &info); chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgecon_("1", &c_n1, a, &c__1, &anrm, &rcond, w, iw, &info); chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgecon_("1", &c__2, a, &c__1, &anrm, &rcond, w, iw, &info); chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGEEQU */ s_copy(srnamc_1.srnamt, "SGEEQU", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgeequ_(&c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgeequ_(&c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgeequ_(&c__2, &c__2, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGEEQUB */ s_copy(srnamc_1.srnamt, "SGEEQUB", (ftnlen)32, (ftnlen)7); infoc_1.infot = 1; sgeequb_(&c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info) ; chkxer_("SGEEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgeequb_(&c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info) ; chkxer_("SGEEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgeequb_(&c__2, &c__2, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info) ; chkxer_("SGEEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "GB")) { /* Test error exits of the routines that use the LU decomposition */ /* of a general band matrix. */ /* SGBTRF */ s_copy(srnamc_1.srnamt, "SGBTRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgbtrf_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbtrf_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbtrf_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info); chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbtrf_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info); chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgbtrf_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info); chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBTF2 */ s_copy(srnamc_1.srnamt, "SGBTF2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgbtf2_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbtf2_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbtf2_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info); chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbtf2_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info); chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgbtf2_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info); chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBTRS */ s_copy(srnamc_1.srnamt, "SGBTRS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgbtrs_("/", &c__0, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbtrs_("N", &c_n1, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbtrs_("N", &c__1, &c_n1, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbtrs_("N", &c__1, &c__0, &c_n1, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgbtrs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgbtrs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, ip, b, &c__2, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sgbtrs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBRFS */ s_copy(srnamc_1.srnamt, "SGBRFS", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgbrfs_("/", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbrfs_("N", &c_n1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbrfs_("N", &c__1, &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbrfs_("N", &c__1, &c__0, &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgbrfs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgbrfs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__2, af, &c__4, ip, b, & c__2, x, &c__2, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; sgbrfs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__3, ip, b, & c__2, x, &c__2, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sgbrfs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__2, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; sgbrfs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, af, &c__1, ip, b, & c__2, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBRFSX */ n_err_bnds__ = 3; nparams = 0; s_copy(srnamc_1.srnamt, "SGBRFSX", (ftnlen)32, (ftnlen)7); infoc_1.infot = 1; sgbrfsx_("/", eq, &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; *(unsigned char *)eq = '/'; sgbrfsx_("N", eq, &c__2, &c__1, &c__1, &c__1, a, &c__1, af, &c__2, ip, r__, c__, b, &c__2, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; *(unsigned char *)eq = 'R'; sgbrfsx_("N", eq, &c_n1, &c__1, &c__1, &c__0, a, &c__1, af, &c__1, ip, r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; *(unsigned char *)eq = 'R'; sgbrfsx_("N", eq, &c__2, &c_n1, &c__1, &c__1, a, &c__3, af, &c__4, ip, r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; *(unsigned char *)eq = 'R'; sgbrfsx_("N", eq, &c__2, &c__1, &c_n1, &c__1, a, &c__3, af, &c__4, ip, r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgbrfsx_("N", eq, &c__0, &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, ip, r__, c__, b, &c__1, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sgbrfsx_("N", eq, &c__2, &c__1, &c__1, &c__1, a, &c__1, af, &c__2, ip, r__, c__, b, &c__2, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sgbrfsx_("N", eq, &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__3, ip, r__, c__, b, &c__2, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; *(unsigned char *)eq = 'C'; sgbrfsx_("N", eq, &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__5, ip, r__, c__, b, &c__1, x, &c__2, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; sgbrfsx_("N", eq, &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__5, ip, r__, c__, b, &c__2, x, &c__1, &rcond, &berr, &n_err_bnds__, err_bnds_n__, err_bnds_c__, &nparams, params, w, iw, &info); chkxer_("SGBRFSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBCON */ s_copy(srnamc_1.srnamt, "SGBCON", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgbcon_("/", &c__0, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbcon_("1", &c_n1, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbcon_("1", &c__1, &c_n1, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbcon_("1", &c__1, &c__0, &c_n1, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgbcon_("1", &c__2, &c__1, &c__1, a, &c__3, ip, &anrm, &rcond, w, iw, &info); chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBEQU */ s_copy(srnamc_1.srnamt, "SGBEQU", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgbequ_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbequ_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbequ_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbequ_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgbequ_(&c__2, &c__2, &c__1, &c__1, a, &c__2, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBEQUB */ s_copy(srnamc_1.srnamt, "SGBEQUB", (ftnlen)32, (ftnlen)7); infoc_1.infot = 1; sgbequb_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbequb_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbequb_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbequb_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgbequb_(&c__2, &c__2, &c__1, &c__1, a, &c__2, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQUB", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of SERRGE */ } /* serrge_ */
/* Subroutine */ int derrbd_(char *path, integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e" "rror exits\002,\002 (\002,i3,\002 tests done)\002)"; static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes" "ts of the error \002,\002exits ***\002)"; /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ doublereal a[16] /* was [4][4] */, d__[4], e[4]; integer i__, j; doublereal q[16] /* was [4][4] */, u[16] /* was [4][4] */, v[16] /* was [4][4] */, w[4]; char c2[2]; integer iq[16] /* was [4][4] */, iw[4], nt; doublereal tp[4], tq[4]; integer info; extern /* Subroutine */ int dgebd2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dbdsdc_(char *, char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dgebrd_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int dbdsqr_(char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dorgbr_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), dormbr_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; static cilist io___18 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___19 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* DERRBD tests the error exits for DGEBRD, DORGBR, DORMBR, DBDSQR and */ /* DBDSDC. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Set the variables to innocuous values. */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { a[i__ + (j << 2) - 5] = 1. / (doublereal) (i__ + j); /* L10: */ } /* L20: */ } infoc_1.ok = TRUE_; nt = 0; /* Test error exits of the SVD routines. */ if (lsamen_(&c__2, c2, "BD")) { /* DGEBRD */ s_copy(srnamc_1.srnamt, "DGEBRD", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgebrd_(&c_n1, &c__0, a, &c__1, d__, e, tq, tp, w, &c__1, &info); chkxer_("DGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgebrd_(&c__0, &c_n1, a, &c__1, d__, e, tq, tp, w, &c__1, &info); chkxer_("DGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgebrd_(&c__2, &c__1, a, &c__1, d__, e, tq, tp, w, &c__2, &info); chkxer_("DGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; dgebrd_(&c__2, &c__1, a, &c__2, d__, e, tq, tp, w, &c__1, &info); chkxer_("DGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 4; /* DGEBD2 */ s_copy(srnamc_1.srnamt, "DGEBD2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dgebd2_(&c_n1, &c__0, a, &c__1, d__, e, tq, tp, w, &info); chkxer_("DGEBD2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dgebd2_(&c__0, &c_n1, a, &c__1, d__, e, tq, tp, w, &info); chkxer_("DGEBD2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dgebd2_(&c__2, &c__1, a, &c__1, d__, e, tq, tp, w, &info); chkxer_("DGEBD2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 3; /* DORGBR */ s_copy(srnamc_1.srnamt, "DORGBR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dorgbr_("/", &c__0, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info); chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dorgbr_("Q", &c_n1, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info); chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgbr_("Q", &c__0, &c_n1, &c__0, a, &c__1, tq, w, &c__1, &info); chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgbr_("Q", &c__0, &c__1, &c__0, a, &c__1, tq, w, &c__1, &info); chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgbr_("Q", &c__1, &c__0, &c__1, a, &c__1, tq, w, &c__1, &info); chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgbr_("P", &c__1, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info); chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dorgbr_("P", &c__0, &c__1, &c__1, a, &c__1, tq, w, &c__1, &info); chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dorgbr_("Q", &c__0, &c__0, &c_n1, a, &c__1, tq, w, &c__1, &info); chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; dorgbr_("Q", &c__2, &c__1, &c__1, a, &c__1, tq, w, &c__1, &info); chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; dorgbr_("Q", &c__2, &c__2, &c__1, a, &c__2, tq, w, &c__1, &info); chkxer_("DORGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 10; /* DORMBR */ s_copy(srnamc_1.srnamt, "DORMBR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dormbr_("/", "L", "T", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dormbr_("Q", "/", "T", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dormbr_("Q", "L", "/", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dormbr_("Q", "L", "T", &c_n1, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dormbr_("Q", "L", "T", &c__0, &c_n1, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; dormbr_("Q", "L", "T", &c__0, &c__0, &c_n1, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dormbr_("Q", "L", "T", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__2, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dormbr_("Q", "R", "T", &c__0, &c__2, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dormbr_("P", "L", "T", &c__2, &c__0, &c__2, a, &c__1, tq, u, &c__2, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; dormbr_("P", "R", "T", &c__0, &c__2, &c__2, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; dormbr_("Q", "R", "T", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; dormbr_("Q", "L", "T", &c__0, &c__2, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; dormbr_("Q", "R", "T", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__2, w, &c__1, &info); chkxer_("DORMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 13; /* DBDSQR */ s_copy(srnamc_1.srnamt, "DBDSQR", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dbdsqr_("/", &c__0, &c__0, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, w, &info); chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dbdsqr_("U", &c_n1, &c__0, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, w, &info); chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dbdsqr_("U", &c__0, &c_n1, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, w, &info); chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; dbdsqr_("U", &c__0, &c__0, &c_n1, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, w, &info); chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; dbdsqr_("U", &c__0, &c__0, &c__0, &c_n1, d__, e, v, &c__1, u, &c__1, a, &c__1, w, &info); chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; dbdsqr_("U", &c__2, &c__1, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, w, &info); chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; dbdsqr_("U", &c__0, &c__0, &c__2, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, w, &info); chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; dbdsqr_("U", &c__2, &c__0, &c__0, &c__1, d__, e, v, &c__1, u, &c__1, a, &c__1, w, &info); chkxer_("DBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* DBDSDC */ s_copy(srnamc_1.srnamt, "DBDSDC", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; dbdsdc_("/", "N", &c__0, d__, e, u, &c__1, v, &c__1, q, iq, w, iw, & info); chkxer_("DBDSDC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; dbdsdc_("U", "/", &c__0, d__, e, u, &c__1, v, &c__1, q, iq, w, iw, & info); chkxer_("DBDSDC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; dbdsdc_("U", "N", &c_n1, d__, e, u, &c__1, v, &c__1, q, iq, w, iw, & info); chkxer_("DBDSDC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; dbdsdc_("U", "I", &c__2, d__, e, u, &c__1, v, &c__1, q, iq, w, iw, & info); chkxer_("DBDSDC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; dbdsdc_("U", "I", &c__2, d__, e, u, &c__2, v, &c__1, q, iq, w, iw, & info); chkxer_("DBDSDC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 5; } /* Print a summary line. */ if (infoc_1.ok) { io___18.ciunit = infoc_1.nout; s_wsfe(&io___18); do_fio(&c__1, path, (ftnlen)3); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___19.ciunit = infoc_1.nout; s_wsfe(&io___19); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } return 0; /* End of DERRBD */ } /* derrbd_ */
/* Subroutine */ int zerrpo_(char *path, integer *nunit) { /* System generated locals */ integer i__1; doublereal d__1, d__2; doublecomplex z__1; /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ doublecomplex a[16] /* was [4][4] */, b[4]; integer i__, j; doublereal r__[4]; doublecomplex w[8], x[4]; char c2[2]; doublereal r1[4], r2[4]; doublecomplex af[16] /* was [4][4] */; integer info; doublereal anrm, rcond; extern /* Subroutine */ int zpbtf2_(char *, integer *, integer *, doublecomplex *, integer *, integer *), zpotf2_(char *, integer *, doublecomplex *, integer *, integer *), alaesm_(char *, logical *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), zpbcon_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zpbequ_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, integer *), zpbrfs_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zpbtrf_(char *, integer *, integer *, doublecomplex *, integer *, integer *), zpocon_(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zppcon_(char *, integer *, doublecomplex *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zpoequ_(integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, integer *), zpbtrs_( char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zporfs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex * , integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zpotrf_(char *, integer *, doublecomplex *, integer *, integer *), zpotri_(char *, integer *, doublecomplex *, integer *, integer *), zppequ_(char *, integer *, doublecomplex *, doublereal *, doublereal *, doublereal *, integer *), zpprfs_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zpptrf_(char * , integer *, doublecomplex *, integer *), zpptri_(char *, integer *, doublecomplex *, integer *), zpotrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zpptrs_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZERRPO tests the error exits for the COMPLEX*16 routines */ /* for Hermitian positive definite matrices. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Set the variables to innocuous values. */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { i__1 = i__ + (j << 2) - 5; d__1 = 1. / (doublereal) (i__ + j); d__2 = -1. / (doublereal) (i__ + j); z__1.r = d__1, z__1.i = d__2; a[i__1].r = z__1.r, a[i__1].i = z__1.i; i__1 = i__ + (j << 2) - 5; d__1 = 1. / (doublereal) (i__ + j); d__2 = -1. / (doublereal) (i__ + j); z__1.r = d__1, z__1.i = d__2; af[i__1].r = z__1.r, af[i__1].i = z__1.i; /* L10: */ } i__1 = j - 1; b[i__1].r = 0., b[i__1].i = 0.; r1[j - 1] = 0.; r2[j - 1] = 0.; i__1 = j - 1; w[i__1].r = 0., w[i__1].i = 0.; i__1 = j - 1; x[i__1].r = 0., x[i__1].i = 0.; /* L20: */ } anrm = 1.; infoc_1.ok = TRUE_; /* Test error exits of the routines that use the Cholesky */ /* decomposition of a Hermitian positive definite matrix. */ if (lsamen_(&c__2, c2, "PO")) { /* ZPOTRF */ s_copy(srnamc_1.srnamt, "ZPOTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpotrf_("/", &c__0, a, &c__1, &info); chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpotrf_("U", &c_n1, a, &c__1, &info); chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpotrf_("U", &c__2, a, &c__1, &info); chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPOTF2 */ s_copy(srnamc_1.srnamt, "ZPOTF2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpotf2_("/", &c__0, a, &c__1, &info); chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpotf2_("U", &c_n1, a, &c__1, &info); chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpotf2_("U", &c__2, a, &c__1, &info); chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPOTRI */ s_copy(srnamc_1.srnamt, "ZPOTRI", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpotri_("/", &c__0, a, &c__1, &info); chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpotri_("U", &c_n1, a, &c__1, &info); chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpotri_("U", &c__2, a, &c__1, &info); chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPOTRS */ s_copy(srnamc_1.srnamt, "ZPOTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpotrs_("/", &c__0, &c__0, a, &c__1, b, &c__1, &info); chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpotrs_("U", &c_n1, &c__0, a, &c__1, b, &c__1, &info); chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpotrs_("U", &c__0, &c_n1, a, &c__1, b, &c__1, &info); chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zpotrs_("U", &c__2, &c__1, a, &c__1, b, &c__2, &info); chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zpotrs_("U", &c__2, &c__1, a, &c__2, b, &c__1, &info); chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPORFS */ s_copy(srnamc_1.srnamt, "ZPORFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zporfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1, r1, r2, w, r__, &info); chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zporfs_("U", &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1, r1, r2, w, r__, &info); chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zporfs_("U", &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &c__1, r1, r2, w, r__, &info); chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zporfs_("U", &c__2, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &c__2, r1, r2, w, r__, &info); chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &c__2, r1, r2, w, r__, &info); chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__1, x, &c__2, r1, r2, w, r__, &info); chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__2, x, &c__1, r1, r2, w, r__, &info); chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPOCON */ s_copy(srnamc_1.srnamt, "ZPOCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpocon_("/", &c__0, a, &c__1, &anrm, &rcond, w, r__, &info) ; chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpocon_("U", &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info) ; chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpocon_("U", &c__2, a, &c__1, &anrm, &rcond, w, r__, &info) ; chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; d__1 = -anrm; zpocon_("U", &c__1, a, &c__1, &d__1, &rcond, w, r__, &info) ; chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPOEQU */ s_copy(srnamc_1.srnamt, "ZPOEQU", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpoequ_(&c_n1, a, &c__1, r1, &rcond, &anrm, &info); chkxer_("ZPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpoequ_(&c__2, a, &c__1, r1, &rcond, &anrm, &info); chkxer_("ZPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* Test error exits of the routines that use the Cholesky */ /* decomposition of a Hermitian positive definite packed matrix. */ } else if (lsamen_(&c__2, c2, "PP")) { /* ZPPTRF */ s_copy(srnamc_1.srnamt, "ZPPTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpptrf_("/", &c__0, a, &info); chkxer_("ZPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpptrf_("U", &c_n1, a, &info); chkxer_("ZPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPPTRI */ s_copy(srnamc_1.srnamt, "ZPPTRI", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpptri_("/", &c__0, a, &info); chkxer_("ZPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpptri_("U", &c_n1, a, &info); chkxer_("ZPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPPTRS */ s_copy(srnamc_1.srnamt, "ZPPTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpptrs_("/", &c__0, &c__0, a, b, &c__1, &info); chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpptrs_("U", &c_n1, &c__0, a, b, &c__1, &info); chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpptrs_("U", &c__0, &c_n1, a, b, &c__1, &info); chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zpptrs_("U", &c__2, &c__1, a, b, &c__1, &info); chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPPRFS */ s_copy(srnamc_1.srnamt, "ZPPRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpprfs_("/", &c__0, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, r__, &info); chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpprfs_("U", &c_n1, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, r__, &info); chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpprfs_("U", &c__0, &c_n1, a, af, b, &c__1, x, &c__1, r1, r2, w, r__, &info); chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zpprfs_("U", &c__2, &c__1, a, af, b, &c__1, x, &c__2, r1, r2, w, r__, &info); chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zpprfs_("U", &c__2, &c__1, a, af, b, &c__2, x, &c__1, r1, r2, w, r__, &info); chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPPCON */ s_copy(srnamc_1.srnamt, "ZPPCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zppcon_("/", &c__0, a, &anrm, &rcond, w, r__, &info); chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zppcon_("U", &c_n1, a, &anrm, &rcond, w, r__, &info); chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; d__1 = -anrm; zppcon_("U", &c__1, a, &d__1, &rcond, w, r__, &info); chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPPEQU */ s_copy(srnamc_1.srnamt, "ZPPEQU", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zppequ_("/", &c__0, a, r1, &rcond, &anrm, &info); chkxer_("ZPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zppequ_("U", &c_n1, a, r1, &rcond, &anrm, &info); chkxer_("ZPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* Test error exits of the routines that use the Cholesky */ /* decomposition of a Hermitian positive definite band matrix. */ } else if (lsamen_(&c__2, c2, "PB")) { /* ZPBTRF */ s_copy(srnamc_1.srnamt, "ZPBTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpbtrf_("/", &c__0, &c__0, a, &c__1, &info); chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpbtrf_("U", &c_n1, &c__0, a, &c__1, &info); chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpbtrf_("U", &c__1, &c_n1, a, &c__1, &info); chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zpbtrf_("U", &c__2, &c__1, a, &c__1, &info); chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPBTF2 */ s_copy(srnamc_1.srnamt, "ZPBTF2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpbtf2_("/", &c__0, &c__0, a, &c__1, &info); chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpbtf2_("U", &c_n1, &c__0, a, &c__1, &info); chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpbtf2_("U", &c__1, &c_n1, a, &c__1, &info); chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zpbtf2_("U", &c__2, &c__1, a, &c__1, &info); chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPBTRS */ s_copy(srnamc_1.srnamt, "ZPBTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpbtrs_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &info); chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpbtrs_("U", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &info); chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpbtrs_("U", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, &info); chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpbtrs_("U", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &info); chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zpbtrs_("U", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, &info); chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zpbtrs_("U", &c__2, &c__0, &c__1, a, &c__1, b, &c__1, &info); chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPBRFS */ s_copy(srnamc_1.srnamt, "ZPBRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpbrfs_("/", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, & c__1, r1, r2, w, r__, &info); chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpbrfs_("U", &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, & c__1, r1, r2, w, r__, &info); chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpbrfs_("U", &c__1, &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, & c__1, r1, r2, w, r__, &info); chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpbrfs_("U", &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, & c__1, r1, r2, w, r__, &info); chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zpbrfs_("U", &c__2, &c__1, &c__1, a, &c__1, af, &c__2, b, &c__2, x, & c__2, r1, r2, w, r__, &info); chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zpbrfs_("U", &c__2, &c__1, &c__1, a, &c__2, af, &c__1, b, &c__2, x, & c__2, r1, r2, w, r__, &info); chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zpbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__1, x, & c__2, r1, r2, w, r__, &info); chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zpbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__2, x, & c__1, r1, r2, w, r__, &info); chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPBCON */ s_copy(srnamc_1.srnamt, "ZPBCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpbcon_("/", &c__0, &c__0, a, &c__1, &anrm, &rcond, w, r__, &info); chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpbcon_("U", &c_n1, &c__0, a, &c__1, &anrm, &rcond, w, r__, &info); chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpbcon_("U", &c__1, &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info); chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zpbcon_("U", &c__2, &c__1, a, &c__1, &anrm, &rcond, w, r__, &info); chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; d__1 = -anrm; zpbcon_("U", &c__1, &c__0, a, &c__1, &d__1, &rcond, w, r__, &info); chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPBEQU */ s_copy(srnamc_1.srnamt, "ZPBEQU", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpbequ_("/", &c__0, &c__0, a, &c__1, r1, &rcond, &anrm, &info); chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpbequ_("U", &c_n1, &c__0, a, &c__1, r1, &rcond, &anrm, &info); chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpbequ_("U", &c__1, &c_n1, a, &c__1, r1, &rcond, &anrm, &info); chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zpbequ_("U", &c__2, &c__1, a, &c__1, r1, &rcond, &anrm, &info); chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of ZERRPO */ } /* zerrpo_ */
/* Subroutine */ int serrps_(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] */; integer i__, j, piv[4], info; real work[8]; extern /* Subroutine */ int spstf2_(char *, integer *, real *, integer *, integer *, integer *, real *, real *, integer *), alaesm_( char *, logical *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), spstrf_(char *, integer *, real *, integer *, integer *, integer *, real *, real *, 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 */ /* ======= */ /* SERRPS tests the error exits for the REAL routines */ /* for SPSTRF.. */ /* 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__) { a[i__ + (j << 2) - 5] = 1.f / (real) (i__ + j); /* L100: */ } piv[j - 1] = j; work[j - 1] = 0.f; work[j + 3] = 0.f; /* L110: */ } infoc_1.ok = TRUE_; /* Test error exits of the routines that use the Cholesky */ /* decomposition of a symmetric positive semidefinite matrix. */ /* SPSTRF */ s_copy(srnamc_1.srnamt, "SPSTRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; spstrf_("/", &c__0, a, &c__1, piv, &c__1, &c_b9, work, &info); chkxer_("SPSTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; spstrf_("U", &c_n1, a, &c__1, piv, &c__1, &c_b9, work, &info); chkxer_("SPSTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; spstrf_("U", &c__2, a, &c__1, piv, &c__1, &c_b9, work, &info); chkxer_("SPSTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SPSTF2 */ s_copy(srnamc_1.srnamt, "SPSTF2", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; spstf2_("/", &c__0, a, &c__1, piv, &c__1, &c_b9, work, &info); chkxer_("SPSTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; spstf2_("U", &c_n1, a, &c__1, piv, &c__1, &c_b9, work, &info); chkxer_("SPSTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; spstf2_("U", &c__2, a, &c__1, piv, &c__1, &c_b9, work, &info); chkxer_("SPSTF2", &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 SERRPS */ } /* serrps_ */
/* Subroutine */ int serrge_(char *path, integer *nunit) { /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ static integer info; static real anrm, a[16] /* was [4][4] */, b[4]; static integer i__, j; static real ccond, w[12], x[4], rcond; static char c2[2]; static real r1[4], r2[4]; extern /* Subroutine */ int sgbtf2_(integer *, integer *, integer *, integer *, real *, integer *, integer *, integer *), sgetf2_( integer *, integer *, real *, integer *, integer *, integer *); static real af[16] /* was [4][4] */; static integer ip[4], iw[4]; extern /* Subroutine */ int alaesm_(char *, logical *, integer *), sgbcon_(char *, integer *, integer *, integer *, real *, integer *, integer *, real *, real *, real *, integer *, integer *), sgecon_(char *, integer *, real *, integer *, real *, real *, real *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), sgbequ_(integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *), sgbrfs_(char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, integer *, integer *), sgbtrf_(integer *, integer *, integer *, integer *, real *, integer *, integer *, integer *), sgeequ_(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *), sgerfs_(char *, integer *, integer *, real *, integer *, real *, integer *, integer *, real * , integer *, real *, integer *, real *, real *, real *, integer *, integer *), sgetrf_(integer *, integer *, real *, integer *, integer *, integer *), sgetri_(integer *, real *, integer *, integer *, real *, integer *, integer *), sgbtrs_(char *, integer *, integer *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *), sgetrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; #define a_ref(a_1,a_2) a[(a_2)*4 + a_1 - 5] #define af_ref(a_1,a_2) af[(a_2)*4 + a_1 - 5] /* -- LAPACK test routine (version 3.0) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University February 29, 1992 Purpose ======= SERRGE tests the error exits for the REAL routines for general matrices. Arguments ========= PATH (input) CHARACTER*3 The LAPACK path name for the routines to be tested. NUNIT (input) INTEGER The unit number for output. ===================================================================== */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Set the variables to innocuous values. */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { a_ref(i__, j) = 1.f / (real) (i__ + j); af_ref(i__, j) = 1.f / (real) (i__ + j); /* L10: */ } b[j - 1] = 0.f; r1[j - 1] = 0.f; r2[j - 1] = 0.f; w[j - 1] = 0.f; x[j - 1] = 0.f; ip[j - 1] = j; iw[j - 1] = j; /* L20: */ } infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "GE")) { /* Test error exits of the routines that use the LU decomposition of a general matrix. SGETRF */ s_copy(srnamc_1.srnamt, "SGETRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgetrf_(&c_n1, &c__0, a, &c__1, ip, &info); chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgetrf_(&c__0, &c_n1, a, &c__1, ip, &info); chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgetrf_(&c__2, &c__1, a, &c__1, ip, &info); chkxer_("SGETRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGETF2 */ s_copy(srnamc_1.srnamt, "SGETF2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgetf2_(&c_n1, &c__0, a, &c__1, ip, &info); chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgetf2_(&c__0, &c_n1, a, &c__1, ip, &info); chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgetf2_(&c__2, &c__1, a, &c__1, ip, &info); chkxer_("SGETF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGETRI */ s_copy(srnamc_1.srnamt, "SGETRI", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgetri_(&c_n1, a, &c__1, ip, w, &c__12, &info); chkxer_("SGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgetri_(&c__2, a, &c__1, ip, w, &c__12, &info); chkxer_("SGETRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGETRS */ s_copy(srnamc_1.srnamt, "SGETRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgetrs_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgetrs_("N", &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgetrs_("N", &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info); chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgetrs_("N", &c__2, &c__1, a, &c__1, ip, b, &c__2, &info); chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sgetrs_("N", &c__2, &c__1, a, &c__2, ip, b, &c__1, &info); chkxer_("SGETRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGERFS */ s_copy(srnamc_1.srnamt, "SGERFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgerfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgerfs_("N", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgerfs_("N", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgerfs_("N", &c__2, &c__1, a, &c__1, af, &c__2, ip, b, &c__2, x, & c__2, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__1, ip, b, &c__2, x, & c__2, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__1, x, & c__2, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sgerfs_("N", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__2, x, & c__1, r1, r2, w, iw, &info); chkxer_("SGERFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGECON */ s_copy(srnamc_1.srnamt, "SGECON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgecon_("/", &c__0, a, &c__1, &anrm, &rcond, w, iw, &info); chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgecon_("1", &c_n1, a, &c__1, &anrm, &rcond, w, iw, &info); chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgecon_("1", &c__2, a, &c__1, &anrm, &rcond, w, iw, &info); chkxer_("SGECON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGEEQU */ s_copy(srnamc_1.srnamt, "SGEEQU", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgeequ_(&c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgeequ_(&c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgeequ_(&c__2, &c__2, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGEEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "GB")) { /* Test error exits of the routines that use the LU decomposition of a general band matrix. SGBTRF */ s_copy(srnamc_1.srnamt, "SGBTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgbtrf_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbtrf_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbtrf_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info); chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbtrf_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info); chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgbtrf_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info); chkxer_("SGBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBTF2 */ s_copy(srnamc_1.srnamt, "SGBTF2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgbtf2_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbtf2_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, ip, &info); chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbtf2_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, ip, &info); chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbtf2_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, ip, &info); chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgbtf2_(&c__2, &c__2, &c__1, &c__1, a, &c__3, ip, &info); chkxer_("SGBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBTRS */ s_copy(srnamc_1.srnamt, "SGBTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgbtrs_("/", &c__0, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbtrs_("N", &c_n1, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbtrs_("N", &c__1, &c_n1, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbtrs_("N", &c__1, &c__0, &c_n1, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgbtrs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgbtrs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, ip, b, &c__2, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sgbtrs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, ip, b, &c__1, & info); chkxer_("SGBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBRFS */ s_copy(srnamc_1.srnamt, "SGBRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgbrfs_("/", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbrfs_("N", &c_n1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbrfs_("N", &c__1, &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbrfs_("N", &c__1, &c__0, &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgbrfs_("N", &c__1, &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgbrfs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__2, af, &c__4, ip, b, & c__2, x, &c__2, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; sgbrfs_("N", &c__2, &c__1, &c__1, &c__1, a, &c__3, af, &c__3, ip, b, & c__2, x, &c__2, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sgbrfs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, af, &c__1, ip, b, & c__1, x, &c__2, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; sgbrfs_("N", &c__2, &c__0, &c__0, &c__1, a, &c__1, af, &c__1, ip, b, & c__2, x, &c__1, r1, r2, w, iw, &info); chkxer_("SGBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBCON */ s_copy(srnamc_1.srnamt, "SGBCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgbcon_("/", &c__0, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbcon_("1", &c_n1, &c__0, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbcon_("1", &c__1, &c_n1, &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbcon_("1", &c__1, &c__0, &c_n1, a, &c__1, ip, &anrm, &rcond, w, iw, &info); chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgbcon_("1", &c__2, &c__1, &c__1, a, &c__3, ip, &anrm, &rcond, w, iw, &info); chkxer_("SGBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SGBEQU */ s_copy(srnamc_1.srnamt, "SGBEQU", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; sgbequ_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgbequ_(&c__0, &c_n1, &c__0, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgbequ_(&c__1, &c__1, &c_n1, &c__0, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgbequ_(&c__1, &c__1, &c__0, &c_n1, a, &c__1, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sgbequ_(&c__2, &c__2, &c__1, &c__1, a, &c__2, r1, r2, &rcond, &ccond, &anrm, &info); chkxer_("SGBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of SERRGE */ } /* serrge_ */
/* Subroutine */ int zerrhs_(char *path, integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e" "rror exits\002,\002 (\002,i3,\002 tests done)\002)"; static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes" "ts of the error \002,\002exits ***\002)"; /* System generated locals */ integer i__1; doublereal d__1; /* Local variables */ doublecomplex a[9] /* was [3][3] */, c__[9] /* was [3][3] */; integer i__, j, m; doublereal s[3]; doublecomplex w[9], x[3]; char c2[2]; integer nt; doublecomplex vl[9] /* was [3][3] */, vr[9] /* was [3][3] */; doublereal rw[3]; integer ihi, ilo; logical sel[3]; doublecomplex tau[3]; integer info, ifaill[3]; extern /* Subroutine */ int zgebak_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublecomplex *, integer *, integer *), zgebal_(char *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, integer *); integer ifailr[3]; extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int zgehrd_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), zhsein_(char *, char *, char *, logical *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, integer * , integer *, doublecomplex *, doublereal *, integer *, integer *, integer *), zhseqr_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), ztrevc_(char *, char *, logical *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, doublecomplex *, doublereal *, integer *), zunghr_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), zunmhr_(char *, char *, integer *, integer *, integer *, integer * , doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; static cilist io___22 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___23 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZERRHS tests the error exits for ZGEBAK, CGEBAL, CGEHRD, ZUNGHR, */ /* ZUNMHR, ZHSEQR, CHSEIN, and ZTREVC. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Set the variables to innocuous values. */ for (j = 1; j <= 3; ++j) { for (i__ = 1; i__ <= 3; ++i__) { i__1 = i__ + j * 3 - 4; d__1 = 1. / (doublereal) (i__ + j); a[i__1].r = d__1, a[i__1].i = 0.; /* L10: */ } sel[j - 1] = TRUE_; /* L20: */ } infoc_1.ok = TRUE_; nt = 0; /* Test error exits of the nonsymmetric eigenvalue routines. */ if (lsamen_(&c__2, c2, "HS")) { /* ZGEBAL */ s_copy(srnamc_1.srnamt, "ZGEBAL", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgebal_("/", &c__0, a, &c__1, &ilo, &ihi, s, &info); chkxer_("ZGEBAL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgebal_("N", &c_n1, a, &c__1, &ilo, &ihi, s, &info); chkxer_("ZGEBAL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgebal_("N", &c__2, a, &c__1, &ilo, &ihi, s, &info); chkxer_("ZGEBAL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 3; /* ZGEBAK */ s_copy(srnamc_1.srnamt, "ZGEBAK", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgebak_("/", "R", &c__0, &c__1, &c__0, s, &c__0, a, &c__1, &info); chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgebak_("N", "/", &c__0, &c__1, &c__0, s, &c__0, a, &c__1, &info); chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgebak_("N", "R", &c_n1, &c__1, &c__0, s, &c__0, a, &c__1, &info); chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgebak_("N", "R", &c__0, &c__0, &c__0, s, &c__0, a, &c__1, &info); chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgebak_("N", "R", &c__0, &c__2, &c__0, s, &c__0, a, &c__1, &info); chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgebak_("N", "R", &c__2, &c__2, &c__1, s, &c__0, a, &c__2, &info); chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgebak_("N", "R", &c__0, &c__1, &c__1, s, &c__0, a, &c__1, &info); chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgebak_("N", "R", &c__0, &c__1, &c__0, s, &c_n1, a, &c__1, &info); chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zgebak_("N", "R", &c__2, &c__1, &c__2, s, &c__0, a, &c__1, &info); chkxer_("ZGEBAK", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 9; /* ZGEHRD */ s_copy(srnamc_1.srnamt, "ZGEHRD", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgehrd_(&c_n1, &c__1, &c__1, a, &c__1, tau, w, &c__1, &info); chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgehrd_(&c__0, &c__0, &c__0, a, &c__1, tau, w, &c__1, &info); chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgehrd_(&c__0, &c__2, &c__0, a, &c__1, tau, w, &c__1, &info); chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgehrd_(&c__1, &c__1, &c__0, a, &c__1, tau, w, &c__1, &info); chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgehrd_(&c__0, &c__1, &c__1, a, &c__1, tau, w, &c__1, &info); chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgehrd_(&c__2, &c__1, &c__1, a, &c__1, tau, w, &c__2, &info); chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zgehrd_(&c__2, &c__1, &c__2, a, &c__2, tau, w, &c__1, &info); chkxer_("ZGEHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 7; /* ZUNGHR */ s_copy(srnamc_1.srnamt, "ZUNGHR", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zunghr_(&c_n1, &c__1, &c__1, a, &c__1, tau, w, &c__1, &info); chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zunghr_(&c__0, &c__0, &c__0, a, &c__1, tau, w, &c__1, &info); chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zunghr_(&c__0, &c__2, &c__0, a, &c__1, tau, w, &c__1, &info); chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zunghr_(&c__1, &c__1, &c__0, a, &c__1, tau, w, &c__1, &info); chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zunghr_(&c__0, &c__1, &c__1, a, &c__1, tau, w, &c__1, &info); chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunghr_(&c__2, &c__1, &c__1, a, &c__1, tau, w, &c__1, &info); chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zunghr_(&c__3, &c__1, &c__3, a, &c__3, tau, w, &c__1, &info); chkxer_("ZUNGHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 7; /* ZUNMHR */ s_copy(srnamc_1.srnamt, "ZUNMHR", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zunmhr_("/", "N", &c__0, &c__0, &c__1, &c__0, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zunmhr_("L", "/", &c__0, &c__0, &c__1, &c__0, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zunmhr_("L", "N", &c_n1, &c__0, &c__1, &c__0, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zunmhr_("L", "N", &c__0, &c_n1, &c__1, &c__0, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmhr_("L", "N", &c__0, &c__0, &c__0, &c__0, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmhr_("L", "N", &c__0, &c__0, &c__2, &c__0, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmhr_("L", "N", &c__1, &c__2, &c__2, &c__1, a, &c__1, tau, c__, & c__1, w, &c__2, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmhr_("R", "N", &c__2, &c__1, &c__2, &c__1, a, &c__1, tau, c__, & c__2, w, &c__2, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zunmhr_("L", "N", &c__1, &c__1, &c__1, &c__0, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zunmhr_("L", "N", &c__0, &c__1, &c__1, &c__1, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zunmhr_("R", "N", &c__1, &c__0, &c__1, &c__1, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zunmhr_("L", "N", &c__2, &c__1, &c__1, &c__1, a, &c__1, tau, c__, & c__2, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zunmhr_("R", "N", &c__1, &c__2, &c__1, &c__1, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zunmhr_("L", "N", &c__2, &c__1, &c__1, &c__1, a, &c__2, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; zunmhr_("L", "N", &c__1, &c__2, &c__1, &c__1, a, &c__1, tau, c__, & c__1, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; zunmhr_("R", "N", &c__2, &c__1, &c__1, &c__1, a, &c__1, tau, c__, & c__2, w, &c__1, &info); chkxer_("ZUNMHR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 16; /* ZHSEQR */ s_copy(srnamc_1.srnamt, "ZHSEQR", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zhseqr_("/", "N", &c__0, &c__1, &c__0, a, &c__1, x, c__, &c__1, w, & c__1, &info); chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zhseqr_("E", "/", &c__0, &c__1, &c__0, a, &c__1, x, c__, &c__1, w, & c__1, &info); chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zhseqr_("E", "N", &c_n1, &c__1, &c__0, a, &c__1, x, c__, &c__1, w, & c__1, &info); chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zhseqr_("E", "N", &c__0, &c__0, &c__0, a, &c__1, x, c__, &c__1, w, & c__1, &info); chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zhseqr_("E", "N", &c__0, &c__2, &c__0, a, &c__1, x, c__, &c__1, w, & c__1, &info); chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zhseqr_("E", "N", &c__1, &c__1, &c__0, a, &c__1, x, c__, &c__1, w, & c__1, &info); chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zhseqr_("E", "N", &c__1, &c__1, &c__2, a, &c__1, x, c__, &c__1, w, & c__1, &info); chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zhseqr_("E", "N", &c__2, &c__1, &c__2, a, &c__1, x, c__, &c__2, w, & c__1, &info); chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zhseqr_("E", "V", &c__2, &c__1, &c__2, a, &c__2, x, c__, &c__1, w, & c__1, &info); chkxer_("ZHSEQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 9; /* ZHSEIN */ s_copy(srnamc_1.srnamt, "ZHSEIN", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zhsein_("/", "N", "N", sel, &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, &c__0, &m, w, rw, ifaill, ifailr, &info); chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zhsein_("R", "/", "N", sel, &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, &c__0, &m, w, rw, ifaill, ifailr, &info); chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zhsein_("R", "N", "/", sel, &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, &c__0, &m, w, rw, ifaill, ifailr, &info); chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zhsein_("R", "N", "N", sel, &c_n1, a, &c__1, x, vl, &c__1, vr, &c__1, &c__0, &m, w, rw, ifaill, ifailr, &info); chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zhsein_("R", "N", "N", sel, &c__2, a, &c__1, x, vl, &c__1, vr, &c__2, &c__4, &m, w, rw, ifaill, ifailr, &info); chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zhsein_("L", "N", "N", sel, &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, &c__4, &m, w, rw, ifaill, ifailr, &info); chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zhsein_("R", "N", "N", sel, &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, &c__4, &m, w, rw, ifaill, ifailr, &info); chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; zhsein_("R", "N", "N", sel, &c__2, a, &c__2, x, vl, &c__1, vr, &c__2, &c__1, &m, w, rw, ifaill, ifailr, &info); chkxer_("ZHSEIN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* ZTREVC */ s_copy(srnamc_1.srnamt, "ZTREVC", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; ztrevc_("/", "A", sel, &c__0, a, &c__1, vl, &c__1, vr, &c__1, &c__0, & m, w, rw, &info); chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztrevc_("L", "/", sel, &c__0, a, &c__1, vl, &c__1, vr, &c__1, &c__0, & m, w, rw, &info); chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; ztrevc_("L", "A", sel, &c_n1, a, &c__1, vl, &c__1, vr, &c__1, &c__0, & m, w, rw, &info); chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; ztrevc_("L", "A", sel, &c__2, a, &c__1, vl, &c__2, vr, &c__1, &c__4, & m, w, rw, &info); chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; ztrevc_("L", "A", sel, &c__2, a, &c__2, vl, &c__1, vr, &c__1, &c__4, & m, w, rw, &info); chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; ztrevc_("R", "A", sel, &c__2, a, &c__2, vl, &c__1, vr, &c__1, &c__4, & m, w, rw, &info); chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; ztrevc_("L", "A", sel, &c__2, a, &c__2, vl, &c__2, vr, &c__1, &c__1, & m, w, rw, &info); chkxer_("ZTREVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 7; } /* Print a summary line. */ if (infoc_1.ok) { io___22.ciunit = infoc_1.nout; s_wsfe(&io___22); do_fio(&c__1, path, (ftnlen)3); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___23.ciunit = infoc_1.nout; s_wsfe(&io___23); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } return 0; /* End of ZERRHS */ } /* zerrhs_ */
/* Subroutine */ int zerrgt_(char *path, integer *nunit) { /* System generated locals */ integer i__1; doublereal d__1; /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ doublecomplex b[2]; doublereal d__[2]; doublecomplex e[2]; integer i__; doublecomplex w[2], x[2]; char c2[2]; doublereal r1[2], r2[2], df[2]; doublecomplex ef[2], dl[2]; integer ip[2]; doublecomplex du[2]; doublereal rw[2]; doublecomplex du2[2], dlf[2], duf[2]; integer info; doublereal rcond, anorm; extern /* Subroutine */ int alaesm_(char *, logical *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), zgtcon_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *), zptcon_(integer *, doublereal *, doublecomplex *, doublereal *, doublereal *, doublereal *, integer *), zgtrfs_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex * , integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zgttrf_(integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *), zptrfs_(char *, integer *, integer *, doublereal *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zpttrf_( integer *, doublereal *, doublecomplex *, integer *), zgttrs_( char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zpttrs_(char *, integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZERRGT tests the error exits for the COMPLEX*16 tridiagonal */ /* routines. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); for (i__ = 1; i__ <= 2; ++i__) { d__[i__ - 1] = 1.; i__1 = i__ - 1; e[i__1].r = 2., e[i__1].i = 0.; i__1 = i__ - 1; dl[i__1].r = 3., dl[i__1].i = 0.; i__1 = i__ - 1; du[i__1].r = 4., du[i__1].i = 0.; /* L10: */ } anorm = 1.; infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "GT")) { /* Test error exits for the general tridiagonal routines. */ /* ZGTTRF */ s_copy(srnamc_1.srnamt, "ZGTTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgttrf_(&c_n1, dl, e, du, du2, ip, &info); chkxer_("ZGTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGTTRS */ s_copy(srnamc_1.srnamt, "ZGTTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgttrs_("/", &c__0, &c__0, dl, e, du, du2, ip, x, &c__1, &info); chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgttrs_("N", &c_n1, &c__0, dl, e, du, du2, ip, x, &c__1, &info); chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgttrs_("N", &c__0, &c_n1, dl, e, du, du2, ip, x, &c__1, &info); chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgttrs_("N", &c__2, &c__1, dl, e, du, du2, ip, x, &c__1, &info); chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGTRFS */ s_copy(srnamc_1.srnamt, "ZGTRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgtrfs_("/", &c__0, &c__0, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1, x, &c__1, r1, r2, w, rw, &info); chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgtrfs_("N", &c_n1, &c__0, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1, x, &c__1, r1, r2, w, rw, &info); chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgtrfs_("N", &c__0, &c_n1, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1, x, &c__1, r1, r2, w, rw, &info); chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; zgtrfs_("N", &c__2, &c__1, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1, x, &c__2, r1, r2, w, rw, &info); chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; zgtrfs_("N", &c__2, &c__1, dl, e, du, dlf, ef, duf, du2, ip, b, &c__2, x, &c__1, r1, r2, w, rw, &info); chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGTCON */ s_copy(srnamc_1.srnamt, "ZGTCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgtcon_("/", &c__0, dl, e, du, du2, ip, &anorm, &rcond, w, &info); chkxer_("ZGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgtcon_("I", &c_n1, dl, e, du, du2, ip, &anorm, &rcond, w, &info); chkxer_("ZGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; d__1 = -anorm; zgtcon_("I", &c__0, dl, e, du, du2, ip, &d__1, &rcond, w, &info); chkxer_("ZGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "PT")) { /* Test error exits for the positive definite tridiagonal */ /* routines. */ /* ZPTTRF */ s_copy(srnamc_1.srnamt, "ZPTTRF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpttrf_(&c_n1, d__, e, &info); chkxer_("ZPTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPTTRS */ s_copy(srnamc_1.srnamt, "ZPTTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpttrs_("/", &c__1, &c__0, d__, e, x, &c__1, &info); chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpttrs_("U", &c_n1, &c__0, d__, e, x, &c__1, &info); chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpttrs_("U", &c__0, &c_n1, d__, e, x, &c__1, &info); chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zpttrs_("U", &c__2, &c__1, d__, e, x, &c__1, &info); chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPTRFS */ s_copy(srnamc_1.srnamt, "ZPTRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zptrfs_("/", &c__1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, rw, &info); chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zptrfs_("U", &c_n1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, rw, &info); chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zptrfs_("U", &c__0, &c_n1, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, w, rw, &info); chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zptrfs_("U", &c__2, &c__1, d__, e, df, ef, b, &c__1, x, &c__2, r1, r2, w, rw, &info); chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zptrfs_("U", &c__2, &c__1, d__, e, df, ef, b, &c__2, x, &c__1, r1, r2, w, rw, &info); chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPTCON */ s_copy(srnamc_1.srnamt, "ZPTCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zptcon_(&c_n1, d__, e, &anorm, &rcond, rw, &info); chkxer_("ZPTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; d__1 = -anorm; zptcon_(&c__0, d__, e, &d__1, &rcond, rw, &info); chkxer_("ZPTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of ZERRGT */ } /* zerrgt_ */
/* Subroutine */ int 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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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)32, (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 zerrtz_(char *path, integer *nunit) { /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsle(cilist *), e_wsle(void); /* Local variables */ doublecomplex a[4] /* was [2][2] */, w[2]; char c2[2]; doublecomplex tau[2]; integer info; extern /* Subroutine */ int alaesm_(char *, logical *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), ztzrqf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztzrzf_( integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___4 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZERRTZ tests the error exits for ZTZRQF and ZTZRZF. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); a[0].r = 1., a[0].i = -1.; a[2].r = 2., a[2].i = -2.; a[3].r = 3., a[3].i = -3.; a[1].r = 4., a[1].i = -4.; w[0].r = 0., w[0].i = 0.; w[1].r = 0., w[1].i = 0.; infoc_1.ok = TRUE_; /* Test error exits for the trapezoidal routines. */ io___4.ciunit = infoc_1.nout; s_wsle(&io___4); e_wsle(); if (lsamen_(&c__2, c2, "TZ")) { /* ZTZRQF */ s_copy(srnamc_1.srnamt, "ZTZRQF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; ztzrqf_(&c_n1, &c__0, a, &c__1, tau, &info); chkxer_("ZTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztzrqf_(&c__1, &c__0, a, &c__1, tau, &info); chkxer_("ZTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; ztzrqf_(&c__2, &c__2, a, &c__1, tau, &info); chkxer_("ZTZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZTZRZF */ s_copy(srnamc_1.srnamt, "ZTZRZF", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; ztzrzf_(&c_n1, &c__0, a, &c__1, tau, w, &c__1, &info); chkxer_("ZTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; ztzrzf_(&c__1, &c__0, a, &c__1, tau, w, &c__1, &info); chkxer_("ZTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; ztzrzf_(&c__2, &c__2, a, &c__1, tau, w, &c__1, &info); chkxer_("ZTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; ztzrzf_(&c__2, &c__2, a, &c__2, tau, w, &c__1, &info); chkxer_("ZTZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of ZERRTZ */ } /* zerrtz_ */
/* Subroutine */ int serrec_(char *path, integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e" "rror exits (\002,i3,\002 tests done)\002)"; static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes" "ts of the error ex\002,\002its ***\002)"; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ real a[16] /* was [4][4] */, b[16] /* was [4][4] */, c__[16] /* was [4][4] */; integer i__, j, m; real s[4], wi[4]; integer nt; real wr[4]; logical sel[4]; real sep[4]; integer info, ifst, ilst; real work[4], scale; integer iwork[4]; extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), strexc_(char *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *), strsna_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *, integer *), strsen_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, real *, real *, real *, integer *, integer *, integer *, integer * ), strsyl_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer * , real *, integer *); /* Fortran I/O blocks */ static cilist io___19 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___20 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SERREC tests the error exits for the routines for eigen- condition */ /* estimation for REAL matrices: */ /* STRSYL, STREXC, STRSNA and STRSEN. */ /* 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 .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; infoc_1.ok = TRUE_; nt = 0; /* Initialize A, B and SEL */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { a[i__ + (j << 2) - 5] = 0.f; b[i__ + (j << 2) - 5] = 0.f; /* L10: */ } /* L20: */ } for (i__ = 1; i__ <= 4; ++i__) { a[i__ + (i__ << 2) - 5] = 1.f; sel[i__ - 1] = TRUE_; /* L30: */ } /* Test STRSYL */ s_copy(srnamc_1.srnamt, "STRSYL", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; strsyl_("X", "N", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strsyl_("N", "X", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; strsyl_("N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strsyl_("N", "N", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; strsyl_("N", "N", &c__1, &c__0, &c_n1, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; strsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__1, b, &c__1, c__, &c__2, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; strsyl_("N", "N", &c__1, &c__0, &c__2, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; strsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__2, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* Test STREXC */ s_copy(srnamc_1.srnamt, "STREXC", (ftnlen)32, (ftnlen)6); ifst = 1; ilst = 1; infoc_1.infot = 1; strexc_("X", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; strexc_("N", &c__0, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; ilst = 2; strexc_("N", &c__2, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; strexc_("V", &c__2, a, &c__2, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; ifst = 0; ilst = 1; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; ifst = 2; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; ifst = 1; ilst = 0; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; ilst = 2; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* Test STRSNA */ s_copy(srnamc_1.srnamt, "STRSNA", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; strsna_("X", "A", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__1, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strsna_("B", "X", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__1, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strsna_("B", "A", sel, &c_n1, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__1, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; strsna_("V", "A", sel, &c__2, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__2, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; strsna_("B", "A", sel, &c__2, a, &c__2, b, &c__1, c__, &c__2, s, sep, & c__2, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; strsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__1, s, sep, & c__2, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; strsna_("B", "A", sel, &c__1, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__0, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; strsna_("B", "S", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, & c__1, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; strsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, & c__2, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 9; /* Test STRSEN */ sel[0] = FALSE_; s_copy(srnamc_1.srnamt, "STRSEN", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; strsen_("X", "N", sel, &c__0, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strsen_("N", "X", sel, &c__0, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strsen_("N", "N", sel, &c_n1, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; strsen_("N", "N", sel, &c__2, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__2, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; strsen_("N", "V", sel, &c__2, a, &c__2, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; strsen_("N", "V", sel, &c__2, a, &c__2, b, &c__2, wr, wi, &m, s, sep, work, &c__0, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; strsen_("E", "V", sel, &c__3, a, &c__3, b, &c__3, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; strsen_("V", "V", sel, &c__3, a, &c__3, b, &c__3, wr, wi, &m, s, sep, work, &c__3, iwork, &c__2, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 17; strsen_("E", "V", sel, &c__2, a, &c__2, b, &c__2, wr, wi, &m, s, sep, work, &c__1, iwork, &c__0, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 17; strsen_("V", "V", sel, &c__3, a, &c__3, b, &c__3, wr, wi, &m, s, sep, work, &c__4, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 10; /* Print a summary line. */ if (infoc_1.ok) { io___19.ciunit = infoc_1.nout; s_wsfe(&io___19); do_fio(&c__1, path, (ftnlen)3); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___20.ciunit = infoc_1.nout; s_wsfe(&io___20); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } return 0; /* End of SERREC */ } /* serrec_ */
/* Subroutine */ int zerrbd_(char *path, integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e" "rror exits (\002,i3,\002 tests done)\002)"; static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes" "ts of the error \002,\002exits ***\002)"; /* 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); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ doublecomplex a[16] /* was [4][4] */; doublereal d__[4], e[4]; integer i__, j; doublecomplex u[16] /* was [4][4] */, v[16] /* was [4][4] */, w[4]; char c2[2]; integer nt; doublecomplex tp[4], tq[4]; doublereal rw[16]; integer info; extern /* Subroutine */ int zgebrd_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), zbdsqr_(char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer * , doublereal *, integer *), zungbr_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), zunmbr_(char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; static cilist io___16 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___17 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZERRBD tests the error exits for ZGEBRD, ZUNGBR, ZUNMBR, and ZBDSQR. */ /* 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); a[i__1].r = d__1, a[i__1].i = 0.; /* L10: */ } /* L20: */ } infoc_1.ok = TRUE_; nt = 0; /* Test error exits of the SVD routines. */ if (lsamen_(&c__2, c2, "BD")) { /* ZGEBRD */ s_copy(srnamc_1.srnamt, "ZGEBRD", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zgebrd_(&c_n1, &c__0, a, &c__1, d__, e, tq, tp, w, &c__1, &info); chkxer_("ZGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgebrd_(&c__0, &c_n1, a, &c__1, d__, e, tq, tp, w, &c__1, &info); chkxer_("ZGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgebrd_(&c__2, &c__1, a, &c__1, d__, e, tq, tp, w, &c__2, &info); chkxer_("ZGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgebrd_(&c__2, &c__1, a, &c__2, d__, e, tq, tp, w, &c__1, &info); chkxer_("ZGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 4; /* ZUNGBR */ s_copy(srnamc_1.srnamt, "ZUNGBR", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zungbr_("/", &c__0, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info); chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zungbr_("Q", &c_n1, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info); chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zungbr_("Q", &c__0, &c_n1, &c__0, a, &c__1, tq, w, &c__1, &info); chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zungbr_("Q", &c__0, &c__1, &c__0, a, &c__1, tq, w, &c__1, &info); chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zungbr_("Q", &c__1, &c__0, &c__1, a, &c__1, tq, w, &c__1, &info); chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zungbr_("P", &c__1, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info); chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zungbr_("P", &c__0, &c__1, &c__1, a, &c__1, tq, w, &c__1, &info); chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zungbr_("Q", &c__0, &c__0, &c_n1, a, &c__1, tq, w, &c__1, &info); chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zungbr_("Q", &c__2, &c__1, &c__1, a, &c__1, tq, w, &c__1, &info); chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zungbr_("Q", &c__2, &c__2, &c__1, a, &c__2, tq, w, &c__1, &info); chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 10; /* ZUNMBR */ s_copy(srnamc_1.srnamt, "ZUNMBR", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zunmbr_("/", "L", "T", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zunmbr_("Q", "/", "T", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zunmbr_("Q", "L", "/", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zunmbr_("Q", "L", "C", &c_n1, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zunmbr_("Q", "L", "C", &c__0, &c_n1, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zunmbr_("Q", "L", "C", &c__0, &c__0, &c_n1, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zunmbr_("Q", "L", "C", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__2, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zunmbr_("Q", "R", "C", &c__0, &c__2, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zunmbr_("P", "L", "C", &c__2, &c__0, &c__2, a, &c__1, tq, u, &c__2, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zunmbr_("P", "R", "C", &c__0, &c__2, &c__2, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zunmbr_("Q", "R", "C", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, &c__1, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; zunmbr_("Q", "L", "C", &c__0, &c__2, &c__0, a, &c__1, tq, u, &c__1, w, &c__0, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; zunmbr_("Q", "R", "C", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__2, w, &c__0, &info); chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 13; /* ZBDSQR */ s_copy(srnamc_1.srnamt, "ZBDSQR", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; zbdsqr_("/", &c__0, &c__0, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, rw, &info); chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zbdsqr_("U", &c_n1, &c__0, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, rw, &info); chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zbdsqr_("U", &c__0, &c_n1, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, rw, &info); chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zbdsqr_("U", &c__0, &c__0, &c_n1, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, rw, &info); chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zbdsqr_("U", &c__0, &c__0, &c__0, &c_n1, d__, e, v, &c__1, u, &c__1, a, &c__1, rw, &info); chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zbdsqr_("U", &c__2, &c__1, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, rw, &info); chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zbdsqr_("U", &c__0, &c__0, &c__2, &c__0, d__, e, v, &c__1, u, &c__1, a, &c__1, rw, &info); chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; zbdsqr_("U", &c__2, &c__0, &c__0, &c__1, d__, e, v, &c__1, u, &c__1, a, &c__1, rw, &info); chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; } /* Print a summary line. */ if (infoc_1.ok) { io___16.ciunit = infoc_1.nout; s_wsfe(&io___16); do_fio(&c__1, path, (ftnlen)3); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___17.ciunit = infoc_1.nout; s_wsfe(&io___17); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } return 0; /* End of ZERRBD */ } /* zerrbd_ */