337 SUBROUTINE zstemr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
338 $ m, w, z, ldz, nzc, isuppz, tryrac, work, lwork,
339 $ iwork, liwork, info )
347 CHARACTER JOBZ, RANGE
349 INTEGER IL, INFO, IU, LDZ, NZC, LIWORK, LWORK, M, N
350 DOUBLE PRECISION VL, VU
353 INTEGER ISUPPZ( * ), IWORK( * )
354 DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
355 COMPLEX*16 Z( ldz, * )
361 DOUBLE PRECISION ZERO, ONE, FOUR, MINRGP
362 parameter ( zero = 0.0d0, one = 1.0d0,
367 LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
368 INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
369 $ iindwk, iinfo, iinspl, iiu, ilast, in, indd,
370 $ inde2, inderr, indgp, indgrs, indwrk, itmp,
371 $ itmp2, j, jblk, jj, liwmin, lwmin, nsplit,
372 $ nzcmin, offset, wbegin, wend
373 DOUBLE PRECISION BIGNUM, CS, EPS, PIVMIN, R1, R2, RMAX, RMIN,
374 $ rtol1, rtol2, safmin, scale, smlnum, sn,
375 $ thresh, tmp, tnrm, wl, wu
380 DOUBLE PRECISION DLAMCH, DLANST
381 EXTERNAL lsame, dlamch, dlanst
388 INTRINSIC max, min, sqrt
396 wantz = lsame( jobz,
'V' )
397 alleig = lsame( range,
'A' )
398 valeig = lsame( range,
'V' )
399 indeig = lsame( range,
'I' )
401 lquery = ( ( lwork.EQ.-1 ).OR.( liwork.EQ.-1 ) )
402 zquery = ( nzc.EQ.-1 )
428 ELSEIF( indeig )
THEN
435 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
437 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
439 ELSE IF( n.LT.0 )
THEN
441 ELSE IF( valeig .AND. n.GT.0 .AND. wu.LE.wl )
THEN
443 ELSE IF( indeig .AND. ( iil.LT.1 .OR. iil.GT.n ) )
THEN
445 ELSE IF( indeig .AND. ( iiu.LT.iil .OR. iiu.GT.n ) )
THEN
447 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
449 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
451 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
457 safmin = dlamch(
'Safe minimum' )
458 eps = dlamch(
'Precision' )
459 smlnum = safmin / eps
460 bignum = one / smlnum
461 rmin = sqrt( smlnum )
462 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
468 IF( wantz .AND. alleig )
THEN
470 ELSE IF( wantz .AND. valeig )
THEN
471 CALL dlarrc(
'T', n, vl, vu, d, e, safmin,
472 $ nzcmin, itmp, itmp2, info )
473 ELSE IF( wantz .AND. indeig )
THEN
479 IF( zquery .AND. info.EQ.0 )
THEN
481 ELSE IF( nzc.LT.nzcmin .AND. .NOT.zquery )
THEN
488 CALL xerbla(
'ZSTEMR', -info )
491 ELSE IF( lquery .OR. zquery )
THEN
502 IF( alleig .OR. indeig )
THEN
506 IF( wl.LT.d( 1 ) .AND. wu.GE.d( 1 ) )
THEN
511 IF( wantz.AND.(.NOT.zquery) )
THEN
520 IF( .NOT.wantz )
THEN
521 CALL dlae2( d(1), e(1), d(2), r1, r2 )
522 ELSE IF( wantz.AND.(.NOT.zquery) )
THEN
523 CALL dlaev2( d(1), e(1), d(2), r1, r2, cs, sn )
526 $ (valeig.AND.(r2.GT.wl).AND.
528 $ (indeig.AND.(iil.EQ.1)) )
THEN
531 IF( wantz.AND.(.NOT.zquery) )
THEN
550 $ (valeig.AND.(r1.GT.wl).AND.
552 $ (indeig.AND.(iiu.EQ.2)) )
THEN
555 IF( wantz.AND.(.NOT.zquery) )
THEN
596 tnrm = dlanst(
'M', n, d, e )
597 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
599 ELSE IF( tnrm.GT.rmax )
THEN
602 IF( scale.NE.one )
THEN
603 CALL dscal( n, scale, d, 1 )
604 CALL dscal( n-1, scale, e, 1 )
624 CALL dlarrr( n, d, e, iinfo )
640 CALL dcopy(n,d,1,work(indd),1)
644 work( inde2+j-1 ) = e(j)**2
648 IF( .NOT.wantz )
THEN
658 rtol2 = max( sqrt(eps)*5.0d-3, four * eps )
660 CALL dlarre( range, n, wl, wu, iil, iiu, d, e,
661 $ work(inde2), rtol1, rtol2, thresh, nsplit,
662 $ iwork( iinspl ), m, w, work( inderr ),
663 $ work( indgp ), iwork( iindbl ),
664 $ iwork( iindw ), work( indgrs ), pivmin,
665 $ work( indwrk ), iwork( iindwk ), iinfo )
666 IF( iinfo.NE.0 )
THEN
667 info = 10 + abs( iinfo )
680 CALL zlarrv( n, wl, wu, d, e,
681 $ pivmin, iwork( iinspl ), m,
682 $ 1, m, minrgp, rtol1, rtol2,
683 $ w, work( inderr ), work( indgp ), iwork( iindbl ),
684 $ iwork( iindw ), work( indgrs ), z, ldz,
685 $ isuppz, work( indwrk ), iwork( iindwk ), iinfo )
686 IF( iinfo.NE.0 )
THEN
687 info = 20 + abs( iinfo )
697 itmp = iwork( iindbl+j-1 )
698 w( j ) = w( j ) + e( iwork( iinspl+itmp-1 ) )
708 DO 39 jblk = 1, iwork( iindbl+m-1 )
709 iend = iwork( iinspl+jblk-1 )
710 in = iend - ibegin + 1
715 IF( iwork( iindbl+wend ).EQ.jblk )
THEN
720 IF( wend.LT.wbegin )
THEN
725 offset = iwork(iindw+wbegin-1)-1
726 ifirst = iwork(iindw+wbegin-1)
727 ilast = iwork(iindw+wend-1)
730 $ work(indd+ibegin-1), work(inde2+ibegin-1),
731 $ ifirst, ilast, rtol2, offset, w(wbegin),
732 $ work( inderr+wbegin-1 ),
733 $ work( indwrk ), iwork( iindwk ), pivmin,
742 IF( scale.NE.one )
THEN
743 CALL dscal( m, one / scale, w, 1 )
750 IF( nsplit.GT.1 .OR. n.EQ.2 )
THEN
751 IF( .NOT. wantz )
THEN
752 CALL dlasrt(
'I', m, w, iinfo )
753 IF( iinfo.NE.0 )
THEN
762 IF( w( jj ).LT.tmp )
THEN
771 CALL zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
772 itmp = isuppz( 2*i-1 )
773 isuppz( 2*i-1 ) = isuppz( 2*j-1 )
774 isuppz( 2*j-1 ) = itmp
776 isuppz( 2*i ) = isuppz( 2*j )
subroutine dlasrt(ID, N, D, INFO)
DLASRT sorts numbers in increasing or decreasing order.
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dlae2(A, B, C, RT1, RT2)
DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix.
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine dlarrr(N, D, E, INFO)
DLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computa...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlaev2(A, B, C, RT1, RT2, CS1, SN1)
DLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix.
subroutine dlarrc(JOBT, N, VL, VU, D, E, PIVMIN, EIGCNT, LCNT, RCNT, INFO)
DLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix.
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine zlarrv(N, VL, VU, D, L, PIVMIN, ISPLIT, M, DOL, DOU, MINRGP, RTOL1, RTOL2, W, WERR, WGAP, IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ, WORK, IWORK, INFO)
ZLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues ...
subroutine dlarrj(N, D, E2, IFIRST, ILAST, RTOL, OFFSET, W, WERR, WORK, IWORK, PIVMIN, SPDIAM, INFO)
DLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T...
subroutine zstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
ZSTEMR
subroutine dlarre(RANGE, N, VL, VU, IL, IU, D, E, E2, RTOL1, RTOL2, SPLTOL, NSPLIT, ISPLIT, M, W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN, WORK, IWORK, INFO)
DLARRE given the tridiagonal matrix T, sets small off-diagonal elements to zero and for each unreduce...