337 SUBROUTINE cstemr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
338 $ m, w, z, ldz, nzc, isuppz, tryrac, work, lwork,
339 $ iwork, liwork, info )
347 CHARACTER JOBZ, RANGE
349 INTEGER IL, INFO, IU, LDZ, NZC, LIWORK, LWORK, M, N
353 INTEGER ISUPPZ( * ), IWORK( * )
354 REAL D( * ), E( * ), W( * ), WORK( * )
361 REAL ZERO, ONE, FOUR, MINRGP
362 parameter ( zero = 0.0e0, one = 1.0e0,
367 LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
368 INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
369 $ iindwk, iinfo, iinspl, iiu, ilast, in, indd,
370 $ inde2, inderr, indgp, indgrs, indwrk, itmp,
371 $ itmp2, j, jblk, jj, liwmin, lwmin, nsplit,
372 $ nzcmin, offset, wbegin, wend
373 REAL BIGNUM, CS, EPS, PIVMIN, R1, R2, RMAX, RMIN,
374 $ rtol1, rtol2, safmin, scale, smlnum, sn,
375 $ thresh, tmp, tnrm, wl, wu
381 EXTERNAL lsame, slamch, slanst
388 INTRINSIC max, min, sqrt
396 wantz = lsame( jobz,
'V' )
397 alleig = lsame( range,
'A' )
398 valeig = lsame( range,
'V' )
399 indeig = lsame( range,
'I' )
401 lquery = ( ( lwork.EQ.-1 ).OR.( liwork.EQ.-1 ) )
402 zquery = ( nzc.EQ.-1 )
428 ELSEIF( indeig )
THEN
435 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
437 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
439 ELSE IF( n.LT.0 )
THEN
441 ELSE IF( valeig .AND. n.GT.0 .AND. wu.LE.wl )
THEN
443 ELSE IF( indeig .AND. ( iil.LT.1 .OR. iil.GT.n ) )
THEN
445 ELSE IF( indeig .AND. ( iiu.LT.iil .OR. iiu.GT.n ) )
THEN
447 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
449 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
451 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
457 safmin = slamch(
'Safe minimum' )
458 eps = slamch(
'Precision' )
459 smlnum = safmin / eps
460 bignum = one / smlnum
461 rmin = sqrt( smlnum )
462 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
468 IF( wantz .AND. alleig )
THEN
470 ELSE IF( wantz .AND. valeig )
THEN
471 CALL slarrc(
'T', n, vl, vu, d, e, safmin,
472 $ nzcmin, itmp, itmp2, info )
473 ELSE IF( wantz .AND. indeig )
THEN
479 IF( zquery .AND. info.EQ.0 )
THEN
481 ELSE IF( nzc.LT.nzcmin .AND. .NOT.zquery )
THEN
488 CALL xerbla(
'CSTEMR', -info )
491 ELSE IF( lquery .OR. zquery )
THEN
502 IF( alleig .OR. indeig )
THEN
506 IF( wl.LT.d( 1 ) .AND. wu.GE.d( 1 ) )
THEN
511 IF( wantz.AND.(.NOT.zquery) )
THEN
520 IF( .NOT.wantz )
THEN
521 CALL slae2( d(1), e(1), d(2), r1, r2 )
522 ELSE IF( wantz.AND.(.NOT.zquery) )
THEN
523 CALL slaev2( d(1), e(1), d(2), r1, r2, cs, sn )
526 $ (valeig.AND.(r2.GT.wl).AND.
528 $ (indeig.AND.(iil.EQ.1)) )
THEN
531 IF( wantz.AND.(.NOT.zquery) )
THEN
550 $ (valeig.AND.(r1.GT.wl).AND.
552 $ (indeig.AND.(iiu.EQ.2)) )
THEN
555 IF( wantz.AND.(.NOT.zquery) )
THEN
596 tnrm = slanst(
'M', n, d, e )
597 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
599 ELSE IF( tnrm.GT.rmax )
THEN
602 IF( scale.NE.one )
THEN
603 CALL sscal( n, scale, d, 1 )
604 CALL sscal( n-1, scale, e, 1 )
624 CALL slarrr( n, d, e, iinfo )
640 CALL scopy(n,d,1,work(indd),1)
644 work( inde2+j-1 ) = e(j)**2
648 IF( .NOT.wantz )
THEN
657 rtol1 = max( sqrt(eps)*5.0e-2, four * eps )
658 rtol2 = max( sqrt(eps)*5.0e-3, four * eps )
660 CALL slarre( range, n, wl, wu, iil, iiu, d, e,
661 $ work(inde2), rtol1, rtol2, thresh, nsplit,
662 $ iwork( iinspl ), m, w, work( inderr ),
663 $ work( indgp ), iwork( iindbl ),
664 $ iwork( iindw ), work( indgrs ), pivmin,
665 $ work( indwrk ), iwork( iindwk ), iinfo )
666 IF( iinfo.NE.0 )
THEN
667 info = 10 + abs( iinfo )
680 CALL clarrv( n, wl, wu, d, e,
681 $ pivmin, iwork( iinspl ), m,
682 $ 1, m, minrgp, rtol1, rtol2,
683 $ w, work( inderr ), work( indgp ), iwork( iindbl ),
684 $ iwork( iindw ), work( indgrs ), z, ldz,
685 $ isuppz, work( indwrk ), iwork( iindwk ), iinfo )
686 IF( iinfo.NE.0 )
THEN
687 info = 20 + abs( iinfo )
697 itmp = iwork( iindbl+j-1 )
698 w( j ) = w( j ) + e( iwork( iinspl+itmp-1 ) )
708 DO 39 jblk = 1, iwork( iindbl+m-1 )
709 iend = iwork( iinspl+jblk-1 )
710 in = iend - ibegin + 1
715 IF( iwork( iindbl+wend ).EQ.jblk )
THEN
720 IF( wend.LT.wbegin )
THEN
725 offset = iwork(iindw+wbegin-1)-1
726 ifirst = iwork(iindw+wbegin-1)
727 ilast = iwork(iindw+wend-1)
730 $ work(indd+ibegin-1), work(inde2+ibegin-1),
731 $ ifirst, ilast, rtol2, offset, w(wbegin),
732 $ work( inderr+wbegin-1 ),
733 $ work( indwrk ), iwork( iindwk ), pivmin,
742 IF( scale.NE.one )
THEN
743 CALL sscal( m, one / scale, w, 1 )
750 IF( nsplit.GT.1 .OR. n.EQ.2 )
THEN
751 IF( .NOT. wantz )
THEN
752 CALL slasrt(
'I', m, w, iinfo )
753 IF( iinfo.NE.0 )
THEN
762 IF( w( jj ).LT.tmp )
THEN
771 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
772 itmp = isuppz( 2*i-1 )
773 isuppz( 2*i-1 ) = isuppz( 2*j-1 )
774 isuppz( 2*j-1 ) = itmp
776 isuppz( 2*i ) = isuppz( 2*j )
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 slae2(A, B, C, RT1, RT2)
SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix.
subroutine slasrt(ID, N, D, INFO)
SLASRT sorts numbers in increasing or decreasing order.
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 slarrr(N, D, E, INFO)
SLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computa...
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 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 sscal(N, SA, SX, INCX)
SSCAL
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
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 scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine cstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
CSTEMR