328 SUBROUTINE zstemr( 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
341 DOUBLE PRECISION vl, vu
344 INTEGER isuppz( * ), iwork( * )
345 DOUBLE PRECISION d( * ), e( * ), w( * ), work( * )
346 COMPLEX*16 z( ldz, * )
352 DOUBLE PRECISION zero, one, four, minrgp
353 parameter( zero = 0.0d0, one = 1.0d0,
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 DOUBLE PRECISION 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 =
dlamch(
'Safe minimum' )
449 eps =
dlamch(
'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
dlarrc(
'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(
'ZSTEMR', -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
dlae2( d(1), e(1), d(2), r1, r2 )
513 ELSE IF( wantz.AND.(.NOT.zquery) )
THEN
514 CALL
dlaev2( 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 =
dlanst(
'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
dscal( n, scale, d, 1 )
595 CALL
dscal( n-1, scale, e, 1 )
615 CALL
dlarrr( n, d, e, iinfo )
631 CALL
dcopy(n,d,1,work(indd),1)
635 work( inde2+
j-1 ) = e(
j)**2
639 IF( .NOT.wantz )
THEN
649 rtol2 = max( sqrt(eps)*5.0d-3, four * eps )
651 CALL
dlarre( 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
zlarrv( 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
dscal( m, one / scale, w, 1 )
741 IF( nsplit.GT.1 .OR. n.EQ.2 )
THEN
742 IF( .NOT. wantz )
THEN
743 CALL
dlasrt(
'I', m, w, iinfo )
744 IF( iinfo.NE.0 )
THEN
753 IF( w( jj ).LT.tmp )
THEN
762 CALL
zswap( 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 dlasrt(ID, N, D, INFO)
DLASRT sorts numbers in increasing or decreasing order.
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
LOGICAL function lsame(CA, CB)
LSAME
subroutine dlarrj(N, D, E2, IFIRST, ILAST, RTOL, OFFSET, W, WERR, WORK, IWORK, PIVMIN, SPDIAM, INFO)
DLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T...
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
DOUBLE PRECISION function dlanst(NORM, N, D, E)
DLANST 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 xerbla(SRNAME, INFO)
XERBLA
subroutine dlae2(A, B, C, RT1, RT2)
DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix.
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dlaev2(A, B, C, RT1, RT2, CS1, SN1)
DLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix.
subroutine zstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
ZSTEMR
subroutine dlarre(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)
DLARRE given the tridiagonal matrix T, sets small off-diagonal elements to zero and for each unreduce...
subroutine dlarrr(N, D, E, INFO)
DLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computa...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zlarrv(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)
ZLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues ...
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine dlarrc(JOBT, N, VL, VU, D, E, PIVMIN, EIGCNT, LCNT, RCNT, INFO)
DLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix.