320 SUBROUTINE dstemr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
321 $ m, w, z, ldz, nzc, isuppz, tryrac, work, lwork,
322 $ iwork, liwork, info )
330 CHARACTER JOBZ, RANGE
332 INTEGER IL, INFO, IU, LDZ, NZC, LIWORK, LWORK, M, N
333 DOUBLE PRECISION VL, VU
336 INTEGER ISUPPZ( * ), IWORK( * )
337 DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
338 DOUBLE PRECISION Z( ldz, * )
344 DOUBLE PRECISION ZERO, ONE, FOUR, MINRGP
345 parameter ( zero = 0.0d0, one = 1.0d0,
350 LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
351 INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
352 $ iindwk, iinfo, iinspl, iiu, ilast, in, indd,
353 $ inde2, inderr, indgp, indgrs, indwrk, itmp,
354 $ itmp2, j, jblk, jj, liwmin, lwmin, nsplit,
355 $ nzcmin, offset, wbegin, wend
356 DOUBLE PRECISION BIGNUM, CS, EPS, PIVMIN, R1, R2, RMAX, RMIN,
357 $ rtol1, rtol2, safmin, scale, smlnum, sn,
358 $ thresh, tmp, tnrm, wl, wu
363 DOUBLE PRECISION DLAMCH, DLANST
364 EXTERNAL lsame, dlamch, dlanst
371 INTRINSIC max, min, sqrt
379 wantz = lsame( jobz,
'V' )
380 alleig = lsame( range,
'A' )
381 valeig = lsame( range,
'V' )
382 indeig = lsame( range,
'I' )
384 lquery = ( ( lwork.EQ.-1 ).OR.( liwork.EQ.-1 ) )
385 zquery = ( nzc.EQ.-1 )
411 ELSEIF( indeig )
THEN
418 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
420 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
422 ELSE IF( n.LT.0 )
THEN
424 ELSE IF( valeig .AND. n.GT.0 .AND. wu.LE.wl )
THEN
426 ELSE IF( indeig .AND. ( iil.LT.1 .OR. iil.GT.n ) )
THEN
428 ELSE IF( indeig .AND. ( iiu.LT.iil .OR. iiu.GT.n ) )
THEN
430 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
432 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
434 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
440 safmin = dlamch(
'Safe minimum' )
441 eps = dlamch(
'Precision' )
442 smlnum = safmin / eps
443 bignum = one / smlnum
444 rmin = sqrt( smlnum )
445 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
451 IF( wantz .AND. alleig )
THEN
453 ELSE IF( wantz .AND. valeig )
THEN
454 CALL dlarrc(
'T', n, vl, vu, d, e, safmin,
455 $ nzcmin, itmp, itmp2, info )
456 ELSE IF( wantz .AND. indeig )
THEN
462 IF( zquery .AND. info.EQ.0 )
THEN
464 ELSE IF( nzc.LT.nzcmin .AND. .NOT.zquery )
THEN
471 CALL xerbla(
'DSTEMR', -info )
474 ELSE IF( lquery .OR. zquery )
THEN
485 IF( alleig .OR. indeig )
THEN
489 IF( wl.LT.d( 1 ) .AND. wu.GE.d( 1 ) )
THEN
494 IF( wantz.AND.(.NOT.zquery) )
THEN
503 IF( .NOT.wantz )
THEN
504 CALL dlae2( d(1), e(1), d(2), r1, r2 )
505 ELSE IF( wantz.AND.(.NOT.zquery) )
THEN
506 CALL dlaev2( d(1), e(1), d(2), r1, r2, cs, sn )
509 $ (valeig.AND.(r2.GT.wl).AND.
511 $ (indeig.AND.(iil.EQ.1)) )
THEN
514 IF( wantz.AND.(.NOT.zquery) )
THEN
533 $ (valeig.AND.(r1.GT.wl).AND.
535 $ (indeig.AND.(iiu.EQ.2)) )
THEN
538 IF( wantz.AND.(.NOT.zquery) )
THEN
580 tnrm = dlanst(
'M', n, d, e )
581 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
583 ELSE IF( tnrm.GT.rmax )
THEN
586 IF( scale.NE.one )
THEN
587 CALL dscal( n, scale, d, 1 )
588 CALL dscal( n-1, scale, e, 1 )
608 CALL dlarrr( n, d, e, iinfo )
624 CALL dcopy(n,d,1,work(indd),1)
628 work( inde2+j-1 ) = e(j)**2
632 IF( .NOT.wantz )
THEN
642 rtol2 = max( sqrt(eps)*5.0d-3, four * eps )
644 CALL dlarre( range, n, wl, wu, iil, iiu, d, e,
645 $ work(inde2), rtol1, rtol2, thresh, nsplit,
646 $ iwork( iinspl ), m, w, work( inderr ),
647 $ work( indgp ), iwork( iindbl ),
648 $ iwork( iindw ), work( indgrs ), pivmin,
649 $ work( indwrk ), iwork( iindwk ), iinfo )
650 IF( iinfo.NE.0 )
THEN
651 info = 10 + abs( iinfo )
664 CALL dlarrv( n, wl, wu, d, e,
665 $ pivmin, iwork( iinspl ), m,
666 $ 1, m, minrgp, rtol1, rtol2,
667 $ w, work( inderr ), work( indgp ), iwork( iindbl ),
668 $ iwork( iindw ), work( indgrs ), z, ldz,
669 $ isuppz, work( indwrk ), iwork( iindwk ), iinfo )
670 IF( iinfo.NE.0 )
THEN
671 info = 20 + abs( iinfo )
681 itmp = iwork( iindbl+j-1 )
682 w( j ) = w( j ) + e( iwork( iinspl+itmp-1 ) )
692 DO 39 jblk = 1, iwork( iindbl+m-1 )
693 iend = iwork( iinspl+jblk-1 )
694 in = iend - ibegin + 1
699 IF( iwork( iindbl+wend ).EQ.jblk )
THEN
704 IF( wend.LT.wbegin )
THEN
709 offset = iwork(iindw+wbegin-1)-1
710 ifirst = iwork(iindw+wbegin-1)
711 ilast = iwork(iindw+wend-1)
714 $ work(indd+ibegin-1), work(inde2+ibegin-1),
715 $ ifirst, ilast, rtol2, offset, w(wbegin),
716 $ work( inderr+wbegin-1 ),
717 $ work( indwrk ), iwork( iindwk ), pivmin,
726 IF( scale.NE.one )
THEN
727 CALL dscal( m, one / scale, w, 1 )
736 IF( nsplit.GT.1 .OR. n.EQ.2 )
THEN
737 IF( .NOT. wantz )
THEN
738 CALL dlasrt(
'I', m, w, iinfo )
739 IF( iinfo.NE.0 )
THEN
748 IF( w( jj ).LT.tmp )
THEN
757 CALL dswap( n, z( 1, i ), 1, z( 1, j ), 1 )
758 itmp = isuppz( 2*i-1 )
759 isuppz( 2*i-1 ) = isuppz( 2*j-1 )
760 isuppz( 2*j-1 ) = itmp
762 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 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 dswap(N, DX, INCX, DY, INCY)
DSWAP
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 dlarrv(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)
DLARRV 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 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 dstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEMR