347 SUBROUTINE cheevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
348 $ abstol, m, w, z, ldz, isuppz, work, lwork,
349 $ rwork, lrwork, iwork, liwork, info )
357 CHARACTER JOBZ, RANGE, UPLO
358 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
363 INTEGER ISUPPZ( * ), IWORK( * )
364 REAL RWORK( * ), W( * )
365 COMPLEX A( lda, * ), WORK( * ), Z( ldz, * )
372 parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
375 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
378 INTEGER I, IEEEOK, IINFO, IMAX, INDIBL, INDIFL, INDISP,
379 $ indiwo, indrd, indrdd, indre, indree, indrwk,
380 $ indtau, indwk, indwkn, iscale, itmp1, j, jj,
381 $ liwmin, llwork, llrwork, llwrkn, lrwmin,
382 $ lwkopt, lwmin, nb, nsplit
383 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
384 $ sigma, smlnum, tmp1, vll, vuu
390 EXTERNAL lsame, ilaenv, clansy, slamch
397 INTRINSIC max, min,
REAL, SQRT
403 ieeeok = ilaenv( 10,
'CHEEVR',
'N', 1, 2, 3, 4 )
405 lower = lsame( uplo,
'L' )
406 wantz = lsame( jobz,
'V' )
407 alleig = lsame( range,
'A' )
408 valeig = lsame( range,
'V' )
409 indeig = lsame( range,
'I' )
411 lquery = ( ( lwork.EQ.-1 ) .OR. ( lrwork.EQ.-1 ) .OR.
414 lrwmin = max( 1, 24*n )
415 liwmin = max( 1, 10*n )
416 lwmin = max( 1, 2*n )
419 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
421 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
423 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
425 ELSE IF( n.LT.0 )
THEN
427 ELSE IF( lda.LT.max( 1, n ) )
THEN
431 IF( n.GT.0 .AND. vu.LE.vl )
433 ELSE IF( indeig )
THEN
434 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
436 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
442 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
448 nb = ilaenv( 1,
'CHETRD', uplo, n, -1, -1, -1 )
449 nb = max( nb, ilaenv( 1,
'CUNMTR', uplo, n, -1, -1, -1 ) )
450 lwkopt = max( ( nb+1 )*n, lwmin )
455 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
457 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
459 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
465 CALL
xerbla(
'CHEEVR', -info )
467 ELSE IF( lquery )
THEN
481 IF( alleig .OR. indeig )
THEN
483 w( 1 ) =
REAL( A( 1, 1 ) )
485 IF( vl.LT.
REAL( A( 1, 1 ) ) .AND. VU.GE.
REAL( A( 1, 1 ) ) )
488 w( 1 ) =
REAL( A( 1, 1 ) )
501 safmin = slamch(
'Safe minimum' )
502 eps = slamch(
'Precision' )
503 smlnum = safmin / eps
504 bignum = one / smlnum
505 rmin = sqrt( smlnum )
506 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
516 anrm = clansy(
'M', uplo, n, a, lda, rwork )
517 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
520 ELSE IF( anrm.GT.rmax )
THEN
524 IF( iscale.EQ.1 )
THEN
527 CALL
csscal( n-j+1, sigma, a( j, j ), 1 )
531 CALL
csscal( j, sigma, a( 1, j ), 1 )
535 $ abstll = abstol*sigma
551 llwork = lwork - indwk + 1
568 llrwork = lrwork - indrwk + 1
587 CALL
chetrd( uplo, n, a, lda, rwork( indrd ), rwork( indre ),
588 $ work( indtau ), work( indwk ), llwork, iinfo )
595 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
599 IF( ( alleig.OR.test ) .AND. ( ieeeok.EQ.1 ) )
THEN
600 IF( .NOT.wantz )
THEN
601 CALL
scopy( n, rwork( indrd ), 1, w, 1 )
602 CALL
scopy( n-1, rwork( indre ), 1, rwork( indree ), 1 )
603 CALL
ssterf( n, w, rwork( indree ), info )
605 CALL
scopy( n-1, rwork( indre ), 1, rwork( indree ), 1 )
606 CALL
scopy( n, rwork( indrd ), 1, rwork( indrdd ), 1 )
608 IF (abstol .LE. two*n*eps)
THEN
613 CALL
cstemr( jobz,
'A', n, rwork( indrdd ),
614 $ rwork( indree ), vl, vu, il, iu, m, w,
615 $ z, ldz, n, isuppz, tryrac,
616 $ rwork( indrwk ), llrwork,
617 $ iwork, liwork, info )
622 IF( wantz .AND. info.EQ.0 )
THEN
624 llwrkn = lwork - indwkn + 1
625 CALL
cunmtr(
'L', uplo,
'N', n, m, a, lda,
626 $ work( indtau ), z, ldz, work( indwkn ),
648 CALL
sstebz( range, order, n, vll, vuu, il, iu, abstll,
649 $ rwork( indrd ), rwork( indre ), m, nsplit, w,
650 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
651 $ iwork( indiwo ), info )
654 CALL
cstein( n, rwork( indrd ), rwork( indre ), m, w,
655 $ iwork( indibl ), iwork( indisp ), z, ldz,
656 $ rwork( indrwk ), iwork( indiwo ), iwork( indifl ),
663 llwrkn = lwork - indwkn + 1
664 CALL
cunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
665 $ ldz, work( indwkn ), llwrkn, iinfo )
671 IF( iscale.EQ.1 )
THEN
677 CALL
sscal( imax, one / sigma, w, 1 )
688 IF( w( jj ).LT.tmp1 )
THEN
695 itmp1 = iwork( indibl+i-1 )
697 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
699 iwork( indibl+j-1 ) = itmp1
700 CALL
cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
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 xerbla(SRNAME, INFO)
XERBLA
subroutine cunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMTR
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine cheevr(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CHEEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...
subroutine cstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
CSTEIN
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine chetrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
CHETRD
subroutine sscal(N, SA, SX, INCX)
SSCAL