354 SUBROUTINE cheevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
355 $ abstol, m, w, z, ldz, isuppz, work, lwork,
356 $ rwork, lrwork, iwork, liwork, info )
364 CHARACTER JOBZ, RANGE, UPLO
365 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
370 INTEGER ISUPPZ( * ), IWORK( * )
371 REAL RWORK( * ), W( * )
372 COMPLEX A( lda, * ), WORK( * ), Z( ldz, * )
379 parameter ( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
382 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
385 INTEGER I, IEEEOK, IINFO, IMAX, INDIBL, INDIFL, INDISP,
386 $ indiwo, indrd, indrdd, indre, indree, indrwk,
387 $ indtau, indwk, indwkn, iscale, itmp1, j, jj,
388 $ liwmin, llwork, llrwork, llwrkn, lrwmin,
389 $ lwkopt, lwmin, nb, nsplit
390 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
391 $ sigma, smlnum, tmp1, vll, vuu
397 EXTERNAL lsame, ilaenv, clansy, slamch
404 INTRINSIC max, min,
REAL, SQRT
410 ieeeok = ilaenv( 10,
'CHEEVR',
'N', 1, 2, 3, 4 )
412 lower = lsame( uplo,
'L' )
413 wantz = lsame( jobz,
'V' )
414 alleig = lsame( range,
'A' )
415 valeig = lsame( range,
'V' )
416 indeig = lsame( range,
'I' )
418 lquery = ( ( lwork.EQ.-1 ) .OR. ( lrwork.EQ.-1 ) .OR.
421 lrwmin = max( 1, 24*n )
422 liwmin = max( 1, 10*n )
423 lwmin = max( 1, 2*n )
426 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
428 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
430 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
432 ELSE IF( n.LT.0 )
THEN
434 ELSE IF( lda.LT.max( 1, n ) )
THEN
438 IF( n.GT.0 .AND. vu.LE.vl )
440 ELSE IF( indeig )
THEN
441 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
443 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
449 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
455 nb = ilaenv( 1,
'CHETRD', uplo, n, -1, -1, -1 )
456 nb = max( nb, ilaenv( 1,
'CUNMTR', uplo, n, -1, -1, -1 ) )
457 lwkopt = max( ( nb+1 )*n, lwmin )
462 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
464 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
466 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
472 CALL xerbla(
'CHEEVR', -info )
474 ELSE IF( lquery )
THEN
488 IF( alleig .OR. indeig )
THEN
490 w( 1 ) =
REAL( A( 1, 1 ) )
492 IF( vl.LT.
REAL( A( 1, 1 ) ) .AND. VU.GE.
REAL( A( 1, 1 ) ) )
495 w( 1 ) =
REAL( A( 1, 1 ) )
508 safmin = slamch(
'Safe minimum' )
509 eps = slamch(
'Precision' )
510 smlnum = safmin / eps
511 bignum = one / smlnum
512 rmin = sqrt( smlnum )
513 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
523 anrm = clansy(
'M', uplo, n, a, lda, rwork )
524 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
527 ELSE IF( anrm.GT.rmax )
THEN
531 IF( iscale.EQ.1 )
THEN
534 CALL csscal( n-j+1, sigma, a( j, j ), 1 )
538 CALL csscal( j, sigma, a( 1, j ), 1 )
542 $ abstll = abstol*sigma
558 llwork = lwork - indwk + 1
575 llrwork = lrwork - indrwk + 1
594 CALL chetrd( uplo, n, a, lda, rwork( indrd ), rwork( indre ),
595 $ work( indtau ), work( indwk ), llwork, iinfo )
602 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
606 IF( ( alleig.OR.test ) .AND. ( ieeeok.EQ.1 ) )
THEN
607 IF( .NOT.wantz )
THEN
608 CALL scopy( n, rwork( indrd ), 1, w, 1 )
609 CALL scopy( n-1, rwork( indre ), 1, rwork( indree ), 1 )
610 CALL ssterf( n, w, rwork( indree ), info )
612 CALL scopy( n-1, rwork( indre ), 1, rwork( indree ), 1 )
613 CALL scopy( n, rwork( indrd ), 1, rwork( indrdd ), 1 )
615 IF (abstol .LE. two*n*eps)
THEN
620 CALL cstemr( jobz,
'A', n, rwork( indrdd ),
621 $ rwork( indree ), vl, vu, il, iu, m, w,
622 $ z, ldz, n, isuppz, tryrac,
623 $ rwork( indrwk ), llrwork,
624 $ iwork, liwork, info )
629 IF( wantz .AND. info.EQ.0 )
THEN
631 llwrkn = lwork - indwkn + 1
632 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda,
633 $ work( indtau ), z, ldz, work( indwkn ),
655 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
656 $ rwork( indrd ), rwork( indre ), m, nsplit, w,
657 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
658 $ iwork( indiwo ), info )
661 CALL cstein( n, rwork( indrd ), rwork( indre ), m, w,
662 $ iwork( indibl ), iwork( indisp ), z, ldz,
663 $ rwork( indrwk ), iwork( indiwo ), iwork( indifl ),
670 llwrkn = lwork - indwkn + 1
671 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
672 $ ldz, work( indwkn ), llwrkn, iinfo )
678 IF( iscale.EQ.1 )
THEN
684 CALL sscal( imax, one / sigma, w, 1 )
695 IF( w( jj ).LT.tmp1 )
THEN
702 itmp1 = iwork( indibl+i-1 )
704 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
706 iwork( indibl+j-1 ) = itmp1
707 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine cunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMTR
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 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 sscal(N, SA, SX, INCX)
SSCAL
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 cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine csscal(N, SA, CX, INCX)
CSSCAL