/* Subroutine */ int cposvx_(char *fact, char *uplo, integer *n, integer *
nrhs, complex *a, integer *lda, complex *af, integer *ldaf, char *
equed, real *s, complex *b, integer *ldb, complex *x, integer *ldx,
real *rcond, real *ferr, real *berr, complex *work, real *rwork,
integer *info)
{
/* -- LAPACK driver routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
June 30, 1999
Purpose
=======
CPOSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to
compute the solution to a complex system of linear equations
A * X = B,
where A is an N-by-N Hermitian positive definite matrix and X and B
are N-by-NRHS matrices.
Error bounds on the solution and a condition estimate are also
provided.
Description
===========
The following steps are performed:
1. If FACT = 'E', real scaling factors are computed to equilibrate
the system:
diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
Whether or not the system will be equilibrated depends on the
scaling of the matrix A, but if equilibration is used, A is
overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
factor the matrix A (after equilibration if FACT = 'E') as
A = U**H* U, if UPLO = 'U', or
A = L * L**H, if UPLO = 'L',
where U is an upper triangular matrix and L is a lower triangular
matrix.
3. If the leading i-by-i principal minor is not positive definite,
then the routine returns with INFO = i. Otherwise, the factored
form of A is used to estimate the condition number of the matrix
A. If the reciprocal of the condition number is less than machine
precision, INFO = N+1 is returned as a warning, but the routine
still goes on to solve for X and compute error bounds as
described below.
4. The system of equations is solved for X using the factored form
of A.
5. Iterative refinement is applied to improve the computed solution
matrix and calculate error bounds and backward error estimates
for it.
6. If equilibration was used, the matrix X is premultiplied by
diag(S) so that it solves the original system before
equilibration.
Arguments
=========
FACT (input) CHARACTER*1
Specifies whether or not the factored form of the matrix A is
supplied on entry, and if not, whether the matrix A should be
equilibrated before it is factored.
= 'F': On entry, AF contains the factored form of A.
If EQUED = 'Y', the matrix A has been equilibrated
with scaling factors given by S. A and AF will not
be modified.
= 'N': The matrix A will be copied to AF and factored.
= 'E': The matrix A will be equilibrated if necessary, then
copied to AF and factored.
UPLO (input) CHARACTER*1
= 'U': Upper triangle of A is stored;
= 'L': Lower triangle of A is stored.
N (input) INTEGER
The number of linear equations, i.e., the order of the
matrix A. N >= 0.
NRHS (input) INTEGER
The number of right hand sides, i.e., the number of columns
of the matrices B and X. NRHS >= 0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the Hermitian matrix A, except if FACT = 'F' and
EQUED = 'Y', then A must contain the equilibrated matrix
diag(S)*A*diag(S). If UPLO = 'U', the leading
N-by-N upper triangular part of A contains the upper
triangular part of the matrix A, and the strictly lower
triangular part of A is not referenced. If UPLO = 'L', the
leading N-by-N lower triangular part of A contains the lower
triangular part of the matrix A, and the strictly upper
triangular part of A is not referenced. A is not modified if
FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
diag(S)*A*diag(S).
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
AF (input or output) COMPLEX array, dimension (LDAF,N)
If FACT = 'F', then AF is an input argument and on entry
contains the triangular factor U or L from the Cholesky
factorization A = U**H*U or A = L*L**H, in the same storage
format as A. If EQUED .ne. 'N', then AF is the factored form
of the equilibrated matrix diag(S)*A*diag(S).
If FACT = 'N', then AF is an output argument and on exit
returns the triangular factor U or L from the Cholesky
factorization A = U**H*U or A = L*L**H of the original
matrix A.
If FACT = 'E', then AF is an output argument and on exit
returns the triangular factor U or L from the Cholesky
factorization A = U**H*U or A = L*L**H of the equilibrated
matrix A (see the description of A for the form of the
equilibrated matrix).
LDAF (input) INTEGER
The leading dimension of the array AF. LDAF >= max(1,N).
EQUED (input or output) CHARACTER*1
Specifies the form of equilibration that was done.
= 'N': No equilibration (always true if FACT = 'N').
= 'Y': Equilibration was done, i.e., A has been replaced by
diag(S) * A * diag(S).
EQUED is an input argument if FACT = 'F'; otherwise, it is an
output argument.
S (input or output) REAL array, dimension (N)
The scale factors for A; not accessed if EQUED = 'N'. S is
an input argument if FACT = 'F'; otherwise, S is an output
argument. If FACT = 'F' and EQUED = 'Y', each element of S
must be positive.
B (input/output) COMPLEX array, dimension (LDB,NRHS)
On entry, the N-by-NRHS righthand side matrix B.
On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
B is overwritten by diag(S) * B.
LDB (input) INTEGER
The leading dimension of the array B. LDB >= max(1,N).
X (output) COMPLEX array, dimension (LDX,NRHS)
If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
the original system of equations. Note that if EQUED = 'Y',
A and B are modified on exit, and the solution to the
equilibrated system is inv(diag(S))*X.
LDX (input) INTEGER
The leading dimension of the array X. LDX >= max(1,N).
RCOND (output) REAL
The estimate of the reciprocal condition number of the matrix
A after equilibration (if done). If RCOND is less than the
machine precision (in particular, if RCOND = 0), the matrix
is singular to working precision. This condition is
indicated by a return code of INFO > 0.
FERR (output) REAL array, dimension (NRHS)
The estimated forward error bound for each solution vector
X(j) (the j-th column of the solution matrix X).
If XTRUE is the true solution corresponding to X(j), FERR(j)
is an estimated upper bound for the magnitude of the largest
element in (X(j) - XTRUE) divided by the magnitude of the
largest element in X(j). The estimate is as reliable as
the estimate for RCOND, and is almost always a slight
overestimate of the true error.
BERR (output) REAL array, dimension (NRHS)
The componentwise relative backward error of each solution
vector X(j) (i.e., the smallest relative change in
any element of A or B that makes X(j) an exact solution).
WORK (workspace) COMPLEX array, dimension (2*N)
RWORK (workspace) REAL array, dimension (N)
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
> 0: if INFO = i, and i is
<= N: the leading minor of order i of A is
not positive definite, so the factorization
could not be completed, and the solution has not
been computed. RCOND = 0 is returned.
= N+1: U is nonsingular, but RCOND is less than machine
precision, meaning that the matrix is singular
to working precision. Nevertheless, the
solution and error bounds are computed because
there are a number of situations where the
computed solution can be more accurate than the
value of RCOND would suggest.
=====================================================================
Parameter adjustments */
/* System generated locals */
integer a_dim1, a_offset, af_dim1, af_offset, b_dim1, b_offset, x_dim1,
x_offset, i__1, i__2, i__3, i__4, i__5;
real r__1, r__2;
complex q__1;
/* Local variables */
static real amax, smin, smax;
static integer i__, j;
extern logical lsame_(char *, char *);
static real scond, anorm;
static logical equil, rcequ;
extern doublereal clanhe_(char *, char *, integer *, complex *, integer *,
real *);
extern /* Subroutine */ int claqhe_(char *, integer *, complex *, integer
*, real *, real *, real *, char *);
extern doublereal slamch_(char *);
static logical nofact;
extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex
*, integer *, complex *, integer *), xerbla_(char *,
integer *);
static real bignum;
extern /* Subroutine */ int cpocon_(char *, integer *, complex *, integer
*, real *, real *, complex *, real *, integer *);
static integer infequ;
extern /* Subroutine */ int cpoequ_(integer *, complex *, integer *, real
*, real *, real *, integer *), cporfs_(char *, integer *, integer
*, complex *, integer *, complex *, integer *, complex *, integer
*, complex *, integer *, real *, real *, complex *, real *,
integer *), cpotrf_(char *, integer *, complex *, integer
*, integer *), cpotrs_(char *, integer *, integer *,
complex *, integer *, complex *, integer *, integer *);
static real smlnum;
#define b_subscr(a_1,a_2) (a_2)*b_dim1 + a_1
#define b_ref(a_1,a_2) b[b_subscr(a_1,a_2)]
#define x_subscr(a_1,a_2) (a_2)*x_dim1 + a_1
#define x_ref(a_1,a_2) x[x_subscr(a_1,a_2)]
a_dim1 = *lda;
a_offset = 1 + a_dim1 * 1;
a -= a_offset;
af_dim1 = *ldaf;
af_offset = 1 + af_dim1 * 1;
af -= af_offset;
--s;
b_dim1 = *ldb;
b_offset = 1 + b_dim1 * 1;
b -= b_offset;
x_dim1 = *ldx;
x_offset = 1 + x_dim1 * 1;
x -= x_offset;
--ferr;
--berr;
--work;
--rwork;
/* Function Body */
*info = 0;
nofact = lsame_(fact, "N");
equil = lsame_(fact, "E");
if (nofact || equil) {
*(unsigned char *)equed = 'N';
rcequ = FALSE_;
} else {
rcequ = lsame_(equed, "Y");
smlnum = slamch_("Safe minimum");
bignum = 1.f / smlnum;
}
/* Test the input parameters. */
if (! nofact && ! equil && ! lsame_(fact, "F")) {
*info = -1;
} else if (! lsame_(uplo, "U") && ! lsame_(uplo,
"L")) {
*info = -2;
} else if (*n < 0) {
*info = -3;
} else if (*nrhs < 0) {
*info = -4;
} else if (*lda < max(1,*n)) {
*info = -6;
} else if (*ldaf < max(1,*n)) {
*info = -8;
} else if (lsame_(fact, "F") && ! (rcequ || lsame_(
equed, "N"))) {
*info = -9;
} else {
if (rcequ) {
smin = bignum;
smax = 0.f;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Computing MIN */
r__1 = smin, r__2 = s[j];
smin = dmin(r__1,r__2);
/* Computing MAX */
r__1 = smax, r__2 = s[j];
smax = dmax(r__1,r__2);
/* L10: */
}
if (smin <= 0.f) {
*info = -10;
} else if (*n > 0) {
scond = dmax(smin,smlnum) / dmin(smax,bignum);
} else {
scond = 1.f;
}
}
if (*info == 0) {
if (*ldb < max(1,*n)) {
*info = -12;
} else if (*ldx < max(1,*n)) {
*info = -14;
}
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("CPOSVX", &i__1);
return 0;
}
if (equil) {
/* Compute row and column scalings to equilibrate the matrix A. */
cpoequ_(n, &a[a_offset], lda, &s[1], &scond, &amax, &infequ);
if (infequ == 0) {
/* Equilibrate the matrix. */
claqhe_(uplo, n, &a[a_offset], lda, &s[1], &scond, &amax, equed);
rcequ = lsame_(equed, "Y");
}
}
/* Scale the right hand side. */
if (rcequ) {
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
i__3 = b_subscr(i__, j);
i__4 = i__;
i__5 = b_subscr(i__, j);
q__1.r = s[i__4] * b[i__5].r, q__1.i = s[i__4] * b[i__5].i;
b[i__3].r = q__1.r, b[i__3].i = q__1.i;
/* L20: */
}
/* L30: */
}
}
if (nofact || equil) {
/* Compute the Cholesky factorization A = U'*U or A = L*L'. */
clacpy_(uplo, n, n, &a[a_offset], lda, &af[af_offset], ldaf);
cpotrf_(uplo, n, &af[af_offset], ldaf, info);
/* Return if INFO is non-zero. */
if (*info != 0) {
if (*info > 0) {
*rcond = 0.f;
}
return 0;
}
}
/* Compute the norm of the matrix A. */
anorm = clanhe_("1", uplo, n, &a[a_offset], lda, &rwork[1]);
/* Compute the reciprocal of the condition number of A. */
cpocon_(uplo, n, &af[af_offset], ldaf, &anorm, rcond, &work[1], &rwork[1],
info);
/* Set INFO = N+1 if the matrix is singular to working precision. */
if (*rcond < slamch_("Epsilon")) {
*info = *n + 1;
}
/* Compute the solution matrix X. */
clacpy_("Full", n, nrhs, &b[b_offset], ldb, &x[x_offset], ldx);
cpotrs_(uplo, n, nrhs, &af[af_offset], ldaf, &x[x_offset], ldx, info);
/* Use iterative refinement to improve the computed solution and
compute error bounds and backward error estimates for it. */
cporfs_(uplo, n, nrhs, &a[a_offset], lda, &af[af_offset], ldaf, &b[
b_offset], ldb, &x[x_offset], ldx, &ferr[1], &berr[1], &work[1], &
rwork[1], info);
/* Transform the solution matrix X to a solution of the original
system. */
if (rcequ) {
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
i__3 = x_subscr(i__, j);
i__4 = i__;
i__5 = x_subscr(i__, j);
q__1.r = s[i__4] * x[i__5].r, q__1.i = s[i__4] * x[i__5].i;
x[i__3].r = q__1.r, x[i__3].i = q__1.i;
/* L40: */
}
/* L50: */
}
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
ferr[j] /= scond;
/* L60: */
}
}
return 0;
/* End of CPOSVX */
} /* cposvx_ */
/* Subroutine */ int cchkpo_(logical *dotype, integer *nn, integer *nval,
integer *nnb, integer *nbval, integer *nns, integer *nsval, real *
thresh, logical *tsterr, integer *nmax, complex *a, complex *afac,
complex *ainv, complex *b, complex *x, complex *xact, complex *work,
real *rwork, integer *nout)
{
/* Initialized data */
static integer iseedy[4] = { 1988,1989,1990,1991 };
static char uplos[1*2] = "U" "L";
/* Format strings */
static char fmt_9999[] = "(\002 UPLO = '\002,a1,\002', N =\002,i5,\002, "
"NB =\002,i4,\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)";
static char fmt_9997[] = "(\002 UPLO = '\002,a1,\002', N =\002,i5,\002"
",\002,10x,\002 type \002,i2,\002, test(\002,i2,\002) =\002,g12.5)"
;
/* System generated locals */
integer i__1, i__2, i__3, i__4;
/* Local variables */
integer i__, k, n, nb, in, kl, ku, lda, inb, 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;
real cndnum;
real result[8];
/* Fortran I/O blocks */
static cilist io___33 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___36 = { 0, 0, 0, fmt_9998, 0 };
static cilist io___38 = { 0, 0, 0, fmt_9997, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* CCHKPO tests CPOTRF, -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. */
/* NNB (input) INTEGER */
/* The number of values of NB contained in the vector NBVAL. */
/* NBVAL (input) INTEGER array, dimension (NBVAL) */
/* The values of the blocksize NB. */
/* 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) COMPLEX array, dimension (NMAX*NMAX) */
/* AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX) */
/* AINV (workspace) COMPLEX array, dimension (NMAX*NMAX) */
/* B (workspace) COMPLEX array, dimension (NMAX*NSMAX) */
/* where NSMAX is the largest entry in NSVAL. */
/* X (workspace) COMPLEX array, dimension (NMAX*NSMAX) */
/* XACT (workspace) COMPLEX array, dimension (NMAX*NSMAX) */
/* WORK (workspace) COMPLEX array, dimension */
/* (NMAX*max(3,NSMAX)) */
/* RWORK (workspace) REAL array, dimension */
/* (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 */
--rwork;
--work;
--xact;
--x;
--b;
--ainv;
--afac;
--a;
--nsval;
--nbval;
--nval;
--dotype;
/* Function Body */
/* .. */
/* .. Executable Statements .. */
/* Initialize constants and the random number seed. */
s_copy(path, "Complex precision", (ftnlen)1, (ftnlen)17);
s_copy(path + 1, "PO", (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) {
cerrpo_(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;
}
izero = 0;
i__2 = nimat;
for (imat = 1; imat <= i__2; ++imat) {
/* Do the tests only if DOTYPE( IMAT ) is true. */
if (! dotype[imat]) {
goto L110;
}
/* Skip types 3, 4, or 5 if the matrix size is too small. */
zerot = imat >= 3 && imat <= 5;
if (zerot && n < imat - 2) {
goto L110;
}
/* Do first for UPLO = 'U', then for UPLO = 'L' */
for (iuplo = 1; iuplo <= 2; ++iuplo) {
*(unsigned char *)uplo = *(unsigned char *)&uplos[iuplo - 1];
/* Set up parameters with CLATB4 and generate a test matrix */
/* with CLATMS. */
clatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode,
&cndnum, dist);
s_copy(srnamc_1.srnamt, "CLATMS", (ftnlen)32, (ftnlen)6);
clatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &
cndnum, &anorm, &kl, &ku, uplo, &a[1], &lda, &work[1],
&info);
/* Check error code from CLATMS. */
if (info != 0) {
alaerh_(path, "CLATMS", &info, &c__0, uplo, &n, &n, &c_n1,
&c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
goto L100;
}
/* 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;
}
ioff = (izero - 1) * lda;
/* Set row and column IZERO of A to 0. */
if (iuplo == 1) {
i__3 = izero - 1;
for (i__ = 1; i__ <= i__3; ++i__) {
i__4 = ioff + i__;
a[i__4].r = 0.f, a[i__4].i = 0.f;
/* L20: */
}
ioff += izero;
i__3 = n;
for (i__ = izero; i__ <= i__3; ++i__) {
i__4 = ioff;
a[i__4].r = 0.f, a[i__4].i = 0.f;
ioff += lda;
/* L30: */
}
} else {
ioff = izero;
i__3 = izero - 1;
for (i__ = 1; i__ <= i__3; ++i__) {
i__4 = ioff;
a[i__4].r = 0.f, a[i__4].i = 0.f;
ioff += lda;
/* L40: */
}
ioff -= izero;
i__3 = n;
for (i__ = izero; i__ <= i__3; ++i__) {
i__4 = ioff + i__;
a[i__4].r = 0.f, a[i__4].i = 0.f;
/* L50: */
}
}
} else {
izero = 0;
}
/* Set the imaginary part of the diagonals. */
i__3 = lda + 1;
claipd_(&n, &a[1], &i__3, &c__0);
/* Do for each value of NB in NBVAL */
i__3 = *nnb;
for (inb = 1; inb <= i__3; ++inb) {
nb = nbval[inb];
xlaenv_(&c__1, &nb);
/* Compute the L*L' or U'*U factorization of the matrix. */
clacpy_(uplo, &n, &n, &a[1], &lda, &afac[1], &lda);
s_copy(srnamc_1.srnamt, "CPOTRF", (ftnlen)32, (ftnlen)6);
cpotrf_(uplo, &n, &afac[1], &lda, &info);
/* Check error code from CPOTRF. */
if (info != izero) {
alaerh_(path, "CPOTRF", &info, &izero, uplo, &n, &n, &
c_n1, &c_n1, &nb, &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. */
clacpy_(uplo, &n, &n, &afac[1], &lda, &ainv[1], &lda);
cpot01_(uplo, &n, &a[1], &lda, &ainv[1], &lda, &rwork[1],
result);
/* + TEST 2 */
/* Form the inverse and compute the residual. */
clacpy_(uplo, &n, &n, &afac[1], &lda, &ainv[1], &lda);
s_copy(srnamc_1.srnamt, "CPOTRI", (ftnlen)32, (ftnlen)6);
cpotri_(uplo, &n, &ainv[1], &lda, &info);
/* Check error code from CPOTRI. */
if (info != 0) {
alaerh_(path, "CPOTRI", &info, &c__0, uplo, &n, &n, &
c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs,
nout);
}
cpot03_(uplo, &n, &a[1], &lda, &ainv[1], &lda, &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___33.ciunit = *nout;
s_wsfe(&io___33);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
;
do_fio(&c__1, (char *)&nb, (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;
/* Skip the rest of the tests unless this is the first */
/* blocksize. */
if (inb != 1) {
goto L90;
}
i__4 = *nns;
for (irhs = 1; irhs <= i__4; ++irhs) {
nrhs = nsval[irhs];
/* + TEST 3 */
/* Solve and compute residual for A * X = B . */
s_copy(srnamc_1.srnamt, "CLARHS", (ftnlen)32, (ftnlen)
6);
clarhs_(path, xtype, uplo, " ", &n, &n, &kl, &ku, &
nrhs, &a[1], &lda, &xact[1], &lda, &b[1], &
lda, iseed, &info);
clacpy_("Full", &n, &nrhs, &b[1], &lda, &x[1], &lda);
s_copy(srnamc_1.srnamt, "CPOTRS", (ftnlen)32, (ftnlen)
6);
cpotrs_(uplo, &n, &nrhs, &afac[1], &lda, &x[1], &lda,
&info);
/* Check error code from CPOTRS. */
if (info != 0) {
alaerh_(path, "CPOTRS", &info, &c__0, uplo, &n, &
n, &c_n1, &c_n1, &nrhs, &imat, &nfail, &
nerrs, nout);
}
clacpy_("Full", &n, &nrhs, &b[1], &lda, &work[1], &
lda);
cpot02_(uplo, &n, &nrhs, &a[1], &lda, &x[1], &lda, &
work[1], &lda, &rwork[1], &result[2]);
/* + TEST 4 */
/* Check solution from generated exact solution. */
cget04_(&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, "CPORFS", (ftnlen)32, (ftnlen)
6);
cporfs_(uplo, &n, &nrhs, &a[1], &lda, &afac[1], &lda,
&b[1], &lda, &x[1], &lda, &rwork[1], &rwork[
nrhs + 1], &work[1], &rwork[(nrhs << 1) + 1],
&info);
/* Check error code from CPORFS. */
if (info != 0) {
alaerh_(path, "CPORFS", &info, &c__0, uplo, &n, &
n, &c_n1, &c_n1, &nrhs, &imat, &nfail, &
nerrs, nout);
}
cget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &
rcondc, &result[4]);
cpot05_(uplo, &n, &nrhs, &a[1], &lda, &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___36.ciunit = *nout;
s_wsfe(&io___36);
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 = clanhe_("1", uplo, &n, &a[1], &lda, &rwork[1]);
s_copy(srnamc_1.srnamt, "CPOCON", (ftnlen)32, (ftnlen)6);
cpocon_(uplo, &n, &afac[1], &lda, &anorm, &rcond, &work[1]
, &rwork[1], &info);
/* Check error code from CPOCON. */
if (info != 0) {
alaerh_(path, "CPOCON", &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 it is .GE. THRESH. */
if (result[7] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
alahd_(nout, path);
}
io___38.ciunit = *nout;
s_wsfe(&io___38);
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:
;
}
/* L120: */
}
/* Print a summary of the results. */
alasum_(path, nout, &nfail, &nrun, &nerrs);
return 0;
/* End of CCHKPO */
} /* cchkpo_ */
/* Subroutine */ int cerrpo_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
real r__1, r__2;
complex q__1;
/* Local variables */
complex a[16] /* was [4][4] */, b[4];
integer i__, j;
real r__[4];
complex w[8], x[4];
char c2[2];
real r1[4], r2[4];
complex af[16] /* was [4][4] */;
integer info;
real anrm, rcond;
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* CERRPO tests the error exits for the COMPLEX routines */
/* for Hermitian positive definite matrices. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name for the routines to be tested. */
/* NUNIT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Set the variables to innocuous values. */
for (j = 1; j <= 4; ++j) {
for (i__ = 1; i__ <= 4; ++i__) {
i__1 = i__ + (j << 2) - 5;
r__1 = 1.f / (real) (i__ + j);
r__2 = -1.f / (real) (i__ + j);
q__1.r = r__1, q__1.i = r__2;
a[i__1].r = q__1.r, a[i__1].i = q__1.i;
i__1 = i__ + (j << 2) - 5;
r__1 = 1.f / (real) (i__ + j);
r__2 = -1.f / (real) (i__ + j);
q__1.r = r__1, q__1.i = r__2;
af[i__1].r = q__1.r, af[i__1].i = q__1.i;
/* L10: */
}
i__1 = j - 1;
b[i__1].r = 0.f, b[i__1].i = 0.f;
r1[j - 1] = 0.f;
r2[j - 1] = 0.f;
i__1 = j - 1;
w[i__1].r = 0.f, w[i__1].i = 0.f;
i__1 = j - 1;
x[i__1].r = 0.f, x[i__1].i = 0.f;
/* L20: */
}
anrm = 1.f;
infoc_1.ok = TRUE_;
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a Hermitian positive definite matrix. */
if (lsamen_(&c__2, c2, "PO")) {
/* CPOTRF */
s_copy(srnamc_1.srnamt, "CPOTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpotrf_("/", &c__0, a, &c__1, &info);
chkxer_("CPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpotrf_("U", &c_n1, a, &c__1, &info);
chkxer_("CPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cpotrf_("U", &c__2, a, &c__1, &info);
chkxer_("CPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPOTF2 */
s_copy(srnamc_1.srnamt, "CPOTF2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpotf2_("/", &c__0, a, &c__1, &info);
chkxer_("CPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpotf2_("U", &c_n1, a, &c__1, &info);
chkxer_("CPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cpotf2_("U", &c__2, a, &c__1, &info);
chkxer_("CPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPOTRI */
s_copy(srnamc_1.srnamt, "CPOTRI", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpotri_("/", &c__0, a, &c__1, &info);
chkxer_("CPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpotri_("U", &c_n1, a, &c__1, &info);
chkxer_("CPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cpotri_("U", &c__2, a, &c__1, &info);
chkxer_("CPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPOTRS */
s_copy(srnamc_1.srnamt, "CPOTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpotrs_("/", &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("CPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpotrs_("U", &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("CPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpotrs_("U", &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("CPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
cpotrs_("U", &c__2, &c__1, a, &c__1, b, &c__2, &info);
chkxer_("CPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
cpotrs_("U", &c__2, &c__1, a, &c__2, b, &c__1, &info);
chkxer_("CPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPORFS */
s_copy(srnamc_1.srnamt, "CPORFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cporfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("CPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cporfs_("U", &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("CPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cporfs_("U", &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("CPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
cporfs_("U", &c__2, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("CPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
cporfs_("U", &c__2, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("CPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
cporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__1, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("CPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
cporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__2, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("CPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPOCON */
s_copy(srnamc_1.srnamt, "CPOCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpocon_("/", &c__0, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("CPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpocon_("U", &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("CPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cpocon_("U", &c__2, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("CPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
r__1 = -anrm;
cpocon_("U", &c__1, a, &c__1, &r__1, &rcond, w, r__, &info)
;
chkxer_("CPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPOEQU */
s_copy(srnamc_1.srnamt, "CPOEQU", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpoequ_(&c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("CPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpoequ_(&c__2, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("CPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a Hermitian positive definite packed matrix. */
} else if (lsamen_(&c__2, c2, "PP")) {
/* CPPTRF */
s_copy(srnamc_1.srnamt, "CPPTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpptrf_("/", &c__0, a, &info);
chkxer_("CPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpptrf_("U", &c_n1, a, &info);
chkxer_("CPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPPTRI */
s_copy(srnamc_1.srnamt, "CPPTRI", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpptri_("/", &c__0, a, &info);
chkxer_("CPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpptri_("U", &c_n1, a, &info);
chkxer_("CPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPPTRS */
s_copy(srnamc_1.srnamt, "CPPTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpptrs_("/", &c__0, &c__0, a, b, &c__1, &info);
chkxer_("CPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpptrs_("U", &c_n1, &c__0, a, b, &c__1, &info);
chkxer_("CPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpptrs_("U", &c__0, &c_n1, a, b, &c__1, &info);
chkxer_("CPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
cpptrs_("U", &c__2, &c__1, a, b, &c__1, &info);
chkxer_("CPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPPRFS */
s_copy(srnamc_1.srnamt, "CPPRFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpprfs_("/", &c__0, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("CPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpprfs_("U", &c_n1, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("CPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpprfs_("U", &c__0, &c_n1, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("CPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
cpprfs_("U", &c__2, &c__1, a, af, b, &c__1, x, &c__2, r1, r2, w, r__,
&info);
chkxer_("CPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
cpprfs_("U", &c__2, &c__1, a, af, b, &c__2, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("CPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPPCON */
s_copy(srnamc_1.srnamt, "CPPCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cppcon_("/", &c__0, a, &anrm, &rcond, w, r__, &info);
chkxer_("CPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cppcon_("U", &c_n1, a, &anrm, &rcond, w, r__, &info);
chkxer_("CPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
r__1 = -anrm;
cppcon_("U", &c__1, a, &r__1, &rcond, w, r__, &info);
chkxer_("CPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPPEQU */
s_copy(srnamc_1.srnamt, "CPPEQU", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cppequ_("/", &c__0, a, r1, &rcond, &anrm, &info);
chkxer_("CPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cppequ_("U", &c_n1, a, r1, &rcond, &anrm, &info);
chkxer_("CPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a Hermitian positive definite band matrix. */
} else if (lsamen_(&c__2, c2, "PB")) {
/* CPBTRF */
s_copy(srnamc_1.srnamt, "CPBTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpbtrf_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("CPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpbtrf_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("CPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpbtrf_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("CPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
cpbtrf_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("CPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPBTF2 */
s_copy(srnamc_1.srnamt, "CPBTF2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpbtf2_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("CPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpbtf2_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("CPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpbtf2_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("CPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
cpbtf2_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("CPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPBTRS */
s_copy(srnamc_1.srnamt, "CPBTRS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpbtrs_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("CPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpbtrs_("U", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("CPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpbtrs_("U", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("CPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cpbtrs_("U", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("CPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
cpbtrs_("U", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("CPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
cpbtrs_("U", &c__2, &c__0, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("CPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPBRFS */
s_copy(srnamc_1.srnamt, "CPBRFS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpbrfs_("/", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("CPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpbrfs_("U", &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("CPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpbrfs_("U", &c__1, &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("CPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cpbrfs_("U", &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("CPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
cpbrfs_("U", &c__2, &c__1, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("CPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
cpbrfs_("U", &c__2, &c__1, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("CPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
cpbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__1, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("CPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
cpbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__2, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("CPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPBCON */
s_copy(srnamc_1.srnamt, "CPBCON", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpbcon_("/", &c__0, &c__0, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("CPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpbcon_("U", &c_n1, &c__0, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("CPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpbcon_("U", &c__1, &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("CPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
cpbcon_("U", &c__2, &c__1, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("CPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
r__1 = -anrm;
cpbcon_("U", &c__1, &c__0, a, &c__1, &r__1, &rcond, w, r__, &info);
chkxer_("CPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CPBEQU */
s_copy(srnamc_1.srnamt, "CPBEQU", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpbequ_("/", &c__0, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("CPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cpbequ_("U", &c_n1, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("CPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
cpbequ_("U", &c__1, &c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("CPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
cpbequ_("U", &c__2, &c__1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("CPBEQU", &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 CERRPO */
} /* cerrpo_ */
