/* Subroutine */ int zdrvpo_(logical *dotype, integer *nn, integer *nval,
integer *nrhs, doublereal *thresh, logical *tsterr, integer *nmax,
doublecomplex *a, doublecomplex *afac, doublecomplex *asav,
doublecomplex *b, doublecomplex *bsav, doublecomplex *x,
doublecomplex *xact, doublereal *s, doublecomplex *work, doublereal *
rwork, integer *nout)
{
/* Initialized data */
static integer iseedy[4] = { 1988,1989,1990,1991 };
static char uplos[1*2] = "U" "L";
static char facts[1*3] = "F" "N" "E";
static char equeds[1*2] = "N" "Y";
/* Format strings */
static char fmt_9999[] = "(1x,a6,\002, UPLO='\002,a1,\002', N =\002,i5"
",\002, type \002,i1,\002, test(\002,i1,\002)=\002,g12.5)";
static char fmt_9997[] = "(1x,a6,\002, FACT='\002,a1,\002', UPLO='\002,a"
"1,\002', N=\002,i5,\002, EQUED='\002,a1,\002', type \002,i1,\002"
", test(\002,i1,\002) =\002,g12.5)";
static char fmt_9998[] = "(1x,a6,\002, FACT='\002,a1,\002', UPLO='\002,a"
"1,\002', N=\002,i5,\002, type \002,i1,\002, test(\002,i1,\002)"
"=\002,g12.5)";
/* System generated locals */
address a__1[2];
integer i__1, i__2, i__3, i__4, i__5[2];
char ch__1[2];
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static char fact[1];
static integer ioff, mode;
static doublereal amax;
static char path[3];
static integer imat, info;
static char dist[1], uplo[1], type__[1];
static integer nrun, i__, k, n, ifact, nfail, iseed[4], nfact;
extern doublereal dget06_(doublereal *, doublereal *);
extern logical lsame_(char *, char *);
static char equed[1];
static integer nbmin;
static doublereal rcond, roldc, scond;
static integer nimat;
static doublereal anorm;
extern /* Subroutine */ int zget04_(integer *, integer *, doublecomplex *,
integer *, doublecomplex *, integer *, doublereal *, doublereal *
);
static logical equil;
static integer iuplo, izero, nerrs, k1;
extern /* Subroutine */ int zpot01_(char *, integer *, doublecomplex *,
integer *, doublecomplex *, integer *, doublereal *, doublereal *), zpot02_(char *, integer *, integer *, doublecomplex *,
integer *, doublecomplex *, integer *, doublecomplex *, integer *,
doublereal *, doublereal *), zpot05_(char *, integer *,
integer *, doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *,
doublereal *, doublereal *, doublereal *);
static logical zerot;
static char xtype[1];
extern /* Subroutine */ int zposv_(char *, integer *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *, integer *), zlatb4_(char *, integer *, integer *, integer *, char *,
integer *, integer *, doublereal *, integer *, doublereal *,
char *), aladhd_(integer *, char *);
static integer nb, in, kl;
extern /* Subroutine */ int alaerh_(char *, char *, integer *, integer *,
char *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
static logical prefac;
static integer ku, nt;
static doublereal rcondc;
static logical nofact;
static integer iequed;
extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *,
integer *, doublereal *);
extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer
*, integer *);
static doublereal cndnum;
extern /* Subroutine */ int zlaipd_(integer *, doublecomplex *, integer *,
integer *), zlaqhe_(char *, integer *, doublecomplex *, integer *
, doublereal *, doublereal *, doublereal *, char *);
static doublereal ainvnm;
extern /* Subroutine */ int xlaenv_(integer *, integer *), zlacpy_(char *,
integer *, integer *, doublecomplex *, integer *, doublecomplex *
, integer *), zlarhs_(char *, char *, char *, char *,
integer *, integer *, integer *, integer *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, integer *, integer *), zlaset_(char *, integer *, integer *,
doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlatms_(integer *, integer *, char *, integer *, char *,
doublereal *, integer *, doublereal *, doublereal *, integer *,
integer *, char *, doublecomplex *, integer *, doublecomplex *,
integer *);
static doublereal result[6];
extern /* Subroutine */ int zpoequ_(integer *, doublecomplex *, integer *,
doublereal *, doublereal *, doublereal *, integer *), zpotrf_(
char *, integer *, doublecomplex *, integer *, integer *),
zpotri_(char *, integer *, doublecomplex *, integer *, integer *), zerrvx_(char *, integer *), zposvx_(char *,
char *, integer *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, char *, doublereal *, doublecomplex *,
integer *, doublecomplex *, integer *, doublereal *, doublereal *
, doublereal *, doublecomplex *, doublereal *, integer *);
static integer lda;
/* Fortran I/O blocks */
static cilist io___48 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___51 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___52 = { 0, 0, 0, fmt_9998, 0 };
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
June 30, 1999
Purpose
=======
ZDRVPO tests the driver routines ZPOSV and -SVX.
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.
NRHS (input) INTEGER
The number of right hand side vectors to be generated for
each linear system.
THRESH (input) DOUBLE PRECISION
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*16 array, dimension (NMAX*NMAX)
AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
ASAV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
BSAV (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
S (workspace) DOUBLE PRECISION array, dimension (NMAX)
WORK (workspace) COMPLEX*16 array, dimension
(NMAX*max(3,NRHS))
RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
NOUT (input) INTEGER
The unit number for output.
=====================================================================
Parameter adjustments */
--rwork;
--work;
--s;
--xact;
--x;
--bsav;
--b;
--asav;
--afac;
--a;
--nval;
--dotype;
/* Function Body
Initialize constants and the random number seed. */
s_copy(path, "Zomplex 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) {
zerrvx_(path, nout);
}
infoc_1.infot = 0;
/* Set the block size and minimum block size for testing. */
nb = 1;
nbmin = 2;
xlaenv_(&c__1, &nb);
xlaenv_(&c__2, &nbmin);
/* 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 L120;
}
/* Skip types 3, 4, or 5 if the matrix size is too small. */
zerot = imat >= 3 && imat <= 5;
if (zerot && n < imat - 2) {
goto L120;
}
/* 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 ZLATB4 and generate a test matrix
with ZLATMS. */
zlatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode,
&cndnum, dist);
s_copy(srnamc_1.srnamt, "ZLATMS", (ftnlen)6, (ftnlen)6);
zlatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &
cndnum, &anorm, &kl, &ku, uplo, &a[1], &lda, &work[1],
&info);
/* Check error code from ZLATMS. */
if (info != 0) {
alaerh_(path, "ZLATMS", &info, &c__0, uplo, &n, &n, &c_n1,
&c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
goto L110;
}
/* 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., a[i__4].i = 0.;
/* L20: */
}
ioff += izero;
i__3 = n;
for (i__ = izero; i__ <= i__3; ++i__) {
i__4 = ioff;
a[i__4].r = 0., a[i__4].i = 0.;
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., a[i__4].i = 0.;
ioff += lda;
/* L40: */
}
ioff -= izero;
i__3 = n;
for (i__ = izero; i__ <= i__3; ++i__) {
i__4 = ioff + i__;
a[i__4].r = 0., a[i__4].i = 0.;
/* L50: */
}
}
} else {
izero = 0;
}
/* Set the imaginary part of the diagonals. */
i__3 = lda + 1;
zlaipd_(&n, &a[1], &i__3, &c__0);
/* Save a copy of the matrix A in ASAV. */
zlacpy_(uplo, &n, &n, &a[1], &lda, &asav[1], &lda);
for (iequed = 1; iequed <= 2; ++iequed) {
*(unsigned char *)equed = *(unsigned char *)&equeds[
iequed - 1];
if (iequed == 1) {
nfact = 3;
} else {
nfact = 1;
}
i__3 = nfact;
for (ifact = 1; ifact <= i__3; ++ifact) {
*(unsigned char *)fact = *(unsigned char *)&facts[
ifact - 1];
prefac = lsame_(fact, "F");
nofact = lsame_(fact, "N");
equil = lsame_(fact, "E");
if (zerot) {
if (prefac) {
goto L90;
}
rcondc = 0.;
} else if (! lsame_(fact, "N"))
{
/* Compute the condition number for comparison with
the value returned by ZPOSVX (FACT = 'N' reuses
the condition number from the previous iteration
with FACT = 'F'). */
zlacpy_(uplo, &n, &n, &asav[1], &lda, &afac[1], &
lda);
if (equil || iequed > 1) {
/* Compute row and column scale factors to
equilibrate the matrix A. */
zpoequ_(&n, &afac[1], &lda, &s[1], &scond, &
amax, &info);
if (info == 0 && n > 0) {
if (iequed > 1) {
scond = 0.;
}
/* Equilibrate the matrix. */
zlaqhe_(uplo, &n, &afac[1], &lda, &s[1], &
scond, &amax, equed);
}
}
/* Save the condition number of the
non-equilibrated system for use in ZGET04. */
if (equil) {
roldc = rcondc;
}
/* Compute the 1-norm of A. */
anorm = zlanhe_("1", uplo, &n, &afac[1], &lda, &
rwork[1]);
/* Factor the matrix A. */
zpotrf_(uplo, &n, &afac[1], &lda, &info);
/* Form the inverse of A. */
zlacpy_(uplo, &n, &n, &afac[1], &lda, &a[1], &lda);
zpotri_(uplo, &n, &a[1], &lda, &info);
/* Compute the 1-norm condition number of A. */
ainvnm = zlanhe_("1", uplo, &n, &a[1], &lda, &
rwork[1]);
if (anorm <= 0. || ainvnm <= 0.) {
rcondc = 1.;
} else {
rcondc = 1. / anorm / ainvnm;
}
}
/* Restore the matrix A. */
zlacpy_(uplo, &n, &n, &asav[1], &lda, &a[1], &lda);
/* Form an exact solution and set the right hand side. */
s_copy(srnamc_1.srnamt, "ZLARHS", (ftnlen)6, (ftnlen)
6);
zlarhs_(path, xtype, uplo, " ", &n, &n, &kl, &ku,
nrhs, &a[1], &lda, &xact[1], &lda, &b[1], &
lda, iseed, &info);
*(unsigned char *)xtype = 'C';
zlacpy_("Full", &n, nrhs, &b[1], &lda, &bsav[1], &lda);
if (nofact) {
/* --- Test ZPOSV ---
Compute the L*L' or U'*U factorization of the
matrix and solve the system. */
zlacpy_(uplo, &n, &n, &a[1], &lda, &afac[1], &lda);
zlacpy_("Full", &n, nrhs, &b[1], &lda, &x[1], &
lda);
s_copy(srnamc_1.srnamt, "ZPOSV ", (ftnlen)6, (
ftnlen)6);
zposv_(uplo, &n, nrhs, &afac[1], &lda, &x[1], &
lda, &info);
/* Check error code from ZPOSV . */
if (info != izero) {
alaerh_(path, "ZPOSV ", &info, &izero, uplo, &
n, &n, &c_n1, &c_n1, nrhs, &imat, &
nfail, &nerrs, nout);
goto L70;
} else if (info != 0) {
goto L70;
}
/* Reconstruct matrix from factors and compute
residual. */
zpot01_(uplo, &n, &a[1], &lda, &afac[1], &lda, &
rwork[1], result);
/* Compute residual of the computed solution. */
zlacpy_("Full", &n, nrhs, &b[1], &lda, &work[1], &
lda);
zpot02_(uplo, &n, nrhs, &a[1], &lda, &x[1], &lda,
&work[1], &lda, &rwork[1], &result[1]);
/* Check solution from generated exact solution. */
zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, &
rcondc, &result[2]);
nt = 3;
/* Print information about the tests that did not
pass the threshold. */
i__4 = nt;
for (k = 1; k <= i__4; ++k) {
if (result[k - 1] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
aladhd_(nout, path);
}
io___48.ciunit = *nout;
s_wsfe(&io___48);
do_fio(&c__1, "ZPOSV ", (ftnlen)6);
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(doublereal));
e_wsfe();
++nfail;
}
/* L60: */
}
nrun += nt;
L70:
;
}
/* --- Test ZPOSVX --- */
if (! prefac) {
zlaset_(uplo, &n, &n, &c_b51, &c_b51, &afac[1], &
lda);
}
zlaset_("Full", &n, nrhs, &c_b51, &c_b51, &x[1], &lda);
if (iequed > 1 && n > 0) {
/* Equilibrate the matrix if FACT='F' and
EQUED='Y'. */
zlaqhe_(uplo, &n, &a[1], &lda, &s[1], &scond, &
amax, equed);
}
/* Solve the system and compute the condition number
and error bounds using ZPOSVX. */
s_copy(srnamc_1.srnamt, "ZPOSVX", (ftnlen)6, (ftnlen)
6);
zposvx_(fact, uplo, &n, nrhs, &a[1], &lda, &afac[1], &
lda, equed, &s[1], &b[1], &lda, &x[1], &lda, &
rcond, &rwork[1], &rwork[*nrhs + 1], &work[1],
&rwork[(*nrhs << 1) + 1], &info);
/* Check the error code from ZPOSVX. */
if (info != izero) {
/* Writing concatenation */
i__5[0] = 1, a__1[0] = fact;
i__5[1] = 1, a__1[1] = uplo;
s_cat(ch__1, a__1, i__5, &c__2, (ftnlen)2);
alaerh_(path, "ZPOSVX", &info, &izero, ch__1, &n,
&n, &c_n1, &c_n1, nrhs, &imat, &nfail, &
nerrs, nout);
goto L90;
}
if (info == 0) {
if (! prefac) {
/* Reconstruct matrix from factors and compute
residual. */
zpot01_(uplo, &n, &a[1], &lda, &afac[1], &lda,
&rwork[(*nrhs << 1) + 1], result);
k1 = 1;
} else {
k1 = 2;
}
/* Compute residual of the computed solution. */
zlacpy_("Full", &n, nrhs, &bsav[1], &lda, &work[1]
, &lda);
zpot02_(uplo, &n, nrhs, &asav[1], &lda, &x[1], &
lda, &work[1], &lda, &rwork[(*nrhs << 1)
+ 1], &result[1]);
/* Check solution from generated exact solution. */
if (nofact || prefac && lsame_(equed, "N")) {
zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda,
&rcondc, &result[2]);
} else {
zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda,
&roldc, &result[2]);
}
/* Check the error bounds from iterative
refinement. */
zpot05_(uplo, &n, nrhs, &asav[1], &lda, &b[1], &
lda, &x[1], &lda, &xact[1], &lda, &rwork[
1], &rwork[*nrhs + 1], &result[3]);
} else {
k1 = 6;
}
/* Compare RCOND from ZPOSVX with the computed value
in RCONDC. */
result[5] = dget06_(&rcond, &rcondc);
/* Print information about the tests that did not pass
the threshold. */
for (k = k1; k <= 6; ++k) {
if (result[k - 1] >= *thresh) {
if (nfail == 0 && nerrs == 0) {
aladhd_(nout, path);
}
if (prefac) {
io___51.ciunit = *nout;
s_wsfe(&io___51);
do_fio(&c__1, "ZPOSVX", (ftnlen)6);
do_fio(&c__1, fact, (ftnlen)1);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
integer));
do_fio(&c__1, equed, (ftnlen)1);
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(doublereal));
e_wsfe();
} else {
io___52.ciunit = *nout;
s_wsfe(&io___52);
do_fio(&c__1, "ZPOSVX", (ftnlen)6);
do_fio(&c__1, fact, (ftnlen)1);
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(doublereal));
e_wsfe();
}
++nfail;
}
/* L80: */
}
nrun = nrun + 7 - k1;
L90:
;
}
/* L100: */
}
L110:
;
}
L120:
;
}
/* L130: */
}
/* Print a summary of the results. */
alasvm_(path, nout, &nfail, &nrun, &nerrs);
return 0;
/* End of ZDRVPO */
} /* zdrvpo_ */
/* Subroutine */ int zerrpo_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
doublecomplex z__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
doublecomplex a[16] /* was [4][4] */, b[4];
integer i__, j;
doublereal r__[4];
doublecomplex w[8], x[4];
char c2[2];
doublereal r1[4], r2[4];
doublecomplex af[16] /* was [4][4] */;
integer info;
doublereal anrm, rcond;
extern /* Subroutine */ int zpbtf2_(char *, integer *, integer *,
doublecomplex *, integer *, integer *), zpotf2_(char *,
integer *, doublecomplex *, integer *, integer *),
alaesm_(char *, logical *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), zpbcon_(char *, integer *, integer *,
doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, doublereal *, integer *), zpbequ_(char *,
integer *, integer *, doublecomplex *, integer *, doublereal *,
doublereal *, doublereal *, integer *), zpbrfs_(char *,
integer *, integer *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, doublereal *, integer *), zpbtrf_(char *,
integer *, integer *, doublecomplex *, integer *, integer *), zpocon_(char *, integer *, doublecomplex *, integer *,
doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *), zppcon_(char *, integer *, doublecomplex *,
doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *), zpoequ_(integer *, doublecomplex *, integer *,
doublereal *, doublereal *, doublereal *, integer *), zpbtrs_(
char *, integer *, integer *, integer *, doublecomplex *, integer
*, doublecomplex *, integer *, integer *), zporfs_(char *,
integer *, integer *, doublecomplex *, integer *, doublecomplex *
, integer *, doublecomplex *, integer *, doublecomplex *, integer
*, doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *), zpotrf_(char *, integer *, doublecomplex *,
integer *, integer *), zpotri_(char *, integer *,
doublecomplex *, integer *, integer *), zppequ_(char *,
integer *, doublecomplex *, doublereal *, doublereal *,
doublereal *, integer *), zpprfs_(char *, integer *,
integer *, doublecomplex *, doublecomplex *, doublecomplex *,
integer *, doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, doublereal *, integer *), zpptrf_(char *
, integer *, doublecomplex *, integer *), zpptri_(char *,
integer *, doublecomplex *, integer *), zpotrs_(char *,
integer *, integer *, doublecomplex *, integer *, doublecomplex *,
integer *, integer *), zpptrs_(char *, integer *,
integer *, doublecomplex *, doublecomplex *, integer *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZERRPO tests the error exits for the COMPLEX*16 routines */
/* for Hermitian positive definite matrices. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name for the routines to be tested. */
/* NUNIT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Set the variables to innocuous values. */
for (j = 1; j <= 4; ++j) {
for (i__ = 1; i__ <= 4; ++i__) {
i__1 = i__ + (j << 2) - 5;
d__1 = 1. / (doublereal) (i__ + j);
d__2 = -1. / (doublereal) (i__ + j);
z__1.r = d__1, z__1.i = d__2;
a[i__1].r = z__1.r, a[i__1].i = z__1.i;
i__1 = i__ + (j << 2) - 5;
d__1 = 1. / (doublereal) (i__ + j);
d__2 = -1. / (doublereal) (i__ + j);
z__1.r = d__1, z__1.i = d__2;
af[i__1].r = z__1.r, af[i__1].i = z__1.i;
/* L10: */
}
i__1 = j - 1;
b[i__1].r = 0., b[i__1].i = 0.;
r1[j - 1] = 0.;
r2[j - 1] = 0.;
i__1 = j - 1;
w[i__1].r = 0., w[i__1].i = 0.;
i__1 = j - 1;
x[i__1].r = 0., x[i__1].i = 0.;
/* L20: */
}
anrm = 1.;
infoc_1.ok = TRUE_;
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a Hermitian positive definite matrix. */
if (lsamen_(&c__2, c2, "PO")) {
/* ZPOTRF */
s_copy(srnamc_1.srnamt, "ZPOTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotrf_("/", &c__0, a, &c__1, &info);
chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotrf_("U", &c_n1, a, &c__1, &info);
chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpotrf_("U", &c__2, a, &c__1, &info);
chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOTF2 */
s_copy(srnamc_1.srnamt, "ZPOTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotf2_("/", &c__0, a, &c__1, &info);
chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotf2_("U", &c_n1, a, &c__1, &info);
chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpotf2_("U", &c__2, a, &c__1, &info);
chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOTRI */
s_copy(srnamc_1.srnamt, "ZPOTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotri_("/", &c__0, a, &c__1, &info);
chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotri_("U", &c_n1, a, &c__1, &info);
chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpotri_("U", &c__2, a, &c__1, &info);
chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOTRS */
s_copy(srnamc_1.srnamt, "ZPOTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotrs_("/", &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotrs_("U", &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpotrs_("U", &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpotrs_("U", &c__2, &c__1, a, &c__1, b, &c__2, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zpotrs_("U", &c__2, &c__1, a, &c__2, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPORFS */
s_copy(srnamc_1.srnamt, "ZPORFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zporfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zporfs_("U", &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zporfs_("U", &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zporfs_("U", &c__2, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__1, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__2, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOCON */
s_copy(srnamc_1.srnamt, "ZPOCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpocon_("/", &c__0, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpocon_("U", &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpocon_("U", &c__2, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
d__1 = -anrm;
zpocon_("U", &c__1, a, &c__1, &d__1, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOEQU */
s_copy(srnamc_1.srnamt, "ZPOEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpoequ_(&c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpoequ_(&c__2, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a Hermitian positive definite packed matrix. */
} else if (lsamen_(&c__2, c2, "PP")) {
/* ZPPTRF */
s_copy(srnamc_1.srnamt, "ZPPTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpptrf_("/", &c__0, a, &info);
chkxer_("ZPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpptrf_("U", &c_n1, a, &info);
chkxer_("ZPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPTRI */
s_copy(srnamc_1.srnamt, "ZPPTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpptri_("/", &c__0, a, &info);
chkxer_("ZPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpptri_("U", &c_n1, a, &info);
chkxer_("ZPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPTRS */
s_copy(srnamc_1.srnamt, "ZPPTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpptrs_("/", &c__0, &c__0, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpptrs_("U", &c_n1, &c__0, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpptrs_("U", &c__0, &c_n1, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zpptrs_("U", &c__2, &c__1, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPRFS */
s_copy(srnamc_1.srnamt, "ZPPRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpprfs_("/", &c__0, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpprfs_("U", &c_n1, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpprfs_("U", &c__0, &c_n1, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zpprfs_("U", &c__2, &c__1, a, af, b, &c__1, x, &c__2, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
zpprfs_("U", &c__2, &c__1, a, af, b, &c__2, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPCON */
s_copy(srnamc_1.srnamt, "ZPPCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zppcon_("/", &c__0, a, &anrm, &rcond, w, r__, &info);
chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zppcon_("U", &c_n1, a, &anrm, &rcond, w, r__, &info);
chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
d__1 = -anrm;
zppcon_("U", &c__1, a, &d__1, &rcond, w, r__, &info);
chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPEQU */
s_copy(srnamc_1.srnamt, "ZPPEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zppequ_("/", &c__0, a, r1, &rcond, &anrm, &info);
chkxer_("ZPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zppequ_("U", &c_n1, a, r1, &rcond, &anrm, &info);
chkxer_("ZPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a Hermitian positive definite band matrix. */
} else if (lsamen_(&c__2, c2, "PB")) {
/* ZPBTRF */
s_copy(srnamc_1.srnamt, "ZPBTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbtrf_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbtrf_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbtrf_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbtrf_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBTF2 */
s_copy(srnamc_1.srnamt, "ZPBTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbtf2_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbtf2_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbtf2_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbtf2_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBTRS */
s_copy(srnamc_1.srnamt, "ZPBTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbtrs_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbtrs_("U", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbtrs_("U", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpbtrs_("U", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zpbtrs_("U", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zpbtrs_("U", &c__2, &c__0, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBRFS */
s_copy(srnamc_1.srnamt, "ZPBRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbrfs_("/", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbrfs_("U", &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbrfs_("U", &c__1, &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpbrfs_("U", &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zpbrfs_("U", &c__2, &c__1, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zpbrfs_("U", &c__2, &c__1, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zpbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__1, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
zpbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__2, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBCON */
s_copy(srnamc_1.srnamt, "ZPBCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbcon_("/", &c__0, &c__0, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbcon_("U", &c_n1, &c__0, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbcon_("U", &c__1, &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbcon_("U", &c__2, &c__1, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
d__1 = -anrm;
zpbcon_("U", &c__1, &c__0, a, &c__1, &d__1, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBEQU */
s_copy(srnamc_1.srnamt, "ZPBEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbequ_("/", &c__0, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbequ_("U", &c_n1, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbequ_("U", &c__1, &c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbequ_("U", &c__2, &c__1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
}
/* Print a summary line. */
alaesm_(path, &infoc_1.ok, &infoc_1.nout);
return 0;
/* End of ZERRPO */
} /* zerrpo_ */
/* Subroutine */ int ztimpo_(char *line, integer *nn, integer *nval, integer *
nns, integer *nsval, integer *nnb, integer *nbval, integer *nlda,
integer *ldaval, doublereal *timmin, doublecomplex *a, doublecomplex *
b, integer *iwork, doublereal *reslts, integer *ldr1, integer *ldr2,
integer *ldr3, integer *nout, ftnlen line_len)
{
/* Initialized data */
static char uplos[1*2] = "U" "L";
static char subnam[6*3] = "ZPOTRF" "ZPOTRS" "ZPOTRI";
/* Format strings */
static char fmt_9999[] = "(1x,a6,\002 timing run not attempted\002,/)";
static char fmt_9998[] = "(/\002 *** Speed of \002,a6,\002 in megaflops "
"***\002)";
static char fmt_9997[] = "(5x,\002line \002,i2,\002 with LDA = \002,i5)";
static char fmt_9996[] = "(5x,a6,\002 with UPLO = '\002,a1,\002'\002,/)";
/* System generated locals */
integer reslts_dim1, reslts_dim2, reslts_dim3, reslts_offset, i__1, i__2,
i__3;
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
s_wsle(cilist *), e_wsle(void);
/* Local variables */
static integer ilda, info;
static char path[3];
static doublereal time;
static integer isub, nrhs;
static char uplo[1];
static integer i__, n;
static char cname[6];
extern doublereal dopla_(char *, integer *, integer *, integer *, integer
*, integer *);
extern logical lsame_(char *, char *);
static integer iuplo, i3;
static doublereal s1, s2;
static integer ic, nb, in;
extern doublereal dsecnd_(void);
extern /* Subroutine */ int atimck_(integer *, char *, integer *, integer
*, integer *, integer *, integer *, integer *, ftnlen);
extern doublereal dmflop_(doublereal *, doublereal *, integer *);
extern /* Subroutine */ int atimin_(char *, char *, integer *, char *,
logical *, integer *, integer *, ftnlen, ftnlen, ftnlen), dprtbl_(
char *, char *, integer *, integer *, integer *, integer *,
integer *, doublereal *, integer *, integer *, integer *, ftnlen,
ftnlen), xlaenv_(integer *, integer *);
static doublereal untime;
extern /* Subroutine */ int zlacpy_(char *, integer *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *);
static logical timsub[3];
extern /* Subroutine */ int ztimmg_(integer *, integer *, integer *,
doublecomplex *, integer *, integer *, integer *), zpotrf_(char *,
integer *, doublecomplex *, integer *, integer *),
zpotri_(char *, integer *, doublecomplex *, integer *, integer *), zpotrs_(char *, integer *, integer *, doublecomplex *,
integer *, doublecomplex *, integer *, integer *);
static integer lda, ldb, icl, inb, mat;
static doublereal ops;
/* Fortran I/O blocks */
static cilist io___7 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___29 = { 0, 0, 0, fmt_9998, 0 };
static cilist io___30 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___31 = { 0, 0, 0, 0, 0 };
static cilist io___32 = { 0, 0, 0, fmt_9996, 0 };
#define subnam_ref(a_0,a_1) &subnam[(a_1)*6 + a_0 - 6]
#define reslts_ref(a_1,a_2,a_3,a_4) reslts[(((a_4)*reslts_dim3 + (a_3))*\
reslts_dim2 + (a_2))*reslts_dim1 + a_1]
/* -- LAPACK timing routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
March 31, 1993
Purpose
=======
ZTIMPO times ZPOTRF, -TRS, and -TRI.
Arguments
=========
LINE (input) CHARACTER*80
The input line that requested this routine. The first six
characters contain either the name of a subroutine or a
generic path name. The remaining characters may be used to
specify the individual routines to be timed. See ATIMIN for
a full description of the format of the input line.
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 size 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.
NNB (input) INTEGER
The number of values of NB contained in the vector NBVAL.
NBVAL (input) INTEGER array, dimension (NNB)
The values of the blocksize NB.
NLDA (input) INTEGER
The number of values of LDA contained in the vector LDAVAL.
LDAVAL (input) INTEGER array, dimension (NLDA)
The values of the leading dimension of the array A.
TIMMIN (input) DOUBLE PRECISION
The minimum time a subroutine will be timed.
A (workspace) COMPLEX*16 array, dimension (LDAMAX*NMAX)
where LDAMAX and NMAX are the maximum values permitted
for LDA and N.
B (workspace) COMPLEX*16 array, dimension (LDAMAX*NMAX)
IWORK (workspace) INTEGER array, dimension (NMAX)
RESLTS (output) DOUBLE PRECISION array, dimension
(LDR1,LDR2,LDR3,NSUBS)
The timing results for each subroutine over the relevant
values of N, NB, and LDA.
LDR1 (input) INTEGER
The first dimension of RESLTS. LDR1 >= max(4,NNB).
LDR2 (input) INTEGER
The second dimension of RESLTS. LDR2 >= max(1,NN).
LDR3 (input) INTEGER
The third dimension of RESLTS. LDR3 >= max(1,2*NLDA).
NOUT (input) INTEGER
The unit number for output.
=====================================================================
Parameter adjustments */
--nval;
--nsval;
--nbval;
--ldaval;
--a;
--b;
--iwork;
reslts_dim1 = *ldr1;
reslts_dim2 = *ldr2;
reslts_dim3 = *ldr3;
reslts_offset = 1 + reslts_dim1 * (1 + reslts_dim2 * (1 + reslts_dim3 * 1)
);
reslts -= reslts_offset;
/* Function Body
Extract the timing request from the input line. */
s_copy(path, "Zomplex precision", (ftnlen)1, (ftnlen)17);
s_copy(path + 1, "PO", (ftnlen)2, (ftnlen)2);
atimin_(path, line, &c__3, subnam, timsub, nout, &info, (ftnlen)3, (
ftnlen)80, (ftnlen)6);
if (info != 0) {
goto L150;
}
/* Check that N <= LDA for the input values. */
s_copy(cname, line, (ftnlen)6, (ftnlen)6);
atimck_(&c__2, cname, nn, &nval[1], nlda, &ldaval[1], nout, &info, (
ftnlen)6);
if (info > 0) {
io___7.ciunit = *nout;
s_wsfe(&io___7);
do_fio(&c__1, cname, (ftnlen)6);
e_wsfe();
goto L150;
}
/* Do first for UPLO = 'U', then for UPLO = 'L' */
for (iuplo = 1; iuplo <= 2; ++iuplo) {
*(unsigned char *)uplo = *(unsigned char *)&uplos[iuplo - 1];
if (lsame_(uplo, "U")) {
mat = 3;
} else {
mat = -3;
}
/* Do for each value of N in NVAL. */
i__1 = *nn;
for (in = 1; in <= i__1; ++in) {
n = nval[in];
/* Do for each value of LDA: */
i__2 = *nlda;
for (ilda = 1; ilda <= i__2; ++ilda) {
lda = ldaval[ilda];
i3 = (iuplo - 1) * *nlda + ilda;
/* Do for each value of NB in NBVAL. Only the blocked
routines are timed in this loop since the other routines
are independent of NB. */
i__3 = *nnb;
for (inb = 1; inb <= i__3; ++inb) {
nb = nbval[inb];
xlaenv_(&c__1, &nb);
/* Time ZPOTRF */
if (timsub[0]) {
ztimmg_(&mat, &n, &n, &a[1], &lda, &c__0, &c__0);
ic = 0;
s1 = dsecnd_();
L10:
zpotrf_(uplo, &n, &a[1], &lda, &info);
s2 = dsecnd_();
time = s2 - s1;
++ic;
if (time < *timmin) {
ztimmg_(&mat, &n, &n, &a[1], &lda, &c__0, &c__0);
goto L10;
}
/* Subtract the time used in ZTIMMG. */
icl = 1;
s1 = dsecnd_();
L20:
s2 = dsecnd_();
untime = s2 - s1;
++icl;
if (icl <= ic) {
ztimmg_(&mat, &n, &n, &a[1], &lda, &c__0, &c__0);
goto L20;
}
time = (time - untime) / (doublereal) ic;
ops = dopla_("ZPOTRF", &n, &n, &c__0, &c__0, &nb);
reslts_ref(inb, in, i3, 1) = dmflop_(&ops, &time, &
info);
} else {
ic = 0;
ztimmg_(&mat, &n, &n, &a[1], &lda, &c__0, &c__0);
}
/* Generate another matrix and factor it using ZPOTRF so
that the factored form can be used in timing the other
routines. */
if (ic != 1) {
zpotrf_(uplo, &n, &a[1], &lda, &info);
}
/* Time ZPOTRI */
if (timsub[2]) {
zlacpy_(uplo, &n, &n, &a[1], &lda, &b[1], &lda);
ic = 0;
s1 = dsecnd_();
L30:
zpotri_(uplo, &n, &b[1], &lda, &info);
s2 = dsecnd_();
time = s2 - s1;
++ic;
if (time < *timmin) {
zlacpy_(uplo, &n, &n, &a[1], &lda, &b[1], &lda);
goto L30;
}
/* Subtract the time used in ZLACPY. */
icl = 1;
s1 = dsecnd_();
L40:
s2 = dsecnd_();
untime = s2 - s1;
++icl;
if (icl <= ic) {
zlacpy_(uplo, &n, &n, &a[1], &lda, &b[1], &lda);
goto L40;
}
time = (time - untime) / (doublereal) ic;
ops = dopla_("ZPOTRI", &n, &n, &c__0, &c__0, &nb);
reslts_ref(inb, in, i3, 3) = dmflop_(&ops, &time, &
info);
}
/* L50: */
}
/* Time ZPOTRS */
if (timsub[1]) {
i__3 = *nns;
for (i__ = 1; i__ <= i__3; ++i__) {
nrhs = nsval[i__];
ldb = lda;
ztimmg_(&c__0, &n, &nrhs, &b[1], &ldb, &c__0, &c__0);
ic = 0;
s1 = dsecnd_();
L60:
zpotrs_(uplo, &n, &nrhs, &a[1], &lda, &b[1], &ldb, &
info);
s2 = dsecnd_();
time = s2 - s1;
++ic;
if (time < *timmin) {
ztimmg_(&c__0, &n, &nrhs, &b[1], &ldb, &c__0, &
c__0);
goto L60;
}
/* Subtract the time used in ZTIMMG. */
icl = 1;
s1 = dsecnd_();
L70:
s2 = dsecnd_();
untime = s2 - s1;
++icl;
if (icl <= ic) {
ztimmg_(&c__0, &n, &nrhs, &b[1], &ldb, &c__0, &
c__0);
goto L70;
}
time = (time - untime) / (doublereal) ic;
ops = dopla_("ZPOTRS", &n, &nrhs, &c__0, &c__0, &c__0);
reslts_ref(i__, in, i3, 2) = dmflop_(&ops, &time, &
info);
/* L80: */
}
}
/* L90: */
}
/* L100: */
}
/* L110: */
}
/* Print tables of results for each timed routine. */
for (isub = 1; isub <= 3; ++isub) {
if (! timsub[isub - 1]) {
goto L140;
}
io___29.ciunit = *nout;
s_wsfe(&io___29);
do_fio(&c__1, subnam_ref(0, isub), (ftnlen)6);
e_wsfe();
if (*nlda > 1) {
i__1 = *nlda;
for (i__ = 1; i__ <= i__1; ++i__) {
io___30.ciunit = *nout;
s_wsfe(&io___30);
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&ldaval[i__], (ftnlen)sizeof(integer));
e_wsfe();
/* L120: */
}
}
io___31.ciunit = *nout;
s_wsle(&io___31);
e_wsle();
for (iuplo = 1; iuplo <= 2; ++iuplo) {
io___32.ciunit = *nout;
s_wsfe(&io___32);
do_fio(&c__1, subnam_ref(0, isub), (ftnlen)6);
do_fio(&c__1, uplos + (iuplo - 1), (ftnlen)1);
e_wsfe();
i3 = (iuplo - 1) * *nlda + 1;
if (isub == 1) {
dprtbl_("NB", "N", nnb, &nbval[1], nn, &nval[1], nlda, &
reslts_ref(1, 1, i3, 1), ldr1, ldr2, nout, (ftnlen)2,
(ftnlen)1);
} else if (isub == 2) {
dprtbl_("NRHS", "N", nns, &nsval[1], nn, &nval[1], nlda, &
reslts_ref(1, 1, i3, 2), ldr1, ldr2, nout, (ftnlen)4,
(ftnlen)1);
} else if (isub == 3) {
dprtbl_("NB", "N", nnb, &nbval[1], nn, &nval[1], nlda, &
reslts_ref(1, 1, i3, 3), ldr1, ldr2, nout, (ftnlen)2,
(ftnlen)1);
}
/* L130: */
}
L140:
;
}
L150:
return 0;
/* End of ZTIMPO */
} /* ztimpo_ */
/* Subroutine */ int zerrpo_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
doublecomplex z__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer info;
static doublereal anrm;
static doublecomplex a[16] /* was [4][4] */, b[4];
static integer i__, j;
static doublereal r__[4];
static doublecomplex w[8], x[4];
static doublereal rcond;
static char c2[2];
static doublereal r1[4], r2[4];
static doublecomplex af[16] /* was [4][4] */;
extern /* Subroutine */ int zpbtf2_(char *, integer *, integer *,
doublecomplex *, integer *, integer *), zpotf2_(char *,
integer *, doublecomplex *, integer *, integer *),
alaesm_(char *, logical *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), zpbcon_(char *, integer *, integer *,
doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, doublereal *, integer *), zpbequ_(char *,
integer *, integer *, doublecomplex *, integer *, doublereal *,
doublereal *, doublereal *, integer *), zpbrfs_(char *,
integer *, integer *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, doublereal *, integer *), zpbtrf_(char *,
integer *, integer *, doublecomplex *, integer *, integer *), zpocon_(char *, integer *, doublecomplex *, integer *,
doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *), zppcon_(char *, integer *, doublecomplex *,
doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *), zpoequ_(integer *, doublecomplex *, integer *,
doublereal *, doublereal *, doublereal *, integer *), zpbtrs_(
char *, integer *, integer *, integer *, doublecomplex *, integer
*, doublecomplex *, integer *, integer *), zporfs_(char *,
integer *, integer *, doublecomplex *, integer *, doublecomplex *
, integer *, doublecomplex *, integer *, doublecomplex *, integer
*, doublereal *, doublereal *, doublecomplex *, doublereal *,
integer *), zpotrf_(char *, integer *, doublecomplex *,
integer *, integer *), zpotri_(char *, integer *,
doublecomplex *, integer *, integer *), zppequ_(char *,
integer *, doublecomplex *, doublereal *, doublereal *,
doublereal *, integer *), zpprfs_(char *, integer *,
integer *, doublecomplex *, doublecomplex *, doublecomplex *,
integer *, doublecomplex *, integer *, doublereal *, doublereal *,
doublecomplex *, doublereal *, integer *), zpptrf_(char *
, integer *, doublecomplex *, integer *), zpptri_(char *,
integer *, doublecomplex *, integer *), zpotrs_(char *,
integer *, integer *, doublecomplex *, integer *, doublecomplex *,
integer *, integer *), zpptrs_(char *, integer *,
integer *, doublecomplex *, doublecomplex *, integer *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
#define a_subscr(a_1,a_2) (a_2)*4 + a_1 - 5
#define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)]
#define af_subscr(a_1,a_2) (a_2)*4 + a_1 - 5
#define af_ref(a_1,a_2) af[af_subscr(a_1,a_2)]
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
February 29, 1992
Purpose
=======
ZERRPO tests the error exits for the COMPLEX*16 routines
for Hermitian positive definite matrices.
Arguments
=========
PATH (input) CHARACTER*3
The LAPACK path name for the routines to be tested.
NUNIT (input) INTEGER
The unit number for output.
===================================================================== */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Set the variables to innocuous values. */
for (j = 1; j <= 4; ++j) {
for (i__ = 1; i__ <= 4; ++i__) {
i__1 = a_subscr(i__, j);
d__1 = 1. / (doublereal) (i__ + j);
d__2 = -1. / (doublereal) (i__ + j);
z__1.r = d__1, z__1.i = d__2;
a[i__1].r = z__1.r, a[i__1].i = z__1.i;
i__1 = af_subscr(i__, j);
d__1 = 1. / (doublereal) (i__ + j);
d__2 = -1. / (doublereal) (i__ + j);
z__1.r = d__1, z__1.i = d__2;
af[i__1].r = z__1.r, af[i__1].i = z__1.i;
/* L10: */
}
i__1 = j - 1;
b[i__1].r = 0., b[i__1].i = 0.;
r1[j - 1] = 0.;
r2[j - 1] = 0.;
i__1 = j - 1;
w[i__1].r = 0., w[i__1].i = 0.;
i__1 = j - 1;
x[i__1].r = 0., x[i__1].i = 0.;
/* L20: */
}
anrm = 1.;
infoc_1.ok = TRUE_;
/* Test error exits of the routines that use the Cholesky
decomposition of a Hermitian positive definite matrix. */
if (lsamen_(&c__2, c2, "PO")) {
/* ZPOTRF */
s_copy(srnamc_1.srnamt, "ZPOTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotrf_("/", &c__0, a, &c__1, &info);
chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotrf_("U", &c_n1, a, &c__1, &info);
chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpotrf_("U", &c__2, a, &c__1, &info);
chkxer_("ZPOTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOTF2 */
s_copy(srnamc_1.srnamt, "ZPOTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotf2_("/", &c__0, a, &c__1, &info);
chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotf2_("U", &c_n1, a, &c__1, &info);
chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpotf2_("U", &c__2, a, &c__1, &info);
chkxer_("ZPOTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOTRI */
s_copy(srnamc_1.srnamt, "ZPOTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotri_("/", &c__0, a, &c__1, &info);
chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotri_("U", &c_n1, a, &c__1, &info);
chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpotri_("U", &c__2, a, &c__1, &info);
chkxer_("ZPOTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOTRS */
s_copy(srnamc_1.srnamt, "ZPOTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpotrs_("/", &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpotrs_("U", &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpotrs_("U", &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpotrs_("U", &c__2, &c__1, a, &c__1, b, &c__2, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zpotrs_("U", &c__2, &c__1, a, &c__2, b, &c__1, &info);
chkxer_("ZPOTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPORFS */
s_copy(srnamc_1.srnamt, "ZPORFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zporfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zporfs_("U", &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zporfs_("U", &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zporfs_("U", &c__2, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__1, x, &c__2,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 11;
zporfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, b, &c__2, x, &c__1,
r1, r2, w, r__, &info);
chkxer_("ZPORFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOCON */
s_copy(srnamc_1.srnamt, "ZPOCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpocon_("/", &c__0, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpocon_("U", &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpocon_("U", &c__2, a, &c__1, &anrm, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
d__1 = -anrm;
zpocon_("U", &c__1, a, &c__1, &d__1, &rcond, w, r__, &info)
;
chkxer_("ZPOCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPOEQU */
s_copy(srnamc_1.srnamt, "ZPOEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpoequ_(&c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpoequ_(&c__2, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPOEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Test error exits of the routines that use the Cholesky
decomposition of a Hermitian positive definite packed matrix. */
} else if (lsamen_(&c__2, c2, "PP")) {
/* ZPPTRF */
s_copy(srnamc_1.srnamt, "ZPPTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpptrf_("/", &c__0, a, &info);
chkxer_("ZPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpptrf_("U", &c_n1, a, &info);
chkxer_("ZPPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPTRI */
s_copy(srnamc_1.srnamt, "ZPPTRI", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpptri_("/", &c__0, a, &info);
chkxer_("ZPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpptri_("U", &c_n1, a, &info);
chkxer_("ZPPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPTRS */
s_copy(srnamc_1.srnamt, "ZPPTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpptrs_("/", &c__0, &c__0, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpptrs_("U", &c_n1, &c__0, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpptrs_("U", &c__0, &c_n1, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zpptrs_("U", &c__2, &c__1, a, b, &c__1, &info);
chkxer_("ZPPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPRFS */
s_copy(srnamc_1.srnamt, "ZPPRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpprfs_("/", &c__0, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpprfs_("U", &c_n1, &c__0, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpprfs_("U", &c__0, &c_n1, a, af, b, &c__1, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zpprfs_("U", &c__2, &c__1, a, af, b, &c__1, x, &c__2, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 9;
zpprfs_("U", &c__2, &c__1, a, af, b, &c__2, x, &c__1, r1, r2, w, r__,
&info);
chkxer_("ZPPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPCON */
s_copy(srnamc_1.srnamt, "ZPPCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zppcon_("/", &c__0, a, &anrm, &rcond, w, r__, &info);
chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zppcon_("U", &c_n1, a, &anrm, &rcond, w, r__, &info);
chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
d__1 = -anrm;
zppcon_("U", &c__1, a, &d__1, &rcond, w, r__, &info);
chkxer_("ZPPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPPEQU */
s_copy(srnamc_1.srnamt, "ZPPEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zppequ_("/", &c__0, a, r1, &rcond, &anrm, &info);
chkxer_("ZPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zppequ_("U", &c_n1, a, r1, &rcond, &anrm, &info);
chkxer_("ZPPEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Test error exits of the routines that use the Cholesky
decomposition of a Hermitian positive definite band matrix. */
} else if (lsamen_(&c__2, c2, "PB")) {
/* ZPBTRF */
s_copy(srnamc_1.srnamt, "ZPBTRF", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbtrf_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbtrf_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbtrf_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbtrf_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("ZPBTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBTF2 */
s_copy(srnamc_1.srnamt, "ZPBTF2", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbtf2_("/", &c__0, &c__0, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbtf2_("U", &c_n1, &c__0, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbtf2_("U", &c__1, &c_n1, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbtf2_("U", &c__2, &c__1, a, &c__1, &info);
chkxer_("ZPBTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBTRS */
s_copy(srnamc_1.srnamt, "ZPBTRS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbtrs_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbtrs_("U", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbtrs_("U", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpbtrs_("U", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zpbtrs_("U", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zpbtrs_("U", &c__2, &c__0, &c__1, a, &c__1, b, &c__1, &info);
chkxer_("ZPBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBRFS */
s_copy(srnamc_1.srnamt, "ZPBRFS", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbrfs_("/", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbrfs_("U", &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbrfs_("U", &c__1, &c_n1, &c__0, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zpbrfs_("U", &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, b, &c__1, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
zpbrfs_("U", &c__2, &c__1, &c__1, a, &c__1, af, &c__2, b, &c__2, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zpbrfs_("U", &c__2, &c__1, &c__1, a, &c__2, af, &c__1, b, &c__2, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zpbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__1, x, &
c__2, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
zpbrfs_("U", &c__2, &c__0, &c__1, a, &c__1, af, &c__1, b, &c__2, x, &
c__1, r1, r2, w, r__, &info);
chkxer_("ZPBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBCON */
s_copy(srnamc_1.srnamt, "ZPBCON", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbcon_("/", &c__0, &c__0, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbcon_("U", &c_n1, &c__0, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbcon_("U", &c__1, &c_n1, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbcon_("U", &c__2, &c__1, a, &c__1, &anrm, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 6;
d__1 = -anrm;
zpbcon_("U", &c__1, &c__0, a, &c__1, &d__1, &rcond, w, r__, &info);
chkxer_("ZPBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZPBEQU */
s_copy(srnamc_1.srnamt, "ZPBEQU", (ftnlen)6, (ftnlen)6);
infoc_1.infot = 1;
zpbequ_("/", &c__0, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zpbequ_("U", &c_n1, &c__0, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zpbequ_("U", &c__1, &c_n1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zpbequ_("U", &c__2, &c__1, a, &c__1, r1, &rcond, &anrm, &info);
chkxer_("ZPBEQU", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
}
/* Print a summary line. */
alaesm_(path, &infoc_1.ok, &infoc_1.nout);
return 0;
/* End of ZERRPO */
} /* zerrpo_ */
/* Subroutine */ int zchkpo_(logical *dotype, integer *nn, integer *nval,
integer *nnb, integer *nbval, integer *nns, integer *nsval,
doublereal *thresh, logical *tsterr, integer *nmax, doublecomplex *a,
doublecomplex *afac, doublecomplex *ainv, doublecomplex *b,
doublecomplex *x, doublecomplex *xact, doublecomplex *work,
doublereal *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];
doublereal rcond;
integer nimat;
doublereal anorm;
integer iuplo, izero, nerrs;
logical zerot;
char xtype[1];
doublereal rcondc;
doublereal cndnum;
doublereal 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 */
/* ======= */
/* ZCHKPO tests ZPOTRF, -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) DOUBLE PRECISION */
/* 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*16 array, dimension (NMAX*NMAX) */
/* AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */
/* AINV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */
/* B (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX) */
/* where NSMAX is the largest entry in NSVAL. */
/* X (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX) */
/* XACT (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX) */
/* WORK (workspace) COMPLEX*16 array, dimension */
/* (NMAX*max(3,NSMAX)) */
/* RWORK (workspace) DOUBLE PRECISION 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, "Zomplex 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) {
zerrpo_(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 ZLATB4 and generate a test matrix */
/* with ZLATMS. */
zlatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode,
&cndnum, dist);
s_copy(srnamc_1.srnamt, "ZLATMS", (ftnlen)32, (ftnlen)6);
zlatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &
cndnum, &anorm, &kl, &ku, uplo, &a[1], &lda, &work[1],
&info);
/* Check error code from ZLATMS. */
if (info != 0) {
alaerh_(path, "ZLATMS", &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., a[i__4].i = 0.;
/* L20: */
}
ioff += izero;
i__3 = n;
for (i__ = izero; i__ <= i__3; ++i__) {
i__4 = ioff;
a[i__4].r = 0., a[i__4].i = 0.;
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., a[i__4].i = 0.;
ioff += lda;
/* L40: */
}
ioff -= izero;
i__3 = n;
for (i__ = izero; i__ <= i__3; ++i__) {
i__4 = ioff + i__;
a[i__4].r = 0., a[i__4].i = 0.;
/* L50: */
}
}
} else {
izero = 0;
}
/* Set the imaginary part of the diagonals. */
i__3 = lda + 1;
zlaipd_(&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. */
zlacpy_(uplo, &n, &n, &a[1], &lda, &afac[1], &lda);
s_copy(srnamc_1.srnamt, "ZPOTRF", (ftnlen)32, (ftnlen)6);
zpotrf_(uplo, &n, &afac[1], &lda, &info);
/* Check error code from ZPOTRF. */
if (info != izero) {
alaerh_(path, "ZPOTRF", &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. */
zlacpy_(uplo, &n, &n, &afac[1], &lda, &ainv[1], &lda);
zpot01_(uplo, &n, &a[1], &lda, &ainv[1], &lda, &rwork[1],
result);
/* + TEST 2 */
/* Form the inverse and compute the residual. */
zlacpy_(uplo, &n, &n, &afac[1], &lda, &ainv[1], &lda);
s_copy(srnamc_1.srnamt, "ZPOTRI", (ftnlen)32, (ftnlen)6);
zpotri_(uplo, &n, &ainv[1], &lda, &info);
/* Check error code from ZPOTRI. */
if (info != 0) {
alaerh_(path, "ZPOTRI", &info, &c__0, uplo, &n, &n, &
c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs,
nout);
}
zpot03_(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(doublereal));
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, "ZLARHS", (ftnlen)32, (ftnlen)
6);
zlarhs_(path, xtype, uplo, " ", &n, &n, &kl, &ku, &
nrhs, &a[1], &lda, &xact[1], &lda, &b[1], &
lda, iseed, &info);
zlacpy_("Full", &n, &nrhs, &b[1], &lda, &x[1], &lda);
s_copy(srnamc_1.srnamt, "ZPOTRS", (ftnlen)32, (ftnlen)
6);
zpotrs_(uplo, &n, &nrhs, &afac[1], &lda, &x[1], &lda,
&info);
/* Check error code from ZPOTRS. */
if (info != 0) {
alaerh_(path, "ZPOTRS", &info, &c__0, uplo, &n, &
n, &c_n1, &c_n1, &nrhs, &imat, &nfail, &
nerrs, nout);
}
zlacpy_("Full", &n, &nrhs, &b[1], &lda, &work[1], &
lda);
zpot02_(uplo, &n, &nrhs, &a[1], &lda, &x[1], &lda, &
work[1], &lda, &rwork[1], &result[2]);
/* + TEST 4 */
/* Check solution from generated exact solution. */
zget04_(&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, "ZPORFS", (ftnlen)32, (ftnlen)
6);
zporfs_(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 ZPORFS. */
if (info != 0) {
alaerh_(path, "ZPORFS", &info, &c__0, uplo, &n, &
n, &c_n1, &c_n1, &nrhs, &imat, &nfail, &
nerrs, nout);
}
zget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &
rcondc, &result[4]);
zpot05_(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(doublereal));
e_wsfe();
++nfail;
}
/* L70: */
}
nrun += 5;
/* L80: */
}
/* + TEST 8 */
/* Get an estimate of RCOND = 1/CNDNUM. */
anorm = zlanhe_("1", uplo, &n, &a[1], &lda, &rwork[1]);
s_copy(srnamc_1.srnamt, "ZPOCON", (ftnlen)32, (ftnlen)6);
zpocon_(uplo, &n, &afac[1], &lda, &anorm, &rcond, &work[1]
, &rwork[1], &info);
/* Check error code from ZPOCON. */
if (info != 0) {
alaerh_(path, "ZPOCON", &info, &c__0, uplo, &n, &n, &
c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs,
nout);
}
result[7] = dget06_(&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(
doublereal));
e_wsfe();
++nfail;
}
++nrun;
L90:
;
}
L100:
;
}
L110:
;
}
/* L120: */
}
/* Print a summary of the results. */
alasum_(path, nout, &nfail, &nrun, &nerrs);
return 0;
/* End of ZCHKPO */
} /* zchkpo_ */
