304 $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
305 $ LWORK, RWORK, IWORK, IFAIL, INFO )
314 CHARACTER JOBZ, RANGE, UPLO
315 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
316 DOUBLE PRECISION ABSTOL, VL, VU
319 INTEGER IFAIL( * ), IWORK( * )
320 DOUBLE PRECISION RWORK( * ), W( * )
321 COMPLEX*16 A( LDA, * ), WORK( * ), Z( LDZ, * )
327 DOUBLE PRECISION ZERO, ONE
328 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
330 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
333 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
336 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
337 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
338 $ itmp1, j, jj, llwork,
339 $ nsplit, lwmin, lhtrd, lwtrd, kd, ib, indhous
340 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
341 $ SIGMA, SMLNUM, TMP1, VLL, VUU
346 DOUBLE PRECISION DLAMCH, ZLANHE
347 EXTERNAL lsame, dlamch, zlanhe, ilaenv2stage
355 INTRINSIC dble, max, min, sqrt
361 lower = lsame( uplo,
'L' )
362 wantz = lsame( jobz,
'V' )
363 alleig = lsame( range,
'A' )
364 valeig = lsame( range,
'V' )
365 indeig = lsame( range,
'I' )
366 lquery = ( lwork.EQ.-1 )
369 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
371 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
373 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
375 ELSE IF( n.LT.0 )
THEN
377 ELSE IF( lda.LT.max( 1, n ) )
THEN
381 IF( n.GT.0 .AND. vu.LE.vl )
383 ELSE IF( indeig )
THEN
384 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
386 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
392 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
402 kd = ilaenv2stage( 1,
'ZHETRD_2STAGE', jobz,
404 ib = ilaenv2stage( 2,
'ZHETRD_2STAGE', jobz,
406 lhtrd = ilaenv2stage( 3,
'ZHETRD_2STAGE', jobz,
408 lwtrd = ilaenv2stage( 4,
'ZHETRD_2STAGE', jobz,
410 lwmin = n + lhtrd + lwtrd
414 IF( lwork.LT.lwmin .AND. .NOT.lquery )
419 CALL xerbla(
'ZHEEVX_2STAGE', -info )
421 ELSE IF( lquery )
THEN
433 IF( alleig .OR. indeig )
THEN
435 w( 1 ) = dble( a( 1, 1 ) )
436 ELSE IF( valeig )
THEN
437 IF( vl.LT.dble( a( 1, 1 ) ) .AND. vu.GE.dble( a( 1, 1 ) ) )
440 w( 1 ) = dble( a( 1, 1 ) )
450 safmin = dlamch(
'Safe minimum' )
451 eps = dlamch(
'Precision' )
452 smlnum = safmin / eps
453 bignum = one / smlnum
454 rmin = sqrt( smlnum )
455 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
465 anrm = zlanhe(
'M', uplo, n, a, lda, rwork )
466 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
469 ELSE IF( anrm.GT.rmax )
THEN
473 IF( iscale.EQ.1 )
THEN
476 CALL zdscal( n-j+1, sigma, a( j, j ), 1 )
480 CALL zdscal( j, sigma, a( 1, j ), 1 )
484 $ abstll = abstol*sigma
498 indwrk = indhous + lhtrd
499 llwork = lwork - indwrk + 1
502 $ rwork( inde ), work( indtau ),
503 $ work( indhous ), lhtrd, work( indwrk ),
512 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
516 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
517 CALL dcopy( n, rwork( indd ), 1, w, 1 )
519 IF( .NOT.wantz )
THEN
520 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
521 CALL dsterf( n, w, rwork( indee ), info )
523 CALL zlacpy(
'A', n, n, a, lda, z, ldz )
524 CALL zungtr( uplo, n, z, ldz, work( indtau ),
525 $ work( indwrk ), llwork, iinfo )
526 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
527 CALL zsteqr( jobz, n, w, rwork( indee ), z, ldz,
528 $ rwork( indrwk ), info )
552 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
553 $ rwork( indd ), rwork( inde ), m, nsplit, w,
554 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
555 $ iwork( indiwk ), info )
558 CALL zstein( n, rwork( indd ), rwork( inde ), m, w,
559 $ iwork( indibl ), iwork( indisp ), z, ldz,
560 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
565 CALL zunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
566 $ ldz, work( indwrk ), llwork, iinfo )
572 IF( iscale.EQ.1 )
THEN
578 CALL dscal( imax, one / sigma, w, 1 )
589 IF( w( jj ).LT.tmp1 )
THEN
596 itmp1 = iwork( indibl+i-1 )
598 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
600 iwork( indibl+j-1 ) = itmp1
601 CALL zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
604 ifail( i ) = ifail( j )
subroutine xerbla(srname, info)
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
subroutine zheevx_2stage(jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail, info)
ZHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE mat...
subroutine zhetrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
ZHETRD_2STAGE
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine dscal(n, da, dx, incx)
DSCAL
subroutine zdscal(n, da, zx, incx)
ZDSCAL
subroutine dstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
DSTEBZ
subroutine zstein(n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
ZSTEIN
subroutine zsteqr(compz, n, d, e, z, ldz, work, info)
ZSTEQR
subroutine dsterf(n, d, e, info)
DSTERF
subroutine zswap(n, zx, incx, zy, incy)
ZSWAP
subroutine zungtr(uplo, n, a, lda, tau, work, lwork, info)
ZUNGTR
subroutine zunmtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
ZUNMTR