201 SUBROUTINE zhpevd( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
202 $ rwork, lrwork, iwork, liwork, info )
211 INTEGER INFO, LDZ, LIWORK, LRWORK, LWORK, N
215 DOUBLE PRECISION RWORK( * ), W( * )
216 COMPLEX*16 AP( * ), WORK( * ), Z( ldz, * )
222 DOUBLE PRECISION ZERO, ONE
223 parameter ( zero = 0.0d+0, one = 1.0d+0 )
225 parameter ( cone = ( 1.0d+0, 0.0d+0 ) )
228 LOGICAL LQUERY, WANTZ
229 INTEGER IINFO, IMAX, INDE, INDRWK, INDTAU, INDWRK,
230 $ iscale, liwmin, llrwk, llwrk, lrwmin, lwmin
231 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
236 DOUBLE PRECISION DLAMCH, ZLANHP
237 EXTERNAL lsame, dlamch, zlanhp
250 wantz = lsame( jobz,
'V' )
251 lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 .OR. liwork.EQ.-1 )
254 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
256 ELSE IF( .NOT.( lsame( uplo,
'L' ) .OR. lsame( uplo,
'U' ) ) )
259 ELSE IF( n.LT.0 )
THEN
261 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
273 lrwmin = 1 + 5*n + 2*n**2
285 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
287 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
289 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
295 CALL xerbla(
'ZHPEVD', -info )
297 ELSE IF( lquery )
THEN
315 safmin = dlamch(
'Safe minimum' )
316 eps = dlamch(
'Precision' )
317 smlnum = safmin / eps
318 bignum = one / smlnum
319 rmin = sqrt( smlnum )
320 rmax = sqrt( bignum )
324 anrm = zlanhp(
'M', uplo, n, ap, rwork )
326 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
329 ELSE IF( anrm.GT.rmax )
THEN
333 IF( iscale.EQ.1 )
THEN
334 CALL zdscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
343 llwrk = lwork - indwrk + 1
344 llrwk = lrwork - indrwk + 1
345 CALL zhptrd( uplo, n, ap, w, rwork( inde ), work( indtau ),
351 IF( .NOT.wantz )
THEN
352 CALL dsterf( n, w, rwork( inde ), info )
354 CALL zstedc(
'I', n, w, rwork( inde ), z, ldz, work( indwrk ),
355 $ llwrk, rwork( indrwk ), llrwk, iwork, liwork,
357 CALL zupmtr(
'L', uplo,
'N', n, n, ap, work( indtau ), z, ldz,
358 $ work( indwrk ), iinfo )
363 IF( iscale.EQ.1 )
THEN
369 CALL dscal( imax, one / sigma, w, 1 )
subroutine zhpevd(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZHPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZSTEDC
subroutine zhptrd(UPLO, N, AP, D, E, TAU, INFO)
ZHPTRD
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zupmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
ZUPMTR