/* Subroutine */ int zhpev_(char *jobz, char *uplo, integer *n, doublecomplex
*ap, doublereal *w, doublecomplex *z__, integer *ldz, doublecomplex *
work, doublereal *rwork, integer *info)
{
/* -- LAPACK driver routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
March 31, 1993
Purpose
=======
ZHPEV computes all the eigenvalues and, optionally, eigenvectors of a
complex Hermitian matrix in packed storage.
Arguments
=========
JOBZ (input) CHARACTER*1
= 'N': Compute eigenvalues only;
= 'V': Compute eigenvalues and eigenvectors.
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) COMPLEX*16 array, dimension (N*(N+1)/2)
On entry, the upper or lower triangle of the Hermitian 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, AP is overwritten by values generated during the
reduction to tridiagonal form. If UPLO = 'U', the diagonal
and first superdiagonal of the tridiagonal matrix T overwrite
the corresponding elements of A, and if UPLO = 'L', the
diagonal and first subdiagonal of T overwrite the
corresponding elements of A.
W (output) DOUBLE PRECISION array, dimension (N)
If INFO = 0, the eigenvalues in ascending order.
Z (output) COMPLEX*16 array, dimension (LDZ, N)
If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
eigenvectors of the matrix A, with the i-th column of Z
holding the eigenvector associated with W(i).
If JOBZ = 'N', then Z is not referenced.
LDZ (input) INTEGER
The leading dimension of the array Z. LDZ >= 1, and if
JOBZ = 'V', LDZ >= max(1,N).
WORK (workspace) COMPLEX*16 array, dimension (max(1, 2*N-1))
RWORK (workspace) DOUBLE PRECISION array, dimension (max(1, 3*N-2))
INFO (output) INTEGER
= 0: successful exit.
< 0: if INFO = -i, the i-th argument had an illegal value.
> 0: if INFO = i, the algorithm failed to converge; i
off-diagonal elements of an intermediate tridiagonal
form did not converge to zero.
=====================================================================
Test the input parameters.
Parameter adjustments */
/* Table of constant values */
static integer c__1 = 1;
/* System generated locals */
integer z_dim1, z_offset, i__1;
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static integer inde;
static doublereal anrm;
static integer imax;
static doublereal rmin, rmax;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *);
static doublereal sigma;
extern logical lsame_(char *, char *);
static integer iinfo;
static logical wantz;
extern doublereal dlamch_(char *);
static integer iscale;
static doublereal safmin;
extern /* Subroutine */ int xerbla_(char *, integer *), zdscal_(
integer *, doublereal *, doublecomplex *, integer *);
static doublereal bignum;
static integer indtau;
extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *,
integer *);
extern doublereal zlanhp_(char *, char *, integer *, doublecomplex *,
doublereal *);
static integer indrwk, indwrk;
static doublereal smlnum;
extern /* Subroutine */ int zhptrd_(char *, integer *, doublecomplex *,
doublereal *, doublereal *, doublecomplex *, integer *),
zsteqr_(char *, integer *, doublereal *, doublereal *,
doublecomplex *, integer *, doublereal *, integer *),
zupgtr_(char *, integer *, doublecomplex *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, integer *);
static doublereal eps;
#define z___subscr(a_1,a_2) (a_2)*z_dim1 + a_1
#define z___ref(a_1,a_2) z__[z___subscr(a_1,a_2)]
--ap;
--w;
z_dim1 = *ldz;
z_offset = 1 + z_dim1 * 1;
z__ -= z_offset;
--work;
--rwork;
/* Function Body */
wantz = lsame_(jobz, "V");
*info = 0;
if (! (wantz || lsame_(jobz, "N"))) {
*info = -1;
} else if (! (lsame_(uplo, "L") || lsame_(uplo,
"U"))) {
*info = -2;
} else if (*n < 0) {
*info = -3;
} else if (*ldz < 1 || wantz && *ldz < *n) {
*info = -7;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("ZHPEV ", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
if (*n == 1) {
w[1] = ap[1].r;
rwork[1] = 1.;
if (wantz) {
i__1 = z___subscr(1, 1);
z__[i__1].r = 1., z__[i__1].i = 0.;
}
return 0;
}
/* Get machine constants. */
safmin = dlamch_("Safe minimum");
eps = dlamch_("Precision");
smlnum = safmin / eps;
bignum = 1. / smlnum;
rmin = sqrt(smlnum);
rmax = sqrt(bignum);
/* Scale matrix to allowable range, if necessary. */
anrm = zlanhp_("M", uplo, n, &ap[1], &rwork[1]);
iscale = 0;
if (anrm > 0. && anrm < rmin) {
iscale = 1;
sigma = rmin / anrm;
} else if (anrm > rmax) {
iscale = 1;
sigma = rmax / anrm;
}
if (iscale == 1) {
i__1 = *n * (*n + 1) / 2;
zdscal_(&i__1, &sigma, &ap[1], &c__1);
}
/* Call ZHPTRD to reduce Hermitian packed matrix to tridiagonal form. */
inde = 1;
indtau = 1;
zhptrd_(uplo, n, &ap[1], &w[1], &rwork[inde], &work[indtau], &iinfo);
/* For eigenvalues only, call DSTERF. For eigenvectors, first call
ZUPGTR to generate the orthogonal matrix, then call ZSTEQR. */
if (! wantz) {
dsterf_(n, &w[1], &rwork[inde], info);
} else {
indwrk = indtau + *n;
zupgtr_(uplo, n, &ap[1], &work[indtau], &z__[z_offset], ldz, &work[
indwrk], &iinfo);
indrwk = inde + *n;
zsteqr_(jobz, n, &w[1], &rwork[inde], &z__[z_offset], ldz, &rwork[
indrwk], info);
}
/* If matrix was scaled, then rescale eigenvalues appropriately. */
if (iscale == 1) {
if (*info == 0) {
imax = *n;
} else {
imax = *info - 1;
}
d__1 = 1. / sigma;
dscal_(&imax, &d__1, &w[1], &c__1);
}
return 0;
/* End of ZHPEV */
} /* zhpev_ */
/* Subroutine */ int zhpevx_(char *jobz, char *range, char *uplo, integer *n,
doublecomplex *ap, doublereal *vl, doublereal *vu, integer *il,
integer *iu, doublereal *abstol, integer *m, doublereal *w,
doublecomplex *z__, integer *ldz, doublecomplex *work, doublereal *
rwork, integer *iwork, integer *ifail, integer *info)
{
/* System generated locals */
integer z_dim1, z_offset, i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
integer i__, j, jj;
doublereal eps, vll, vuu, tmp1;
integer indd, inde;
doublereal anrm;
integer imax;
doublereal rmin, rmax;
logical test;
integer itmp1, indee;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *);
doublereal sigma;
extern logical lsame_(char *, char *);
integer iinfo;
char order[1];
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *);
logical wantz;
extern /* Subroutine */ int zswap_(integer *, doublecomplex *, integer *,
doublecomplex *, integer *);
extern doublereal dlamch_(char *);
logical alleig, indeig;
integer iscale, indibl;
logical valeig;
doublereal safmin;
extern /* Subroutine */ int xerbla_(char *, integer *), zdscal_(
integer *, doublereal *, doublecomplex *, integer *);
doublereal abstll, bignum;
integer indiwk, indisp, indtau;
extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *,
integer *), dstebz_(char *, char *, integer *, doublereal *,
doublereal *, integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *, integer *, doublereal *, integer *,
integer *, doublereal *, integer *, integer *);
extern doublereal zlanhp_(char *, char *, integer *, doublecomplex *,
doublereal *);
integer indrwk, indwrk, nsplit;
doublereal smlnum;
extern /* Subroutine */ int zhptrd_(char *, integer *, doublecomplex *,
doublereal *, doublereal *, doublecomplex *, integer *),
zstein_(integer *, doublereal *, doublereal *, integer *,
doublereal *, integer *, integer *, doublecomplex *, integer *,
doublereal *, integer *, integer *, integer *), zsteqr_(char *,
integer *, doublereal *, doublereal *, doublecomplex *, integer *,
doublereal *, integer *), zupgtr_(char *, integer *,
doublecomplex *, doublecomplex *, doublecomplex *, integer *,
doublecomplex *, integer *), zupmtr_(char *, char *, char
*, integer *, integer *, doublecomplex *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, integer *);
/* -- LAPACK driver routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZHPEVX computes selected eigenvalues and, optionally, eigenvectors */
/* of a complex Hermitian matrix A in packed storage. */
/* Eigenvalues/vectors can be selected by specifying either a range of */
/* values or a range of indices for the desired eigenvalues. */
/* Arguments */
/* ========= */
/* JOBZ (input) CHARACTER*1 */
/* = 'N': Compute eigenvalues only; */
/* = 'V': Compute eigenvalues and eigenvectors. */
/* RANGE (input) CHARACTER*1 */
/* = 'A': all eigenvalues will be found; */
/* = 'V': all eigenvalues in the half-open interval (VL,VU] */
/* will be found; */
/* = 'I': the IL-th through IU-th eigenvalues will be found. */
/* 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) COMPLEX*16 array, dimension (N*(N+1)/2) */
/* On entry, the upper or lower triangle of the Hermitian 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, AP is overwritten by values generated during the */
/* reduction to tridiagonal form. If UPLO = 'U', the diagonal */
/* and first superdiagonal of the tridiagonal matrix T overwrite */
/* the corresponding elements of A, and if UPLO = 'L', the */
/* diagonal and first subdiagonal of T overwrite the */
/* corresponding elements of A. */
/* VL (input) DOUBLE PRECISION */
/* VU (input) DOUBLE PRECISION */
/* If RANGE='V', the lower and upper bounds of the interval to */
/* be searched for eigenvalues. VL < VU. */
/* Not referenced if RANGE = 'A' or 'I'. */
/* IL (input) INTEGER */
/* IU (input) INTEGER */
/* If RANGE='I', the indices (in ascending order) of the */
/* smallest and largest eigenvalues to be returned. */
/* 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. */
/* Not referenced if RANGE = 'A' or 'V'. */
/* ABSTOL (input) DOUBLE PRECISION */
/* The absolute error tolerance for the eigenvalues. */
/* An approximate eigenvalue is accepted as converged */
/* when it is determined to lie in an interval [a,b] */
/* of width less than or equal to */
/* ABSTOL + EPS * max( |a|,|b| ) , */
/* where EPS is the machine precision. If ABSTOL is less than */
/* or equal to zero, then EPS*|T| will be used in its place, */
/* where |T| is the 1-norm of the tridiagonal matrix obtained */
/* by reducing AP to tridiagonal form. */
/* Eigenvalues will be computed most accurately when ABSTOL is */
/* set to twice the underflow threshold 2*DLAMCH('S'), not zero. */
/* If this routine returns with INFO>0, indicating that some */
/* eigenvectors did not converge, try setting ABSTOL to */
/* 2*DLAMCH('S'). */
/* See "Computing Small Singular Values of Bidiagonal Matrices */
/* with Guaranteed High Relative Accuracy," by Demmel and */
/* Kahan, LAPACK Working Note #3. */
/* M (output) INTEGER */
/* The total number of eigenvalues found. 0 <= M <= N. */
/* If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1. */
/* W (output) DOUBLE PRECISION array, dimension (N) */
/* If INFO = 0, the selected eigenvalues in ascending order. */
/* Z (output) COMPLEX*16 array, dimension (LDZ, max(1,M)) */
/* If JOBZ = 'V', then if INFO = 0, the first M columns of Z */
/* contain the orthonormal eigenvectors of the matrix A */
/* corresponding to the selected eigenvalues, with the i-th */
/* column of Z holding the eigenvector associated with W(i). */
/* If an eigenvector fails to converge, then that column of Z */
/* contains the latest approximation to the eigenvector, and */
/* the index of the eigenvector is returned in IFAIL. */
/* If JOBZ = 'N', then Z is not referenced. */
/* Note: the user must ensure that at least max(1,M) columns are */
/* supplied in the array Z; if RANGE = 'V', the exact value of M */
/* is not known in advance and an upper bound must be used. */
/* LDZ (input) INTEGER */
/* The leading dimension of the array Z. LDZ >= 1, and if */
/* JOBZ = 'V', LDZ >= max(1,N). */
/* WORK (workspace) COMPLEX*16 array, dimension (2*N) */
/* RWORK (workspace) DOUBLE PRECISION array, dimension (7*N) */
/* IWORK (workspace) INTEGER array, dimension (5*N) */
/* IFAIL (output) INTEGER array, dimension (N) */
/* If JOBZ = 'V', then if INFO = 0, the first M elements of */
/* IFAIL are zero. If INFO > 0, then IFAIL contains the */
/* indices of the eigenvectors that failed to converge. */
/* If JOBZ = 'N', then IFAIL is not referenced. */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -i, the i-th argument had an illegal value */
/* > 0: if INFO = i, then i eigenvectors failed to converge. */
/* Their indices are stored in array IFAIL. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
--ap;
--w;
z_dim1 = *ldz;
z_offset = 1 + z_dim1;
z__ -= z_offset;
--work;
--rwork;
--iwork;
--ifail;
/* Function Body */
wantz = lsame_(jobz, "V");
alleig = lsame_(range, "A");
valeig = lsame_(range, "V");
indeig = lsame_(range, "I");
*info = 0;
if (! (wantz || lsame_(jobz, "N"))) {
*info = -1;
} else if (! (alleig || valeig || indeig)) {
*info = -2;
} else if (! (lsame_(uplo, "L") || lsame_(uplo,
"U"))) {
*info = -3;
} else if (*n < 0) {
*info = -4;
} else {
if (valeig) {
if (*n > 0 && *vu <= *vl) {
*info = -7;
}
} else if (indeig) {
if (*il < 1 || *il > max(1,*n)) {
*info = -8;
} else if (*iu < min(*n,*il) || *iu > *n) {
*info = -9;
}
}
}
if (*info == 0) {
if (*ldz < 1 || wantz && *ldz < *n) {
*info = -14;
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("ZHPEVX", &i__1);
return 0;
}
/* Quick return if possible */
*m = 0;
if (*n == 0) {
return 0;
}
if (*n == 1) {
if (alleig || indeig) {
*m = 1;
w[1] = ap[1].r;
} else {
if (*vl < ap[1].r && *vu >= ap[1].r) {
*m = 1;
w[1] = ap[1].r;
}
}
if (wantz) {
i__1 = z_dim1 + 1;
z__[i__1].r = 1., z__[i__1].i = 0.;
}
return 0;
}
/* Get machine constants. */
safmin = dlamch_("Safe minimum");
eps = dlamch_("Precision");
smlnum = safmin / eps;
bignum = 1. / smlnum;
rmin = sqrt(smlnum);
/* Computing MIN */
d__1 = sqrt(bignum), d__2 = 1. / sqrt(sqrt(safmin));
rmax = min(d__1,d__2);
/* Scale matrix to allowable range, if necessary. */
iscale = 0;
abstll = *abstol;
if (valeig) {
vll = *vl;
vuu = *vu;
} else {
vll = 0.;
vuu = 0.;
}
anrm = zlanhp_("M", uplo, n, &ap[1], &rwork[1]);
if (anrm > 0. && anrm < rmin) {
iscale = 1;
sigma = rmin / anrm;
} else if (anrm > rmax) {
iscale = 1;
sigma = rmax / anrm;
}
if (iscale == 1) {
i__1 = *n * (*n + 1) / 2;
zdscal_(&i__1, &sigma, &ap[1], &c__1);
if (*abstol > 0.) {
abstll = *abstol * sigma;
}
if (valeig) {
vll = *vl * sigma;
vuu = *vu * sigma;
}
}
/* Call ZHPTRD to reduce Hermitian packed matrix to tridiagonal form. */
indd = 1;
inde = indd + *n;
indrwk = inde + *n;
indtau = 1;
indwrk = indtau + *n;
zhptrd_(uplo, n, &ap[1], &rwork[indd], &rwork[inde], &work[indtau], &
iinfo);
/* If all eigenvalues are desired and ABSTOL is less than or equal */
/* to zero, then call DSTERF or ZUPGTR and ZSTEQR. If this fails */
/* for some eigenvalue, then try DSTEBZ. */
test = FALSE_;
if (indeig) {
if (*il == 1 && *iu == *n) {
test = TRUE_;
}
}
if ((alleig || test) && *abstol <= 0.) {
dcopy_(n, &rwork[indd], &c__1, &w[1], &c__1);
indee = indrwk + (*n << 1);
if (! wantz) {
i__1 = *n - 1;
dcopy_(&i__1, &rwork[inde], &c__1, &rwork[indee], &c__1);
dsterf_(n, &w[1], &rwork[indee], info);
} else {
zupgtr_(uplo, n, &ap[1], &work[indtau], &z__[z_offset], ldz, &
work[indwrk], &iinfo);
i__1 = *n - 1;
dcopy_(&i__1, &rwork[inde], &c__1, &rwork[indee], &c__1);
zsteqr_(jobz, n, &w[1], &rwork[indee], &z__[z_offset], ldz, &
rwork[indrwk], info);
if (*info == 0) {
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
ifail[i__] = 0;
/* L10: */
}
}
}
if (*info == 0) {
*m = *n;
goto L20;
}
*info = 0;
}
/* Otherwise, call DSTEBZ and, if eigenvectors are desired, ZSTEIN. */
if (wantz) {
*(unsigned char *)order = 'B';
} else {
*(unsigned char *)order = 'E';
}
indibl = 1;
indisp = indibl + *n;
indiwk = indisp + *n;
dstebz_(range, order, n, &vll, &vuu, il, iu, &abstll, &rwork[indd], &
rwork[inde], m, &nsplit, &w[1], &iwork[indibl], &iwork[indisp], &
rwork[indrwk], &iwork[indiwk], info);
if (wantz) {
zstein_(n, &rwork[indd], &rwork[inde], m, &w[1], &iwork[indibl], &
iwork[indisp], &z__[z_offset], ldz, &rwork[indrwk], &iwork[
indiwk], &ifail[1], info);
/* Apply unitary matrix used in reduction to tridiagonal */
/* form to eigenvectors returned by ZSTEIN. */
indwrk = indtau + *n;
zupmtr_("L", uplo, "N", n, m, &ap[1], &work[indtau], &z__[z_offset],
ldz, &work[indwrk], &iinfo);
}
/* If matrix was scaled, then rescale eigenvalues appropriately. */
L20:
if (iscale == 1) {
if (*info == 0) {
imax = *m;
} else {
imax = *info - 1;
}
d__1 = 1. / sigma;
dscal_(&imax, &d__1, &w[1], &c__1);
}
/* If eigenvalues are not in order, then sort them, along with */
/* eigenvectors. */
if (wantz) {
i__1 = *m - 1;
for (j = 1; j <= i__1; ++j) {
i__ = 0;
tmp1 = w[j];
i__2 = *m;
for (jj = j + 1; jj <= i__2; ++jj) {
if (w[jj] < tmp1) {
i__ = jj;
tmp1 = w[jj];
}
/* L30: */
}
if (i__ != 0) {
itmp1 = iwork[indibl + i__ - 1];
w[i__] = w[j];
iwork[indibl + i__ - 1] = iwork[indibl + j - 1];
w[j] = tmp1;
iwork[indibl + j - 1] = itmp1;
zswap_(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[j * z_dim1 + 1],
&c__1);
if (*info != 0) {
itmp1 = ifail[i__];
ifail[i__] = ifail[j];
ifail[j] = itmp1;
}
}
/* L40: */
}
}
return 0;
/* End of ZHPEVX */
} /* zhpevx_ */
/* Subroutine */ int zhpevd_(char *jobz, char *uplo, integer *n,
doublecomplex *ap, doublereal *w, doublecomplex *z__, integer *ldz,
doublecomplex *work, integer *lwork, doublereal *rwork, integer *
lrwork, integer *iwork, integer *liwork, integer *info)
{
/* -- LAPACK driver routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
June 30, 1999
Purpose
=======
ZHPEVD computes all the eigenvalues and, optionally, eigenvectors of
a complex Hermitian matrix A in packed storage. If eigenvectors are
desired, it uses a divide and conquer algorithm.
The divide and conquer algorithm makes very mild assumptions about
floating point arithmetic. It will work on machines with a guard
digit in add/subtract, or on those binary machines without guard
digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
Cray-2. It could conceivably fail on hexadecimal or decimal machines
without guard digits, but we know of none.
Arguments
=========
JOBZ (input) CHARACTER*1
= 'N': Compute eigenvalues only;
= 'V': Compute eigenvalues and eigenvectors.
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) COMPLEX*16 array, dimension (N*(N+1)/2)
On entry, the upper or lower triangle of the Hermitian 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, AP is overwritten by values generated during the
reduction to tridiagonal form. If UPLO = 'U', the diagonal
and first superdiagonal of the tridiagonal matrix T overwrite
the corresponding elements of A, and if UPLO = 'L', the
diagonal and first subdiagonal of T overwrite the
corresponding elements of A.
W (output) DOUBLE PRECISION array, dimension (N)
If INFO = 0, the eigenvalues in ascending order.
Z (output) COMPLEX*16 array, dimension (LDZ, N)
If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
eigenvectors of the matrix A, with the i-th column of Z
holding the eigenvector associated with W(i).
If JOBZ = 'N', then Z is not referenced.
LDZ (input) INTEGER
The leading dimension of the array Z. LDZ >= 1, and if
JOBZ = 'V', LDZ >= max(1,N).
WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of array WORK.
If N <= 1, LWORK must be at least 1.
If JOBZ = 'N' and N > 1, LWORK must be at least N.
If JOBZ = 'V' and N > 1, LWORK must be at least 2*N.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued by XERBLA.
RWORK (workspace/output) DOUBLE PRECISION array,
dimension (LRWORK)
On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
LRWORK (input) INTEGER
The dimension of array RWORK.
If N <= 1, LRWORK must be at least 1.
If JOBZ = 'N' and N > 1, LRWORK must be at least N.
If JOBZ = 'V' and N > 1, LRWORK must be at least
1 + 5*N + 2*N**2.
If LRWORK = -1, then a workspace query is assumed; the
routine only calculates the optimal size of the RWORK array,
returns this value as the first entry of the RWORK array, and
no error message related to LRWORK is issued by XERBLA.
IWORK (workspace/output) INTEGER array, dimension (LIWORK)
On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
LIWORK (input) INTEGER
The dimension of array IWORK.
If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
If LIWORK = -1, then a workspace query is assumed; the
routine only calculates the optimal size of the IWORK array,
returns this value as the first entry of the IWORK array, and
no error message related to LIWORK is issued by XERBLA.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value.
> 0: if INFO = i, the algorithm failed to converge; i
off-diagonal elements of an intermediate tridiagonal
form did not converge to zero.
=====================================================================
Test the input parameters.
Parameter adjustments */
/* Table of constant values */
static integer c__1 = 1;
/* System generated locals */
integer z_dim1, z_offset, i__1;
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static integer inde;
static doublereal anrm;
static integer imax;
static doublereal rmin, rmax;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *);
static doublereal sigma;
extern logical lsame_(char *, char *);
static integer iinfo, lwmin, llrwk, llwrk;
static logical wantz;
extern doublereal dlamch_(char *);
static integer iscale;
static doublereal safmin;
extern /* Subroutine */ int xerbla_(char *, integer *), zdscal_(
integer *, doublereal *, doublecomplex *, integer *);
static doublereal bignum;
static integer indtau;
extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *,
integer *);
extern doublereal zlanhp_(char *, char *, integer *, doublecomplex *,
doublereal *);
extern /* Subroutine */ int zstedc_(char *, integer *, doublereal *,
doublereal *, doublecomplex *, integer *, doublecomplex *,
integer *, doublereal *, integer *, integer *, integer *, integer
*);
static integer indrwk, indwrk, liwmin, lrwmin;
static doublereal smlnum;
extern /* Subroutine */ int zhptrd_(char *, integer *, doublecomplex *,
doublereal *, doublereal *, doublecomplex *, integer *);
static logical lquery;
extern /* Subroutine */ int zupmtr_(char *, char *, char *, integer *,
integer *, doublecomplex *, doublecomplex *, doublecomplex *,
integer *, doublecomplex *, integer *);
static doublereal eps;
#define z___subscr(a_1,a_2) (a_2)*z_dim1 + a_1
#define z___ref(a_1,a_2) z__[z___subscr(a_1,a_2)]
--ap;
--w;
z_dim1 = *ldz;
z_offset = 1 + z_dim1 * 1;
z__ -= z_offset;
--work;
--rwork;
--iwork;
/* Function Body */
wantz = lsame_(jobz, "V");
lquery = *lwork == -1 || *lrwork == -1 || *liwork == -1;
*info = 0;
if (*n <= 1) {
lwmin = 1;
liwmin = 1;
lrwmin = 1;
} else {
if (wantz) {
lwmin = *n << 1;
/* Computing 2nd power */
i__1 = *n;
lrwmin = *n * 5 + 1 + (i__1 * i__1 << 1);
liwmin = *n * 5 + 3;
} else {
lwmin = *n;
lrwmin = *n;
liwmin = 1;
}
}
if (! (wantz || lsame_(jobz, "N"))) {
*info = -1;
} else if (! (lsame_(uplo, "L") || lsame_(uplo,
"U"))) {
*info = -2;
} else if (*n < 0) {
*info = -3;
} else if (*ldz < 1 || wantz && *ldz < *n) {
*info = -7;
} else if (*lwork < lwmin && ! lquery) {
*info = -9;
} else if (*lrwork < lrwmin && ! lquery) {
*info = -11;
} else if (*liwork < liwmin && ! lquery) {
*info = -13;
}
if (*info == 0) {
work[1].r = (doublereal) lwmin, work[1].i = 0.;
rwork[1] = (doublereal) lrwmin;
iwork[1] = liwmin;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("ZHPEVD", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
if (*n == 1) {
w[1] = ap[1].r;
if (wantz) {
i__1 = z___subscr(1, 1);
z__[i__1].r = 1., z__[i__1].i = 0.;
}
return 0;
}
/* Get machine constants. */
safmin = dlamch_("Safe minimum");
eps = dlamch_("Precision");
smlnum = safmin / eps;
bignum = 1. / smlnum;
rmin = sqrt(smlnum);
rmax = sqrt(bignum);
/* Scale matrix to allowable range, if necessary. */
anrm = zlanhp_("M", uplo, n, &ap[1], &rwork[1]);
iscale = 0;
if (anrm > 0. && anrm < rmin) {
iscale = 1;
sigma = rmin / anrm;
} else if (anrm > rmax) {
iscale = 1;
sigma = rmax / anrm;
}
if (iscale == 1) {
i__1 = *n * (*n + 1) / 2;
zdscal_(&i__1, &sigma, &ap[1], &c__1);
}
/* Call ZHPTRD to reduce Hermitian packed matrix to tridiagonal form. */
inde = 1;
indtau = 1;
indrwk = inde + *n;
indwrk = indtau + *n;
llwrk = *lwork - indwrk + 1;
llrwk = *lrwork - indrwk + 1;
zhptrd_(uplo, n, &ap[1], &w[1], &rwork[inde], &work[indtau], &iinfo);
/* For eigenvalues only, call DSTERF. For eigenvectors, first call
ZUPGTR to generate the orthogonal matrix, then call ZSTEDC. */
if (! wantz) {
dsterf_(n, &w[1], &rwork[inde], info);
} else {
zstedc_("I", n, &w[1], &rwork[inde], &z__[z_offset], ldz, &work[
indwrk], &llwrk, &rwork[indrwk], &llrwk, &iwork[1], liwork,
info);
zupmtr_("L", uplo, "N", n, n, &ap[1], &work[indtau], &z__[z_offset],
ldz, &work[indwrk], &iinfo);
}
/* If matrix was scaled, then rescale eigenvalues appropriately. */
if (iscale == 1) {
if (*info == 0) {
imax = *n;
} else {
imax = *info - 1;
}
d__1 = 1. / sigma;
dscal_(&imax, &d__1, &w[1], &c__1);
}
work[1].r = (doublereal) lwmin, work[1].i = 0.;
rwork[1] = (doublereal) lrwmin;
iwork[1] = liwmin;
return 0;
/* End of ZHPEVD */
} /* zhpevd_ */
int zhpev_(char *jobz, char *uplo, int *n, doublecomplex
*ap, double *w, doublecomplex *z__, int *ldz, doublecomplex *
work, double *rwork, int *info)
{
/* System generated locals */
int z_dim1, z_offset, i__1;
double d__1;
/* Builtin functions */
double sqrt(double);
/* Local variables */
double eps;
int inde;
double anrm;
int imax;
double rmin, rmax;
extern int dscal_(int *, double *, double *,
int *);
double sigma;
extern int lsame_(char *, char *);
int iinfo;
int wantz;
extern double dlamch_(char *);
int iscale;
double safmin;
extern int xerbla_(char *, int *), zdscal_(
int *, double *, doublecomplex *, int *);
double bignum;
int indtau;
extern int dsterf_(int *, double *, double *,
int *);
extern double zlanhp_(char *, char *, int *, doublecomplex *,
double *);
int indrwk, indwrk;
double smlnum;
extern int zhptrd_(char *, int *, doublecomplex *,
double *, double *, doublecomplex *, int *),
zsteqr_(char *, int *, double *, double *,
doublecomplex *, int *, double *, int *),
zupgtr_(char *, int *, doublecomplex *, doublecomplex *,
doublecomplex *, int *, doublecomplex *, int *);
/* -- LAPACK driver routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZHPEV computes all the eigenvalues and, optionally, eigenvectors of a */
/* complex Hermitian matrix in packed storage. */
/* Arguments */
/* ========= */
/* JOBZ (input) CHARACTER*1 */
/* = 'N': Compute eigenvalues only; */
/* = 'V': Compute eigenvalues and eigenvectors. */
/* 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) COMPLEX*16 array, dimension (N*(N+1)/2) */
/* On entry, the upper or lower triangle of the Hermitian 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, AP is overwritten by values generated during the */
/* reduction to tridiagonal form. If UPLO = 'U', the diagonal */
/* and first superdiagonal of the tridiagonal matrix T overwrite */
/* the corresponding elements of A, and if UPLO = 'L', the */
/* diagonal and first subdiagonal of T overwrite the */
/* corresponding elements of A. */
/* W (output) DOUBLE PRECISION array, dimension (N) */
/* If INFO = 0, the eigenvalues in ascending order. */
/* Z (output) COMPLEX*16 array, dimension (LDZ, N) */
/* If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal */
/* eigenvectors of the matrix A, with the i-th column of Z */
/* holding the eigenvector associated with W(i). */
/* If JOBZ = 'N', then Z is not referenced. */
/* LDZ (input) INTEGER */
/* The leading dimension of the array Z. LDZ >= 1, and if */
/* JOBZ = 'V', LDZ >= MAX(1,N). */
/* WORK (workspace) COMPLEX*16 array, dimension (MAX(1, 2*N-1)) */
/* RWORK (workspace) DOUBLE PRECISION array, dimension (MAX(1, 3*N-2)) */
/* INFO (output) INTEGER */
/* = 0: successful exit. */
/* < 0: if INFO = -i, the i-th argument had an illegal value. */
/* > 0: if INFO = i, the algorithm failed to converge; i */
/* off-diagonal elements of an intermediate tridiagonal */
/* form did not converge to zero. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
--ap;
--w;
z_dim1 = *ldz;
z_offset = 1 + z_dim1;
z__ -= z_offset;
--work;
--rwork;
/* Function Body */
wantz = lsame_(jobz, "V");
*info = 0;
if (! (wantz || lsame_(jobz, "N"))) {
*info = -1;
} else if (! (lsame_(uplo, "L") || lsame_(uplo,
"U"))) {
*info = -2;
} else if (*n < 0) {
*info = -3;
} else if (*ldz < 1 || wantz && *ldz < *n) {
*info = -7;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("ZHPEV ", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
if (*n == 1) {
w[1] = ap[1].r;
rwork[1] = 1.;
if (wantz) {
i__1 = z_dim1 + 1;
z__[i__1].r = 1., z__[i__1].i = 0.;
}
return 0;
}
/* Get machine constants. */
safmin = dlamch_("Safe minimum");
eps = dlamch_("Precision");
smlnum = safmin / eps;
bignum = 1. / smlnum;
rmin = sqrt(smlnum);
rmax = sqrt(bignum);
/* Scale matrix to allowable range, if necessary. */
anrm = zlanhp_("M", uplo, n, &ap[1], &rwork[1]);
iscale = 0;
if (anrm > 0. && anrm < rmin) {
iscale = 1;
sigma = rmin / anrm;
} else if (anrm > rmax) {
iscale = 1;
sigma = rmax / anrm;
}
if (iscale == 1) {
i__1 = *n * (*n + 1) / 2;
zdscal_(&i__1, &sigma, &ap[1], &c__1);
}
/* Call ZHPTRD to reduce Hermitian packed matrix to tridiagonal form. */
inde = 1;
indtau = 1;
zhptrd_(uplo, n, &ap[1], &w[1], &rwork[inde], &work[indtau], &iinfo);
/* For eigenvalues only, call DSTERF. For eigenvectors, first call */
/* ZUPGTR to generate the orthogonal matrix, then call ZSTEQR. */
if (! wantz) {
dsterf_(n, &w[1], &rwork[inde], info);
} else {
indwrk = indtau + *n;
zupgtr_(uplo, n, &ap[1], &work[indtau], &z__[z_offset], ldz, &work[
indwrk], &iinfo);
indrwk = inde + *n;
zsteqr_(jobz, n, &w[1], &rwork[inde], &z__[z_offset], ldz, &rwork[
indrwk], info);
}
/* If matrix was scaled, then rescale eigenvalues appropriately. */
if (iscale == 1) {
if (*info == 0) {
imax = *n;
} else {
imax = *info - 1;
}
d__1 = 1. / sigma;
dscal_(&imax, &d__1, &w[1], &c__1);
}
return 0;
/* End of ZHPEV */
} /* zhpev_ */
/* Subroutine */
int zhpev_(char *jobz, char *uplo, integer *n, doublecomplex *ap, doublereal *w, doublecomplex *z__, integer *ldz, doublecomplex * work, doublereal *rwork, integer *info)
{
/* System generated locals */
integer z_dim1, z_offset, i__1;
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
doublereal eps;
integer inde;
doublereal anrm;
integer imax;
doublereal rmin, rmax;
extern /* Subroutine */
int dscal_(integer *, doublereal *, doublereal *, integer *);
doublereal sigma;
extern logical lsame_(char *, char *);
integer iinfo;
logical wantz;
extern doublereal dlamch_(char *);
integer iscale;
doublereal safmin;
extern /* Subroutine */
int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *);
doublereal bignum;
integer indtau;
extern /* Subroutine */
int dsterf_(integer *, doublereal *, doublereal *, integer *);
extern doublereal zlanhp_(char *, char *, integer *, doublecomplex *, doublereal *);
integer indrwk, indwrk;
doublereal smlnum;
extern /* Subroutine */
int zhptrd_(char *, integer *, doublecomplex *, doublereal *, doublereal *, doublecomplex *, integer *), zsteqr_(char *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublereal *, integer *), zupgtr_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *);
/* -- LAPACK driver 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 */
--ap;
--w;
z_dim1 = *ldz;
z_offset = 1 + z_dim1;
z__ -= z_offset;
--work;
--rwork;
/* Function Body */
wantz = lsame_(jobz, "V");
*info = 0;
if (! (wantz || lsame_(jobz, "N")))
{
*info = -1;
}
else if (! (lsame_(uplo, "L") || lsame_(uplo, "U")))
{
*info = -2;
}
else if (*n < 0)
{
*info = -3;
}
else if (*ldz < 1 || wantz && *ldz < *n)
{
*info = -7;
}
if (*info != 0)
{
i__1 = -(*info);
xerbla_("ZHPEV ", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0)
{
return 0;
}
if (*n == 1)
{
w[1] = ap[1].r;
rwork[1] = 1.;
if (wantz)
{
i__1 = z_dim1 + 1;
z__[i__1].r = 1.;
z__[i__1].i = 0.; // , expr subst
}
return 0;
}
/* Get machine constants. */
safmin = dlamch_("Safe minimum");
eps = dlamch_("Precision");
smlnum = safmin / eps;
bignum = 1. / smlnum;
rmin = sqrt(smlnum);
rmax = sqrt(bignum);
/* Scale matrix to allowable range, if necessary. */
anrm = zlanhp_("M", uplo, n, &ap[1], &rwork[1]);
iscale = 0;
if (anrm > 0. && anrm < rmin)
{
iscale = 1;
sigma = rmin / anrm;
}
else if (anrm > rmax)
{
iscale = 1;
sigma = rmax / anrm;
}
if (iscale == 1)
{
i__1 = *n * (*n + 1) / 2;
zdscal_(&i__1, &sigma, &ap[1], &c__1);
}
/* Call ZHPTRD to reduce Hermitian packed matrix to tridiagonal form. */
inde = 1;
indtau = 1;
zhptrd_(uplo, n, &ap[1], &w[1], &rwork[inde], &work[indtau], &iinfo);
/* For eigenvalues only, call DSTERF. For eigenvectors, first call */
/* ZUPGTR to generate the orthogonal matrix, then call ZSTEQR. */
if (! wantz)
{
dsterf_(n, &w[1], &rwork[inde], info);
}
else
{
indwrk = indtau + *n;
zupgtr_(uplo, n, &ap[1], &work[indtau], &z__[z_offset], ldz, &work[ indwrk], &iinfo);
indrwk = inde + *n;
zsteqr_(jobz, n, &w[1], &rwork[inde], &z__[z_offset], ldz, &rwork[ indrwk], info);
}
/* If matrix was scaled, then rescale eigenvalues appropriately. */
if (iscale == 1)
{
if (*info == 0)
{
imax = *n;
}
else
{
imax = *info - 1;
}
d__1 = 1. / sigma;
dscal_(&imax, &d__1, &w[1], &c__1);
}
return 0;
/* End of ZHPEV */
}
