251 SUBROUTINE zheevx( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
252 $ abstol, m, w, z, ldz, work, lwork, rwork,
253 $ iwork, ifail, info )
261 CHARACTER JOBZ, RANGE, UPLO
262 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
263 DOUBLE PRECISION ABSTOL, VL, VU
266 INTEGER IFAIL( * ), IWORK( * )
267 DOUBLE PRECISION RWORK( * ), W( * )
268 COMPLEX*16 A( lda, * ), WORK( * ), Z( ldz, * )
274 DOUBLE PRECISION ZERO, ONE
275 parameter( zero = 0.0d+0, one = 1.0d+0 )
277 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
280 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
283 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
284 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
285 $ itmp1, j, jj, llwork, lwkmin, lwkopt, nb,
287 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
288 $ sigma, smlnum, tmp1, vll, vuu
293 DOUBLE PRECISION DLAMCH, ZLANHE
294 EXTERNAL lsame, ilaenv, dlamch, zlanhe
302 INTRINSIC dble, max, min, sqrt
308 lower = lsame( uplo,
'L' )
309 wantz = lsame( jobz,
'V' )
310 alleig = lsame( range,
'A' )
311 valeig = lsame( range,
'V' )
312 indeig = lsame( range,
'I' )
313 lquery = ( lwork.EQ.-1 )
316 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
318 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
320 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
322 ELSE IF( n.LT.0 )
THEN
324 ELSE IF( lda.LT.max( 1, n ) )
THEN
328 IF( n.GT.0 .AND. vu.LE.vl )
330 ELSE IF( indeig )
THEN
331 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
333 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
339 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
350 nb = ilaenv( 1,
'ZHETRD', uplo, n, -1, -1, -1 )
351 nb = max( nb, ilaenv( 1,
'ZUNMTR', uplo, n, -1, -1, -1 ) )
352 lwkopt = max( 1, ( nb + 1 )*n )
356 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
361 CALL xerbla(
'ZHEEVX', -info )
363 ELSE IF( lquery )
THEN
375 IF( alleig .OR. indeig )
THEN
378 ELSE IF( valeig )
THEN
379 IF( vl.LT.dble( a( 1, 1 ) ) .AND. vu.GE.dble( a( 1, 1 ) ) )
392 safmin = dlamch(
'Safe minimum' )
393 eps = dlamch(
'Precision' )
394 smlnum = safmin / eps
395 bignum = one / smlnum
396 rmin = sqrt( smlnum )
397 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
407 anrm = zlanhe(
'M', uplo, n, a, lda, rwork )
408 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
411 ELSE IF( anrm.GT.rmax )
THEN
415 IF( iscale.EQ.1 )
THEN
418 CALL zdscal( n-j+1, sigma, a( j, j ), 1 )
422 CALL zdscal( j, sigma, a( 1, j ), 1 )
426 $ abstll = abstol*sigma
440 llwork = lwork - indwrk + 1
441 CALL zhetrd( uplo, n, a, lda, rwork( indd ), rwork( inde ),
442 $ work( indtau ), work( indwrk ), llwork, iinfo )
450 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
454 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
455 CALL dcopy( n, rwork( indd ), 1, w, 1 )
457 IF( .NOT.wantz )
THEN
458 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
459 CALL dsterf( n, w, rwork( indee ), info )
461 CALL zlacpy(
'A', n, n, a, lda, z, ldz )
462 CALL zungtr( uplo, n, z, ldz, work( indtau ),
463 $ work( indwrk ), llwork, iinfo )
464 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
465 CALL zsteqr( jobz, n, w, rwork( indee ), z, ldz,
466 $ rwork( indrwk ), info )
490 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
491 $ rwork( indd ), rwork( inde ), m, nsplit, w,
492 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
493 $ iwork( indiwk ), info )
496 CALL zstein( n, rwork( indd ), rwork( inde ), m, w,
497 $ iwork( indibl ), iwork( indisp ), z, ldz,
498 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
503 CALL zunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
504 $ ldz, work( indwrk ), llwork, iinfo )
510 IF( iscale.EQ.1 )
THEN
516 CALL dscal( imax, one / sigma, w, 1 )
527 IF( w( jj ).LT.tmp1 )
THEN
534 itmp1 = iwork( indibl+i-1 )
536 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
538 iwork( indibl+j-1 ) = itmp1
539 CALL zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
542 ifail( i ) = ifail( j )
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 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 xerbla(SRNAME, INFO)
XERBLA
subroutine zhetrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
ZHETRD
subroutine dscal(N, DA, DX, INCX)
DSCAL
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 zunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMTR
subroutine zungtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGTR
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 ...