239 SUBROUTINE zhpevx( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
240 $ abstol, m, w, z, ldz, work, rwork, iwork,
249 CHARACTER JOBZ, RANGE, UPLO
250 INTEGER IL, INFO, IU, LDZ, M, N
251 DOUBLE PRECISION ABSTOL, VL, VU
254 INTEGER IFAIL( * ), IWORK( * )
255 DOUBLE PRECISION RWORK( * ), W( * )
256 COMPLEX*16 AP( * ), WORK( * ), Z( ldz, * )
262 DOUBLE PRECISION ZERO, ONE
263 parameter ( zero = 0.0d0, one = 1.0d0 )
265 parameter ( cone = ( 1.0d0, 0.0d0 ) )
268 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
270 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
271 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
272 $ itmp1, j, jj, nsplit
273 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
274 $ sigma, smlnum, tmp1, vll, vuu
278 DOUBLE PRECISION DLAMCH, ZLANHP
279 EXTERNAL lsame, dlamch, zlanhp
286 INTRINSIC dble, max, min, sqrt
292 wantz = lsame( jobz,
'V' )
293 alleig = lsame( range,
'A' )
294 valeig = lsame( range,
'V' )
295 indeig = lsame( range,
'I' )
298 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
300 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
302 ELSE IF( .NOT.( lsame( uplo,
'L' ) .OR. lsame( uplo,
'U' ) ) )
305 ELSE IF( n.LT.0 )
THEN
309 IF( n.GT.0 .AND. vu.LE.vl )
311 ELSE IF( indeig )
THEN
312 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
314 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
320 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
325 CALL xerbla(
'ZHPEVX', -info )
336 IF( alleig .OR. indeig )
THEN
340 IF( vl.LT.dble( ap( 1 ) ) .AND. vu.GE.dble( ap( 1 ) ) )
THEN
352 safmin = dlamch(
'Safe minimum' )
353 eps = dlamch(
'Precision' )
354 smlnum = safmin / eps
355 bignum = one / smlnum
356 rmin = sqrt( smlnum )
357 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
370 anrm = zlanhp(
'M', uplo, n, ap, rwork )
371 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
374 ELSE IF( anrm.GT.rmax )
THEN
378 IF( iscale.EQ.1 )
THEN
379 CALL zdscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
381 $ abstll = abstol*sigma
395 CALL zhptrd( uplo, n, ap, rwork( indd ), rwork( inde ),
396 $ work( indtau ), iinfo )
404 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
408 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
409 CALL dcopy( n, rwork( indd ), 1, w, 1 )
411 IF( .NOT.wantz )
THEN
412 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
413 CALL dsterf( n, w, rwork( indee ), info )
415 CALL zupgtr( uplo, n, ap, work( indtau ), z, ldz,
416 $ work( indwrk ), iinfo )
417 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
418 CALL zsteqr( jobz, n, w, rwork( indee ), z, ldz,
419 $ rwork( indrwk ), info )
443 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
444 $ rwork( indd ), rwork( inde ), m, nsplit, w,
445 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
446 $ iwork( indiwk ), info )
449 CALL zstein( n, rwork( indd ), rwork( inde ), m, w,
450 $ iwork( indibl ), iwork( indisp ), z, ldz,
451 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
457 CALL zupmtr(
'L', uplo,
'N', n, m, ap, work( indtau ), z, ldz,
458 $ work( indwrk ), iinfo )
464 IF( iscale.EQ.1 )
THEN
470 CALL dscal( imax, one / sigma, w, 1 )
481 IF( w( jj ).LT.tmp1 )
THEN
488 itmp1 = iwork( indibl+i-1 )
490 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
492 iwork( indibl+j-1 ) = itmp1
493 CALL zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
496 ifail( i ) = ifail( j )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine zsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
ZSTEQR
subroutine zstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
ZSTEIN
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ
subroutine zupmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
ZUPMTR
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
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...