305 SUBROUTINE cheevx_2stage( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
306 $ il, iu, abstol, m, w, z, ldz, work,
307 $ lwork, rwork, iwork, ifail, info )
317 CHARACTER JOBZ, RANGE, UPLO
318 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
322 INTEGER IFAIL( * ), IWORK( * )
323 REAL RWORK( * ), W( * )
324 COMPLEX A( lda, * ), WORK( * ), Z( ldz, * )
331 parameter ( zero = 0.0e+0, one = 1.0e+0 )
333 parameter ( cone = ( 1.0e+0, 0.0e+0 ) )
336 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
339 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
340 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
341 $ itmp1, j, jj, llwork,
342 $ nsplit, lwmin, lhtrd, lwtrd, kd, ib, indhous
343 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
344 $ sigma, smlnum, tmp1, vll, vuu
350 EXTERNAL lsame, ilaenv, slamch, clanhe
358 INTRINSIC REAL, MAX, MIN, SQRT
364 lower = lsame( uplo,
'L' )
365 wantz = lsame( jobz,
'V' )
366 alleig = lsame( range,
'A' )
367 valeig = lsame( range,
'V' )
368 indeig = lsame( range,
'I' )
369 lquery = ( lwork.EQ.-1 )
372 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
374 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
376 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
378 ELSE IF( n.LT.0 )
THEN
380 ELSE IF( lda.LT.max( 1, n ) )
THEN
384 IF( n.GT.0 .AND. vu.LE.vl )
386 ELSE IF( indeig )
THEN
387 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
389 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
395 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
405 kd = ilaenv( 17,
'CHETRD_2STAGE', jobz, n, -1, -1, -1 )
406 ib = ilaenv( 18,
'CHETRD_2STAGE', jobz, n, kd, -1, -1 )
407 lhtrd = ilaenv( 19,
'CHETRD_2STAGE', jobz, n, kd, ib, -1 )
408 lwtrd = ilaenv( 20,
'CHETRD_2STAGE', jobz, n, kd, ib, -1 )
409 lwmin = n + lhtrd + lwtrd
413 IF( lwork.LT.lwmin .AND. .NOT.lquery )
418 CALL xerbla(
'CHEEVX_2STAGE', -info )
420 ELSE IF( lquery )
THEN
432 IF( alleig .OR. indeig )
THEN
434 w( 1 ) =
REAL( A( 1, 1 ) )
435 ELSE IF( valeig )
THEN
436 IF( vl.LT.
REAL( A( 1, 1 ) ) .AND. VU.GE.
REAL( A( 1, 1 ) ) )
439 w( 1 ) =
REAL( A( 1, 1 ) )
449 safmin = slamch(
'Safe minimum' )
450 eps = slamch(
'Precision' )
451 smlnum = safmin / eps
452 bignum = one / smlnum
453 rmin = sqrt( smlnum )
454 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
464 anrm = clanhe(
'M', uplo, n, a, lda, rwork )
465 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
468 ELSE IF( anrm.GT.rmax )
THEN
472 IF( iscale.EQ.1 )
THEN
475 CALL csscal( n-j+1, sigma, a( j, j ), 1 )
479 CALL csscal( j, sigma, a( 1, j ), 1 )
483 $ abstll = abstol*sigma
497 indwrk = indhous + lhtrd
498 llwork = lwork - indwrk + 1
501 $ rwork( inde ), work( indtau ),
502 $ work( indhous ), lhtrd, work( indwrk ),
511 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
515 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
516 CALL scopy( n, rwork( indd ), 1, w, 1 )
518 IF( .NOT.wantz )
THEN
519 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
520 CALL ssterf( n, w, rwork( indee ), info )
522 CALL clacpy(
'A', n, n, a, lda, z, ldz )
523 CALL cungtr( uplo, n, z, ldz, work( indtau ),
524 $ work( indwrk ), llwork, iinfo )
525 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
526 CALL csteqr( jobz, n, w, rwork( indee ), z, ldz,
527 $ rwork( indrwk ), info )
551 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
552 $ rwork( indd ), rwork( inde ), m, nsplit, w,
553 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
554 $ iwork( indiwk ), info )
557 CALL cstein( n, rwork( indd ), rwork( inde ), m, w,
558 $ iwork( indibl ), iwork( indisp ), z, ldz,
559 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
564 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
565 $ ldz, work( indwrk ), llwork, iinfo )
571 IF( iscale.EQ.1 )
THEN
577 CALL sscal( imax, one / sigma, w, 1 )
588 IF( w( jj ).LT.tmp1 )
THEN
595 itmp1 = iwork( indibl+i-1 )
597 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
599 iwork( indibl+j-1 ) = itmp1
600 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
603 ifail( i ) = ifail( j )
subroutine cstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
CSTEIN
subroutine cheevx_2stage(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, INFO)
CHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE ma...
subroutine cungtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
CUNGTR
subroutine csteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
CSTEQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine chetrd_2stage(VECT, UPLO, N, A, LDA, D, E, TAU, HOUS2, LHOUS2, WORK, LWORK, INFO)
CHETRD_2STAGE
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine cunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMTR
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine csscal(N, SA, CX, INCX)
CSSCAL