232 SUBROUTINE zhpevx( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
233 $ abstol, m, w, z, ldz, work, rwork, iwork,
242 CHARACTER JOBZ, RANGE, UPLO
243 INTEGER IL, INFO, IU, LDZ, M, N
244 DOUBLE PRECISION ABSTOL, VL, VU
247 INTEGER IFAIL( * ), IWORK( * )
248 DOUBLE PRECISION RWORK( * ), W( * )
249 COMPLEX*16 AP( * ), WORK( * ), Z( ldz, * )
255 DOUBLE PRECISION ZERO, ONE
256 parameter( zero = 0.0d0, one = 1.0d0 )
258 parameter( cone = ( 1.0d0, 0.0d0 ) )
261 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
263 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
264 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
265 $ itmp1, j, jj, nsplit
266 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
267 $ sigma, smlnum, tmp1, vll, vuu
271 DOUBLE PRECISION DLAMCH, ZLANHP
272 EXTERNAL lsame, dlamch, zlanhp
279 INTRINSIC dble, max, min, sqrt
285 wantz = lsame( jobz,
'V' )
286 alleig = lsame( range,
'A' )
287 valeig = lsame( range,
'V' )
288 indeig = lsame( range,
'I' )
291 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
293 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
295 ELSE IF( .NOT.( lsame( uplo,
'L' ) .OR. lsame( uplo,
'U' ) ) )
298 ELSE IF( n.LT.0 )
THEN
302 IF( n.GT.0 .AND. vu.LE.vl )
304 ELSE IF( indeig )
THEN
305 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
307 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
313 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
318 CALL xerbla(
'ZHPEVX', -info )
329 IF( alleig .OR. indeig )
THEN
333 IF( vl.LT.dble( ap( 1 ) ) .AND. vu.GE.dble( ap( 1 ) ) )
THEN
345 safmin = dlamch(
'Safe minimum' )
346 eps = dlamch(
'Precision' )
347 smlnum = safmin / eps
348 bignum = one / smlnum
349 rmin = sqrt( smlnum )
350 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
363 anrm = zlanhp(
'M', uplo, n, ap, rwork )
364 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
367 ELSE IF( anrm.GT.rmax )
THEN
371 IF( iscale.EQ.1 )
THEN
372 CALL zdscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
374 $ abstll = abstol*sigma
388 CALL zhptrd( uplo, n, ap, rwork( indd ), rwork( inde ),
389 $ work( indtau ), iinfo )
397 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
401 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
402 CALL dcopy( n, rwork( indd ), 1, w, 1 )
404 IF( .NOT.wantz )
THEN
405 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
406 CALL dsterf( n, w, rwork( indee ), info )
408 CALL zupgtr( uplo, n, ap, work( indtau ), z, ldz,
409 $ work( indwrk ), iinfo )
410 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
411 CALL zsteqr( jobz, n, w, rwork( indee ), z, ldz,
412 $ rwork( indrwk ), info )
436 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
437 $ rwork( indd ), rwork( inde ), m, nsplit, w,
438 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
439 $ iwork( indiwk ), info )
442 CALL zstein( n, rwork( indd ), rwork( inde ), m, w,
443 $ iwork( indibl ), iwork( indisp ), z, ldz,
444 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
450 CALL zupmtr(
'L', uplo,
'N', n, m, ap, work( indtau ), z, ldz,
451 $ work( indwrk ), iinfo )
457 IF( iscale.EQ.1 )
THEN
463 CALL dscal( imax, one / sigma, w, 1 )
474 IF( w( jj ).LT.tmp1 )
THEN
481 itmp1 = iwork( indibl+i-1 )
483 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
485 iwork( indibl+j-1 ) = itmp1
486 CALL zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
489 ifail( i ) = ifail( j )
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zhptrd(UPLO, N, AP, D, E, TAU, INFO)
ZHPTRD
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
ZSTEIN
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine zupmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
ZUPMTR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine zupgtr(UPLO, N, AP, TAU, Q, LDQ, WORK, INFO)
ZUPGTR
subroutine zsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
ZSTEQR
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ
subroutine zhpevx(JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
ZHPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...