/* Subroutine */ int cspt02_(char *uplo, integer *n, integer *nrhs, complex *
a, complex *x, integer *ldx, complex *b, integer *ldb, real *rwork,
real *resid)
{
/* System generated locals */
integer b_dim1, b_offset, x_dim1, x_offset, i__1;
real r__1, r__2;
complex q__1;
/* Local variables */
integer j;
real eps, anorm, bnorm;
real xnorm;
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* CSPT02 computes the residual in the solution of a complex symmetric */
/* system of linear equations A*x = b when packed storage is used for */
/* the coefficient matrix. The ratio computed is */
/* RESID = norm( B - A*X ) / ( norm(A) * norm(X) * EPS). */
/* where EPS is the machine precision. */
/* Arguments */
/* ========= */
/* UPLO (input) CHARACTER*1 */
/* Specifies whether the upper or lower triangular part of the */
/* complex symmetric matrix A is stored: */
/* = 'U': Upper triangular */
/* = 'L': Lower triangular */
/* N (input) INTEGER */
/* The number of rows and columns of the matrix A. N >= 0. */
/* NRHS (input) INTEGER */
/* The number of columns of B, the matrix of right hand sides. */
/* NRHS >= 0. */
/* A (input) COMPLEX array, dimension (N*(N+1)/2) */
/* The original complex symmetric matrix A, stored as a packed */
/* triangular matrix. */
/* X (input) COMPLEX array, dimension (LDX,NRHS) */
/* The computed solution vectors for the system of linear */
/* equations. */
/* LDX (input) INTEGER */
/* The leading dimension of the array X. LDX >= max(1,N). */
/* B (input/output) COMPLEX array, dimension (LDB,NRHS) */
/* On entry, the right hand side vectors for the system of */
/* linear equations. */
/* On exit, B is overwritten with the difference B - A*X. */
/* LDB (input) INTEGER */
/* The leading dimension of the array B. LDB >= max(1,N). */
/* RWORK (workspace) REAL array, dimension (N) */
/* RESID (output) REAL */
/* The maximum over the number of right hand sides of */
/* norm(B - A*X) / ( norm(A) * norm(X) * EPS ). */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Quick exit if N = 0 or NRHS = 0 */
/* Parameter adjustments */
--a;
x_dim1 = *ldx;
x_offset = 1 + x_dim1;
x -= x_offset;
b_dim1 = *ldb;
b_offset = 1 + b_dim1;
b -= b_offset;
--rwork;
/* Function Body */
if (*n <= 0 || *nrhs <= 0) {
*resid = 0.f;
return 0;
}
/* Exit with RESID = 1/EPS if ANORM = 0. */
eps = slamch_("Epsilon");
anorm = clansp_("1", uplo, n, &a[1], &rwork[1]);
if (anorm <= 0.f) {
*resid = 1.f / eps;
return 0;
}
/* Compute B - A*X for the matrix of right hand sides B. */
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
q__1.r = -1.f, q__1.i = -0.f;
cspmv_(uplo, n, &q__1, &a[1], &x[j * x_dim1 + 1], &c__1, &c_b1, &b[j *
b_dim1 + 1], &c__1);
/* L10: */
}
/* Compute the maximum over the number of right hand sides of */
/* norm( B - A*X ) / ( norm(A) * norm(X) * EPS ) . */
*resid = 0.f;
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
bnorm = scasum_(n, &b[j * b_dim1 + 1], &c__1);
xnorm = scasum_(n, &x[j * x_dim1 + 1], &c__1);
if (xnorm <= 0.f) {
*resid = 1.f / eps;
} else {
/* Computing MAX */
r__1 = *resid, r__2 = bnorm / anorm / xnorm / eps;
*resid = dmax(r__1,r__2);
}
/* L20: */
}
return 0;
/* End of CSPT02 */
} /* cspt02_ */
/* Subroutine */ int cspt03_(char *uplo, integer *n, complex *a, complex *
ainv, complex *work, integer *ldw, real *rwork, real *rcond, real *
resid)
{
/* System generated locals */
integer work_dim1, work_offset, i__1, i__2, i__3, i__4, i__5;
complex q__1, q__2;
/* Local variables */
integer i__, j, k;
complex t;
real eps;
integer icol, jcol, kcol, nall;
real anorm;
real ainvnm;
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* CSPT03 computes the residual for a complex symmetric packed matrix */
/* times its inverse: */
/* norm( I - A*AINV ) / ( N * norm(A) * norm(AINV) * EPS ), */
/* where EPS is the machine epsilon. */
/* Arguments */
/* ========== */
/* UPLO (input) CHARACTER*1 */
/* Specifies whether the upper or lower triangular part of the */
/* complex symmetric matrix A is stored: */
/* = 'U': Upper triangular */
/* = 'L': Lower triangular */
/* N (input) INTEGER */
/* The number of rows and columns of the matrix A. N >= 0. */
/* A (input) COMPLEX array, dimension (N*(N+1)/2) */
/* The original complex symmetric matrix A, stored as a packed */
/* triangular matrix. */
/* AINV (input) COMPLEX array, dimension (N*(N+1)/2) */
/* The (symmetric) inverse of the matrix A, stored as a packed */
/* triangular matrix. */
/* WORK (workspace) COMPLEX array, dimension (LDWORK,N) */
/* LDWORK (input) INTEGER */
/* The leading dimension of the array WORK. LDWORK >= max(1,N). */
/* RWORK (workspace) REAL array, dimension (N) */
/* RCOND (output) REAL */
/* The reciprocal of the condition number of A, computed as */
/* ( 1/norm(A) ) / norm(AINV). */
/* RESID (output) REAL */
/* norm(I - A*AINV) / ( N * norm(A) * norm(AINV) * EPS ) */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Quick exit if N = 0. */
/* Parameter adjustments */
--a;
--ainv;
work_dim1 = *ldw;
work_offset = 1 + work_dim1;
work -= work_offset;
--rwork;
/* Function Body */
if (*n <= 0) {
*rcond = 1.f;
*resid = 0.f;
return 0;
}
/* Exit with RESID = 1/EPS if ANORM = 0 or AINVNM = 0. */
eps = slamch_("Epsilon");
anorm = clansp_("1", uplo, n, &a[1], &rwork[1]);
ainvnm = clansp_("1", uplo, n, &ainv[1], &rwork[1]);
if (anorm <= 0.f || ainvnm <= 0.f) {
*rcond = 0.f;
*resid = 1.f / eps;
return 0;
}
*rcond = 1.f / anorm / ainvnm;
/* Case where both A and AINV are upper triangular: */
/* Each element of - A * AINV is computed by taking the dot product */
/* of a row of A with a column of AINV. */
if (lsame_(uplo, "U")) {
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
icol = (i__ - 1) * i__ / 2 + 1;
/* Code when J <= I */
i__2 = i__;
for (j = 1; j <= i__2; ++j) {
jcol = (j - 1) * j / 2 + 1;
cdotu_(&q__1, &j, &a[icol], &c__1, &ainv[jcol], &c__1);
t.r = q__1.r, t.i = q__1.i;
jcol = jcol + (j << 1) - 1;
kcol = icol - 1;
i__3 = i__;
for (k = j + 1; k <= i__3; ++k) {
i__4 = kcol + k;
i__5 = jcol;
q__2.r = a[i__4].r * ainv[i__5].r - a[i__4].i * ainv[i__5]
.i, q__2.i = a[i__4].r * ainv[i__5].i + a[i__4].i
* ainv[i__5].r;
q__1.r = t.r + q__2.r, q__1.i = t.i + q__2.i;
t.r = q__1.r, t.i = q__1.i;
jcol += k;
/* L10: */
}
kcol += i__ << 1;
i__3 = *n;
for (k = i__ + 1; k <= i__3; ++k) {
i__4 = kcol;
i__5 = jcol;
q__2.r = a[i__4].r * ainv[i__5].r - a[i__4].i * ainv[i__5]
.i, q__2.i = a[i__4].r * ainv[i__5].i + a[i__4].i
* ainv[i__5].r;
q__1.r = t.r + q__2.r, q__1.i = t.i + q__2.i;
t.r = q__1.r, t.i = q__1.i;
kcol += k;
jcol += k;
/* L20: */
}
i__3 = i__ + j * work_dim1;
q__1.r = -t.r, q__1.i = -t.i;
work[i__3].r = q__1.r, work[i__3].i = q__1.i;
/* L30: */
}
/* Code when J > I */
i__2 = *n;
for (j = i__ + 1; j <= i__2; ++j) {
jcol = (j - 1) * j / 2 + 1;
cdotu_(&q__1, &i__, &a[icol], &c__1, &ainv[jcol], &c__1);
t.r = q__1.r, t.i = q__1.i;
--jcol;
kcol = icol + (i__ << 1) - 1;
i__3 = j;
for (k = i__ + 1; k <= i__3; ++k) {
i__4 = kcol;
i__5 = jcol + k;
q__2.r = a[i__4].r * ainv[i__5].r - a[i__4].i * ainv[i__5]
.i, q__2.i = a[i__4].r * ainv[i__5].i + a[i__4].i
* ainv[i__5].r;
q__1.r = t.r + q__2.r, q__1.i = t.i + q__2.i;
t.r = q__1.r, t.i = q__1.i;
kcol += k;
/* L40: */
}
jcol += j << 1;
i__3 = *n;
for (k = j + 1; k <= i__3; ++k) {
i__4 = kcol;
i__5 = jcol;
q__2.r = a[i__4].r * ainv[i__5].r - a[i__4].i * ainv[i__5]
.i, q__2.i = a[i__4].r * ainv[i__5].i + a[i__4].i
* ainv[i__5].r;
q__1.r = t.r + q__2.r, q__1.i = t.i + q__2.i;
t.r = q__1.r, t.i = q__1.i;
kcol += k;
jcol += k;
/* L50: */
}
i__3 = i__ + j * work_dim1;
q__1.r = -t.r, q__1.i = -t.i;
work[i__3].r = q__1.r, work[i__3].i = q__1.i;
/* L60: */
}
/* L70: */
}
} else {
/* Case where both A and AINV are lower triangular */
nall = *n * (*n + 1) / 2;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Code when J <= I */
icol = nall - (*n - i__ + 1) * (*n - i__ + 2) / 2 + 1;
i__2 = i__;
for (j = 1; j <= i__2; ++j) {
jcol = nall - (*n - j) * (*n - j + 1) / 2 - (*n - i__);
i__3 = *n - i__ + 1;
cdotu_(&q__1, &i__3, &a[icol], &c__1, &ainv[jcol], &c__1);
t.r = q__1.r, t.i = q__1.i;
kcol = i__;
jcol = j;
i__3 = j - 1;
for (k = 1; k <= i__3; ++k) {
i__4 = kcol;
i__5 = jcol;
q__2.r = a[i__4].r * ainv[i__5].r - a[i__4].i * ainv[i__5]
.i, q__2.i = a[i__4].r * ainv[i__5].i + a[i__4].i
* ainv[i__5].r;
q__1.r = t.r + q__2.r, q__1.i = t.i + q__2.i;
t.r = q__1.r, t.i = q__1.i;
jcol = jcol + *n - k;
kcol = kcol + *n - k;
/* L80: */
}
jcol -= j;
i__3 = i__ - 1;
for (k = j; k <= i__3; ++k) {
i__4 = kcol;
i__5 = jcol + k;
q__2.r = a[i__4].r * ainv[i__5].r - a[i__4].i * ainv[i__5]
.i, q__2.i = a[i__4].r * ainv[i__5].i + a[i__4].i
* ainv[i__5].r;
q__1.r = t.r + q__2.r, q__1.i = t.i + q__2.i;
t.r = q__1.r, t.i = q__1.i;
kcol = kcol + *n - k;
/* L90: */
}
i__3 = i__ + j * work_dim1;
q__1.r = -t.r, q__1.i = -t.i;
work[i__3].r = q__1.r, work[i__3].i = q__1.i;
/* L100: */
}
/* Code when J > I */
icol = nall - (*n - i__) * (*n - i__ + 1) / 2;
i__2 = *n;
for (j = i__ + 1; j <= i__2; ++j) {
jcol = nall - (*n - j + 1) * (*n - j + 2) / 2 + 1;
i__3 = *n - j + 1;
cdotu_(&q__1, &i__3, &a[icol - *n + j], &c__1, &ainv[jcol], &
c__1);
t.r = q__1.r, t.i = q__1.i;
kcol = i__;
jcol = j;
i__3 = i__ - 1;
for (k = 1; k <= i__3; ++k) {
i__4 = kcol;
i__5 = jcol;
q__2.r = a[i__4].r * ainv[i__5].r - a[i__4].i * ainv[i__5]
.i, q__2.i = a[i__4].r * ainv[i__5].i + a[i__4].i
* ainv[i__5].r;
q__1.r = t.r + q__2.r, q__1.i = t.i + q__2.i;
t.r = q__1.r, t.i = q__1.i;
jcol = jcol + *n - k;
kcol = kcol + *n - k;
/* L110: */
}
kcol -= i__;
i__3 = j - 1;
for (k = i__; k <= i__3; ++k) {
i__4 = kcol + k;
i__5 = jcol;
q__2.r = a[i__4].r * ainv[i__5].r - a[i__4].i * ainv[i__5]
.i, q__2.i = a[i__4].r * ainv[i__5].i + a[i__4].i
* ainv[i__5].r;
q__1.r = t.r + q__2.r, q__1.i = t.i + q__2.i;
t.r = q__1.r, t.i = q__1.i;
jcol = jcol + *n - k;
/* L120: */
}
i__3 = i__ + j * work_dim1;
q__1.r = -t.r, q__1.i = -t.i;
work[i__3].r = q__1.r, work[i__3].i = q__1.i;
/* L130: */
}
/* L140: */
}
}
/* Add the identity matrix to WORK . */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = i__ + i__ * work_dim1;
i__3 = i__ + i__ * work_dim1;
q__1.r = work[i__3].r + 1.f, q__1.i = work[i__3].i;
work[i__2].r = q__1.r, work[i__2].i = q__1.i;
/* L150: */
}
/* Compute norm(I - A*AINV) / (N * norm(A) * norm(AINV) * EPS) */
*resid = clange_("1", n, n, &work[work_offset], ldw, &rwork[1])
;
*resid = *resid * *rcond / eps / (real) (*n);
return 0;
/* End of CSPT03 */
} /* cspt03_ */
/* Subroutine */ int cspsvx_(char *fact, char *uplo, integer *n, integer *
nrhs, complex *ap, complex *afp, integer *ipiv, complex *b, integer *
ldb, complex *x, integer *ldx, real *rcond, real *ferr, real *berr,
complex *work, real *rwork, integer *info)
{
/* System generated locals */
integer b_dim1, b_offset, x_dim1, x_offset, i__1;
/* Local variables */
extern logical lsame_(char *, char *);
real anorm;
extern /* Subroutine */ int ccopy_(integer *, complex *, integer *,
complex *, integer *);
extern doublereal slamch_(char *);
logical nofact;
extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex
*, integer *, complex *, integer *), xerbla_(char *,
integer *);
extern doublereal clansp_(char *, char *, integer *, complex *, real *);
extern /* Subroutine */ int cspcon_(char *, integer *, complex *, integer
*, real *, real *, complex *, integer *), csprfs_(char *,
integer *, integer *, complex *, complex *, integer *, complex *,
integer *, complex *, integer *, real *, real *, complex *, real *
, integer *), csptrf_(char *, integer *, complex *,
integer *, integer *), csptrs_(char *, integer *, integer
*, complex *, integer *, complex *, integer *, integer *);
/* -- LAPACK driver routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* CSPSVX uses the diagonal pivoting factorization A = U*D*U**T or */
/* A = L*D*L**T to compute the solution to a complex system of linear */
/* equations A * X = B, where A is an N-by-N symmetric matrix stored */
/* in packed format 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 = 'N', the diagonal pivoting method is used to factor A as */
/* A = U * D * U**T, if UPLO = 'U', or */
/* A = L * D * L**T, if UPLO = 'L', */
/* where U (or L) is a product of permutation and unit upper (lower) */
/* triangular matrices and D is symmetric and block diagonal with */
/* 1-by-1 and 2-by-2 diagonal blocks. */
/* 2. If some D(i,i)=0, so that D is exactly singular, 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. */
/* 3. The system of equations is solved for X using the factored form */
/* of A. */
/* 4. Iterative refinement is applied to improve the computed solution */
/* matrix and calculate error bounds and backward error estimates */
/* for it. */
/* Arguments */
/* ========= */
/* FACT (input) CHARACTER*1 */
/* Specifies whether or not the factored form of A has been */
/* supplied on entry. */
/* = 'F': On entry, AFP and IPIV contain the factored form */
/* of A. AP, AFP and IPIV will not be modified. */
/* = 'N': The matrix A will be copied to AFP 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. */
/* AP (input) COMPLEX array, dimension (N*(N+1)/2) */
/* The upper or lower triangle of the symmetric matrix A, packed */
/* columnwise in a linear array. The j-th column of A is stored */
/* in the array AP as follows: */
/* if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j; */
/* if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n. */
/* See below for further details. */
/* AFP (input or output) COMPLEX array, dimension (N*(N+1)/2) */
/* If FACT = 'F', then AFP is an input argument and on entry */
/* contains the block diagonal matrix D and the multipliers used */
/* to obtain the factor U or L from the factorization */
/* A = U*D*U**T or A = L*D*L**T as computed by CSPTRF, stored as */
/* a packed triangular matrix in the same storage format as A. */
/* If FACT = 'N', then AFP is an output argument and on exit */
/* contains the block diagonal matrix D and the multipliers used */
/* to obtain the factor U or L from the factorization */
/* A = U*D*U**T or A = L*D*L**T as computed by CSPTRF, stored as */
/* a packed triangular matrix in the same storage format as A. */
/* IPIV (input or output) INTEGER array, dimension (N) */
/* If FACT = 'F', then IPIV is an input argument and on entry */
/* contains details of the interchanges and the block structure */
/* of D, as determined by CSPTRF. */
/* If IPIV(k) > 0, then rows and columns k and IPIV(k) were */
/* interchanged and D(k,k) is a 1-by-1 diagonal block. */
/* If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and */
/* columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k) */
/* is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) = */
/* IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were */
/* interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block. */
/* If FACT = 'N', then IPIV is an output argument and on exit */
/* contains details of the interchanges and the block structure */
/* of D, as determined by CSPTRF. */
/* B (input) COMPLEX array, dimension (LDB,NRHS) */
/* The N-by-NRHS right hand side matrix 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. */
/* 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. 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: D(i,i) is exactly zero. The factorization */
/* has been completed but the factor D is exactly */
/* singular, so the solution and error bounds could */
/* not be computed. RCOND = 0 is returned. */
/* = N+1: D 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. */
/* Further Details */
/* =============== */
/* The packed storage scheme is illustrated by the following example */
/* when N = 4, UPLO = 'U': */
/* Two-dimensional storage of the symmetric matrix A: */
/* a11 a12 a13 a14 */
/* a22 a23 a24 */
/* a33 a34 (aij = aji) */
/* a44 */
/* Packed storage of the upper triangle of A: */
/* AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ] */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
--ap;
--afp;
--ipiv;
b_dim1 = *ldb;
b_offset = 1 + b_dim1;
b -= b_offset;
x_dim1 = *ldx;
x_offset = 1 + x_dim1;
x -= x_offset;
--ferr;
--berr;
--work;
--rwork;
/* Function Body */
*info = 0;
nofact = lsame_(fact, "N");
if (! nofact && ! 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 (*ldb < max(1,*n)) {
*info = -9;
} else if (*ldx < max(1,*n)) {
*info = -11;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("CSPSVX", &i__1);
return 0;
}
if (nofact) {
/* Compute the factorization A = U*D*U' or A = L*D*L'. */
i__1 = *n * (*n + 1) / 2;
ccopy_(&i__1, &ap[1], &c__1, &afp[1], &c__1);
csptrf_(uplo, n, &afp[1], &ipiv[1], info);
/* Return if INFO is non-zero. */
if (*info > 0) {
*rcond = 0.f;
return 0;
}
}
/* Compute the norm of the matrix A. */
anorm = clansp_("I", uplo, n, &ap[1], &rwork[1]);
/* Compute the reciprocal of the condition number of A. */
cspcon_(uplo, n, &afp[1], &ipiv[1], &anorm, rcond, &work[1], info);
/* Compute the solution vectors X. */
clacpy_("Full", n, nrhs, &b[b_offset], ldb, &x[x_offset], ldx);
csptrs_(uplo, n, nrhs, &afp[1], &ipiv[1], &x[x_offset], ldx, info);
/* Use iterative refinement to improve the computed solutions and */
/* compute error bounds and backward error estimates for them. */
csprfs_(uplo, n, nrhs, &ap[1], &afp[1], &ipiv[1], &b[b_offset], ldb, &x[
x_offset], ldx, &ferr[1], &berr[1], &work[1], &rwork[1], info);
/* Set INFO = N+1 if the matrix is singular to working precision. */
if (*rcond < slamch_("Epsilon")) {
*info = *n + 1;
}
return 0;
/* End of CSPSVX */
} /* cspsvx_ */
