/* Cholesky factorization with complete pivoting */
void THLapack_(pstrf)(char uplo, int n, real *a, int lda, int *piv, int *rank, real tol, real *work, int *info)
{
#ifdef USE_LAPACK
#if defined(TH_REAL_IS_DOUBLE)
dpstrf_(&uplo, &n, a, &lda, piv, rank, &tol, work, info);
#else
spstrf_(&uplo, &n, a, &lda, piv, rank, &tol, work, info);
#endif
#else
THError("pstrf: Lapack library not found at compile time\n");
#endif
}
/* 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_ */
