403 $ IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ,
404 $ WORK, LWORK, RWORK, LRWORK, IWORK,
414 CHARACTER JOBZ, RANGE, UPLO
415 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
420 INTEGER ISUPPZ( * ), IWORK( * )
421 REAL RWORK( * ), W( * )
422 COMPLEX A( LDA, * ), WORK( * ), Z( LDZ, * )
429 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
432 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
435 INTEGER I, IEEEOK, IINFO, IMAX, INDIBL, INDIFL, INDISP,
436 $ INDIWO, INDRD, INDRDD, INDRE, INDREE, INDRWK,
437 $ indtau, indwk, indwkn, iscale, itmp1, j, jj,
438 $ liwmin, llwork, llrwork, llwrkn, lrwmin,
439 $ lwmin, nsplit, lhtrd, lwtrd, kd, ib, indhous
440 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
441 $ SIGMA, SMLNUM, TMP1, VLL, VUU
445 INTEGER ILAENV, ILAENV2STAGE
447 EXTERNAL lsame, slamch, clansy, ilaenv, ilaenv2stage
454 INTRINSIC real, max, min, sqrt
460 ieeeok = ilaenv( 10,
'CHEEVR',
'N', 1, 2, 3, 4 )
462 lower = lsame( uplo,
'L' )
463 wantz = lsame( jobz,
'V' )
464 alleig = lsame( range,
'A' )
465 valeig = lsame( range,
'V' )
466 indeig = lsame( range,
'I' )
468 lquery = ( ( lwork.EQ.-1 ) .OR. ( lrwork.EQ.-1 ) .OR.
471 kd = ilaenv2stage( 1,
'CHETRD_2STAGE', jobz, n, -1, -1, -1 )
472 ib = ilaenv2stage( 2,
'CHETRD_2STAGE', jobz, n, kd, -1, -1 )
473 lhtrd = ilaenv2stage( 3,
'CHETRD_2STAGE', jobz, n, kd, ib, -1 )
474 lwtrd = ilaenv2stage( 4,
'CHETRD_2STAGE', jobz, n, kd, ib, -1 )
475 lwmin = n + lhtrd + lwtrd
476 lrwmin = max( 1, 24*n )
477 liwmin = max( 1, 10*n )
480 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
482 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
484 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
486 ELSE IF( n.LT.0 )
THEN
488 ELSE IF( lda.LT.max( 1, n ) )
THEN
492 IF( n.GT.0 .AND. vu.LE.vl )
494 ELSE IF( indeig )
THEN
495 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
497 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
503 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
513 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
515 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
517 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
523 CALL xerbla(
'CHEEVR_2STAGE', -info )
525 ELSE IF( lquery )
THEN
539 IF( alleig .OR. indeig )
THEN
541 w( 1 ) = real( a( 1, 1 ) )
543 IF( vl.LT.real( a( 1, 1 ) ) .AND. vu.GE.real( a( 1, 1 ) ) )
546 w( 1 ) = real( a( 1, 1 ) )
559 safmin = slamch(
'Safe minimum' )
560 eps = slamch(
'Precision' )
561 smlnum = safmin / eps
562 bignum = one / smlnum
563 rmin = sqrt( smlnum )
564 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
574 anrm = clansy(
'M', uplo, n, a, lda, rwork )
575 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
578 ELSE IF( anrm.GT.rmax )
THEN
582 IF( iscale.EQ.1 )
THEN
585 CALL csscal( n-j+1, sigma, a( j, j ), 1 )
589 CALL csscal( j, sigma, a( 1, j ), 1 )
593 $ abstll = abstol*sigma
609 indwk = indhous + lhtrd
610 llwork = lwork - indwk + 1
627 llrwork = lrwork - indrwk + 1
647 $ rwork( indre ), work( indtau ),
648 $ work( indhous ), lhtrd,
649 $ work( indwk ), llwork, iinfo )
656 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
660 IF( ( alleig.OR.test ) .AND. ( ieeeok.EQ.1 ) )
THEN
661 IF( .NOT.wantz )
THEN
662 CALL scopy( n, rwork( indrd ), 1, w, 1 )
663 CALL scopy( n-1, rwork( indre ), 1, rwork( indree ), 1 )
664 CALL ssterf( n, w, rwork( indree ), info )
666 CALL scopy( n-1, rwork( indre ), 1, rwork( indree ), 1 )
667 CALL scopy( n, rwork( indrd ), 1, rwork( indrdd ), 1 )
669 IF (abstol .LE. two*n*eps)
THEN
674 CALL cstemr( jobz,
'A', n, rwork( indrdd ),
675 $ rwork( indree ), vl, vu, il, iu, m, w,
676 $ z, ldz, n, isuppz, tryrac,
677 $ rwork( indrwk ), llrwork,
678 $ iwork, liwork, info )
683 IF( wantz .AND. info.EQ.0 )
THEN
685 llwrkn = lwork - indwkn + 1
686 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda,
687 $ work( indtau ), z, ldz, work( indwkn ),
709 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
710 $ rwork( indrd ), rwork( indre ), m, nsplit, w,
711 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
712 $ iwork( indiwo ), info )
715 CALL cstein( n, rwork( indrd ), rwork( indre ), m, w,
716 $ iwork( indibl ), iwork( indisp ), z, ldz,
717 $ rwork( indrwk ), iwork( indiwo ), iwork( indifl ),
724 llwrkn = lwork - indwkn + 1
725 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
726 $ ldz, work( indwkn ), llwrkn, iinfo )
732 IF( iscale.EQ.1 )
THEN
738 CALL sscal( imax, one / sigma, w, 1 )
749 IF( w( jj ).LT.tmp1 )
THEN
756 itmp1 = iwork( indibl+i-1 )
758 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
760 iwork( indibl+j-1 ) = itmp1
761 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
subroutine xerbla(srname, info)
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
subroutine cheevr_2stage(jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, rwork, lrwork, iwork, liwork, info)
CHEEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE mat...
subroutine chetrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
CHETRD_2STAGE
subroutine csscal(n, sa, cx, incx)
CSSCAL
subroutine sscal(n, sa, sx, incx)
SSCAL
subroutine sstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
SSTEBZ
subroutine cstein(n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
CSTEIN
subroutine cstemr(jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, work, lwork, iwork, liwork, info)
CSTEMR
subroutine ssterf(n, d, e, info)
SSTERF
subroutine cswap(n, cx, incx, cy, incy)
CSWAP
subroutine cunmtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
CUNMTR