320 SUBROUTINE sstemr( 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
336 INTEGER ISUPPZ( * ), IWORK( * )
337 REAL D( * ), E( * ), W( * ), WORK( * )
344 REAL ZERO, ONE, FOUR, MINRGP
345 parameter ( zero = 0.0e0, one = 1.0e0,
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 REAL BIGNUM, CS, EPS, PIVMIN, R1, R2, RMAX, RMIN,
357 $ rtol1, rtol2, safmin, scale, smlnum, sn,
358 $ thresh, tmp, tnrm, wl, wu
364 EXTERNAL lsame, slamch, slanst
371 INTRINSIC max, min, sqrt
377 wantz = lsame( jobz,
'V' )
378 alleig = lsame( range,
'A' )
379 valeig = lsame( range,
'V' )
380 indeig = lsame( range,
'I' )
382 lquery = ( ( lwork.EQ.-1 ).OR.( liwork.EQ.-1 ) )
383 zquery = ( nzc.EQ.-1 )
409 ELSEIF( indeig )
THEN
416 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
418 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
420 ELSE IF( n.LT.0 )
THEN
422 ELSE IF( valeig .AND. n.GT.0 .AND. wu.LE.wl )
THEN
424 ELSE IF( indeig .AND. ( iil.LT.1 .OR. iil.GT.n ) )
THEN
426 ELSE IF( indeig .AND. ( iiu.LT.iil .OR. iiu.GT.n ) )
THEN
428 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
430 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
432 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
438 safmin = slamch(
'Safe minimum' )
439 eps = slamch(
'Precision' )
440 smlnum = safmin / eps
441 bignum = one / smlnum
442 rmin = sqrt( smlnum )
443 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
449 IF( wantz .AND. alleig )
THEN
451 ELSE IF( wantz .AND. valeig )
THEN
452 CALL slarrc(
'T', n, vl, vu, d, e, safmin,
453 $ nzcmin, itmp, itmp2, info )
454 ELSE IF( wantz .AND. indeig )
THEN
460 IF( zquery .AND. info.EQ.0 )
THEN
462 ELSE IF( nzc.LT.nzcmin .AND. .NOT.zquery )
THEN
469 CALL xerbla(
'SSTEMR', -info )
472 ELSE IF( lquery .OR. zquery )
THEN
483 IF( alleig .OR. indeig )
THEN
487 IF( wl.LT.d( 1 ) .AND. wu.GE.d( 1 ) )
THEN
492 IF( wantz.AND.(.NOT.zquery) )
THEN
501 IF( .NOT.wantz )
THEN
502 CALL slae2( d(1), e(1), d(2), r1, r2 )
503 ELSE IF( wantz.AND.(.NOT.zquery) )
THEN
504 CALL slaev2( d(1), e(1), d(2), r1, r2, cs, sn )
507 $ (valeig.AND.(r2.GT.wl).AND.
509 $ (indeig.AND.(iil.EQ.1)) )
THEN
512 IF( wantz.AND.(.NOT.zquery) )
THEN
531 $ (valeig.AND.(r1.GT.wl).AND.
533 $ (indeig.AND.(iiu.EQ.2)) )
THEN
536 IF( wantz.AND.(.NOT.zquery) )
THEN
577 tnrm = slanst(
'M', n, d, e )
578 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
580 ELSE IF( tnrm.GT.rmax )
THEN
583 IF( scale.NE.one )
THEN
584 CALL sscal( n, scale, d, 1 )
585 CALL sscal( n-1, scale, e, 1 )
605 CALL slarrr( n, d, e, iinfo )
621 CALL scopy(n,d,1,work(indd),1)
625 work( inde2+j-1 ) = e(j)**2
629 IF( .NOT.wantz )
THEN
638 rtol1 = max( sqrt(eps)*5.0e-2, four * eps )
639 rtol2 = max( sqrt(eps)*5.0e-3, four * eps )
641 CALL slarre( range, n, wl, wu, iil, iiu, d, e,
642 $ work(inde2), rtol1, rtol2, thresh, nsplit,
643 $ iwork( iinspl ), m, w, work( inderr ),
644 $ work( indgp ), iwork( iindbl ),
645 $ iwork( iindw ), work( indgrs ), pivmin,
646 $ work( indwrk ), iwork( iindwk ), iinfo )
647 IF( iinfo.NE.0 )
THEN
648 info = 10 + abs( iinfo )
661 CALL slarrv( n, wl, wu, d, e,
662 $ pivmin, iwork( iinspl ), m,
663 $ 1, m, minrgp, rtol1, rtol2,
664 $ w, work( inderr ), work( indgp ), iwork( iindbl ),
665 $ iwork( iindw ), work( indgrs ), z, ldz,
666 $ isuppz, work( indwrk ), iwork( iindwk ), iinfo )
667 IF( iinfo.NE.0 )
THEN
668 info = 20 + abs( iinfo )
678 itmp = iwork( iindbl+j-1 )
679 w( j ) = w( j ) + e( iwork( iinspl+itmp-1 ) )
689 DO 39 jblk = 1, iwork( iindbl+m-1 )
690 iend = iwork( iinspl+jblk-1 )
691 in = iend - ibegin + 1
696 IF( iwork( iindbl+wend ).EQ.jblk )
THEN
701 IF( wend.LT.wbegin )
THEN
706 offset = iwork(iindw+wbegin-1)-1
707 ifirst = iwork(iindw+wbegin-1)
708 ilast = iwork(iindw+wend-1)
711 $ work(indd+ibegin-1), work(inde2+ibegin-1),
712 $ ifirst, ilast, rtol2, offset, w(wbegin),
713 $ work( inderr+wbegin-1 ),
714 $ work( indwrk ), iwork( iindwk ), pivmin,
723 IF( scale.NE.one )
THEN
724 CALL sscal( m, one / scale, w, 1 )
731 IF( nsplit.GT.1 .OR. n.EQ.2 )
THEN
732 IF( .NOT. wantz )
THEN
733 CALL slasrt(
'I', m, w, iinfo )
734 IF( iinfo.NE.0 )
THEN
743 IF( w( jj ).LT.tmp )
THEN
752 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
753 itmp = isuppz( 2*i-1 )
754 isuppz( 2*i-1 ) = isuppz( 2*j-1 )
755 isuppz( 2*j-1 ) = itmp
757 isuppz( 2*i ) = isuppz( 2*j )
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 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 slarrr(N, D, E, INFO)
SLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computa...
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 xerbla(SRNAME, INFO)
XERBLA
subroutine slaev2(A, B, C, RT1, RT2, CS1, SN1)
SLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix.
subroutine slasrt(ID, N, D, INFO)
SLASRT sorts numbers in increasing or decreasing order.
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 sscal(N, SA, SX, INCX)
SSCAL
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
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 scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine slae2(A, B, C, RT1, RT2)
SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix.