258 SUBROUTINE zheevx( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
259 $ abstol, m, w, z, ldz, work, lwork, rwork,
260 $ iwork, ifail, info )
268 CHARACTER JOBZ, RANGE, UPLO
269 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
270 DOUBLE PRECISION ABSTOL, VL, VU
273 INTEGER IFAIL( * ), IWORK( * )
274 DOUBLE PRECISION RWORK( * ), W( * )
275 COMPLEX*16 A( lda, * ), WORK( * ), Z( ldz, * )
281 DOUBLE PRECISION ZERO, ONE
282 parameter ( zero = 0.0d+0, one = 1.0d+0 )
284 parameter ( cone = ( 1.0d+0, 0.0d+0 ) )
287 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
290 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
291 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
292 $ itmp1, j, jj, llwork, lwkmin, lwkopt, nb,
294 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
295 $ sigma, smlnum, tmp1, vll, vuu
300 DOUBLE PRECISION DLAMCH, ZLANHE
301 EXTERNAL lsame, ilaenv, dlamch, zlanhe
309 INTRINSIC dble, max, min, sqrt
315 lower = lsame( uplo,
'L' )
316 wantz = lsame( jobz,
'V' )
317 alleig = lsame( range,
'A' )
318 valeig = lsame( range,
'V' )
319 indeig = lsame( range,
'I' )
320 lquery = ( lwork.EQ.-1 )
323 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
325 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
327 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
329 ELSE IF( n.LT.0 )
THEN
331 ELSE IF( lda.LT.max( 1, n ) )
THEN
335 IF( n.GT.0 .AND. vu.LE.vl )
337 ELSE IF( indeig )
THEN
338 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
340 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
346 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
357 nb = ilaenv( 1,
'ZHETRD', uplo, n, -1, -1, -1 )
358 nb = max( nb, ilaenv( 1,
'ZUNMTR', uplo, n, -1, -1, -1 ) )
359 lwkopt = max( 1, ( nb + 1 )*n )
363 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
368 CALL xerbla(
'ZHEEVX', -info )
370 ELSE IF( lquery )
THEN
382 IF( alleig .OR. indeig )
THEN
385 ELSE IF( valeig )
THEN
386 IF( vl.LT.dble( a( 1, 1 ) ) .AND. vu.GE.dble( a( 1, 1 ) ) )
399 safmin = dlamch(
'Safe minimum' )
400 eps = dlamch(
'Precision' )
401 smlnum = safmin / eps
402 bignum = one / smlnum
403 rmin = sqrt( smlnum )
404 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
414 anrm = zlanhe(
'M', uplo, n, a, lda, rwork )
415 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
418 ELSE IF( anrm.GT.rmax )
THEN
422 IF( iscale.EQ.1 )
THEN
425 CALL zdscal( n-j+1, sigma, a( j, j ), 1 )
429 CALL zdscal( j, sigma, a( 1, j ), 1 )
433 $ abstll = abstol*sigma
447 llwork = lwork - indwrk + 1
448 CALL zhetrd( uplo, n, a, lda, rwork( indd ), rwork( inde ),
449 $ work( indtau ), work( indwrk ), llwork, iinfo )
457 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
461 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
462 CALL dcopy( n, rwork( indd ), 1, w, 1 )
464 IF( .NOT.wantz )
THEN
465 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
466 CALL dsterf( n, w, rwork( indee ), info )
468 CALL zlacpy(
'A', n, n, a, lda, z, ldz )
469 CALL zungtr( uplo, n, z, ldz, work( indtau ),
470 $ work( indwrk ), llwork, iinfo )
471 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
472 CALL zsteqr( jobz, n, w, rwork( indee ), z, ldz,
473 $ rwork( indrwk ), info )
497 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
498 $ rwork( indd ), rwork( inde ), m, nsplit, w,
499 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
500 $ iwork( indiwk ), info )
503 CALL zstein( n, rwork( indd ), rwork( inde ), m, w,
504 $ iwork( indibl ), iwork( indisp ), z, ldz,
505 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
510 CALL zunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
511 $ ldz, work( indwrk ), llwork, iinfo )
517 IF( iscale.EQ.1 )
THEN
523 CALL dscal( imax, one / sigma, w, 1 )
534 IF( w( jj ).LT.tmp1 )
THEN
541 itmp1 = iwork( indibl+i-1 )
543 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
545 iwork( indibl+j-1 ) = itmp1
546 CALL zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
549 ifail( i ) = ifail( j )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine zungtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGTR
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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 zunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMTR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zhetrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
ZHETRD
subroutine zheevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, INFO)
ZHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...