200 SUBROUTINE chpevd( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
201 $ rwork, lrwork, iwork, liwork, info )
210 INTEGER info, ldz, liwork, lrwork, lwork, n
214 REAL rwork( * ), w( * )
215 COMPLEX ap( * ), work( * ), z( ldz, * )
222 parameter( zero = 0.0e+0, one = 1.0e+0 )
224 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
227 LOGICAL lquery, wantz
228 INTEGER iinfo, imax, inde, indrwk, indtau, indwrk,
229 $ iscale, liwmin, llrwk, llwrk, lrwmin, lwmin
230 REAL anrm, bignum, eps, rmax, rmin, safmin, sigma,
249 wantz =
lsame( jobz,
'V' )
250 lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 .OR. liwork.EQ.-1 )
253 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
255 ELSE IF( .NOT.(
lsame( uplo,
'L' ) .OR.
lsame( uplo,
'U' ) ) )
258 ELSE IF( n.LT.0 )
THEN
260 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
272 lrwmin = 1 + 5*n + 2*n**2
284 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
286 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
288 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
294 CALL
xerbla(
'CHPEVD', -info )
296 ELSE IF( lquery )
THEN
314 safmin =
slamch(
'Safe minimum' )
315 eps =
slamch(
'Precision' )
316 smlnum = safmin / eps
317 bignum = one / smlnum
318 rmin = sqrt( smlnum )
319 rmax = sqrt( bignum )
323 anrm =
clanhp(
'M', uplo, n, ap, rwork )
325 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
328 ELSE IF( anrm.GT.rmax )
THEN
332 IF( iscale.EQ.1 )
THEN
333 CALL
csscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
342 llwrk = lwork - indwrk + 1
343 llrwk = lrwork - indrwk + 1
344 CALL
chptrd( uplo, n, ap, w, rwork( inde ), work( indtau ),
350 IF( .NOT.wantz )
THEN
351 CALL
ssterf( n, w, rwork( inde ), info )
353 CALL
cstedc(
'I', n, w, rwork( inde ), z, ldz, work( indwrk ),
354 $ llwrk, rwork( indrwk ), llrwk, iwork, liwork,
356 CALL
cupmtr(
'L', uplo,
'N', n, n, ap, work( indtau ), z, ldz,
357 $ work( indwrk ), iinfo )
362 IF( iscale.EQ.1 )
THEN
368 CALL
sscal( imax, one / sigma, w, 1 )
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine cstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CSTEDC
subroutine chptrd(UPLO, N, AP, D, E, TAU, INFO)
CHPTRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cupmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
CUPMTR
subroutine chpevd(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CHPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine csscal(N, SA, CX, INCX)
CSSCAL
REAL function clanhp(NORM, UPLO, N, AP, WORK)
CLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix supplied in packed form.
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine sscal(N, SA, SX, INCX)
SSCAL