335 SUBROUTINE zstemr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
336 $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK,
337 $ IWORK, LIWORK, INFO )
344 CHARACTER JOBZ, RANGE
346 INTEGER IL, INFO, IU, LDZ, NZC, LIWORK, LWORK, M, N
347 DOUBLE PRECISION VL, VU
350 INTEGER ISUPPZ( * ), IWORK( * )
351 DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
352 COMPLEX*16 Z( ldz, * )
358 DOUBLE PRECISION ZERO, ONE, FOUR, MINRGP
359 parameter( zero = 0.0d0, one = 1.0d0,
364 LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
365 INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
366 $ iindwk, iinfo, iinspl, iiu, ilast, in, indd,
367 $ inde2, inderr, indgp, indgrs, indwrk, itmp,
368 $ itmp2, j, jblk, jj, liwmin, lwmin, nsplit,
369 $ nzcmin, offset, wbegin, wend
370 DOUBLE PRECISION BIGNUM, CS, EPS, PIVMIN, R1, R2, RMAX, RMIN,
371 $ rtol1, rtol2, safmin, scale, smlnum, sn,
372 $ thresh, tmp, tnrm, wl, wu
377 DOUBLE PRECISION DLAMCH, DLANST
378 EXTERNAL lsame, dlamch, dlanst
385 INTRINSIC max, min, sqrt
393 wantz = lsame( jobz,
'V' )
394 alleig = lsame( range,
'A' )
395 valeig = lsame( range,
'V' )
396 indeig = lsame( range,
'I' )
398 lquery = ( ( lwork.EQ.-1 ).OR.( liwork.EQ.-1 ) )
399 zquery = ( nzc.EQ.-1 )
425 ELSEIF( indeig )
THEN 432 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN 434 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN 436 ELSE IF( n.LT.0 )
THEN 438 ELSE IF( valeig .AND. n.GT.0 .AND. wu.LE.wl )
THEN 440 ELSE IF( indeig .AND. ( iil.LT.1 .OR. iil.GT.n ) )
THEN 442 ELSE IF( indeig .AND. ( iiu.LT.iil .OR. iiu.GT.n ) )
THEN 444 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN 446 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN 448 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN 454 safmin = dlamch(
'Safe minimum' )
455 eps = dlamch(
'Precision' )
456 smlnum = safmin / eps
457 bignum = one / smlnum
458 rmin = sqrt( smlnum )
459 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
465 IF( wantz .AND. alleig )
THEN 467 ELSE IF( wantz .AND. valeig )
THEN 468 CALL dlarrc(
'T', n, vl, vu, d, e, safmin,
469 $ nzcmin, itmp, itmp2, info )
470 ELSE IF( wantz .AND. indeig )
THEN 476 IF( zquery .AND. info.EQ.0 )
THEN 478 ELSE IF( nzc.LT.nzcmin .AND. .NOT.zquery )
THEN 485 CALL xerbla(
'ZSTEMR', -info )
488 ELSE IF( lquery .OR. zquery )
THEN 499 IF( alleig .OR. indeig )
THEN 503 IF( wl.LT.d( 1 ) .AND. wu.GE.d( 1 ) )
THEN 508 IF( wantz.AND.(.NOT.zquery) )
THEN 517 IF( .NOT.wantz )
THEN 518 CALL dlae2( d(1), e(1), d(2), r1, r2 )
519 ELSE IF( wantz.AND.(.NOT.zquery) )
THEN 520 CALL dlaev2( d(1), e(1), d(2), r1, r2, cs, sn )
523 $ (valeig.AND.(r2.GT.wl).AND.
525 $ (indeig.AND.(iil.EQ.1)) )
THEN 528 IF( wantz.AND.(.NOT.zquery) )
THEN 547 $ (valeig.AND.(r1.GT.wl).AND.
549 $ (indeig.AND.(iiu.EQ.2)) )
THEN 552 IF( wantz.AND.(.NOT.zquery) )
THEN 593 tnrm = dlanst(
'M', n, d, e )
594 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN 596 ELSE IF( tnrm.GT.rmax )
THEN 599 IF( scale.NE.one )
THEN 600 CALL dscal( n, scale, d, 1 )
601 CALL dscal( n-1, scale, e, 1 )
621 CALL dlarrr( n, d, e, iinfo )
637 CALL dcopy(n,d,1,work(indd),1)
641 work( inde2+j-1 ) = e(j)**2
645 IF( .NOT.wantz )
THEN 655 rtol2 = max( sqrt(eps)*5.0d-3, four * eps )
657 CALL dlarre( range, n, wl, wu, iil, iiu, d, e,
658 $ work(inde2), rtol1, rtol2, thresh, nsplit,
659 $ iwork( iinspl ), m, w, work( inderr ),
660 $ work( indgp ), iwork( iindbl ),
661 $ iwork( iindw ), work( indgrs ), pivmin,
662 $ work( indwrk ), iwork( iindwk ), iinfo )
663 IF( iinfo.NE.0 )
THEN 664 info = 10 + abs( iinfo )
677 CALL zlarrv( n, wl, wu, d, e,
678 $ pivmin, iwork( iinspl ), m,
679 $ 1, m, minrgp, rtol1, rtol2,
680 $ w, work( inderr ), work( indgp ), iwork( iindbl ),
681 $ iwork( iindw ), work( indgrs ), z, ldz,
682 $ isuppz, work( indwrk ), iwork( iindwk ), iinfo )
683 IF( iinfo.NE.0 )
THEN 684 info = 20 + abs( iinfo )
694 itmp = iwork( iindbl+j-1 )
695 w( j ) = w( j ) + e( iwork( iinspl+itmp-1 ) )
705 DO 39 jblk = 1, iwork( iindbl+m-1 )
706 iend = iwork( iinspl+jblk-1 )
707 in = iend - ibegin + 1
712 IF( iwork( iindbl+wend ).EQ.jblk )
THEN 717 IF( wend.LT.wbegin )
THEN 722 offset = iwork(iindw+wbegin-1)-1
723 ifirst = iwork(iindw+wbegin-1)
724 ilast = iwork(iindw+wend-1)
727 $ work(indd+ibegin-1), work(inde2+ibegin-1),
728 $ ifirst, ilast, rtol2, offset, w(wbegin),
729 $ work( inderr+wbegin-1 ),
730 $ work( indwrk ), iwork( iindwk ), pivmin,
739 IF( scale.NE.one )
THEN 740 CALL dscal( m, one / scale, w, 1 )
747 IF( nsplit.GT.1 .OR. n.EQ.2 )
THEN 748 IF( .NOT. wantz )
THEN 749 CALL dlasrt(
'I', m, w, iinfo )
750 IF( iinfo.NE.0 )
THEN 759 IF( w( jj ).LT.tmp )
THEN 768 CALL zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
769 itmp = isuppz( 2*i-1 )
770 isuppz( 2*i-1 ) = isuppz( 2*j-1 )
771 isuppz( 2*j-1 ) = itmp
773 isuppz( 2*i ) = isuppz( 2*j )
subroutine dlaev2(A, B, C, RT1, RT2, CS1, SN1)
DLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
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 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 dlarrc(JOBT, N, VL, VU, D, E, PIVMIN, EIGCNT, LCNT, RCNT, INFO)
DLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix.
subroutine dlarrr(N, D, E, INFO)
DLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computa...
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 dscal(N, DA, DX, INCX)
DSCAL
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...
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine dlae2(A, B, C, RT1, RT2)
DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix.
subroutine dlasrt(ID, N, D, INFO)
DLASRT sorts numbers in increasing or decreasing order.