/* Subroutine */
int zlatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, doublecomplex *ap, doublecomplex *x, doublereal * scale, doublereal *cnorm, integer *info)
{
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5;
doublereal d__1, d__2, d__3, d__4;
doublecomplex z__1, z__2, z__3, z__4;
/* Builtin functions */
double d_imag(doublecomplex *);
void d_cnjg(doublecomplex *, doublecomplex *);
/* Local variables */
integer i__, j, ip;
doublereal xj, rec, tjj;
integer jinc, jlen;
doublereal xbnd;
integer imax;
doublereal tmax;
doublecomplex tjjs;
doublereal xmax, grow;
extern /* Subroutine */
int dscal_(integer *, doublereal *, doublereal *, integer *);
extern logical lsame_(char *, char *);
doublereal tscal;
doublecomplex uscal;
integer jlast;
doublecomplex csumj;
extern /* Double Complex */
VOID zdotc_f2c_(doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *);
logical upper;
extern /* Double Complex */
VOID zdotu_f2c_(doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *);
extern /* Subroutine */
int zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztpsv_( char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), dlabad_(doublereal *, doublereal *);
extern doublereal dlamch_(char *);
extern integer idamax_(integer *, doublereal *, integer *);
extern /* Subroutine */
int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *);
doublereal bignum;
extern integer izamax_(integer *, doublecomplex *, integer *);
extern /* Double Complex */
VOID zladiv_(doublecomplex *, doublecomplex *, doublecomplex *);
logical notran;
integer jfirst;
extern doublereal dzasum_(integer *, doublecomplex *, integer *);
doublereal smlnum;
logical nounit;
/* -- LAPACK auxiliary routine (version 3.4.2) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* September 2012 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Statement Functions .. */
/* .. */
/* .. Statement Function definitions .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
--cnorm;
--x;
--ap;
/* Function Body */
*info = 0;
upper = lsame_(uplo, "U");
notran = lsame_(trans, "N");
nounit = lsame_(diag, "N");
/* Test the input parameters. */
if (! upper && ! lsame_(uplo, "L"))
{
*info = -1;
}
else if (! notran && ! lsame_(trans, "T") && ! lsame_(trans, "C"))
{
*info = -2;
}
else if (! nounit && ! lsame_(diag, "U"))
{
*info = -3;
}
else if (! lsame_(normin, "Y") && ! lsame_(normin, "N"))
{
*info = -4;
}
else if (*n < 0)
{
*info = -5;
}
if (*info != 0)
{
i__1 = -(*info);
xerbla_("ZLATPS", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0)
{
return 0;
}
/* Determine machine dependent parameters to control overflow. */
smlnum = dlamch_("Safe minimum");
bignum = 1. / smlnum;
dlabad_(&smlnum, &bignum);
smlnum /= dlamch_("Precision");
bignum = 1. / smlnum;
*scale = 1.;
if (lsame_(normin, "N"))
{
/* Compute the 1-norm of each column, not including the diagonal. */
if (upper)
{
/* A is upper triangular. */
ip = 1;
i__1 = *n;
for (j = 1;
j <= i__1;
++j)
{
i__2 = j - 1;
cnorm[j] = dzasum_(&i__2, &ap[ip], &c__1);
ip += j;
/* L10: */
}
}
else
{
/* A is lower triangular. */
ip = 1;
i__1 = *n - 1;
for (j = 1;
j <= i__1;
++j)
{
i__2 = *n - j;
cnorm[j] = dzasum_(&i__2, &ap[ip + 1], &c__1);
ip = ip + *n - j + 1;
/* L20: */
}
cnorm[*n] = 0.;
}
}
/* Scale the column norms by TSCAL if the maximum element in CNORM is */
/* greater than BIGNUM/2. */
imax = idamax_(n, &cnorm[1], &c__1);
tmax = cnorm[imax];
if (tmax <= bignum * .5)
{
tscal = 1.;
}
else
{
tscal = .5 / (smlnum * tmax);
dscal_(n, &tscal, &cnorm[1], &c__1);
}
/* Compute a bound on the computed solution vector to see if the */
/* Level 2 BLAS routine ZTPSV can be used. */
xmax = 0.;
i__1 = *n;
for (j = 1;
j <= i__1;
++j)
{
/* Computing MAX */
i__2 = j;
d__3 = xmax;
d__4 = (d__1 = x[i__2].r / 2., abs(d__1)) + (d__2 = d_imag(&x[j]) / 2., abs(d__2)); // , expr subst
xmax = max(d__3,d__4);
/* L30: */
}
xbnd = xmax;
if (notran)
{
/* Compute the growth in A * x = b. */
if (upper)
{
jfirst = *n;
jlast = 1;
jinc = -1;
}
else
{
jfirst = 1;
jlast = *n;
jinc = 1;
}
if (tscal != 1.)
{
grow = 0.;
goto L60;
}
if (nounit)
{
/* A is non-unit triangular. */
/* Compute GROW = 1/G(j) and XBND = 1/M(j). */
/* Initially, G(0) = max{
x(i), i=1,...,n}
. */
grow = .5 / max(xbnd,smlnum);
xbnd = grow;
ip = jfirst * (jfirst + 1) / 2;
jlen = *n;
i__1 = jlast;
i__2 = jinc;
for (j = jfirst;
i__2 < 0 ? j >= i__1 : j <= i__1;
j += i__2)
{
/* Exit the loop if the growth factor is too small. */
if (grow <= smlnum)
{
goto L60;
}
i__3 = ip;
tjjs.r = ap[i__3].r;
tjjs.i = ap[i__3].i; // , expr subst
tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs( d__2));
if (tjj >= smlnum)
{
/* M(j) = G(j-1) / abs(A(j,j)) */
/* Computing MIN */
d__1 = xbnd;
d__2 = min(1.,tjj) * grow; // , expr subst
xbnd = min(d__1,d__2);
}
else
{
/* M(j) could overflow, set XBND to 0. */
xbnd = 0.;
}
if (tjj + cnorm[j] >= smlnum)
{
/* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) ) */
grow *= tjj / (tjj + cnorm[j]);
}
else
{
/* G(j) could overflow, set GROW to 0. */
grow = 0.;
}
ip += jinc * jlen;
--jlen;
/* L40: */
}
grow = xbnd;
}
else
{
/* A is unit triangular. */
/* Compute GROW = 1/G(j), where G(0) = max{
x(i), i=1,...,n}
. */
/* Computing MIN */
d__1 = 1.;
d__2 = .5 / max(xbnd,smlnum); // , expr subst
grow = min(d__1,d__2);
i__2 = jlast;
i__1 = jinc;
for (j = jfirst;
i__1 < 0 ? j >= i__2 : j <= i__2;
j += i__1)
{
/* Exit the loop if the growth factor is too small. */
if (grow <= smlnum)
{
goto L60;
}
/* G(j) = G(j-1)*( 1 + CNORM(j) ) */
grow *= 1. / (cnorm[j] + 1.);
/* L50: */
}
}
L60:
;
}
else
{
/* Compute the growth in A**T * x = b or A**H * x = b. */
if (upper)
{
jfirst = 1;
jlast = *n;
jinc = 1;
}
else
{
jfirst = *n;
jlast = 1;
jinc = -1;
}
if (tscal != 1.)
{
grow = 0.;
goto L90;
}
if (nounit)
{
/* A is non-unit triangular. */
/* Compute GROW = 1/G(j) and XBND = 1/M(j). */
/* Initially, M(0) = max{
x(i), i=1,...,n}
. */
grow = .5 / max(xbnd,smlnum);
xbnd = grow;
ip = jfirst * (jfirst + 1) / 2;
jlen = 1;
i__1 = jlast;
i__2 = jinc;
for (j = jfirst;
i__2 < 0 ? j >= i__1 : j <= i__1;
j += i__2)
{
/* Exit the loop if the growth factor is too small. */
if (grow <= smlnum)
{
goto L90;
}
/* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) ) */
xj = cnorm[j] + 1.;
/* Computing MIN */
d__1 = grow;
d__2 = xbnd / xj; // , expr subst
grow = min(d__1,d__2);
i__3 = ip;
tjjs.r = ap[i__3].r;
tjjs.i = ap[i__3].i; // , expr subst
tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs( d__2));
if (tjj >= smlnum)
{
/* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j)) */
if (xj > tjj)
{
xbnd *= tjj / xj;
}
}
else
{
/* M(j) could overflow, set XBND to 0. */
xbnd = 0.;
}
++jlen;
ip += jinc * jlen;
/* L70: */
}
grow = min(grow,xbnd);
}
else
{
/* A is unit triangular. */
/* Compute GROW = 1/G(j), where G(0) = max{
x(i), i=1,...,n}
. */
/* Computing MIN */
d__1 = 1.;
d__2 = .5 / max(xbnd,smlnum); // , expr subst
grow = min(d__1,d__2);
i__2 = jlast;
i__1 = jinc;
for (j = jfirst;
i__1 < 0 ? j >= i__2 : j <= i__2;
j += i__1)
{
/* Exit the loop if the growth factor is too small. */
if (grow <= smlnum)
{
goto L90;
}
/* G(j) = ( 1 + CNORM(j) )*G(j-1) */
xj = cnorm[j] + 1.;
grow /= xj;
/* L80: */
}
}
L90:
;
}
if (grow * tscal > smlnum)
{
/* Use the Level 2 BLAS solve if the reciprocal of the bound on */
/* elements of X is not too small. */
ztpsv_(uplo, trans, diag, n, &ap[1], &x[1], &c__1);
}
else
{
/* Use a Level 1 BLAS solve, scaling intermediate results. */
if (xmax > bignum * .5)
{
/* Scale X so that its components are less than or equal to */
/* BIGNUM in absolute value. */
*scale = bignum * .5 / xmax;
zdscal_(n, scale, &x[1], &c__1);
xmax = bignum;
}
else
{
xmax *= 2.;
}
if (notran)
{
/* Solve A * x = b */
ip = jfirst * (jfirst + 1) / 2;
i__1 = jlast;
i__2 = jinc;
for (j = jfirst;
i__2 < 0 ? j >= i__1 : j <= i__1;
j += i__2)
{
/* Compute x(j) = b(j) / A(j,j), scaling x if necessary. */
i__3 = j;
xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]), abs(d__2));
if (nounit)
{
i__3 = ip;
z__1.r = tscal * ap[i__3].r;
z__1.i = tscal * ap[i__3].i; // , expr subst
tjjs.r = z__1.r;
tjjs.i = z__1.i; // , expr subst
}
else
{
tjjs.r = tscal;
tjjs.i = 0.; // , expr subst
if (tscal == 1.)
{
goto L110;
}
}
tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs( d__2));
if (tjj > smlnum)
{
/* abs(A(j,j)) > SMLNUM: */
if (tjj < 1.)
{
if (xj > tjj * bignum)
{
/* Scale x by 1/b(j). */
rec = 1. / xj;
zdscal_(n, &rec, &x[1], &c__1);
*scale *= rec;
xmax *= rec;
}
}
i__3 = j;
zladiv_(&z__1, &x[j], &tjjs);
x[i__3].r = z__1.r;
x[i__3].i = z__1.i; // , expr subst
i__3 = j;
xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]) , abs(d__2));
}
else if (tjj > 0.)
{
/* 0 < abs(A(j,j)) <= SMLNUM: */
if (xj > tjj * bignum)
{
/* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM */
/* to avoid overflow when dividing by A(j,j). */
rec = tjj * bignum / xj;
if (cnorm[j] > 1.)
{
/* Scale by 1/CNORM(j) to avoid overflow when */
/* multiplying x(j) times column j. */
rec /= cnorm[j];
}
zdscal_(n, &rec, &x[1], &c__1);
*scale *= rec;
xmax *= rec;
}
i__3 = j;
zladiv_(&z__1, &x[j], &tjjs);
x[i__3].r = z__1.r;
x[i__3].i = z__1.i; // , expr subst
i__3 = j;
xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]) , abs(d__2));
}
else
{
/* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and */
/* scale = 0, and compute a solution to A*x = 0. */
i__3 = *n;
for (i__ = 1;
i__ <= i__3;
++i__)
{
i__4 = i__;
x[i__4].r = 0.;
x[i__4].i = 0.; // , expr subst
/* L100: */
}
i__3 = j;
x[i__3].r = 1.;
x[i__3].i = 0.; // , expr subst
xj = 1.;
*scale = 0.;
xmax = 0.;
}
L110: /* Scale x if necessary to avoid overflow when adding a */
/* multiple of column j of A. */
if (xj > 1.)
{
rec = 1. / xj;
if (cnorm[j] > (bignum - xmax) * rec)
{
/* Scale x by 1/(2*abs(x(j))). */
rec *= .5;
zdscal_(n, &rec, &x[1], &c__1);
*scale *= rec;
}
}
else if (xj * cnorm[j] > bignum - xmax)
{
/* Scale x by 1/2. */
zdscal_(n, &c_b36, &x[1], &c__1);
*scale *= .5;
}
if (upper)
{
if (j > 1)
{
/* Compute the update */
/* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) */
i__3 = j - 1;
i__4 = j;
z__2.r = -x[i__4].r;
z__2.i = -x[i__4].i; // , expr subst
z__1.r = tscal * z__2.r;
z__1.i = tscal * z__2.i; // , expr subst
zaxpy_(&i__3, &z__1, &ap[ip - j + 1], &c__1, &x[1], & c__1);
i__3 = j - 1;
i__ = izamax_(&i__3, &x[1], &c__1);
i__3 = i__;
xmax = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag( &x[i__]), abs(d__2));
}
ip -= j;
}
else
{
if (j < *n)
{
/* Compute the update */
/* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j) */
i__3 = *n - j;
i__4 = j;
z__2.r = -x[i__4].r;
z__2.i = -x[i__4].i; // , expr subst
z__1.r = tscal * z__2.r;
z__1.i = tscal * z__2.i; // , expr subst
zaxpy_(&i__3, &z__1, &ap[ip + 1], &c__1, &x[j + 1], & c__1);
i__3 = *n - j;
i__ = j + izamax_(&i__3, &x[j + 1], &c__1);
i__3 = i__;
xmax = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag( &x[i__]), abs(d__2));
}
ip = ip + *n - j + 1;
}
/* L120: */
}
}
else if (lsame_(trans, "T"))
{
/* Solve A**T * x = b */
ip = jfirst * (jfirst + 1) / 2;
jlen = 1;
i__2 = jlast;
i__1 = jinc;
for (j = jfirst;
i__1 < 0 ? j >= i__2 : j <= i__2;
j += i__1)
{
/* Compute x(j) = b(j) - sum A(k,j)*x(k). */
/* k<>j */
i__3 = j;
xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]), abs(d__2));
uscal.r = tscal;
uscal.i = 0.; // , expr subst
rec = 1. / max(xmax,1.);
if (cnorm[j] > (bignum - xj) * rec)
{
/* If x(j) could overflow, scale x by 1/(2*XMAX). */
rec *= .5;
if (nounit)
{
i__3 = ip;
z__1.r = tscal * ap[i__3].r;
z__1.i = tscal * ap[i__3] .i; // , expr subst
tjjs.r = z__1.r;
tjjs.i = z__1.i; // , expr subst
}
else
{
tjjs.r = tscal;
tjjs.i = 0.; // , expr subst
}
tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs(d__2));
if (tjj > 1.)
{
/* Divide by A(j,j) when scaling x if A(j,j) > 1. */
/* Computing MIN */
d__1 = 1.;
d__2 = rec * tjj; // , expr subst
rec = min(d__1,d__2);
zladiv_(&z__1, &uscal, &tjjs);
uscal.r = z__1.r;
uscal.i = z__1.i; // , expr subst
}
if (rec < 1.)
{
zdscal_(n, &rec, &x[1], &c__1);
*scale *= rec;
xmax *= rec;
}
}
csumj.r = 0.;
csumj.i = 0.; // , expr subst
if (uscal.r == 1. && uscal.i == 0.)
{
/* If the scaling needed for A in the dot product is 1, */
/* call ZDOTU to perform the dot product. */
if (upper)
{
i__3 = j - 1;
zdotu_f2c_(&z__1, &i__3, &ap[ip - j + 1], &c__1, &x[1], & c__1);
csumj.r = z__1.r;
csumj.i = z__1.i; // , expr subst
}
else if (j < *n)
{
i__3 = *n - j;
zdotu_f2c_(&z__1, &i__3, &ap[ip + 1], &c__1, &x[j + 1], & c__1);
csumj.r = z__1.r;
csumj.i = z__1.i; // , expr subst
}
}
else
{
/* Otherwise, use in-line code for the dot product. */
if (upper)
{
i__3 = j - 1;
for (i__ = 1;
i__ <= i__3;
++i__)
{
i__4 = ip - j + i__;
z__3.r = ap[i__4].r * uscal.r - ap[i__4].i * uscal.i;
z__3.i = ap[i__4].r * uscal.i + ap[i__4].i * uscal.r; // , expr subst
i__5 = i__;
z__2.r = z__3.r * x[i__5].r - z__3.i * x[i__5].i;
z__2.i = z__3.r * x[i__5].i + z__3.i * x[ i__5].r; // , expr subst
z__1.r = csumj.r + z__2.r;
z__1.i = csumj.i + z__2.i; // , expr subst
csumj.r = z__1.r;
csumj.i = z__1.i; // , expr subst
/* L130: */
}
}
else if (j < *n)
{
i__3 = *n - j;
for (i__ = 1;
i__ <= i__3;
++i__)
{
i__4 = ip + i__;
z__3.r = ap[i__4].r * uscal.r - ap[i__4].i * uscal.i;
z__3.i = ap[i__4].r * uscal.i + ap[i__4].i * uscal.r; // , expr subst
i__5 = j + i__;
z__2.r = z__3.r * x[i__5].r - z__3.i * x[i__5].i;
z__2.i = z__3.r * x[i__5].i + z__3.i * x[ i__5].r; // , expr subst
z__1.r = csumj.r + z__2.r;
z__1.i = csumj.i + z__2.i; // , expr subst
csumj.r = z__1.r;
csumj.i = z__1.i; // , expr subst
/* L140: */
}
}
}
z__1.r = tscal;
z__1.i = 0.; // , expr subst
if (uscal.r == z__1.r && uscal.i == z__1.i)
{
/* Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j) */
/* was not used to scale the dotproduct. */
i__3 = j;
i__4 = j;
z__1.r = x[i__4].r - csumj.r;
z__1.i = x[i__4].i - csumj.i; // , expr subst
x[i__3].r = z__1.r;
x[i__3].i = z__1.i; // , expr subst
i__3 = j;
xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]) , abs(d__2));
if (nounit)
{
/* Compute x(j) = x(j) / A(j,j), scaling if necessary. */
i__3 = ip;
z__1.r = tscal * ap[i__3].r;
z__1.i = tscal * ap[i__3] .i; // , expr subst
tjjs.r = z__1.r;
tjjs.i = z__1.i; // , expr subst
}
else
{
tjjs.r = tscal;
tjjs.i = 0.; // , expr subst
if (tscal == 1.)
{
goto L160;
}
}
tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs(d__2));
if (tjj > smlnum)
{
/* abs(A(j,j)) > SMLNUM: */
if (tjj < 1.)
{
if (xj > tjj * bignum)
{
/* Scale X by 1/abs(x(j)). */
rec = 1. / xj;
zdscal_(n, &rec, &x[1], &c__1);
*scale *= rec;
xmax *= rec;
}
}
i__3 = j;
zladiv_(&z__1, &x[j], &tjjs);
x[i__3].r = z__1.r;
x[i__3].i = z__1.i; // , expr subst
}
else if (tjj > 0.)
{
/* 0 < abs(A(j,j)) <= SMLNUM: */
if (xj > tjj * bignum)
{
/* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. */
rec = tjj * bignum / xj;
zdscal_(n, &rec, &x[1], &c__1);
*scale *= rec;
xmax *= rec;
}
i__3 = j;
zladiv_(&z__1, &x[j], &tjjs);
x[i__3].r = z__1.r;
x[i__3].i = z__1.i; // , expr subst
}
else
{
/* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and */
/* scale = 0 and compute a solution to A**T *x = 0. */
i__3 = *n;
for (i__ = 1;
i__ <= i__3;
++i__)
{
i__4 = i__;
x[i__4].r = 0.;
x[i__4].i = 0.; // , expr subst
/* L150: */
}
i__3 = j;
x[i__3].r = 1.;
x[i__3].i = 0.; // , expr subst
*scale = 0.;
xmax = 0.;
}
L160:
;
}
else
{
/* Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot */
/* product has already been divided by 1/A(j,j). */
i__3 = j;
zladiv_(&z__2, &x[j], &tjjs);
z__1.r = z__2.r - csumj.r;
z__1.i = z__2.i - csumj.i; // , expr subst
x[i__3].r = z__1.r;
x[i__3].i = z__1.i; // , expr subst
}
/* Computing MAX */
i__3 = j;
d__3 = xmax;
d__4 = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]), abs(d__2)); // , expr subst
xmax = max(d__3,d__4);
++jlen;
ip += jinc * jlen;
/* L170: */
}
}
else
{
/* Solve A**H * x = b */
ip = jfirst * (jfirst + 1) / 2;
jlen = 1;
i__1 = jlast;
i__2 = jinc;
for (j = jfirst;
i__2 < 0 ? j >= i__1 : j <= i__1;
j += i__2)
{
/* Compute x(j) = b(j) - sum A(k,j)*x(k). */
/* k<>j */
i__3 = j;
xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]), abs(d__2));
uscal.r = tscal;
uscal.i = 0.; // , expr subst
rec = 1. / max(xmax,1.);
if (cnorm[j] > (bignum - xj) * rec)
{
/* If x(j) could overflow, scale x by 1/(2*XMAX). */
rec *= .5;
if (nounit)
{
d_cnjg(&z__2, &ap[ip]);
z__1.r = tscal * z__2.r;
z__1.i = tscal * z__2.i; // , expr subst
tjjs.r = z__1.r;
tjjs.i = z__1.i; // , expr subst
}
else
{
tjjs.r = tscal;
tjjs.i = 0.; // , expr subst
}
tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs(d__2));
if (tjj > 1.)
{
/* Divide by A(j,j) when scaling x if A(j,j) > 1. */
/* Computing MIN */
d__1 = 1.;
d__2 = rec * tjj; // , expr subst
rec = min(d__1,d__2);
zladiv_(&z__1, &uscal, &tjjs);
uscal.r = z__1.r;
uscal.i = z__1.i; // , expr subst
}
if (rec < 1.)
{
zdscal_(n, &rec, &x[1], &c__1);
*scale *= rec;
xmax *= rec;
}
}
csumj.r = 0.;
csumj.i = 0.; // , expr subst
if (uscal.r == 1. && uscal.i == 0.)
{
/* If the scaling needed for A in the dot product is 1, */
/* call ZDOTC to perform the dot product. */
if (upper)
{
i__3 = j - 1;
zdotc_f2c_(&z__1, &i__3, &ap[ip - j + 1], &c__1, &x[1], & c__1);
csumj.r = z__1.r;
csumj.i = z__1.i; // , expr subst
}
else if (j < *n)
{
i__3 = *n - j;
zdotc_f2c_(&z__1, &i__3, &ap[ip + 1], &c__1, &x[j + 1], & c__1);
csumj.r = z__1.r;
csumj.i = z__1.i; // , expr subst
}
}
else
{
/* Otherwise, use in-line code for the dot product. */
if (upper)
{
i__3 = j - 1;
for (i__ = 1;
i__ <= i__3;
++i__)
{
d_cnjg(&z__4, &ap[ip - j + i__]);
z__3.r = z__4.r * uscal.r - z__4.i * uscal.i;
z__3.i = z__4.r * uscal.i + z__4.i * uscal.r; // , expr subst
i__4 = i__;
z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i;
z__2.i = z__3.r * x[i__4].i + z__3.i * x[ i__4].r; // , expr subst
z__1.r = csumj.r + z__2.r;
z__1.i = csumj.i + z__2.i; // , expr subst
csumj.r = z__1.r;
csumj.i = z__1.i; // , expr subst
/* L180: */
}
}
else if (j < *n)
{
i__3 = *n - j;
for (i__ = 1;
i__ <= i__3;
++i__)
{
d_cnjg(&z__4, &ap[ip + i__]);
z__3.r = z__4.r * uscal.r - z__4.i * uscal.i;
z__3.i = z__4.r * uscal.i + z__4.i * uscal.r; // , expr subst
i__4 = j + i__;
z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i;
z__2.i = z__3.r * x[i__4].i + z__3.i * x[ i__4].r; // , expr subst
z__1.r = csumj.r + z__2.r;
z__1.i = csumj.i + z__2.i; // , expr subst
csumj.r = z__1.r;
csumj.i = z__1.i; // , expr subst
/* L190: */
}
}
}
z__1.r = tscal;
z__1.i = 0.; // , expr subst
if (uscal.r == z__1.r && uscal.i == z__1.i)
{
/* Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j) */
/* was not used to scale the dotproduct. */
i__3 = j;
i__4 = j;
z__1.r = x[i__4].r - csumj.r;
z__1.i = x[i__4].i - csumj.i; // , expr subst
x[i__3].r = z__1.r;
x[i__3].i = z__1.i; // , expr subst
i__3 = j;
xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]) , abs(d__2));
if (nounit)
{
/* Compute x(j) = x(j) / A(j,j), scaling if necessary. */
d_cnjg(&z__2, &ap[ip]);
z__1.r = tscal * z__2.r;
z__1.i = tscal * z__2.i; // , expr subst
tjjs.r = z__1.r;
tjjs.i = z__1.i; // , expr subst
}
else
{
tjjs.r = tscal;
tjjs.i = 0.; // , expr subst
if (tscal == 1.)
{
goto L210;
}
}
tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs(d__2));
if (tjj > smlnum)
{
/* abs(A(j,j)) > SMLNUM: */
if (tjj < 1.)
{
if (xj > tjj * bignum)
{
/* Scale X by 1/abs(x(j)). */
rec = 1. / xj;
zdscal_(n, &rec, &x[1], &c__1);
*scale *= rec;
xmax *= rec;
}
}
i__3 = j;
zladiv_(&z__1, &x[j], &tjjs);
x[i__3].r = z__1.r;
x[i__3].i = z__1.i; // , expr subst
}
else if (tjj > 0.)
{
/* 0 < abs(A(j,j)) <= SMLNUM: */
if (xj > tjj * bignum)
{
/* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. */
rec = tjj * bignum / xj;
zdscal_(n, &rec, &x[1], &c__1);
*scale *= rec;
xmax *= rec;
}
i__3 = j;
zladiv_(&z__1, &x[j], &tjjs);
x[i__3].r = z__1.r;
x[i__3].i = z__1.i; // , expr subst
}
else
{
/* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and */
/* scale = 0 and compute a solution to A**H *x = 0. */
i__3 = *n;
for (i__ = 1;
i__ <= i__3;
++i__)
{
i__4 = i__;
x[i__4].r = 0.;
x[i__4].i = 0.; // , expr subst
/* L200: */
}
i__3 = j;
x[i__3].r = 1.;
x[i__3].i = 0.; // , expr subst
*scale = 0.;
xmax = 0.;
}
L210:
;
}
else
{
/* Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot */
/* product has already been divided by 1/A(j,j). */
i__3 = j;
zladiv_(&z__2, &x[j], &tjjs);
z__1.r = z__2.r - csumj.r;
z__1.i = z__2.i - csumj.i; // , expr subst
x[i__3].r = z__1.r;
x[i__3].i = z__1.i; // , expr subst
}
/* Computing MAX */
i__3 = j;
d__3 = xmax;
d__4 = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]), abs(d__2)); // , expr subst
xmax = max(d__3,d__4);
++jlen;
ip += jinc * jlen;
/* L220: */
}
}
*scale /= tscal;
}
/* Scale the column norms by 1/TSCAL for return. */
if (tscal != 1.)
{
d__1 = 1. / tscal;
dscal_(n, &d__1, &cnorm[1], &c__1);
}
return 0;
/* End of ZLATPS */
}
/* Subroutine */
int zsptri_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, doublecomplex *work, integer *info)
{
/* System generated locals */
integer i__1, i__2, i__3;
doublecomplex z__1, z__2, z__3;
/* Builtin functions */
void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
/* Local variables */
doublecomplex d__;
integer j, k;
doublecomplex t, ak;
integer kc, kp, kx, kpc, npp;
doublecomplex akp1, temp, akkp1;
extern logical lsame_(char *, char *);
integer kstep;
logical upper;
extern /* Subroutine */
int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *);
extern /* Double Complex */
VOID zdotu_f2c_(doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *);
extern /* Subroutine */
int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zspmv_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_( char *, integer *);
integer kcnext;
/* -- LAPACK computational routine (version 3.4.0) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* November 2011 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
--work;
--ipiv;
--ap;
/* Function Body */
*info = 0;
upper = lsame_(uplo, "U");
if (! upper && ! lsame_(uplo, "L"))
{
*info = -1;
}
else if (*n < 0)
{
*info = -2;
}
if (*info != 0)
{
i__1 = -(*info);
xerbla_("ZSPTRI", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0)
{
return 0;
}
/* Check that the diagonal matrix D is nonsingular. */
if (upper)
{
/* Upper triangular storage: examine D from bottom to top */
kp = *n * (*n + 1) / 2;
for (*info = *n;
*info >= 1;
--(*info))
{
i__1 = kp;
if (ipiv[*info] > 0 && (ap[i__1].r == 0. && ap[i__1].i == 0.))
{
return 0;
}
kp -= *info;
/* L10: */
}
}
else
{
/* Lower triangular storage: examine D from top to bottom. */
kp = 1;
i__1 = *n;
for (*info = 1;
*info <= i__1;
++(*info))
{
i__2 = kp;
if (ipiv[*info] > 0 && (ap[i__2].r == 0. && ap[i__2].i == 0.))
{
return 0;
}
kp = kp + *n - *info + 1;
/* L20: */
}
}
*info = 0;
if (upper)
{
/* Compute inv(A) from the factorization A = U*D*U**T. */
/* K is the main loop index, increasing from 1 to N in steps of */
/* 1 or 2, depending on the size of the diagonal blocks. */
k = 1;
kc = 1;
L30: /* If K > N, exit from loop. */
if (k > *n)
{
goto L50;
}
kcnext = kc + k;
if (ipiv[k] > 0)
{
/* 1 x 1 diagonal block */
/* Invert the diagonal block. */
i__1 = kc + k - 1;
z_div(&z__1, &c_b1, &ap[kc + k - 1]);
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
/* Compute column K of the inverse. */
if (k > 1)
{
i__1 = k - 1;
zcopy_(&i__1, &ap[kc], &c__1, &work[1], &c__1);
i__1 = k - 1;
z__1.r = -1.;
z__1.i = -0.; // , expr subst
zspmv_(uplo, &i__1, &z__1, &ap[1], &work[1], &c__1, &c_b2, & ap[kc], &c__1);
i__1 = kc + k - 1;
i__2 = kc + k - 1;
i__3 = k - 1;
zdotu_f2c_(&z__2, &i__3, &work[1], &c__1, &ap[kc], &c__1);
z__1.r = ap[i__2].r - z__2.r;
z__1.i = ap[i__2].i - z__2.i; // , expr subst
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
}
kstep = 1;
}
else
{
/* 2 x 2 diagonal block */
/* Invert the diagonal block. */
i__1 = kcnext + k - 1;
t.r = ap[i__1].r;
t.i = ap[i__1].i; // , expr subst
z_div(&z__1, &ap[kc + k - 1], &t);
ak.r = z__1.r;
ak.i = z__1.i; // , expr subst
z_div(&z__1, &ap[kcnext + k], &t);
akp1.r = z__1.r;
akp1.i = z__1.i; // , expr subst
z_div(&z__1, &ap[kcnext + k - 1], &t);
akkp1.r = z__1.r;
akkp1.i = z__1.i; // , expr subst
z__3.r = ak.r * akp1.r - ak.i * akp1.i;
z__3.i = ak.r * akp1.i + ak.i * akp1.r; // , expr subst
z__2.r = z__3.r - 1.;
z__2.i = z__3.i - 0.; // , expr subst
z__1.r = t.r * z__2.r - t.i * z__2.i;
z__1.i = t.r * z__2.i + t.i * z__2.r; // , expr subst
d__.r = z__1.r;
d__.i = z__1.i; // , expr subst
i__1 = kc + k - 1;
z_div(&z__1, &akp1, &d__);
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
i__1 = kcnext + k;
z_div(&z__1, &ak, &d__);
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
i__1 = kcnext + k - 1;
z__2.r = -akkp1.r;
z__2.i = -akkp1.i; // , expr subst
z_div(&z__1, &z__2, &d__);
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
/* Compute columns K and K+1 of the inverse. */
if (k > 1)
{
i__1 = k - 1;
zcopy_(&i__1, &ap[kc], &c__1, &work[1], &c__1);
i__1 = k - 1;
z__1.r = -1.;
z__1.i = -0.; // , expr subst
zspmv_(uplo, &i__1, &z__1, &ap[1], &work[1], &c__1, &c_b2, & ap[kc], &c__1);
i__1 = kc + k - 1;
i__2 = kc + k - 1;
i__3 = k - 1;
zdotu_f2c_(&z__2, &i__3, &work[1], &c__1, &ap[kc], &c__1);
z__1.r = ap[i__2].r - z__2.r;
z__1.i = ap[i__2].i - z__2.i; // , expr subst
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
i__1 = kcnext + k - 1;
i__2 = kcnext + k - 1;
i__3 = k - 1;
zdotu_f2c_(&z__2, &i__3, &ap[kc], &c__1, &ap[kcnext], &c__1);
z__1.r = ap[i__2].r - z__2.r;
z__1.i = ap[i__2].i - z__2.i; // , expr subst
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
i__1 = k - 1;
zcopy_(&i__1, &ap[kcnext], &c__1, &work[1], &c__1);
i__1 = k - 1;
z__1.r = -1.;
z__1.i = -0.; // , expr subst
zspmv_(uplo, &i__1, &z__1, &ap[1], &work[1], &c__1, &c_b2, & ap[kcnext], &c__1);
i__1 = kcnext + k;
i__2 = kcnext + k;
i__3 = k - 1;
zdotu_f2c_(&z__2, &i__3, &work[1], &c__1, &ap[kcnext], &c__1);
z__1.r = ap[i__2].r - z__2.r;
z__1.i = ap[i__2].i - z__2.i; // , expr subst
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
}
kstep = 2;
kcnext = kcnext + k + 1;
}
kp = (i__1 = ipiv[k], f2c_abs(i__1));
if (kp != k)
{
/* Interchange rows and columns K and KP in the leading */
/* submatrix A(1:k+1,1:k+1) */
kpc = (kp - 1) * kp / 2 + 1;
i__1 = kp - 1;
zswap_(&i__1, &ap[kc], &c__1, &ap[kpc], &c__1);
kx = kpc + kp - 1;
i__1 = k - 1;
for (j = kp + 1;
j <= i__1;
++j)
{
kx = kx + j - 1;
i__2 = kc + j - 1;
temp.r = ap[i__2].r;
temp.i = ap[i__2].i; // , expr subst
i__2 = kc + j - 1;
i__3 = kx;
ap[i__2].r = ap[i__3].r;
ap[i__2].i = ap[i__3].i; // , expr subst
i__2 = kx;
ap[i__2].r = temp.r;
ap[i__2].i = temp.i; // , expr subst
/* L40: */
}
i__1 = kc + k - 1;
temp.r = ap[i__1].r;
temp.i = ap[i__1].i; // , expr subst
i__1 = kc + k - 1;
i__2 = kpc + kp - 1;
ap[i__1].r = ap[i__2].r;
ap[i__1].i = ap[i__2].i; // , expr subst
i__1 = kpc + kp - 1;
ap[i__1].r = temp.r;
ap[i__1].i = temp.i; // , expr subst
if (kstep == 2)
{
i__1 = kc + k + k - 1;
temp.r = ap[i__1].r;
temp.i = ap[i__1].i; // , expr subst
i__1 = kc + k + k - 1;
i__2 = kc + k + kp - 1;
ap[i__1].r = ap[i__2].r;
ap[i__1].i = ap[i__2].i; // , expr subst
i__1 = kc + k + kp - 1;
ap[i__1].r = temp.r;
ap[i__1].i = temp.i; // , expr subst
}
}
k += kstep;
kc = kcnext;
goto L30;
L50:
;
}
else
{
/* Compute inv(A) from the factorization A = L*D*L**T. */
/* K is the main loop index, increasing from 1 to N in steps of */
/* 1 or 2, depending on the size of the diagonal blocks. */
npp = *n * (*n + 1) / 2;
k = *n;
kc = npp;
L60: /* If K < 1, exit from loop. */
if (k < 1)
{
goto L80;
}
kcnext = kc - (*n - k + 2);
if (ipiv[k] > 0)
{
/* 1 x 1 diagonal block */
/* Invert the diagonal block. */
i__1 = kc;
z_div(&z__1, &c_b1, &ap[kc]);
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
/* Compute column K of the inverse. */
if (k < *n)
{
i__1 = *n - k;
zcopy_(&i__1, &ap[kc + 1], &c__1, &work[1], &c__1);
i__1 = *n - k;
z__1.r = -1.;
z__1.i = -0.; // , expr subst
zspmv_(uplo, &i__1, &z__1, &ap[kc + *n - k + 1], &work[1], & c__1, &c_b2, &ap[kc + 1], &c__1);
i__1 = kc;
i__2 = kc;
i__3 = *n - k;
zdotu_f2c_(&z__2, &i__3, &work[1], &c__1, &ap[kc + 1], &c__1);
z__1.r = ap[i__2].r - z__2.r;
z__1.i = ap[i__2].i - z__2.i; // , expr subst
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
}
kstep = 1;
}
else
{
/* 2 x 2 diagonal block */
/* Invert the diagonal block. */
i__1 = kcnext + 1;
t.r = ap[i__1].r;
t.i = ap[i__1].i; // , expr subst
z_div(&z__1, &ap[kcnext], &t);
ak.r = z__1.r;
ak.i = z__1.i; // , expr subst
z_div(&z__1, &ap[kc], &t);
akp1.r = z__1.r;
akp1.i = z__1.i; // , expr subst
z_div(&z__1, &ap[kcnext + 1], &t);
akkp1.r = z__1.r;
akkp1.i = z__1.i; // , expr subst
z__3.r = ak.r * akp1.r - ak.i * akp1.i;
z__3.i = ak.r * akp1.i + ak.i * akp1.r; // , expr subst
z__2.r = z__3.r - 1.;
z__2.i = z__3.i - 0.; // , expr subst
z__1.r = t.r * z__2.r - t.i * z__2.i;
z__1.i = t.r * z__2.i + t.i * z__2.r; // , expr subst
d__.r = z__1.r;
d__.i = z__1.i; // , expr subst
i__1 = kcnext;
z_div(&z__1, &akp1, &d__);
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
i__1 = kc;
z_div(&z__1, &ak, &d__);
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
i__1 = kcnext + 1;
z__2.r = -akkp1.r;
z__2.i = -akkp1.i; // , expr subst
z_div(&z__1, &z__2, &d__);
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
/* Compute columns K-1 and K of the inverse. */
if (k < *n)
{
i__1 = *n - k;
zcopy_(&i__1, &ap[kc + 1], &c__1, &work[1], &c__1);
i__1 = *n - k;
z__1.r = -1.;
z__1.i = -0.; // , expr subst
zspmv_(uplo, &i__1, &z__1, &ap[kc + (*n - k + 1)], &work[1], & c__1, &c_b2, &ap[kc + 1], &c__1);
i__1 = kc;
i__2 = kc;
i__3 = *n - k;
zdotu_f2c_(&z__2, &i__3, &work[1], &c__1, &ap[kc + 1], &c__1);
z__1.r = ap[i__2].r - z__2.r;
z__1.i = ap[i__2].i - z__2.i; // , expr subst
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
i__1 = kcnext + 1;
i__2 = kcnext + 1;
i__3 = *n - k;
zdotu_f2c_(&z__2, &i__3, &ap[kc + 1], &c__1, &ap[kcnext + 2], & c__1);
z__1.r = ap[i__2].r - z__2.r;
z__1.i = ap[i__2].i - z__2.i; // , expr subst
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
i__1 = *n - k;
zcopy_(&i__1, &ap[kcnext + 2], &c__1, &work[1], &c__1);
i__1 = *n - k;
z__1.r = -1.;
z__1.i = -0.; // , expr subst
zspmv_(uplo, &i__1, &z__1, &ap[kc + (*n - k + 1)], &work[1], & c__1, &c_b2, &ap[kcnext + 2], &c__1);
i__1 = kcnext;
i__2 = kcnext;
i__3 = *n - k;
zdotu_f2c_(&z__2, &i__3, &work[1], &c__1, &ap[kcnext + 2], &c__1);
z__1.r = ap[i__2].r - z__2.r;
z__1.i = ap[i__2].i - z__2.i; // , expr subst
ap[i__1].r = z__1.r;
ap[i__1].i = z__1.i; // , expr subst
}
kstep = 2;
kcnext -= *n - k + 3;
}
kp = (i__1 = ipiv[k], f2c_abs(i__1));
if (kp != k)
{
/* Interchange rows and columns K and KP in the trailing */
/* submatrix A(k-1:n,k-1:n) */
kpc = npp - (*n - kp + 1) * (*n - kp + 2) / 2 + 1;
if (kp < *n)
{
i__1 = *n - kp;
zswap_(&i__1, &ap[kc + kp - k + 1], &c__1, &ap[kpc + 1], & c__1);
}
kx = kc + kp - k;
i__1 = kp - 1;
for (j = k + 1;
j <= i__1;
++j)
{
kx = kx + *n - j + 1;
i__2 = kc + j - k;
temp.r = ap[i__2].r;
temp.i = ap[i__2].i; // , expr subst
i__2 = kc + j - k;
i__3 = kx;
ap[i__2].r = ap[i__3].r;
ap[i__2].i = ap[i__3].i; // , expr subst
i__2 = kx;
ap[i__2].r = temp.r;
ap[i__2].i = temp.i; // , expr subst
/* L70: */
}
i__1 = kc;
temp.r = ap[i__1].r;
temp.i = ap[i__1].i; // , expr subst
i__1 = kc;
i__2 = kpc;
ap[i__1].r = ap[i__2].r;
ap[i__1].i = ap[i__2].i; // , expr subst
i__1 = kpc;
ap[i__1].r = temp.r;
ap[i__1].i = temp.i; // , expr subst
if (kstep == 2)
{
i__1 = kc - *n + k - 1;
temp.r = ap[i__1].r;
temp.i = ap[i__1].i; // , expr subst
i__1 = kc - *n + k - 1;
i__2 = kc - *n + kp - 1;
ap[i__1].r = ap[i__2].r;
ap[i__1].i = ap[i__2].i; // , expr subst
i__1 = kc - *n + kp - 1;
ap[i__1].r = temp.r;
ap[i__1].i = temp.i; // , expr subst
}
}
k -= kstep;
kc = kcnext;
goto L60;
L80:
;
}
return 0;
/* End of ZSPTRI */
}