335 SUBROUTINE cstemr( 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
350 INTEGER ISUPPZ( * ), IWORK( * )
351 REAL D( * ), E( * ), W( * ), WORK( * )
358 REAL ZERO, ONE, FOUR, MINRGP
359 PARAMETER ( ZERO = 0.0e0, one = 1.0e0,
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 REAL BIGNUM, CS, EPS, PIVMIN, R1, R2, RMAX, RMIN,
371 $ RTOL1, RTOL2, SAFMIN, SCALE, SMLNUM, SN,
372 $ thresh, tmp, tnrm, wl, wu
378 EXTERNAL lsame,
slamch, slanst
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 =
slamch(
'Safe minimum' )
455 eps =
slamch(
'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 slarrc(
'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
488.OR.
ELSE IF( LQUERY ZQUERY ) THEN
499.OR.
IF( ALLEIG INDEIG ) THEN
503.LT..AND..GE.
IF( WLD( 1 ) WUD( 1 ) ) THEN
508.AND..NOT.
IF( WANTZ(ZQUERY) ) THEN
517.NOT.
IF( WANTZ ) THEN
518 CALL SLAE2( D(1), E(1), D(2), R1, R2 )
519.AND..NOT.
ELSE IF( WANTZ(ZQUERY) ) THEN
520 CALL SLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
523.AND..GT..AND.
$ (VALEIG(R2WL)
525.AND..EQ.
$ (INDEIG(IIL1)) ) THEN
528.AND..NOT.
IF( WANTZ(ZQUERY) ) THEN
547.AND..GT..AND.
$ (VALEIG(R1WL)
549.AND..EQ.
$ (INDEIG(IIU2)) ) THEN
552.AND..NOT.
IF( WANTZ(ZQUERY) ) THEN
593 TNRM = SLANST( 'm
', N, D, E )
594.GT..AND..LT.
IF( TNRMZERO TNRMRMIN ) THEN
596.GT.
ELSE IF( TNRMRMAX ) THEN
599.NE.
IF( SCALEONE ) THEN
600 CALL SSCAL( N, SCALE, D, 1 )
601 CALL SSCAL( N-1, SCALE, E, 1 )
621 CALL SLARRR( N, D, E, IINFO )
637 CALL SCOPY(N,D,1,WORK(INDD),1)
641 WORK( INDE2+J-1 ) = E(J)**2
645.NOT.
IF( WANTZ ) THEN
654 RTOL1 = MAX( SQRT(EPS)*5.0E-2, FOUR * EPS )
655 RTOL2 = MAX( SQRT(EPS)*5.0E-3, FOUR * EPS )
657 CALL SLARRE( 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.NE.
IF( IINFO0 ) THEN
664 INFO = 10 + ABS( IINFO )
677 CALL CLARRV( 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.NE.
IF( IINFO0 ) 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.EQ.
IF( IWORK( IINDBL+WEND )JBLK ) THEN
717.LT.
IF( WENDWBEGIN ) 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.NE.
IF( SCALEONE ) THEN
740 CALL SSCAL( M, ONE / SCALE, W, 1 )
747.GT..OR..EQ.
IF( NSPLIT1 N2 ) THEN
748.NOT.
IF( WANTZ ) THEN
749 CALL SLASRT( 'i
', M, W, IINFO )
750.NE.
IF( IINFO0 ) THEN
759.LT.
IF( W( JJ )TMP ) THEN
768 CALL CSWAP( 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 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 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 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 slarrc(jobt, n, vl, vu, d, e, pivmin, eigcnt, lcnt, rcnt, info)
SLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix.
subroutine slasrt(id, n, d, info)
SLASRT sorts numbers in increasing or decreasing order.
subroutine xerbla(srname, info)
XERBLA
subroutine clarrv(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)
CLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues ...
subroutine cstemr(jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, work, lwork, iwork, liwork, info)
CSTEMR
subroutine cswap(n, cx, incx, cy, incy)
CSWAP
subroutine sscal(n, sa, sx, incx)
SSCAL
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
real function slamch(cmach)
SLAMCH