138 SUBROUTINE zhpev( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK,
151 DOUBLE PRECISION RWORK( * ), W( * )
152 COMPLEX*16 AP( * ), WORK( * ), Z( ldz, * )
158 DOUBLE PRECISION ZERO, ONE
159 parameter ( zero = 0.0d0, one = 1.0d0 )
163 INTEGER IINFO, IMAX, INDE, INDRWK, INDTAU, INDWRK,
165 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
170 DOUBLE PRECISION DLAMCH, ZLANHP
171 EXTERNAL lsame, dlamch, zlanhp
184 wantz = lsame( jobz,
'V' )
187 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
189 ELSE IF( .NOT.( lsame( uplo,
'L' ) .OR. lsame( uplo,
'U' ) ) )
192 ELSE IF( n.LT.0 )
THEN
194 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
199 CALL xerbla(
'ZHPEV ', -info )
218 safmin = dlamch(
'Safe minimum' )
219 eps = dlamch(
'Precision' )
220 smlnum = safmin / eps
221 bignum = one / smlnum
222 rmin = sqrt( smlnum )
223 rmax = sqrt( bignum )
227 anrm = zlanhp(
'M', uplo, n, ap, rwork )
229 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
232 ELSE IF( anrm.GT.rmax )
THEN
236 IF( iscale.EQ.1 )
THEN
237 CALL zdscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
244 CALL zhptrd( uplo, n, ap, w, rwork( inde ), work( indtau ),
250 IF( .NOT.wantz )
THEN
251 CALL dsterf( n, w, rwork( inde ), info )
254 CALL zupgtr( uplo, n, ap, work( indtau ), z, ldz,
255 $ work( indwrk ), iinfo )
257 CALL zsteqr( jobz, n, w, rwork( inde ), z, ldz,
258 $ rwork( indrwk ), info )
263 IF( iscale.EQ.1 )
THEN
269 CALL dscal( imax, one / sigma, w, 1 )
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine zsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
ZSTEQR
subroutine zhpev(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK, INFO)
ZHPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
subroutine zhptrd(UPLO, N, AP, D, E, TAU, INFO)
ZHPTRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine zupgtr(UPLO, N, AP, TAU, Q, LDQ, WORK, INFO)
ZUPGTR
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL