311 SUBROUTINE sstemr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
312 $ m, w, z, ldz, nzc, isuppz, tryrac, work, lwork,
313 $ iwork, liwork, info )
321 CHARACTER JOBZ, RANGE
323 INTEGER IL, INFO, IU, LDZ, NZC, LIWORK, LWORK, M, N
327 INTEGER ISUPPZ( * ), IWORK( * )
328 REAL D( * ), E( * ), W( * ), WORK( * )
335 REAL ZERO, ONE, FOUR, MINRGP
336 parameter( zero = 0.0e0, one = 1.0e0,
341 LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
342 INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
343 $ iindwk, iinfo, iinspl, iiu, ilast, in, indd,
344 $ inde2, inderr, indgp, indgrs, indwrk, itmp,
345 $ itmp2, j, jblk, jj, liwmin, lwmin, nsplit,
346 $ nzcmin, offset, wbegin, wend
347 REAL BIGNUM, CS, EPS, PIVMIN, R1, R2, RMAX, RMIN,
348 $ rtol1, rtol2, safmin, scale, smlnum, sn,
349 $ thresh, tmp, tnrm, wl, wu
355 EXTERNAL lsame, slamch, slanst
362 INTRINSIC max, min, sqrt
368 wantz = lsame( jobz,
'V' )
369 alleig = lsame( range,
'A' )
370 valeig = lsame( range,
'V' )
371 indeig = lsame( range,
'I' )
373 lquery = ( ( lwork.EQ.-1 ).OR.( liwork.EQ.-1 ) )
374 zquery = ( nzc.EQ.-1 )
400 ELSEIF( indeig )
THEN
407 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
409 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
411 ELSE IF( n.LT.0 )
THEN
413 ELSE IF( valeig .AND. n.GT.0 .AND. wu.LE.wl )
THEN
415 ELSE IF( indeig .AND. ( iil.LT.1 .OR. iil.GT.n ) )
THEN
417 ELSE IF( indeig .AND. ( iiu.LT.iil .OR. iiu.GT.n ) )
THEN
419 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
421 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
423 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
429 safmin = slamch(
'Safe minimum' )
430 eps = slamch(
'Precision' )
431 smlnum = safmin / eps
432 bignum = one / smlnum
433 rmin = sqrt( smlnum )
434 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
440 IF( wantz .AND. alleig )
THEN
442 ELSE IF( wantz .AND. valeig )
THEN
443 CALL slarrc(
'T', n, vl, vu, d, e, safmin,
444 $ nzcmin, itmp, itmp2, info )
445 ELSE IF( wantz .AND. indeig )
THEN
451 IF( zquery .AND. info.EQ.0 )
THEN
453 ELSE IF( nzc.LT.nzcmin .AND. .NOT.zquery )
THEN
460 CALL xerbla(
'SSTEMR', -info )
463 ELSE IF( lquery .OR. zquery )
THEN
474 IF( alleig .OR. indeig )
THEN
478 IF( wl.LT.d( 1 ) .AND. wu.GE.d( 1 ) )
THEN
483 IF( wantz.AND.(.NOT.zquery) )
THEN
492 IF( .NOT.wantz )
THEN
493 CALL slae2( d(1), e(1), d(2), r1, r2 )
494 ELSE IF( wantz.AND.(.NOT.zquery) )
THEN
495 CALL slaev2( d(1), e(1), d(2), r1, r2, cs, sn )
498 $ (valeig.AND.(r2.GT.wl).AND.
500 $ (indeig.AND.(iil.EQ.1)) )
THEN
503 IF( wantz.AND.(.NOT.zquery) )
THEN
522 $ (valeig.AND.(r1.GT.wl).AND.
524 $ (indeig.AND.(iiu.EQ.2)) )
THEN
527 IF( wantz.AND.(.NOT.zquery) )
THEN
568 tnrm = slanst(
'M', n, d, e )
569 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
571 ELSE IF( tnrm.GT.rmax )
THEN
574 IF( scale.NE.one )
THEN
575 CALL sscal( n, scale, d, 1 )
576 CALL sscal( n-1, scale, e, 1 )
596 CALL slarrr( n, d, e, iinfo )
612 CALL scopy(n,d,1,work(indd),1)
616 work( inde2+j-1 ) = e(j)**2
620 IF( .NOT.wantz )
THEN
629 rtol1 = max( sqrt(eps)*5.0e-2, four * eps )
630 rtol2 = max( sqrt(eps)*5.0e-3, four * eps )
632 CALL slarre( range, n, wl, wu, iil, iiu, d, e,
633 $ work(inde2), rtol1, rtol2, thresh, nsplit,
634 $ iwork( iinspl ), m, w, work( inderr ),
635 $ work( indgp ), iwork( iindbl ),
636 $ iwork( iindw ), work( indgrs ), pivmin,
637 $ work( indwrk ), iwork( iindwk ), iinfo )
638 IF( iinfo.NE.0 )
THEN
639 info = 10 + abs( iinfo )
652 CALL slarrv( n, wl, wu, d, e,
653 $ pivmin, iwork( iinspl ), m,
654 $ 1, m, minrgp, rtol1, rtol2,
655 $ w, work( inderr ), work( indgp ), iwork( iindbl ),
656 $ iwork( iindw ), work( indgrs ), z, ldz,
657 $ isuppz, work( indwrk ), iwork( iindwk ), iinfo )
658 IF( iinfo.NE.0 )
THEN
659 info = 20 + abs( iinfo )
669 itmp = iwork( iindbl+j-1 )
670 w( j ) = w( j ) + e( iwork( iinspl+itmp-1 ) )
680 DO 39 jblk = 1, iwork( iindbl+m-1 )
681 iend = iwork( iinspl+jblk-1 )
682 in = iend - ibegin + 1
687 IF( iwork( iindbl+wend ).EQ.jblk )
THEN
692 IF( wend.LT.wbegin )
THEN
697 offset = iwork(iindw+wbegin-1)-1
698 ifirst = iwork(iindw+wbegin-1)
699 ilast = iwork(iindw+wend-1)
702 $ work(indd+ibegin-1), work(inde2+ibegin-1),
703 $ ifirst, ilast, rtol2, offset, w(wbegin),
704 $ work( inderr+wbegin-1 ),
705 $ work( indwrk ), iwork( iindwk ), pivmin,
714 IF( scale.NE.one )
THEN
715 CALL sscal( m, one / scale, w, 1 )
722 IF( nsplit.GT.1 .OR. n.EQ.2 )
THEN
723 IF( .NOT. wantz )
THEN
724 CALL slasrt(
'I', m, w, iinfo )
725 IF( iinfo.NE.0 )
THEN
734 IF( w( jj ).LT.tmp )
THEN
743 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
744 itmp = isuppz( 2*i-1 )
745 isuppz( 2*i-1 ) = isuppz( 2*j-1 )
746 isuppz( 2*j-1 ) = itmp
748 isuppz( 2*i ) = isuppz( 2*j )
subroutine slarrr(N, D, E, INFO)
SLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computa...
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine slae2(A, B, C, RT1, RT2)
SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix.
subroutine slaev2(A, B, C, RT1, RT2, CS1, SN1)
SLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine slarrv(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)
SLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues ...
subroutine slarre(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)
SLARRE given the tridiagonal matrix T, sets small off-diagonal elements to zero and for each unreduce...
subroutine slarrc(JOBT, N, VL, VU, D, E, PIVMIN, EIGCNT, LCNT, RCNT, INFO)
SLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix.
subroutine sstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEMR
subroutine slasrt(ID, N, D, INFO)
SLASRT sorts numbers in increasing or decreasing order.
subroutine slarrj(N, D, E2, IFIRST, ILAST, RTOL, OFFSET, W, WERR, WORK, IWORK, PIVMIN, SPDIAM, INFO)
SLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T...
subroutine sscal(N, SA, SX, INCX)
SSCAL