int
f2c_sspr2(char* uplo, integer* N,
real* alpha,
real* X, integer* incX,
real* Y, integer* incY,
real* A)
{
sspr2_(uplo, N, alpha,
X, incX, Y, incY, A);
return 0;
}
/* Subroutine */ int sspgst_(integer *itype, char *uplo, integer *n, real *ap,
real *bp, integer *info)
{
/* System generated locals */
integer i__1, i__2;
real r__1;
/* Local variables */
integer j, k, j1, k1, jj, kk;
real ct, ajj;
integer j1j1;
real akk;
integer k1k1;
real bjj, bkk;
extern doublereal sdot_(integer *, real *, integer *, real *, integer *);
extern /* Subroutine */ int sspr2_(char *, integer *, real *, real *,
integer *, real *, integer *, real *);
extern logical lsame_(char *, char *);
extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *);
logical upper;
extern /* Subroutine */ int saxpy_(integer *, real *, real *, integer *,
real *, integer *), sspmv_(char *, integer *, real *, real *,
real *, integer *, real *, real *, integer *), stpmv_(
char *, char *, char *, integer *, real *, real *, integer *), stpsv_(char *, char *, char *, integer *,
real *, real *, integer *), xerbla_(char
*, integer *);
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SSPGST reduces a real symmetric-definite generalized eigenproblem */
/* to standard form, using packed storage. */
/* If ITYPE = 1, the problem is A*x = lambda*B*x, */
/* and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) */
/* If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or */
/* B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L. */
/* B must have been previously factorized as U**T*U or L*L**T by SPPTRF. */
/* Arguments */
/* ========= */
/* ITYPE (input) INTEGER */
/* = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T); */
/* = 2 or 3: compute U*A*U**T or L**T*A*L. */
/* UPLO (input) CHARACTER*1 */
/* = 'U': Upper triangle of A is stored and B is factored as */
/* U**T*U; */
/* = 'L': Lower triangle of A is stored and B is factored as */
/* L*L**T. */
/* N (input) INTEGER */
/* The order of the matrices A and B. N >= 0. */
/* AP (input/output) REAL array, dimension (N*(N+1)/2) */
/* On entry, 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)*(2n-j)/2) = A(i,j) for j<=i<=n. */
/* On exit, if INFO = 0, the transformed matrix, stored in the */
/* same format as A. */
/* BP (input) REAL array, dimension (N*(N+1)/2) */
/* The triangular factor from the Cholesky factorization of B, */
/* stored in the same format as A, as returned by SPPTRF. */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -i, the i-th argument had an illegal value */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
--bp;
--ap;
/* Function Body */
*info = 0;
upper = lsame_(uplo, "U");
if (*itype < 1 || *itype > 3) {
*info = -1;
} else if (! upper && ! lsame_(uplo, "L")) {
*info = -2;
} else if (*n < 0) {
*info = -3;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("SSPGST", &i__1);
return 0;
}
if (*itype == 1) {
if (upper) {
/* Compute inv(U')*A*inv(U) */
/* J1 and JJ are the indices of A(1,j) and A(j,j) */
jj = 0;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
j1 = jj + 1;
jj += j;
/* Compute the j-th column of the upper triangle of A */
bjj = bp[jj];
stpsv_(uplo, "Transpose", "Nonunit", &j, &bp[1], &ap[j1], &
c__1);
i__2 = j - 1;
sspmv_(uplo, &i__2, &c_b9, &ap[1], &bp[j1], &c__1, &c_b11, &
ap[j1], &c__1);
i__2 = j - 1;
r__1 = 1.f / bjj;
sscal_(&i__2, &r__1, &ap[j1], &c__1);
i__2 = j - 1;
ap[jj] = (ap[jj] - sdot_(&i__2, &ap[j1], &c__1, &bp[j1], &
c__1)) / bjj;
/* L10: */
}
} else {
/* Compute inv(L)*A*inv(L') */
/* KK and K1K1 are the indices of A(k,k) and A(k+1,k+1) */
kk = 1;
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
k1k1 = kk + *n - k + 1;
/* Update the lower triangle of A(k:n,k:n) */
akk = ap[kk];
bkk = bp[kk];
/* Computing 2nd power */
r__1 = bkk;
akk /= r__1 * r__1;
ap[kk] = akk;
if (k < *n) {
i__2 = *n - k;
r__1 = 1.f / bkk;
sscal_(&i__2, &r__1, &ap[kk + 1], &c__1);
ct = akk * -.5f;
i__2 = *n - k;
saxpy_(&i__2, &ct, &bp[kk + 1], &c__1, &ap[kk + 1], &c__1)
;
i__2 = *n - k;
sspr2_(uplo, &i__2, &c_b9, &ap[kk + 1], &c__1, &bp[kk + 1]
, &c__1, &ap[k1k1]);
i__2 = *n - k;
saxpy_(&i__2, &ct, &bp[kk + 1], &c__1, &ap[kk + 1], &c__1)
;
i__2 = *n - k;
stpsv_(uplo, "No transpose", "Non-unit", &i__2, &bp[k1k1],
&ap[kk + 1], &c__1);
}
kk = k1k1;
/* L20: */
}
}
} else {
if (upper) {
/* Compute U*A*U' */
/* K1 and KK are the indices of A(1,k) and A(k,k) */
kk = 0;
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
k1 = kk + 1;
kk += k;
/* Update the upper triangle of A(1:k,1:k) */
akk = ap[kk];
bkk = bp[kk];
i__2 = k - 1;
stpmv_(uplo, "No transpose", "Non-unit", &i__2, &bp[1], &ap[
k1], &c__1);
ct = akk * .5f;
i__2 = k - 1;
saxpy_(&i__2, &ct, &bp[k1], &c__1, &ap[k1], &c__1);
i__2 = k - 1;
sspr2_(uplo, &i__2, &c_b11, &ap[k1], &c__1, &bp[k1], &c__1, &
ap[1]);
i__2 = k - 1;
saxpy_(&i__2, &ct, &bp[k1], &c__1, &ap[k1], &c__1);
i__2 = k - 1;
sscal_(&i__2, &bkk, &ap[k1], &c__1);
/* Computing 2nd power */
r__1 = bkk;
ap[kk] = akk * (r__1 * r__1);
/* L30: */
}
} else {
/* Compute L'*A*L */
/* JJ and J1J1 are the indices of A(j,j) and A(j+1,j+1) */
jj = 1;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
j1j1 = jj + *n - j + 1;
/* Compute the j-th column of the lower triangle of A */
ajj = ap[jj];
bjj = bp[jj];
i__2 = *n - j;
ap[jj] = ajj * bjj + sdot_(&i__2, &ap[jj + 1], &c__1, &bp[jj
+ 1], &c__1);
i__2 = *n - j;
sscal_(&i__2, &bjj, &ap[jj + 1], &c__1);
i__2 = *n - j;
sspmv_(uplo, &i__2, &c_b11, &ap[j1j1], &bp[jj + 1], &c__1, &
c_b11, &ap[jj + 1], &c__1);
i__2 = *n - j + 1;
stpmv_(uplo, "Transpose", "Non-unit", &i__2, &bp[jj], &ap[jj],
&c__1);
jj = j1j1;
/* L40: */
}
}
}
return 0;
/* End of SSPGST */
} /* sspgst_ */
void
sspr2(char uplo, int n, float alpha, float *x, int incx, float *y, int incy, float *a )
{
sspr2_( &uplo, &n, &alpha, x, &incx, y, &incy, a );
}
/* Subroutine */ int ssbt21_(char *uplo, integer *n, integer *ka, integer *ks,
real *a, integer *lda, real *d__, real *e, real *u, integer *ldu,
real *work, real *result)
{
/* System generated locals */
integer a_dim1, a_offset, u_dim1, u_offset, i__1, i__2, i__3, i__4;
real r__1, r__2;
/* Local variables */
integer j, jc, jr, lw, ika;
real ulp, unfl;
extern /* Subroutine */ int sspr_(char *, integer *, real *, real *,
integer *, real *), sspr2_(char *, integer *, real *,
real *, integer *, real *, integer *, real *);
extern /* Subroutine */ int sgemm_(char *, char *, integer *, integer *,
integer *, real *, real *, integer *, real *, integer *, real *,
real *, integer *);
real anorm;
char cuplo[1];
logical lower;
real wnorm;
extern doublereal slamch_(char *), slange_(char *, integer *,
integer *, real *, integer *, real *), slansb_(char *,
char *, integer *, integer *, real *, integer *, real *), slansp_(char *, char *, integer *, real *, real *);
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SSBT21 generally checks a decomposition of the form */
/* A = U S U' */
/* where ' means transpose, A is symmetric banded, U is */
/* orthogonal, and S is diagonal (if KS=0) or symmetric */
/* tridiagonal (if KS=1). */
/* Specifically: */
/* RESULT(1) = | A - U S U' | / ( |A| n ulp ) *and* */
/* RESULT(2) = | I - UU' | / ( n ulp ) */
/* Arguments */
/* ========= */
/* UPLO (input) CHARACTER */
/* If UPLO='U', the upper triangle of A and V will be used and */
/* the (strictly) lower triangle will not be referenced. */
/* If UPLO='L', the lower triangle of A and V will be used and */
/* the (strictly) upper triangle will not be referenced. */
/* N (input) INTEGER */
/* The size of the matrix. If it is zero, SSBT21 does nothing. */
/* It must be at least zero. */
/* KA (input) INTEGER */
/* The bandwidth of the matrix A. It must be at least zero. If */
/* it is larger than N-1, then max( 0, N-1 ) will be used. */
/* KS (input) INTEGER */
/* The bandwidth of the matrix S. It may only be zero or one. */
/* If zero, then S is diagonal, and E is not referenced. If */
/* one, then S is symmetric tri-diagonal. */
/* A (input) REAL array, dimension (LDA, N) */
/* The original (unfactored) matrix. It is assumed to be */
/* symmetric, and only the upper (UPLO='U') or only the lower */
/* (UPLO='L') will be referenced. */
/* LDA (input) INTEGER */
/* The leading dimension of A. It must be at least 1 */
/* and at least min( KA, N-1 ). */
/* D (input) REAL array, dimension (N) */
/* The diagonal of the (symmetric tri-) diagonal matrix S. */
/* E (input) REAL array, dimension (N-1) */
/* The off-diagonal of the (symmetric tri-) diagonal matrix S. */
/* E(1) is the (1,2) and (2,1) element, E(2) is the (2,3) and */
/* (3,2) element, etc. */
/* Not referenced if KS=0. */
/* U (input) REAL array, dimension (LDU, N) */
/* The orthogonal matrix in the decomposition, expressed as a */
/* dense matrix (i.e., not as a product of Householder */
/* transformations, Givens transformations, etc.) */
/* LDU (input) INTEGER */
/* The leading dimension of U. LDU must be at least N and */
/* at least 1. */
/* WORK (workspace) REAL array, dimension (N**2+N) */
/* RESULT (output) REAL array, dimension (2) */
/* The values computed by the two tests described above. The */
/* values are currently limited to 1/ulp, to avoid overflow. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Constants */
/* Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--d__;
--e;
u_dim1 = *ldu;
u_offset = 1 + u_dim1;
u -= u_offset;
--work;
--result;
/* Function Body */
result[1] = 0.f;
result[2] = 0.f;
if (*n <= 0) {
return 0;
}
/* Computing MAX */
/* Computing MIN */
i__3 = *n - 1;
i__1 = 0, i__2 = min(i__3,*ka);
ika = max(i__1,i__2);
lw = *n * (*n + 1) / 2;
if (lsame_(uplo, "U")) {
lower = FALSE_;
*(unsigned char *)cuplo = 'U';
} else {
lower = TRUE_;
*(unsigned char *)cuplo = 'L';
}
unfl = slamch_("Safe minimum");
ulp = slamch_("Epsilon") * slamch_("Base");
/* Some Error Checks */
/* Do Test 1 */
/* Norm of A: */
/* Computing MAX */
r__1 = slansb_("1", cuplo, n, &ika, &a[a_offset], lda, &work[1]);
anorm = dmax(r__1,unfl);
/* Compute error matrix: Error = A - U S U' */
/* Copy A from SB to SP storage format. */
j = 0;
i__1 = *n;
for (jc = 1; jc <= i__1; ++jc) {
if (lower) {
/* Computing MIN */
i__3 = ika + 1, i__4 = *n + 1 - jc;
i__2 = min(i__3,i__4);
for (jr = 1; jr <= i__2; ++jr) {
++j;
work[j] = a[jr + jc * a_dim1];
/* L10: */
}
i__2 = *n + 1 - jc;
for (jr = ika + 2; jr <= i__2; ++jr) {
++j;
work[j] = 0.f;
/* L20: */
}
} else {
i__2 = jc;
for (jr = ika + 2; jr <= i__2; ++jr) {
++j;
work[j] = 0.f;
/* L30: */
}
/* Computing MIN */
i__2 = ika, i__3 = jc - 1;
for (jr = min(i__2,i__3); jr >= 0; --jr) {
++j;
work[j] = a[ika + 1 - jr + jc * a_dim1];
/* L40: */
}
}
/* L50: */
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
r__1 = -d__[j];
sspr_(cuplo, n, &r__1, &u[j * u_dim1 + 1], &c__1, &work[1])
;
/* L60: */
}
if (*n > 1 && *ks == 1) {
i__1 = *n - 1;
for (j = 1; j <= i__1; ++j) {
r__1 = -e[j];
sspr2_(cuplo, n, &r__1, &u[j * u_dim1 + 1], &c__1, &u[(j + 1) *
u_dim1 + 1], &c__1, &work[1]);
/* L70: */
}
}
wnorm = slansp_("1", cuplo, n, &work[1], &work[lw + 1]);
if (anorm > wnorm) {
result[1] = wnorm / anorm / (*n * ulp);
} else {
if (anorm < 1.f) {
/* Computing MIN */
r__1 = wnorm, r__2 = *n * anorm;
result[1] = dmin(r__1,r__2) / anorm / (*n * ulp);
} else {
/* Computing MIN */
r__1 = wnorm / anorm, r__2 = (real) (*n);
result[1] = dmin(r__1,r__2) / (*n * ulp);
}
}
/* Do Test 2 */
/* Compute UU' - I */
sgemm_("N", "C", n, n, n, &c_b22, &u[u_offset], ldu, &u[u_offset], ldu, &
c_b23, &work[1], n);
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
work[(*n + 1) * (j - 1) + 1] += -1.f;
/* L80: */
}
/* Computing MIN */
/* Computing 2nd power */
i__1 = *n;
r__1 = slange_("1", n, n, &work[1], n, &work[i__1 * i__1 + 1]),
r__2 = (real) (*n);
result[2] = dmin(r__1,r__2) / (*n * ulp);
return 0;
/* End of SSBT21 */
} /* ssbt21_ */
/* Subroutine */ int ssptrd_(char *uplo, integer *n, real *ap, real *d, real *
e, real *tau, integer *info)
{
/* -- LAPACK routine (version 2.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
March 31, 1993
Purpose
=======
SSPTRD reduces a real symmetric matrix A stored in packed form to
symmetric tridiagonal form T by an orthogonal similarity
transformation: Q**T * A * Q = T.
Arguments
=========
UPLO (input) CHARACTER*1
= 'U': Upper triangle of A is stored;
= 'L': Lower triangle of A is stored.
N (input) INTEGER
The order of the matrix A. N >= 0.
AP (input/output) REAL array, dimension (N*(N+1)/2)
On entry, 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.
On exit, if UPLO = 'U', the diagonal and first superdiagonal
of A are overwritten by the corresponding elements of the
tridiagonal matrix T, and the elements above the first
superdiagonal, with the array TAU, represent the orthogonal
matrix Q as a product of elementary reflectors; if UPLO
= 'L', the diagonal and first subdiagonal of A are over-
written by the corresponding elements of the tridiagonal
matrix T, and the elements below the first subdiagonal, with
the array TAU, represent the orthogonal matrix Q as a product
of elementary reflectors. See Further Details.
D (output) REAL array, dimension (N)
The diagonal elements of the tridiagonal matrix T:
D(i) = A(i,i).
E (output) REAL array, dimension (N-1)
The off-diagonal elements of the tridiagonal matrix T:
E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
TAU (output) REAL array, dimension (N-1)
The scalar factors of the elementary reflectors (see Further
Details).
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
Further Details
===============
If UPLO = 'U', the matrix Q is represented as a product of elementary
reflectors
Q = H(n-1) . . . H(2) H(1).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a real scalar, and v is a real vector with
v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP,
overwriting A(1:i-1,i+1), and tau is stored in TAU(i).
If UPLO = 'L', the matrix Q is represented as a product of elementary
reflectors
Q = H(1) H(2) . . . H(n-1).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a real scalar, and v is a real vector with
v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP,
overwriting A(i+2:n,i), and tau is stored in TAU(i).
=====================================================================
Test the input parameters
Parameter adjustments
Function Body */
/* Table of constant values */
static integer c__1 = 1;
static real c_b8 = 0.f;
static real c_b14 = -1.f;
/* System generated locals */
integer i__1, i__2;
/* Local variables */
static real taui;
extern doublereal sdot_(integer *, real *, integer *, real *, integer *);
static integer i;
extern /* Subroutine */ int sspr2_(char *, integer *, real *, real *,
integer *, real *, integer *, real *);
static real alpha;
extern logical lsame_(char *, char *);
static integer i1;
static logical upper;
extern /* Subroutine */ int saxpy_(integer *, real *, real *, integer *,
real *, integer *), sspmv_(char *, integer *, real *, real *,
real *, integer *, real *, real *, integer *);
static integer ii;
extern /* Subroutine */ int xerbla_(char *, integer *), slarfg_(
integer *, real *, real *, integer *, real *);
static integer i1i1;
#define TAU(I) tau[(I)-1]
#define E(I) e[(I)-1]
#define D(I) d[(I)-1]
#define AP(I) ap[(I)-1]
*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_("SSPTRD", &i__1);
return 0;
}
/* Quick return if possible */
if (*n <= 0) {
return 0;
}
if (upper) {
/* Reduce the upper triangle of A.
I1 is the index in AP of A(1,I+1). */
i1 = *n * (*n - 1) / 2 + 1;
for (i = *n - 1; i >= 1; --i) {
/* Generate elementary reflector H(i) = I - tau * v * v'
to annihilate A(1:i-1,i+1) */
slarfg_(&i, &AP(i1 + i - 1), &AP(i1), &c__1, &taui);
E(i) = AP(i1 + i - 1);
if (taui != 0.f) {
/* Apply H(i) from both sides to A(1:i,1:i) */
AP(i1 + i - 1) = 1.f;
/* Compute y := tau * A * v storing y in TAU(1:
i) */
sspmv_(uplo, &i, &taui, &AP(1), &AP(i1), &c__1, &c_b8, &TAU(1)
, &c__1);
/* Compute w := y - 1/2 * tau * (y'*v) * v */
alpha = taui * -.5f * sdot_(&i, &TAU(1), &c__1, &AP(i1), &
c__1);
saxpy_(&i, &alpha, &AP(i1), &c__1, &TAU(1), &c__1);
/* Apply the transformation as a rank-2 update:
A := A - v * w' - w * v' */
sspr2_(uplo, &i, &c_b14, &AP(i1), &c__1, &TAU(1), &c__1, &AP(
1));
AP(i1 + i - 1) = E(i);
}
D(i + 1) = AP(i1 + i);
TAU(i) = taui;
i1 -= i;
/* L10: */
}
D(1) = AP(1);
} else {
/* Reduce the lower triangle of A. II is the index in AP of
A(i,i) and I1I1 is the index of A(i+1,i+1). */
ii = 1;
i__1 = *n - 1;
for (i = 1; i <= *n-1; ++i) {
i1i1 = ii + *n - i + 1;
/* Generate elementary reflector H(i) = I - tau * v * v'
to annihilate A(i+2:n,i) */
i__2 = *n - i;
slarfg_(&i__2, &AP(ii + 1), &AP(ii + 2), &c__1, &taui);
E(i) = AP(ii + 1);
if (taui != 0.f) {
/* Apply H(i) from both sides to A(i+1:n,i+1:n)
*/
AP(ii + 1) = 1.f;
/* Compute y := tau * A * v storing y in TAU(i:
n-1) */
i__2 = *n - i;
sspmv_(uplo, &i__2, &taui, &AP(i1i1), &AP(ii + 1), &c__1, &
c_b8, &TAU(i), &c__1);
/* Compute w := y - 1/2 * tau * (y'*v) * v */
i__2 = *n - i;
alpha = taui * -.5f * sdot_(&i__2, &TAU(i), &c__1, &AP(ii + 1)
, &c__1);
i__2 = *n - i;
saxpy_(&i__2, &alpha, &AP(ii + 1), &c__1, &TAU(i), &c__1);
/* Apply the transformation as a rank-2 update:
A := A - v * w' - w * v' */
i__2 = *n - i;
sspr2_(uplo, &i__2, &c_b14, &AP(ii + 1), &c__1, &TAU(i), &
c__1, &AP(i1i1));
AP(ii + 1) = E(i);
}
D(i) = AP(ii);
TAU(i) = taui;
ii = i1i1;
/* L20: */
}
D(*n) = AP(ii);
}
return 0;
/* End of SSPTRD */
} /* ssptrd_ */
