328 SUBROUTINE cstemr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
329 $ m, w, z, ldz, nzc, isuppz, tryrac, work, lwork,
330 $ iwork, liwork, info )
338 CHARACTER jobz, range
340 INTEGER il, info, iu, ldz, nzc, liwork, lwork, m, n
344 INTEGER isuppz( * ), iwork( * )
345 REAL d( * ), e( * ), w( * ), work( * )
352 REAL zero, one, four, minrgp
353 parameter( zero = 0.0e0, one = 1.0e0,
358 LOGICAL alleig, indeig, lquery, valeig, wantz, zquery
359 INTEGER i, ibegin, iend, ifirst, iil, iindbl, iindw,
360 $ iindwk, iinfo, iinspl, iiu, ilast, in, indd,
361 $ inde2, inderr, indgp, indgrs, indwrk, itmp,
362 $ itmp2,
j, jblk, jj, liwmin, lwmin, nsplit,
363 $ nzcmin, offset, wbegin, wend
364 REAL bignum, cs, eps, pivmin, r1, r2, rmax, rmin,
365 $ rtol1, rtol2, safmin, scale, smlnum, sn,
366 $ thresh, tmp, tnrm, wl, wu
379 INTRINSIC max, min, sqrt
387 wantz =
lsame( jobz,
'V' )
388 alleig =
lsame( range,
'A' )
389 valeig =
lsame( range,
'V' )
390 indeig =
lsame( range,
'I' )
392 lquery = ( ( lwork.EQ.-1 ).OR.( liwork.EQ.-1 ) )
393 zquery = ( nzc.EQ.-1 )
419 ELSEIF( indeig )
THEN
426 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
428 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
430 ELSE IF( n.LT.0 )
THEN
432 ELSE IF( valeig .AND. n.GT.0 .AND. wu.LE.wl )
THEN
434 ELSE IF( indeig .AND. ( iil.LT.1 .OR. iil.GT.n ) )
THEN
436 ELSE IF( indeig .AND. ( iiu.LT.iil .OR. iiu.GT.n ) )
THEN
438 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
440 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
442 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
448 safmin =
slamch(
'Safe minimum' )
449 eps =
slamch(
'Precision' )
450 smlnum = safmin / eps
451 bignum = one / smlnum
452 rmin = sqrt( smlnum )
453 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
459 IF( wantz .AND. alleig )
THEN
461 ELSE IF( wantz .AND. valeig )
THEN
462 CALL
slarrc(
'T', n, vl, vu, d, e, safmin,
463 $ nzcmin, itmp, itmp2, info )
464 ELSE IF( wantz .AND. indeig )
THEN
470 IF( zquery .AND. info.EQ.0 )
THEN
472 ELSE IF( nzc.LT.nzcmin .AND. .NOT.zquery )
THEN
479 CALL
xerbla(
'CSTEMR', -info )
482 ELSE IF( lquery .OR. zquery )
THEN
493 IF( alleig .OR. indeig )
THEN
497 IF( wl.LT.d( 1 ) .AND. wu.GE.d( 1 ) )
THEN
502 IF( wantz.AND.(.NOT.zquery) )
THEN
511 IF( .NOT.wantz )
THEN
512 CALL
slae2( d(1), e(1), d(2), r1, r2 )
513 ELSE IF( wantz.AND.(.NOT.zquery) )
THEN
514 CALL
slaev2( d(1), e(1), d(2), r1, r2, cs, sn )
517 $ (valeig.AND.(r2.GT.wl).AND.
519 $ (indeig.AND.(iil.EQ.1)) )
THEN
522 IF( wantz.AND.(.NOT.zquery) )
THEN
541 $ (valeig.AND.(r1.GT.wl).AND.
543 $ (indeig.AND.(iiu.EQ.2)) )
THEN
546 IF( wantz.AND.(.NOT.zquery) )
THEN
587 tnrm =
slanst(
'M', n, d, e )
588 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
590 ELSE IF( tnrm.GT.rmax )
THEN
593 IF( scale.NE.one )
THEN
594 CALL
sscal( n, scale, d, 1 )
595 CALL
sscal( n-1, scale, e, 1 )
615 CALL
slarrr( n, d, e, iinfo )
631 CALL
scopy(n,d,1,work(indd),1)
635 work( inde2+
j-1 ) = e(
j)**2
639 IF( .NOT.wantz )
THEN
648 rtol1 = max( sqrt(eps)*5.0e-2, four * eps )
649 rtol2 = max( sqrt(eps)*5.0e-3, four * eps )
651 CALL
slarre( range, n, wl, wu, iil, iiu, d, e,
652 $ work(inde2), rtol1, rtol2, thresh, nsplit,
653 $ iwork( iinspl ), m, w, work( inderr ),
654 $ work( indgp ), iwork( iindbl ),
655 $ iwork( iindw ), work( indgrs ), pivmin,
656 $ work( indwrk ), iwork( iindwk ), iinfo )
657 IF( iinfo.NE.0 )
THEN
658 info = 10 + abs( iinfo )
671 CALL
clarrv( n, wl, wu, d, e,
672 $ pivmin, iwork( iinspl ), m,
673 $ 1, m, minrgp, rtol1, rtol2,
674 $ w, work( inderr ), work( indgp ), iwork( iindbl ),
675 $ iwork( iindw ), work( indgrs ), z, ldz,
676 $ isuppz, work( indwrk ), iwork( iindwk ), iinfo )
677 IF( iinfo.NE.0 )
THEN
678 info = 20 + abs( iinfo )
688 itmp = iwork( iindbl+
j-1 )
689 w(
j ) = w(
j ) + e( iwork( iinspl+itmp-1 ) )
699 DO 39 jblk = 1, iwork( iindbl+m-1 )
700 iend = iwork( iinspl+jblk-1 )
701 in = iend - ibegin + 1
706 IF( iwork( iindbl+wend ).EQ.jblk )
THEN
711 IF( wend.LT.wbegin )
THEN
716 offset = iwork(iindw+wbegin-1)-1
717 ifirst = iwork(iindw+wbegin-1)
718 ilast = iwork(iindw+wend-1)
721 $ work(indd+ibegin-1), work(inde2+ibegin-1),
722 $ ifirst, ilast, rtol2, offset, w(wbegin),
723 $ work( inderr+wbegin-1 ),
724 $ work( indwrk ), iwork( iindwk ), pivmin,
733 IF( scale.NE.one )
THEN
734 CALL
sscal( m, one / scale, w, 1 )
741 IF( nsplit.GT.1 .OR. n.EQ.2 )
THEN
742 IF( .NOT. wantz )
THEN
743 CALL
slasrt(
'I', m, w, iinfo )
744 IF( iinfo.NE.0 )
THEN
753 IF( w( jj ).LT.tmp )
THEN
762 CALL
cswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
763 itmp = isuppz( 2*i-1 )
764 isuppz( 2*i-1 ) = isuppz( 2*
j-1 )
765 isuppz( 2*
j-1 ) = itmp
767 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...
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
REAL function slanst(NORM, N, D, E)
SLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix.
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 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 cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
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 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...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real 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 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