/* Subroutine */ int serrpo_(char *path, integer *nunit)
{
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer info;
static real anrm, a[16] /* was [4][4] */, b[4];
static integer i__, j;
static real w[12], x[4], rcond;
static char c2[2];
static real r1[4], r2[4];
extern /* Subroutine */ int spbtf2_(char *, integer *, integer *, real *,
integer *, integer *);
static real af[16] /* was [4][4] */;
extern /* Subroutine */ int spotf2_(char *, integer *, real *, integer *,
integer *);
static integer iw[4];
extern /* Subroutine */ int alaesm_(char *, logical *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), spbcon_(char *, integer *, integer *, real
*, integer *, real *, real *, real *, integer *, integer *), spbequ_(char *, integer *, integer *, real *, integer *,
real *, real *, real *, integer *), spbrfs_(char *,
integer *, integer *, integer *, real *, integer *, real *,
integer *, real *, integer *, real *, integer *, real *, real *,
real *, integer *, integer *), spbtrf_(char *, integer *,
integer *, real *, integer *, integer *), spocon_(char *,
integer *, real *, integer *, real *, real *, real *, integer *,
integer *), sppcon_(char *, integer *, real *, real *,
real *, real *, integer *, integer *), spoequ_(integer *,
real *, integer *, real *, real *, real *, integer *), spbtrs_(
char *, integer *, integer *, integer *, real *, integer *, real *
, integer *, integer *), sporfs_(char *, integer *,
integer *, real *, integer *, real *, integer *, real *, integer *
, real *, integer *, real *, real *, real *, integer *, integer *), spotrf_(char *, integer *, real *, integer *, integer *), spotri_(char *, integer *, real *, integer *, integer *), sppequ_(char *, integer *, real *, real *, real *, real
*, integer *), spprfs_(char *, integer *, integer *, real
*, real *, real *, integer *, real *, integer *, real *, real *,
real *, integer *, integer *), spptrf_(char *, integer *,
real *, integer *), spptri_(char *, integer *, real *,
integer *), spotrs_(char *, integer *, integer *, real *,
integer *, real *, integer *, integer *), spptrs_(char *,
integer *, integer *, real *, real *, integer *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
#define a_ref(a_1,a_2) a[(a_2)*4 + a_1 - 5]
#define af_ref(a_1,a_2) af[(a_2)*4 + a_1 - 5]
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
February 29, 1992
Purpose
=======
SERRPO tests the error exits for the REAL routines
for symmetric positive definite matrices.
Arguments
=========
PATH (input) CHARACTER*3
The LAPACK path name for the routines to be tested.
NUNIT (input) INTEGER
The unit number for output.
===================================================================== */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Set the variables to innocuous values. */
for (j = 1; j <= 4; ++j) {
for (i__ = 1; i__ <= 4; ++i__) {
a_ref(i__, j) = 1.f / (real) (i__ + j);
af_ref(i__, j) = 1.f / (real) (i__ + j);
/* L10: */
}
b[j - 1] = 0.f;
r1[j - 1] = 0.f;
r2[j - 1] = 0.f;
w[j - 1] = 0.f;
x[j - 1] = 0.f;
iw[j - 1] = j;
/* L20: */
}
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "PO")) {
/* Test error exits of the routines that use the Cholesky
decomposition of a symmetric positive definite matrix.
SPOTRF */
s_copy(srnamc_1.srnamt, "SPOTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spotrf_("/", &c__0, a, &c__1, &info);
chkxer_("SPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spotrf_("U", &c_n1, a, &c__1, &info);
chkxer_("SPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spotrf_("U", &c__2, a, &c__1, &info);
chkxer_("SPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPOTF2 */
s_copy(srnamc_1.srnamt, "SPOTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spotf2_("/", &c__0, a, &c__1, &info);
chkxer_("SPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spotf2_("U", &c_n1, a, &c__1, &info);
chkxer_("SPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spotf2_("U", &c__2, a, &c__1, &info);
chkxer_("SPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPOTRI */
s_copy(srnamc_1.srnamt, "SPOTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spotri_("/", &c__0, a, &c__1, &info);
chkxer_("SPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spotri_("U", &c_n1, a, &c__1, &info);
chkxer_("SPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spotri_("U", &c__2, a, &c__1, &info);
chkxer_("SPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPOTRS */
s_copy(srnamc_1.srnamt, "SPOTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spotrs_("/", &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("SPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spotrs_("U", &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("SPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spotrs_("U", &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("SPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
spotrs_("U", &c__2, &c__1, a, &c__1, b, &c__2, &info);
chkxer_("SPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
spotrs_("U", &c__2, &c__1, a, &c__2, b, &c__1, &info);
chkxer_("SPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPORFS */
s_copy(srnamc_1.srnamt, "SPORFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sporfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sporfs_("U", &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
sporfs_("U", &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
sporfs_("U", &c__2, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &c__2,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sporfs_("U", &c__2, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &c__2,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
sporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__1, x, &c__2,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
sporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__2, x, &c__1,
r1, r2, w, iw, &info);
chkxer_("SPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPOCON */
s_copy(srnamc_1.srnamt, "SPOCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spocon_("/", &c__0, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spocon_("U", &c_n1, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spocon_("U", &c__2, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPOEQU */
s_copy(srnamc_1.srnamt, "SPOEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spoequ_(&c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spoequ_(&c__2, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "PP")) {
/* Test error exits of the routines that use the Cholesky
decomposition of a symmetric positive definite packed matrix.
SPPTRF */
s_copy(srnamc_1.srnamt, "SPPTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spptrf_("/", &c__0, a, &info);
chkxer_("SPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spptrf_("U", &c_n1, a, &info);
chkxer_("SPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPPTRI */
s_copy(srnamc_1.srnamt, "SPPTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spptri_("/", &c__0, a, &info);
chkxer_("SPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spptri_("U", &c_n1, a, &info);
chkxer_("SPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPPTRS */
s_copy(srnamc_1.srnamt, "SPPTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spptrs_("/", &c__0, &c__0, a, b, &c__1, &info);
chkxer_("SPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spptrs_("U", &c_n1, &c__0, a, b, &c__1, &info);
chkxer_("SPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spptrs_("U", &c__0, &c_n1, a, b, &c__1, &info);
chkxer_("SPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
spptrs_("U", &c__2, &c__1, a, b, &c__1, &info);
chkxer_("SPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPPRFS */
s_copy(srnamc_1.srnamt, "SPPRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spprfs_("/", &c__0, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, iw, &
info);
chkxer_("SPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spprfs_("U", &c_n1, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, iw, &
info);
chkxer_("SPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spprfs_("U", &c__0, &c_n1, a, af, b, &c__1, x, &c__1, r1, r2, w, iw, &
info);
chkxer_("SPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
spprfs_("U", &c__2, &c__1, a, af, b, &c__1, x, &c__2, r1, r2, w, iw, &
info);
chkxer_("SPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
spprfs_("U", &c__2, &c__1, a, af, b, &c__2, x, &c__1, r1, r2, w, iw, &
info);
chkxer_("SPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPPCON */
s_copy(srnamc_1.srnamt, "SPPCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sppcon_("/", &c__0, a, &anrm, &rcond, w, iw, &info);
chkxer_("SPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sppcon_("U", &c_n1, a, &anrm, &rcond, w, iw, &info);
chkxer_("SPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPPEQU */
s_copy(srnamc_1.srnamt, "SPPEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
sppequ_("/", &c__0, a, r1, &rcond, &anrm, &info);
chkxer_("SPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sppequ_("U", &c_n1, a, r1, &rcond, &anrm, &info);
chkxer_("SPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "PB")) {
/* Test error exits of the routines that use the Cholesky
decomposition of a symmetric positive definite band matrix.
SPBTRF */
s_copy(srnamc_1.srnamt, "SPBTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spbtrf_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("SPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbtrf_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("SPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbtrf_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("SPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
spbtrf_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("SPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPBTF2 */
s_copy(srnamc_1.srnamt, "SPBTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spbtf2_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("SPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbtf2_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("SPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbtf2_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("SPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
spbtf2_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("SPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPBTRS */
s_copy(srnamc_1.srnamt, "SPBTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spbtrs_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbtrs_("U", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbtrs_("U", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spbtrs_("U", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
spbtrs_("U", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
spbtrs_("U", &c__2, &c__0, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("SPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPBRFS */
s_copy(srnamc_1.srnamt, "SPBRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spbrfs_("/", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbrfs_("U", &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbrfs_("U", &c__1, &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spbrfs_("U", &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
spbrfs_("U", &c__2, &c__1, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
spbrfs_("U", &c__2, &c__1, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
spbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__1, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
spbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__2, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("SPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPBCON */
s_copy(srnamc_1.srnamt, "SPBCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spbcon_("/", &c__0, &c__0, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbcon_("U", &c_n1, &c__0, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbcon_("U", &c__1, &c_n1, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
spbcon_("U", &c__2, &c__1, a, &c__1, &anrm, &rcond, w, iw, &info);
chkxer_("SPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SPBEQU */
s_copy(srnamc_1.srnamt, "SPBEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
spbequ_("/", &c__0, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spbequ_("U", &c_n1, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
spbequ_("U", &c__1, &c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
spbequ_("U", &c__2, &c__1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("SPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
}
/* Print a summary line. */
alaesm_(path, &infoc_1.ok, &infoc_1.nout);
return 0;
/* End of SERRPO */
} /* serrpo_ */
/* Subroutine */ int schkpp_(logical *dotype, integer *nn, integer *nval,
integer *nns, integer *nsval, real *thresh, logical *tsterr, integer *
nmax, real *a, real *afac, real *ainv, real *b, real *x, real *xact,
real *work, real *rwork, integer *iwork, integer *nout)
{
/* Initialized data */
static integer iseedy[4] = { 1988,1989,1990,1991 };
static char uplos[1*2] = "U" "L";
static char packs[1*2] = "C" "R";
/* Format strings */
static char fmt_9999[] = "(\002 UPLO = '\002,a1,\002', N =\002,i5,\002, "
"type \002,i2,\002, test \002,i2,\002, ratio =\002,g12.5)";
static char fmt_9998[] = "(\002 UPLO = '\002,a1,\002', N =\002,i5,\002, "
"NRHS=\002,i3,\002, type \002,i2,\002, test(\002,i2,\002) =\002,g"
"12.5)";
/* System generated locals */
integer i__1, i__2, i__3;
/* Local variables */
integer i__, k, n, in, kl, ku, lda, npp, ioff, mode, imat, info;
char path[3], dist[1];
integer irhs, nrhs;
char uplo[1], type__[1];
integer nrun;
integer nfail, iseed[4];
real rcond;
integer nimat;
real anorm;
integer iuplo, izero, nerrs;
logical zerot;
char xtype[1];
real rcondc;
char packit[1];
real cndnum;
real result[8];
/* Fortran I/O blocks */
static cilist io___34 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___37 = { 0, 0, 0, fmt_9998, 0 };
static cilist io___39 = { 0, 0, 0, fmt_9999, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SCHKPP tests SPPTRF, -TRI, -TRS, -RFS, and -CON */
/* Arguments */
/* ========= */
/* DOTYPE (input) LOGICAL array, dimension (NTYPES) */
/* The matrix types to be used for testing. Matrices of type j */
/* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
/* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */
/* NN (input) INTEGER */
/* The number of values of N contained in the vector NVAL. */
/* NVAL (input) INTEGER array, dimension (NN) */
/* The values of the matrix dimension N. */
/* NNS (input) INTEGER */
/* The number of values of NRHS contained in the vector NSVAL. */
/* NSVAL (input) INTEGER array, dimension (NNS) */
/* The values of the number of right hand sides NRHS. */
/* THRESH (input) REAL */
/* The threshold value for the test ratios. A result is */
/* included in the output file if RESULT >= THRESH. To have */
/* every test ratio printed, use THRESH = 0. */
/* TSTERR (input) LOGICAL */
/* Flag that indicates whether error exits are to be tested. */
/* NMAX (input) INTEGER */
/* The maximum value permitted for N, used in dimensioning the */
/* work arrays. */
/* A (workspace) REAL array, dimension */
/* (NMAX*(NMAX+1)/2) */
/* AFAC (workspace) REAL array, dimension */
/* (NMAX*(NMAX+1)/2) */
/* AINV (workspace) REAL array, dimension */
/* (NMAX*(NMAX+1)/2) */
/* B (workspace) REAL array, dimension (NMAX*NSMAX) */
/* where NSMAX is the largest entry in NSVAL. */
/* X (workspace) REAL array, dimension (NMAX*NSMAX) */
/* XACT (workspace) REAL array, dimension (NMAX*NSMAX) */
/* WORK (workspace) REAL array, dimension */
/* (NMAX*max(3,NSMAX)) */
/* RWORK (workspace) REAL array, dimension */
/* (max(NMAX,2*NSMAX)) */
/* IWORK (workspace) INTEGER array, dimension (NMAX) */
/* NOUT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Data statements .. */
/* Parameter adjustments */
--iwork;
--rwork;
--work;
--xact;
--x;
--b;
--ainv;
--afac;
--a;
--nsval;
--nval;
--dotype;
/* Function Body */
/* .. */
/* .. Executable Statements .. */
/* Initialize constants and the random number seed. */
s_copy(path, "Single precision", (ftnlen)1, (ftnlen)16);
s_copy(path + 1, "PP", (ftnlen)2, (ftnlen)2);
nrun = 0;
nfail = 0;
nerrs = 0;
for (i__ = 1; i__ <= 4; ++i__) {
iseed[i__ - 1] = iseedy[i__ - 1];
/* L10: */
}
/* Test the error exits */
if (*tsterr) {
serrpo_(path, nout);
}
infoc_1.infot = 0;
/* Do for each value of N in NVAL */
i__1 = *nn;
for (in = 1; in <= i__1; ++in) {
n = nval[in];
lda = max(n,1);
*(unsigned char *)xtype = 'N';
nimat = 9;
if (n <= 0) {
nimat = 1;
}
i__2 = nimat;
for (imat = 1; imat <= i__2; ++imat) {
/* Do the tests only if DOTYPE( IMAT ) is true. */
if (! dotype[imat]) {
goto L100;
}
/* Skip types 3, 4, or 5 if the matrix size is too small. */
zerot = imat >= 3 && imat <= 5;
if (zerot && n < imat - 2) {
goto L100;
}
/* Do first for UPLO = 'U', then for UPLO = 'L' */
for (iuplo = 1; iuplo <= 2; ++iuplo) {
*(unsigned char *)uplo = *(unsigned char *)&uplos[iuplo - 1];
*(unsigned char *)packit = *(unsigned char *)&packs[iuplo - 1]
;
/* Set up parameters with SLATB4 and generate a test matrix */
/* with SLATMS. */
slatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode,
&cndnum, dist);
s_copy(srnamc_1.srnamt, "SLATMS", (ftnlen)32, (ftnlen)6);
slatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &
cndnum, &anorm, &kl, &ku, packit, &a[1], &lda, &work[
1], &info);
/* Check error code from SLATMS. */
if (info != 0) {
alaerh_(path, "SLATMS", &info, &c__0, uplo, &n, &n, &c_n1,
&c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
goto L90;
}
/* For types 3-5, zero one row and column of the matrix to */
/* test that INFO is returned correctly. */
if (zerot) {
if (imat == 3) {
izero = 1;
} else if (imat == 4) {
izero = n;
} else {
izero = n / 2 + 1;
}
/* Set row and column IZERO of A to 0. */
if (iuplo == 1) {
ioff = (izero - 1) * izero / 2;
i__3 = izero - 1;
for (i__ = 1; i__ <= i__3; ++i__) {
a[ioff + i__] = 0.f;
/* L20: */
}
ioff += izero;
i__3 = n;
for (i__ = izero; i__ <= i__3; ++i__) {
a[ioff] = 0.f;
ioff += i__;
/* L30: */
}
} else {
ioff = izero;
i__3 = izero - 1;
for (i__ = 1; i__ <= i__3; ++i__) {
a[ioff] = 0.f;
ioff = ioff + n - i__;
/* L40: */
}
ioff -= izero;
i__3 = n;
for (i__ = izero; i__ <= i__3; ++i__) {
a[ioff + i__] = 0.f;
/* L50: */
}
}
} else {
izero = 0;
}
/* Compute the L*L' or U'*U factorization of the matrix. */
npp = n * (n + 1) / 2;
scopy_(&npp, &a[1], &c__1, &afac[1], &c__1);
s_copy(srnamc_1.srnamt, "SPPTRF", (ftnlen)32, (ftnlen)6);
spptrf_(uplo, &n, &afac[1], &info);
/* Check error code from SPPTRF. */
if (info != izero) {
alaerh_(path, "SPPTRF", &info, &izero, uplo, &n, &n, &
c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
goto L90;
}
/* Skip the tests if INFO is not 0. */
if (info != 0) {
goto L90;
}
/* + TEST 1 */
/* Reconstruct matrix from factors and compute residual. */
scopy_(&npp, &afac[1], &c__1, &ainv[1], &c__1);
sppt01_(uplo, &n, &a[1], &ainv[1], &rwork[1], result);
/* + TEST 2 */
/* Form the inverse and compute the residual. */
scopy_(&npp, &afac[1], &c__1, &ainv[1], &c__1);
s_copy(srnamc_1.srnamt, "SPPTRI", (ftnlen)32, (ftnlen)6);
spptri_(uplo, &n, &ainv[1], &info);
/* Check error code from SPPTRI. */
if (info != 0) {
alaerh_(path, "SPPTRI", &info, &c__0, uplo, &n, &n, &c_n1,
&c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
}
sppt03_(uplo, &n, &a[1], &ainv[1], &work[1], &lda, &rwork[1],
&rcondc, &result[1]);
/* Print information about the tests that did not pass */
/* the threshold. */
for (k = 1; k <= 2; ++k) {
if (result[k - 1] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
alahd_(nout, path);
}
io___34.ciunit = *nout;
s_wsfe(&io___34);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[k - 1], (ftnlen)sizeof(
real));
e_wsfe();
++nfail;
}
/* L60: */
}
nrun += 2;
i__3 = *nns;
for (irhs = 1; irhs <= i__3; ++irhs) {
nrhs = nsval[irhs];
/* + TEST 3 */
/* Solve and compute residual for A * X = B. */
s_copy(srnamc_1.srnamt, "SLARHS", (ftnlen)32, (ftnlen)6);
slarhs_(path, xtype, uplo, " ", &n, &n, &kl, &ku, &nrhs, &
a[1], &lda, &xact[1], &lda, &b[1], &lda, iseed, &
info);
slacpy_("Full", &n, &nrhs, &b[1], &lda, &x[1], &lda);
s_copy(srnamc_1.srnamt, "SPPTRS", (ftnlen)32, (ftnlen)6);
spptrs_(uplo, &n, &nrhs, &afac[1], &x[1], &lda, &info);
/* Check error code from SPPTRS. */
if (info != 0) {
alaerh_(path, "SPPTRS", &info, &c__0, uplo, &n, &n, &
c_n1, &c_n1, &nrhs, &imat, &nfail, &nerrs,
nout);
}
slacpy_("Full", &n, &nrhs, &b[1], &lda, &work[1], &lda);
sppt02_(uplo, &n, &nrhs, &a[1], &x[1], &lda, &work[1], &
lda, &rwork[1], &result[2]);
/* + TEST 4 */
/* Check solution from generated exact solution. */
sget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &rcondc, &
result[3]);
/* + TESTS 5, 6, and 7 */
/* Use iterative refinement to improve the solution. */
s_copy(srnamc_1.srnamt, "SPPRFS", (ftnlen)32, (ftnlen)6);
spprfs_(uplo, &n, &nrhs, &a[1], &afac[1], &b[1], &lda, &x[
1], &lda, &rwork[1], &rwork[nrhs + 1], &work[1], &
iwork[1], &info);
/* Check error code from SPPRFS. */
if (info != 0) {
alaerh_(path, "SPPRFS", &info, &c__0, uplo, &n, &n, &
c_n1, &c_n1, &nrhs, &imat, &nfail, &nerrs,
nout);
}
sget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &rcondc, &
result[4]);
sppt05_(uplo, &n, &nrhs, &a[1], &b[1], &lda, &x[1], &lda,
&xact[1], &lda, &rwork[1], &rwork[nrhs + 1], &
result[5]);
/* Print information about the tests that did not pass */
/* the threshold. */
for (k = 3; k <= 7; ++k) {
if (result[k - 1] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
alahd_(nout, path);
}
io___37.ciunit = *nout;
s_wsfe(&io___37);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
;
do_fio(&c__1, (char *)&nrhs, (ftnlen)sizeof(
integer));
do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
integer));
do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer))
;
do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
sizeof(real));
e_wsfe();
++nfail;
}
/* L70: */
}
nrun += 5;
/* L80: */
}
/* + TEST 8 */
/* Get an estimate of RCOND = 1/CNDNUM. */
anorm = slansp_("1", uplo, &n, &a[1], &rwork[1]);
s_copy(srnamc_1.srnamt, "SPPCON", (ftnlen)32, (ftnlen)6);
sppcon_(uplo, &n, &afac[1], &anorm, &rcond, &work[1], &iwork[
1], &info);
/* Check error code from SPPCON. */
if (info != 0) {
alaerh_(path, "SPPCON", &info, &c__0, uplo, &n, &n, &c_n1,
&c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
}
result[7] = sget06_(&rcond, &rcondc);
/* Print the test ratio if greater than or equal to THRESH. */
if (result[7] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
alahd_(nout, path);
}
io___39.ciunit = *nout;
s_wsfe(&io___39);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&c__8, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[7], (ftnlen)sizeof(real));
e_wsfe();
++nfail;
}
++nrun;
L90:
;
}
L100:
;
}
/* L110: */
}
/* Print a summary of the results. */
alasum_(path, nout, &nfail, &nrun, &nerrs);
return 0;
/* End of SCHKPP */
} /* schkpp_ */
/* 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_ */
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
lapack_int n, n_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *ap = NULL, *ap_i = NULL;
float *ap_save = NULL;
float *ap_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_spptri( &uplo, &n );
uplo_i = uplo;
n_i = n;
/* Allocate memory for the LAPACK routine arrays */
ap = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
/* Allocate memory for the C interface function arrays */
ap_i = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
/* Allocate memory for the backup arrays */
ap_save = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
/* Allocate memory for the row-major arrays */
ap_r = (float *)LAPACKE_malloc( n*(n+1)/2 * sizeof(float) );
/* Initialize input arrays */
init_ap( (n*(n+1)/2), ap );
/* Backup the ouptut arrays */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_save[i] = ap[i];
}
/* Call the LAPACK routine */
spptri_( &uplo, &n, ap, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap_save[i];
}
info_i = LAPACKE_spptri_work( LAPACK_COL_MAJOR, uplo_i, n_i, ap_i );
failed = compare_spptri( ap, ap_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to spptri\n" );
} else {
printf( "FAILED: column-major middle-level interface to spptri\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap_save[i];
}
info_i = LAPACKE_spptri( LAPACK_COL_MAJOR, uplo_i, n_i, ap_i );
failed = compare_spptri( ap, ap_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to spptri\n" );
} else {
printf( "FAILED: column-major high-level interface to spptri\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap_save[i];
}
LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
info_i = LAPACKE_spptri_work( LAPACK_ROW_MAJOR, uplo_i, n_i, ap_r );
LAPACKE_spp_trans( LAPACK_ROW_MAJOR, uplo, n, ap_r, ap_i );
failed = compare_spptri( ap, ap_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to spptri\n" );
} else {
printf( "FAILED: row-major middle-level interface to spptri\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap_save[i];
}
/* Init row_major arrays */
LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
info_i = LAPACKE_spptri( LAPACK_ROW_MAJOR, uplo_i, n_i, ap_r );
LAPACKE_spp_trans( LAPACK_ROW_MAJOR, uplo, n, ap_r, ap_i );
failed = compare_spptri( ap, ap_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to spptri\n" );
} else {
printf( "FAILED: row-major high-level interface to spptri\n" );
}
/* Release memory */
if( ap != NULL ) {
LAPACKE_free( ap );
}
if( ap_i != NULL ) {
LAPACKE_free( ap_i );
}
if( ap_r != NULL ) {
LAPACKE_free( ap_r );
}
if( ap_save != NULL ) {
LAPACKE_free( ap_save );
}
return 0;
}
