/* Subroutine */ int schktp_(logical *dotype, integer *nn, integer *nval,
integer *nns, integer *nsval, real *thresh, logical *tsterr, integer *
nmax, real *ap, real *ainvp, 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 transs[1*3] = "N" "T" "C";
/* Format strings */
static char fmt_9999[] = "(\002 UPLO='\002,a1,\002', DIAG='\002,a1,\002'"
", N=\002,i5,\002, type \002,i2,\002, test(\002,i2,\002)= \002,g1"
"2.5)";
static char fmt_9998[] = "(\002 UPLO='\002,a1,\002', TRANS='\002,a1,\002"
"', DIAG='\002,a1,\002', N=\002,i5,\002', NRHS=\002,i5,\002, type "
"\002,i2,\002, test(\002,i2,\002)= \002,g12.5)";
static char fmt_9997[] = "(1x,a,\002( '\002,a1,\002', '\002,a1,\002', "
"'\002,a1,\002',\002,i5,\002, ... ), type \002,i2,\002, test(\002"
",i2,\002)=\002,g12.5)";
static char fmt_9996[] = "(1x,a,\002( '\002,a1,\002', '\002,a1,\002', "
"'\002,a1,\002', '\002,a1,\002',\002,i5,\002, ... ), type \002,i2,"
"\002, test(\002,i2,\002)=\002,g12.5)";
/* System generated locals */
address a__1[2], a__2[3], a__3[4];
integer i__1, i__2[2], i__3, i__4[3], i__5[4];
char ch__1[2], ch__2[3], ch__3[4];
/* Local variables */
integer i__, k, n, in, lda, lap;
char diag[1];
integer imat, info;
char path[3];
integer irhs, nrhs;
char norm[1], uplo[1];
integer nrun;
integer idiag;
real scale;
integer nfail, iseed[4];
real rcond;
real anorm;
integer itran;
char trans[1];
integer iuplo, nerrs;
char xtype[1];
real rcondc, rcondi;
real rcondo, ainvnm;
real result[9];
/* Fortran I/O blocks */
static cilist io___26 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___34 = { 0, 0, 0, fmt_9998, 0 };
static cilist io___36 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___38 = { 0, 0, 0, fmt_9996, 0 };
static cilist io___39 = { 0, 0, 0, fmt_9996, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SCHKTP tests STPTRI, -TRS, -RFS, and -CON, and SLATPS */
/* 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 column 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 leading dimension of the work arrays. NMAX >= the */
/* maximumm value of N in NVAL. */
/* AP (workspace) REAL array, dimension */
/* (NMAX*(NMAX+1)/2) */
/* AINVP (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)) */
/* IWORK (workspace) INTEGER array, dimension (NMAX) */
/* RWORK (workspace) REAL array, dimension */
/* (max(NMAX,2*NSMAX)) */
/* 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;
--ainvp;
--ap;
--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, "TP", (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) {
serrtr_(path, nout);
}
infoc_1.infot = 0;
i__1 = *nn;
for (in = 1; in <= i__1; ++in) {
/* Do for each value of N in NVAL */
n = nval[in];
lda = max(1,n);
lap = lda * (lda + 1) / 2;
*(unsigned char *)xtype = 'N';
for (imat = 1; imat <= 10; ++imat) {
/* Do the tests only if DOTYPE( IMAT ) is true. */
if (! dotype[imat]) {
goto L70;
}
for (iuplo = 1; iuplo <= 2; ++iuplo) {
/* Do first for UPLO = 'U', then for UPLO = 'L' */
*(unsigned char *)uplo = *(unsigned char *)&uplos[iuplo - 1];
/* Call SLATTP to generate a triangular test matrix. */
s_copy(srnamc_1.srnamt, "SLATTP", (ftnlen)32, (ftnlen)6);
slattp_(&imat, uplo, "No transpose", diag, iseed, &n, &ap[1],
&x[1], &work[1], &info);
/* Set IDIAG = 1 for non-unit matrices, 2 for unit. */
if (lsame_(diag, "N")) {
idiag = 1;
} else {
idiag = 2;
}
/* + TEST 1 */
/* Form the inverse of A. */
if (n > 0) {
scopy_(&lap, &ap[1], &c__1, &ainvp[1], &c__1);
}
s_copy(srnamc_1.srnamt, "STPTRI", (ftnlen)32, (ftnlen)6);
stptri_(uplo, diag, &n, &ainvp[1], &info);
/* Check error code from STPTRI. */
if (info != 0) {
/* Writing concatenation */
i__2[0] = 1, a__1[0] = uplo;
i__2[1] = 1, a__1[1] = diag;
s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)2);
alaerh_(path, "STPTRI", &info, &c__0, ch__1, &n, &n, &
c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
}
/* Compute the infinity-norm condition number of A. */
anorm = slantp_("I", uplo, diag, &n, &ap[1], &rwork[1]);
ainvnm = slantp_("I", uplo, diag, &n, &ainvp[1], &rwork[1]);
if (anorm <= 0.f || ainvnm <= 0.f) {
rcondi = 1.f;
} else {
rcondi = 1.f / anorm / ainvnm;
}
/* Compute the residual for the triangular matrix times its */
/* inverse. Also compute the 1-norm condition number of A. */
stpt01_(uplo, diag, &n, &ap[1], &ainvp[1], &rcondo, &rwork[1],
result);
/* Print the test ratio if it is .GE. THRESH. */
if (result[0] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
alahd_(nout, path);
}
io___26.ciunit = *nout;
s_wsfe(&io___26);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, diag, (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__1, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[0], (ftnlen)sizeof(real));
e_wsfe();
++nfail;
}
++nrun;
i__3 = *nns;
for (irhs = 1; irhs <= i__3; ++irhs) {
nrhs = nsval[irhs];
*(unsigned char *)xtype = 'N';
for (itran = 1; itran <= 3; ++itran) {
/* Do for op(A) = A, A**T, or A**H. */
*(unsigned char *)trans = *(unsigned char *)&transs[
itran - 1];
if (itran == 1) {
*(unsigned char *)norm = 'O';
rcondc = rcondo;
} else {
*(unsigned char *)norm = 'I';
rcondc = rcondi;
}
/* + TEST 2 */
/* Solve and compute residual for op(A)*x = b. */
s_copy(srnamc_1.srnamt, "SLARHS", (ftnlen)32, (ftnlen)
6);
slarhs_(path, xtype, uplo, trans, &n, &n, &c__0, &
idiag, &nrhs, &ap[1], &lap, &xact[1], &lda, &
b[1], &lda, iseed, &info);
*(unsigned char *)xtype = 'C';
slacpy_("Full", &n, &nrhs, &b[1], &lda, &x[1], &lda);
s_copy(srnamc_1.srnamt, "STPTRS", (ftnlen)32, (ftnlen)
6);
stptrs_(uplo, trans, diag, &n, &nrhs, &ap[1], &x[1], &
lda, &info);
/* Check error code from STPTRS. */
if (info != 0) {
/* Writing concatenation */
i__4[0] = 1, a__2[0] = uplo;
i__4[1] = 1, a__2[1] = trans;
i__4[2] = 1, a__2[2] = diag;
s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)3);
alaerh_(path, "STPTRS", &info, &c__0, ch__2, &n, &
n, &c_n1, &c_n1, &c_n1, &imat, &nfail, &
nerrs, nout);
}
stpt02_(uplo, trans, diag, &n, &nrhs, &ap[1], &x[1], &
lda, &b[1], &lda, &work[1], &result[1]);
/* + TEST 3 */
/* Check solution from generated exact solution. */
sget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &
rcondc, &result[2]);
/* + TESTS 4, 5, and 6 */
/* Use iterative refinement to improve the solution and */
/* compute error bounds. */
s_copy(srnamc_1.srnamt, "STPRFS", (ftnlen)32, (ftnlen)
6);
stprfs_(uplo, trans, diag, &n, &nrhs, &ap[1], &b[1], &
lda, &x[1], &lda, &rwork[1], &rwork[nrhs + 1],
&work[1], &iwork[1], &info);
/* Check error code from STPRFS. */
if (info != 0) {
/* Writing concatenation */
i__4[0] = 1, a__2[0] = uplo;
i__4[1] = 1, a__2[1] = trans;
i__4[2] = 1, a__2[2] = diag;
s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)3);
alaerh_(path, "STPRFS", &info, &c__0, ch__2, &n, &
n, &c_n1, &c_n1, &nrhs, &imat, &nfail, &
nerrs, nout);
}
sget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &
rcondc, &result[3]);
stpt05_(uplo, trans, diag, &n, &nrhs, &ap[1], &b[1], &
lda, &x[1], &lda, &xact[1], &lda, &rwork[1], &
rwork[nrhs + 1], &result[4]);
/* Print information about the tests that did not pass */
/* the threshold. */
for (k = 2; k <= 6; ++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, trans, (ftnlen)1);
do_fio(&c__1, diag, (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;
}
/* L20: */
}
nrun += 5;
/* L30: */
}
/* L40: */
}
/* + TEST 7 */
/* Get an estimate of RCOND = 1/CNDNUM. */
for (itran = 1; itran <= 2; ++itran) {
if (itran == 1) {
*(unsigned char *)norm = 'O';
rcondc = rcondo;
} else {
*(unsigned char *)norm = 'I';
rcondc = rcondi;
}
s_copy(srnamc_1.srnamt, "STPCON", (ftnlen)32, (ftnlen)6);
stpcon_(norm, uplo, diag, &n, &ap[1], &rcond, &work[1], &
iwork[1], &info);
/* Check error code from STPCON. */
if (info != 0) {
/* Writing concatenation */
i__4[0] = 1, a__2[0] = norm;
i__4[1] = 1, a__2[1] = uplo;
i__4[2] = 1, a__2[2] = diag;
s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)3);
alaerh_(path, "STPCON", &info, &c__0, ch__2, &n, &n, &
c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs,
nout);
}
stpt06_(&rcond, &rcondc, uplo, diag, &n, &ap[1], &rwork[1]
, &result[6]);
/* Print the test ratio if it is .GE. THRESH. */
if (result[6] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
alahd_(nout, path);
}
io___36.ciunit = *nout;
s_wsfe(&io___36);
do_fio(&c__1, "STPCON", (ftnlen)6);
do_fio(&c__1, norm, (ftnlen)1);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, diag, (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__7, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[6], (ftnlen)sizeof(real)
);
e_wsfe();
++nfail;
}
++nrun;
/* L50: */
}
/* L60: */
}
L70:
;
}
/* Use pathological test matrices to test SLATPS. */
for (imat = 11; imat <= 18; ++imat) {
/* Do the tests only if DOTYPE( IMAT ) is true. */
if (! dotype[imat]) {
goto L100;
}
for (iuplo = 1; iuplo <= 2; ++iuplo) {
/* Do first for UPLO = 'U', then for UPLO = 'L' */
*(unsigned char *)uplo = *(unsigned char *)&uplos[iuplo - 1];
for (itran = 1; itran <= 3; ++itran) {
/* Do for op(A) = A, A**T, or A**H. */
*(unsigned char *)trans = *(unsigned char *)&transs[itran
- 1];
/* Call SLATTP to generate a triangular test matrix. */
s_copy(srnamc_1.srnamt, "SLATTP", (ftnlen)32, (ftnlen)6);
slattp_(&imat, uplo, trans, diag, iseed, &n, &ap[1], &x[1]
, &work[1], &info);
/* + TEST 8 */
/* Solve the system op(A)*x = b. */
s_copy(srnamc_1.srnamt, "SLATPS", (ftnlen)32, (ftnlen)6);
scopy_(&n, &x[1], &c__1, &b[1], &c__1);
slatps_(uplo, trans, diag, "N", &n, &ap[1], &b[1], &scale,
&rwork[1], &info);
/* Check error code from SLATPS. */
if (info != 0) {
/* Writing concatenation */
i__5[0] = 1, a__3[0] = uplo;
i__5[1] = 1, a__3[1] = trans;
i__5[2] = 1, a__3[2] = diag;
i__5[3] = 1, a__3[3] = "N";
s_cat(ch__3, a__3, i__5, &c__4, (ftnlen)4);
alaerh_(path, "SLATPS", &info, &c__0, ch__3, &n, &n, &
c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs,
nout);
}
stpt03_(uplo, trans, diag, &n, &c__1, &ap[1], &scale, &
rwork[1], &c_b103, &b[1], &lda, &x[1], &lda, &
work[1], &result[7]);
/* + TEST 9 */
/* Solve op(A)*x = b again with NORMIN = 'Y'. */
scopy_(&n, &x[1], &c__1, &b[n + 1], &c__1);
slatps_(uplo, trans, diag, "Y", &n, &ap[1], &b[n + 1], &
scale, &rwork[1], &info);
/* Check error code from SLATPS. */
if (info != 0) {
/* Writing concatenation */
i__5[0] = 1, a__3[0] = uplo;
i__5[1] = 1, a__3[1] = trans;
i__5[2] = 1, a__3[2] = diag;
i__5[3] = 1, a__3[3] = "Y";
s_cat(ch__3, a__3, i__5, &c__4, (ftnlen)4);
alaerh_(path, "SLATPS", &info, &c__0, ch__3, &n, &n, &
c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs,
nout);
}
stpt03_(uplo, trans, diag, &n, &c__1, &ap[1], &scale, &
rwork[1], &c_b103, &b[n + 1], &lda, &x[1], &lda, &
work[1], &result[8]);
/* Print information about the tests that did not pass */
/* the threshold. */
if (result[7] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
alahd_(nout, path);
}
io___38.ciunit = *nout;
s_wsfe(&io___38);
do_fio(&c__1, "SLATPS", (ftnlen)6);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, diag, (ftnlen)1);
do_fio(&c__1, "N", (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;
}
if (result[8] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
alahd_(nout, path);
}
io___39.ciunit = *nout;
s_wsfe(&io___39);
do_fio(&c__1, "SLATPS", (ftnlen)6);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, diag, (ftnlen)1);
do_fio(&c__1, "Y", (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__9, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&result[8], (ftnlen)sizeof(real)
);
e_wsfe();
++nfail;
}
nrun += 2;
/* L80: */
}
/* L90: */
}
L100:
;
}
/* L110: */
}
/* Print a summary of the results. */
alasum_(path, nout, &nfail, &nrun, &nerrs);
return 0;
/* End of SCHKTP */
} /* schktp_ */
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
char trans, trans_i;
char diag, diag_i;
lapack_int n, n_i;
lapack_int nrhs, nrhs_i;
lapack_int ldb, ldb_i;
lapack_int ldb_r;
lapack_int ldx, ldx_i;
lapack_int ldx_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *ap = NULL, *ap_i = NULL;
float *b = NULL, *b_i = NULL;
float *x = NULL, *x_i = NULL;
float *ferr = NULL, *ferr_i = NULL;
float *berr = NULL, *berr_i = NULL;
float *work = NULL, *work_i = NULL;
lapack_int *iwork = NULL, *iwork_i = NULL;
float *ferr_save = NULL;
float *berr_save = NULL;
float *ap_r = NULL;
float *b_r = NULL;
float *x_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_stprfs( &uplo, &trans, &diag, &n, &nrhs, &ldb, &ldx );
ldb_r = nrhs+2;
ldx_r = nrhs+2;
uplo_i = uplo;
trans_i = trans;
diag_i = diag;
n_i = n;
nrhs_i = nrhs;
ldb_i = ldb;
ldx_i = ldx;
/* Allocate memory for the LAPACK routine arrays */
ap = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
b = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
x = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) );
ferr = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
berr = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
work = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
iwork = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the C interface function arrays */
ap_i = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
b_i = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
x_i = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) );
ferr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
berr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
iwork_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the backup arrays */
ferr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
berr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
/* Allocate memory for the row-major arrays */
ap_r = (float *)LAPACKE_malloc( n*(n+1)/2 * sizeof(float) );
b_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) );
x_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) );
/* Initialize input arrays */
init_ap( (n*(n+1)/2), ap );
init_b( ldb*nrhs, b );
init_x( ldx*nrhs, x );
init_ferr( nrhs, ferr );
init_berr( nrhs, berr );
init_work( 3*n, work );
init_iwork( n, iwork );
/* Backup the ouptut arrays */
for( i = 0; i < nrhs; i++ ) {
ferr_save[i] = ferr[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_save[i] = berr[i];
}
/* Call the LAPACK routine */
stprfs_( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, x, &ldx, ferr, berr,
work, iwork, &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[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
info_i = LAPACKE_stprfs_work( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i,
n_i, nrhs_i, ap_i, b_i, ldb_i, x_i, ldx_i,
ferr_i, berr_i, work_i, iwork_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to stprfs\n" );
} else {
printf( "FAILED: column-major middle-level interface to stprfs\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[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
info_i = LAPACKE_stprfs( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i, n_i,
nrhs_i, ap_i, b_i, ldb_i, x_i, ldx_i, ferr_i,
berr_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to stprfs\n" );
} else {
printf( "FAILED: column-major high-level interface to stprfs\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[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
info_i = LAPACKE_stprfs_work( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i,
n_i, nrhs_i, ap_r, b_r, ldb_r, x_r, ldx_r,
ferr_i, berr_i, work_i, iwork_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to stprfs\n" );
} else {
printf( "FAILED: row-major middle-level interface to stprfs\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[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
/* Init row_major arrays */
LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
info_i = LAPACKE_stprfs( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i, n_i,
nrhs_i, ap_r, b_r, ldb_r, x_r, ldx_r, ferr_i,
berr_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to stprfs\n" );
} else {
printf( "FAILED: row-major high-level interface to stprfs\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( b != NULL ) {
LAPACKE_free( b );
}
if( b_i != NULL ) {
LAPACKE_free( b_i );
}
if( b_r != NULL ) {
LAPACKE_free( b_r );
}
if( x != NULL ) {
LAPACKE_free( x );
}
if( x_i != NULL ) {
LAPACKE_free( x_i );
}
if( x_r != NULL ) {
LAPACKE_free( x_r );
}
if( ferr != NULL ) {
LAPACKE_free( ferr );
}
if( ferr_i != NULL ) {
LAPACKE_free( ferr_i );
}
if( ferr_save != NULL ) {
LAPACKE_free( ferr_save );
}
if( berr != NULL ) {
LAPACKE_free( berr );
}
if( berr_i != NULL ) {
LAPACKE_free( berr_i );
}
if( berr_save != NULL ) {
LAPACKE_free( berr_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
if( iwork != NULL ) {
LAPACKE_free( iwork );
}
if( iwork_i != NULL ) {
LAPACKE_free( iwork_i );
}
return 0;
}
/* Subroutine */ int serrtr_(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[4] /* was [2][2] */, b[2], w[2], x[2];
char c2[2];
real r1[2], r2[2];
integer iw[2], info;
real scale, rcond;
extern /* Subroutine */ int strti2_(char *, char *, integer *, real *,
integer *, integer *), alaesm_(char *, logical *,
integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), slatbs_(char *, char *, char *, char *,
integer *, integer *, real *, integer *, real *, real *, real *,
integer *), stbcon_(char *, char *
, char *, integer *, integer *, real *, integer *, real *, real *,
integer *, integer *), stbrfs_(char *,
char *, char *, integer *, integer *, integer *, real *, integer *
, real *, integer *, real *, integer *, real *, real *, real *,
integer *, integer *), slatps_(char *,
char *, char *, char *, integer *, real *, real *, real *, real *,
integer *), stpcon_(char *, char
*, char *, integer *, real *, real *, real *, integer *, integer *
), slatrs_(char *, char *, char *, char *,
integer *, real *, integer *, real *, real *, real *, integer *), strcon_(char *, char *, char *,
integer *, real *, integer *, real *, real *, integer *, integer *
), stbtrs_(char *, char *, char *,
integer *, integer *, integer *, real *, integer *, real *,
integer *, integer *), stprfs_(char *,
char *, char *, integer *, integer *, real *, real *, integer *,
real *, integer *, real *, real *, real *, integer *, integer *), strrfs_(char *, char *, char *, integer *
, integer *, real *, integer *, real *, integer *, real *,
integer *, real *, real *, real *, integer *, integer *), stptri_(char *, char *, integer *, real *,
integer *), strtri_(char *, char *, integer *,
real *, integer *, integer *), stptrs_(char *,
char *, char *, integer *, integer *, real *, real *, integer *,
integer *), strtrs_(char *, char *, char *
, integer *, integer *, real *, integer *, 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 */
/* ======= */
/* SERRTR tests the error exits for the REAL 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] = 1.f;
a[2] = 2.f;
a[3] = 3.f;
a[1] = 4.f;
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "TR")) {
/* Test error exits for the general triangular routines. */
/* STRTRI */
s_copy(srnamc_1.srnamt, "STRTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
strtri_("/", "N", &c__0, a, &c__1, &info);
chkxer_("STRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
strtri_("U", "/", &c__0, a, &c__1, &info);
chkxer_("STRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
strtri_("U", "N", &c_n1, a, &c__1, &info);
chkxer_("STRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
strtri_("U", "N", &c__2, a, &c__1, &info);
chkxer_("STRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* STRTI2 */
s_copy(srnamc_1.srnamt, "STRTI2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
strti2_("/", "N", &c__0, a, &c__1, &info);
chkxer_("STRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
strti2_("U", "/", &c__0, a, &c__1, &info);
chkxer_("STRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
strti2_("U", "N", &c_n1, a, &c__1, &info);
chkxer_("STRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
strti2_("U", "N", &c__2, a, &c__1, &info);
chkxer_("STRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* STRTRS */
s_copy(srnamc_1.srnamt, "STRTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
strtrs_("/", "N", "N", &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
strtrs_("U", "/", "N", &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
strtrs_("U", "N", "/", &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
strtrs_("U", "N", "N", &c_n1, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
strtrs_("U", "N", "N", &c__0, &c_n1, a, &c__1, x, &c__1, &info);
chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
strtrs_("U", "N", "N", &c__2, &c__1, a, &c__1, x, &c__2, &info);
chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
strtrs_("U", "N", "N", &c__2, &c__1, a, &c__2, x, &c__1, &info);
chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* STRRFS */
s_copy(srnamc_1.srnamt, "STRRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
strrfs_("/", "N", "N", &c__0, &c__0, a, &c__1, b, &c__1, x, &c__1, r1,
r2, w, iw, &info);
chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
strrfs_("U", "/", "N", &c__0, &c__0, a, &c__1, b, &c__1, x, &c__1, r1,
r2, w, iw, &info);
chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
strrfs_("U", "N", "/", &c__0, &c__0, a, &c__1, b, &c__1, x, &c__1, r1,
r2, w, iw, &info);
chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
strrfs_("U", "N", "N", &c_n1, &c__0, a, &c__1, b, &c__1, x, &c__1, r1,
r2, w, iw, &info);
chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
strrfs_("U", "N", "N", &c__0, &c_n1, a, &c__1, b, &c__1, x, &c__1, r1,
r2, w, iw, &info);
chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
strrfs_("U", "N", "N", &c__2, &c__1, a, &c__1, b, &c__2, x, &c__2, r1,
r2, w, iw, &info);
chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
strrfs_("U", "N", "N", &c__2, &c__1, a, &c__2, b, &c__1, x, &c__2, r1,
r2, w, iw, &info);
chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
strrfs_("U", "N", "N", &c__2, &c__1, a, &c__2, b, &c__2, x, &c__1, r1,
r2, w, iw, &info);
chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* STRCON */
s_copy(srnamc_1.srnamt, "STRCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
strcon_("/", "U", "N", &c__0, a, &c__1, &rcond, w, iw, &info);
chkxer_("STRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
strcon_("1", "/", "N", &c__0, a, &c__1, &rcond, w, iw, &info);
chkxer_("STRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
strcon_("1", "U", "/", &c__0, a, &c__1, &rcond, w, iw, &info);
chkxer_("STRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
strcon_("1", "U", "N", &c_n1, a, &c__1, &rcond, w, iw, &info);
chkxer_("STRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
strcon_("1", "U", "N", &c__2, a, &c__1, &rcond, w, iw, &info);
chkxer_("STRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SLATRS */
s_copy(srnamc_1.srnamt, "SLATRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
slatrs_("/", "N", "N", "N", &c__0, a, &c__1, x, &scale, w, &info);
chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
slatrs_("U", "/", "N", "N", &c__0, a, &c__1, x, &scale, w, &info);
chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
slatrs_("U", "N", "/", "N", &c__0, a, &c__1, x, &scale, w, &info);
chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
slatrs_("U", "N", "N", "/", &c__0, a, &c__1, x, &scale, w, &info);
chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
slatrs_("U", "N", "N", "N", &c_n1, a, &c__1, x, &scale, w, &info);
chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
slatrs_("U", "N", "N", "N", &c__2, a, &c__1, x, &scale, w, &info);
chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "TP")) {
/* Test error exits for the packed triangular routines. */
/* STPTRI */
s_copy(srnamc_1.srnamt, "STPTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
stptri_("/", "N", &c__0, a, &info);
chkxer_("STPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stptri_("U", "/", &c__0, a, &info);
chkxer_("STPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
stptri_("U", "N", &c_n1, a, &info);
chkxer_("STPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* STPTRS */
s_copy(srnamc_1.srnamt, "STPTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
stptrs_("/", "N", "N", &c__0, &c__0, a, x, &c__1, &info);
chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stptrs_("U", "/", "N", &c__0, &c__0, a, x, &c__1, &info);
chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
stptrs_("U", "N", "/", &c__0, &c__0, a, x, &c__1, &info);
chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
stptrs_("U", "N", "N", &c_n1, &c__0, a, x, &c__1, &info);
chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
stptrs_("U", "N", "N", &c__0, &c_n1, a, x, &c__1, &info);
chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
stptrs_("U", "N", "N", &c__2, &c__1, a, x, &c__1, &info);
chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* STPRFS */
s_copy(srnamc_1.srnamt, "STPRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
stprfs_("/", "N", "N", &c__0, &c__0, a, b, &c__1, x, &c__1, r1, r2, w,
iw, &info);
chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stprfs_("U", "/", "N", &c__0, &c__0, a, b, &c__1, x, &c__1, r1, r2, w,
iw, &info);
chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
stprfs_("U", "N", "/", &c__0, &c__0, a, b, &c__1, x, &c__1, r1, r2, w,
iw, &info);
chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
stprfs_("U", "N", "N", &c_n1, &c__0, a, b, &c__1, x, &c__1, r1, r2, w,
iw, &info);
chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
stprfs_("U", "N", "N", &c__0, &c_n1, a, b, &c__1, x, &c__1, r1, r2, w,
iw, &info);
chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
stprfs_("U", "N", "N", &c__2, &c__1, a, b, &c__1, x, &c__2, r1, r2, w,
iw, &info);
chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
stprfs_("U", "N", "N", &c__2, &c__1, a, b, &c__2, x, &c__1, r1, r2, w,
iw, &info);
chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* STPCON */
s_copy(srnamc_1.srnamt, "STPCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
stpcon_("/", "U", "N", &c__0, a, &rcond, w, iw, &info);
chkxer_("STPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stpcon_("1", "/", "N", &c__0, a, &rcond, w, iw, &info);
chkxer_("STPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
stpcon_("1", "U", "/", &c__0, a, &rcond, w, iw, &info);
chkxer_("STPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
stpcon_("1", "U", "N", &c_n1, a, &rcond, w, iw, &info);
chkxer_("STPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SLATPS */
s_copy(srnamc_1.srnamt, "SLATPS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
slatps_("/", "N", "N", "N", &c__0, a, x, &scale, w, &info);
chkxer_("SLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
slatps_("U", "/", "N", "N", &c__0, a, x, &scale, w, &info);
chkxer_("SLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
slatps_("U", "N", "/", "N", &c__0, a, x, &scale, w, &info);
chkxer_("SLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
slatps_("U", "N", "N", "/", &c__0, a, x, &scale, w, &info);
chkxer_("SLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
slatps_("U", "N", "N", "N", &c_n1, a, x, &scale, w, &info);
chkxer_("SLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
} else if (lsamen_(&c__2, c2, "TB")) {
/* Test error exits for the banded triangular routines. */
/* STBTRS */
s_copy(srnamc_1.srnamt, "STBTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
stbtrs_("/", "N", "N", &c__0, &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stbtrs_("U", "/", "N", &c__0, &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
stbtrs_("U", "N", "/", &c__0, &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
stbtrs_("U", "N", "N", &c_n1, &c__0, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
stbtrs_("U", "N", "N", &c__0, &c_n1, &c__0, a, &c__1, x, &c__1, &info);
chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
stbtrs_("U", "N", "N", &c__0, &c__0, &c_n1, a, &c__1, x, &c__1, &info);
chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
stbtrs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__1, x, &c__2, &info);
chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
stbtrs_("U", "N", "N", &c__2, &c__0, &c__1, a, &c__1, x, &c__1, &info);
chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* STBRFS */
s_copy(srnamc_1.srnamt, "STBRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
stbrfs_("/", "N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stbrfs_("U", "/", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
stbrfs_("U", "N", "/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
stbrfs_("U", "N", "N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
stbrfs_("U", "N", "N", &c__0, &c_n1, &c__0, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
stbrfs_("U", "N", "N", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
stbrfs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__1, b, &c__2, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
stbrfs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__1, x, &
c__2, r1, r2, w, iw, &info);
chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
stbrfs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, x, &
c__1, r1, r2, w, iw, &info);
chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* STBCON */
s_copy(srnamc_1.srnamt, "STBCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
stbcon_("/", "U", "N", &c__0, &c__0, a, &c__1, &rcond, w, iw, &info);
chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
stbcon_("1", "/", "N", &c__0, &c__0, a, &c__1, &rcond, w, iw, &info);
chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
stbcon_("1", "U", "/", &c__0, &c__0, a, &c__1, &rcond, w, iw, &info);
chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
stbcon_("1", "U", "N", &c_n1, &c__0, a, &c__1, &rcond, w, iw, &info);
chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
stbcon_("1", "U", "N", &c__0, &c_n1, a, &c__1, &rcond, w, iw, &info);
chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
stbcon_("1", "U", "N", &c__2, &c__1, a, &c__1, &rcond, w, iw, &info);
chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SLATBS */
s_copy(srnamc_1.srnamt, "SLATBS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
slatbs_("/", "N", "N", "N", &c__0, &c__0, a, &c__1, x, &scale, w, &
info);
chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
slatbs_("U", "/", "N", "N", &c__0, &c__0, a, &c__1, x, &scale, w, &
info);
chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
slatbs_("U", "N", "/", "N", &c__0, &c__0, a, &c__1, x, &scale, w, &
info);
chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
slatbs_("U", "N", "N", "/", &c__0, &c__0, a, &c__1, x, &scale, w, &
info);
chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
slatbs_("U", "N", "N", "N", &c_n1, &c__0, a, &c__1, x, &scale, w, &
info);
chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
slatbs_("U", "N", "N", "N", &c__1, &c_n1, a, &c__1, x, &scale, w, &
info);
chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
slatbs_("U", "N", "N", "N", &c__2, &c__1, a, &c__1, x, &scale, w, &
info);
chkxer_("SLATBS", &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 SERRTR */
} /* serrtr_ */