356 SUBROUTINE cheevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
357 $ abstol, m, w, z, ldz, isuppz, work, lwork,
358 $ rwork, lrwork, iwork, liwork, info )
366 CHARACTER JOBZ, RANGE, UPLO
367 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
372 INTEGER ISUPPZ( * ), IWORK( * )
373 REAL RWORK( * ), W( * )
374 COMPLEX A( lda, * ), WORK( * ), Z( ldz, * )
381 parameter ( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
384 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
387 INTEGER I, IEEEOK, IINFO, IMAX, INDIBL, INDIFL, INDISP,
388 $ indiwo, indrd, indrdd, indre, indree, indrwk,
389 $ indtau, indwk, indwkn, iscale, itmp1, j, jj,
390 $ liwmin, llwork, llrwork, llwrkn, lrwmin,
391 $ lwkopt, lwmin, nb, nsplit
392 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
393 $ sigma, smlnum, tmp1, vll, vuu
399 EXTERNAL lsame, ilaenv, clansy, slamch
406 INTRINSIC max, min,
REAL, SQRT
412 ieeeok = ilaenv( 10,
'CHEEVR',
'N', 1, 2, 3, 4 )
414 lower = lsame( uplo,
'L' )
415 wantz = lsame( jobz,
'V' )
416 alleig = lsame( range,
'A' )
417 valeig = lsame( range,
'V' )
418 indeig = lsame( range,
'I' )
420 lquery = ( ( lwork.EQ.-1 ) .OR. ( lrwork.EQ.-1 ) .OR.
423 lrwmin = max( 1, 24*n )
424 liwmin = max( 1, 10*n )
425 lwmin = max( 1, 2*n )
428 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
430 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
432 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
434 ELSE IF( n.LT.0 )
THEN
436 ELSE IF( lda.LT.max( 1, n ) )
THEN
440 IF( n.GT.0 .AND. vu.LE.vl )
442 ELSE IF( indeig )
THEN
443 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
445 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
451 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
457 nb = ilaenv( 1,
'CHETRD', uplo, n, -1, -1, -1 )
458 nb = max( nb, ilaenv( 1,
'CUNMTR', uplo, n, -1, -1, -1 ) )
459 lwkopt = max( ( nb+1 )*n, lwmin )
464 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
466 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
468 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
474 CALL xerbla(
'CHEEVR', -info )
476 ELSE IF( lquery )
THEN
490 IF( alleig .OR. indeig )
THEN
492 w( 1 ) =
REAL( A( 1, 1 ) )
494 IF( vl.LT.
REAL( A( 1, 1 ) ) .AND. VU.GE.
REAL( A( 1, 1 ) ) )
497 w( 1 ) =
REAL( A( 1, 1 ) )
510 safmin = slamch(
'Safe minimum' )
511 eps = slamch(
'Precision' )
512 smlnum = safmin / eps
513 bignum = one / smlnum
514 rmin = sqrt( smlnum )
515 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
525 anrm = clansy(
'M', uplo, n, a, lda, rwork )
526 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
529 ELSE IF( anrm.GT.rmax )
THEN
533 IF( iscale.EQ.1 )
THEN
536 CALL csscal( n-j+1, sigma, a( j, j ), 1 )
540 CALL csscal( j, sigma, a( 1, j ), 1 )
544 $ abstll = abstol*sigma
560 llwork = lwork - indwk + 1
577 llrwork = lrwork - indrwk + 1
596 CALL chetrd( uplo, n, a, lda, rwork( indrd ), rwork( indre ),
597 $ work( indtau ), work( indwk ), llwork, iinfo )
604 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
608 IF( ( alleig.OR.test ) .AND. ( ieeeok.EQ.1 ) )
THEN
609 IF( .NOT.wantz )
THEN
610 CALL scopy( n, rwork( indrd ), 1, w, 1 )
611 CALL scopy( n-1, rwork( indre ), 1, rwork( indree ), 1 )
612 CALL ssterf( n, w, rwork( indree ), info )
614 CALL scopy( n-1, rwork( indre ), 1, rwork( indree ), 1 )
615 CALL scopy( n, rwork( indrd ), 1, rwork( indrdd ), 1 )
617 IF (abstol .LE. two*n*eps)
THEN
622 CALL cstemr( jobz,
'A', n, rwork( indrdd ),
623 $ rwork( indree ), vl, vu, il, iu, m, w,
624 $ z, ldz, n, isuppz, tryrac,
625 $ rwork( indrwk ), llrwork,
626 $ iwork, liwork, info )
631 IF( wantz .AND. info.EQ.0 )
THEN
633 llwrkn = lwork - indwkn + 1
634 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda,
635 $ work( indtau ), z, ldz, work( indwkn ),
657 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
658 $ rwork( indrd ), rwork( indre ), m, nsplit, w,
659 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
660 $ iwork( indiwo ), info )
663 CALL cstein( n, rwork( indrd ), rwork( indre ), m, w,
664 $ iwork( indibl ), iwork( indisp ), z, ldz,
665 $ rwork( indrwk ), iwork( indiwo ), iwork( indifl ),
672 llwrkn = lwork - indwkn + 1
673 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
674 $ ldz, work( indwkn ), llwrkn, iinfo )
680 IF( iscale.EQ.1 )
THEN
686 CALL sscal( imax, one / sigma, w, 1 )
697 IF( w( jj ).LT.tmp1 )
THEN
704 itmp1 = iwork( indibl+i-1 )
706 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
708 iwork( indibl+j-1 ) = itmp1
709 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
subroutine cstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
CSTEIN
subroutine chetrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
CHETRD
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 xerbla(SRNAME, INFO)
XERBLA
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 cstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
CSTEMR
subroutine csscal(N, SA, CX, INCX)
CSSCAL