327 SUBROUTINE dlarrd( RANGE, ORDER, N, VL, VU, IL, IU, GERS,
328 $ reltol, d, e, e2, pivmin, nsplit, isplit,
329 $ m, w, werr, wl, wu, iblock, indexw,
330 $ work, iwork, info )
338 CHARACTER ORDER, RANGE
339 INTEGER IL, INFO, IU, M, N, NSPLIT
340 DOUBLE PRECISION PIVMIN, RELTOL, VL, VU, WL, WU
343 INTEGER IBLOCK( * ), INDEXW( * ),
344 $ isplit( * ), iwork( * )
345 DOUBLE PRECISION D( * ), E( * ), E2( * ),
346 $ gers( * ), w( * ), werr( * ), work( * )
352 DOUBLE PRECISION ZERO, ONE, TWO, HALF, FUDGE
353 parameter ( zero = 0.0d0, one = 1.0d0,
354 $ two = 2.0d0, half = one/two,
356 INTEGER ALLRNG, VALRNG, INDRNG
357 parameter( allrng = 1, valrng = 2, indrng = 3 )
360 LOGICAL NCNVRG, TOOFEW
361 INTEGER I, IB, IBEGIN, IDISCL, IDISCU, IE, IEND, IINFO,
362 $ im, in, ioff, iout, irange, itmax, itmp1,
363 $ itmp2, iw, iwoff, j, jblk, jdisc, je, jee, nb,
365 DOUBLE PRECISION ATOLI, EPS, GL, GU, RTOLI, TMP1, TMP2,
366 $ tnorm, uflow, wkill, wlu, wul
375 DOUBLE PRECISION DLAMCH
376 EXTERNAL lsame, ilaenv, dlamch
382 INTRINSIC abs, int, log, max, min
390 IF( lsame( range,
'A' ) )
THEN
392 ELSE IF( lsame( range,
'V' ) )
THEN
394 ELSE IF( lsame( range,
'I' ) )
THEN
402 IF( irange.LE.0 )
THEN
404 ELSE IF( .NOT.(lsame(order,
'B').OR.lsame(order,
'E')) )
THEN
406 ELSE IF( n.LT.0 )
THEN
408 ELSE IF( irange.EQ.valrng )
THEN
411 ELSE IF( irange.EQ.indrng .AND.
412 $ ( il.LT.1 .OR. il.GT.max( 1, n ) ) )
THEN
414 ELSE IF( irange.EQ.indrng .AND.
415 $ ( iu.LT.min( n, il ) .OR. iu.GT.n ) )
THEN
433 IF( irange.EQ.indrng .AND. il.EQ.1 .AND. iu.EQ.n ) irange = 1
437 uflow = dlamch(
'U' )
443 IF( (irange.EQ.allrng).OR.
444 $ ((irange.EQ.valrng).AND.(d(1).GT.vl).AND.(d(1).LE.vu)).OR.
445 $ ((irange.EQ.indrng).AND.(il.EQ.1).AND.(iu.EQ.1)) )
THEN
458 nb = ilaenv( 1,
'DSTEBZ',
' ', n, -1, -1, -1 )
465 gl = min( gl, gers( 2*i - 1))
466 gu = max( gu, gers(2*i) )
469 tnorm = max( abs( gl ), abs( gu ) )
470 gl = gl - fudge*tnorm*eps*n - fudge*two*pivmin
471 gu = gu + fudge*tnorm*eps*n + fudge*two*pivmin
484 atoli = fudge*two*uflow + fudge*two*pivmin
486 IF( irange.EQ.indrng )
THEN
491 itmax = int( ( log( tnorm+pivmin )-log( pivmin ) ) /
506 CALL dlaebz( 3, itmax, n, 2, 2, nb, atoli, rtoli, pivmin,
507 $ d, e, e2, iwork( 5 ), work( n+1 ), work( n+5 ), iout,
508 $ iwork, w, iblock, iinfo )
509 IF( iinfo .NE. 0 )
THEN
514 IF( iwork( 6 ).EQ.iu )
THEN
531 IF( nwl.LT.0 .OR. nwl.GE.n .OR. nwu.LT.1 .OR. nwu.GT.n )
THEN
536 ELSEIF( irange.EQ.valrng )
THEN
540 ELSEIF( irange.EQ.allrng )
THEN
556 DO 70 jblk = 1, nsplit
559 iend = isplit( jblk )
564 IF( wl.GE.d( ibegin )-pivmin )
566 IF( wu.GE.d( ibegin )-pivmin )
568 IF( irange.EQ.allrng .OR.
569 $ ( wl.LT.d( ibegin )-pivmin
570 $ .AND. wu.GE. d( ibegin )-pivmin ) )
THEN
634 DO 40 j = ibegin, iend
635 gl = min( gl, gers( 2*j - 1))
636 gu = max( gu, gers(2*j) )
644 gl = gl - fudge*tnorm*eps*in - fudge*pivmin
645 gu = gu + fudge*tnorm*eps*in + fudge*pivmin
647 IF( irange.GT.1 )
THEN
664 CALL dlaebz( 1, 0, in, in, 1, nb, atoli, rtoli, pivmin,
665 $ d( ibegin ), e( ibegin ), e2( ibegin ),
666 $ idumma, work( n+1 ), work( n+2*in+1 ), im,
667 $ iwork, w( m+1 ), iblock( m+1 ), iinfo )
668 IF( iinfo .NE. 0 )
THEN
673 nwl = nwl + iwork( 1 )
674 nwu = nwu + iwork( in+1 )
675 iwoff = m - iwork( 1 )
678 itmax = int( ( log( gu-gl+pivmin )-log( pivmin ) ) /
680 CALL dlaebz( 2, itmax, in, in, 1, nb, atoli, rtoli, pivmin,
681 $ d( ibegin ), e( ibegin ), e2( ibegin ),
682 $ idumma, work( n+1 ), work( n+2*in+1 ), iout,
683 $ iwork, w( m+1 ), iblock( m+1 ), iinfo )
684 IF( iinfo .NE. 0 )
THEN
694 tmp1 = half*( work( j+n )+work( j+in+n ) )
696 tmp2 = half*abs( work( j+n )-work( j+in+n ) )
697 IF( j.GT.iout-iinfo )
THEN
704 DO 50 je = iwork( j ) + 1 + iwoff,
705 $ iwork( j+in ) + iwoff
708 indexw( je ) = je - iwoff
719 IF( irange.EQ.indrng )
THEN
720 idiscl = il - 1 - nwl
723 IF( idiscl.GT.0 )
THEN
728 IF( w( je ).LE.wlu .AND. idiscl.GT.0 )
THEN
733 werr( im ) = werr( je )
734 indexw( im ) = indexw( je )
735 iblock( im ) = iblock( je )
740 IF( idiscu.GT.0 )
THEN
745 IF( w( je ).GE.wul .AND. idiscu.GT.0 )
THEN
750 werr( im ) = werr( je )
751 indexw( im ) = indexw( je )
752 iblock( im ) = iblock( je )
759 werr( jee ) = werr( je )
760 indexw( jee ) = indexw( je )
761 iblock( jee ) = iblock( je )
766 IF( idiscl.GT.0 .OR. idiscu.GT.0 )
THEN
773 IF( idiscl.GT.0 )
THEN
775 DO 100 jdisc = 1, idiscl
778 IF( iblock( je ).NE.0 .AND.
779 $ ( w( je ).LT.wkill .OR. iw.EQ.0 ) )
THEN
787 IF( idiscu.GT.0 )
THEN
789 DO 120 jdisc = 1, idiscu
792 IF( iblock( je ).NE.0 .AND.
793 $ ( w( je ).GE.wkill .OR. iw.EQ.0 ) )
THEN
804 IF( iblock( je ).NE.0 )
THEN
807 werr( im ) = werr( je )
808 indexw( im ) = indexw( je )
809 iblock( im ) = iblock( je )
814 IF( idiscl.LT.0 .OR. idiscu.LT.0 )
THEN
819 IF(( irange.EQ.allrng .AND. m.NE.n ).OR.
820 $ ( irange.EQ.indrng .AND. m.NE.iu-il+1 ) )
THEN
828 IF( lsame(order,
'E') .AND. nsplit.GT.1 )
THEN
833 IF( w( j ).LT.tmp1 )
THEN
843 werr( ie ) = werr( je )
844 iblock( ie ) = iblock( je )
845 indexw( ie ) = indexw( je )
subroutine dlaebz(IJOB, NITMAX, N, MMAX, MINP, NBMIN, ABSTOL, RELTOL, PIVMIN, D, E, E2, NVAL, AB, C, MOUT, NAB, WORK, IWORK, INFO)
DLAEBZ computes the number of eigenvalues of a real symmetric tridiagonal matrix which are less than ...
subroutine dlarrd(RANGE, ORDER, N, VL, VU, IL, IU, GERS, RELTOL, D, E, E2, PIVMIN, NSPLIT, ISPLIT, M, W, WERR, WL, WU, IBLOCK, INDEXW, WORK, IWORK, INFO)
DLARRD computes the eigenvalues of a symmetric tridiagonal matrix to suitable accuracy.