262 SUBROUTINE dstebz( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
263 $ m, nsplit, w, iblock, isplit, work, iwork,
272 CHARACTER ORDER, RANGE
273 INTEGER IL, INFO, IU, M, N, NSPLIT
274 DOUBLE PRECISION ABSTOL, VL, VU
277 INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * )
278 DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
284 DOUBLE PRECISION ZERO, ONE, TWO, HALF
285 parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0,
286 $ half = 1.0d0 / two )
287 DOUBLE PRECISION FUDGE, RELFAC
288 parameter( fudge = 2.1d0, relfac = 2.0d0 )
291 LOGICAL NCNVRG, TOOFEW
292 INTEGER IB, IBEGIN, IDISCL, IDISCU, IE, IEND, IINFO,
293 $ im, in, ioff, iorder, iout, irange, itmax,
294 $ itmp1, iw, iwoff, j, jb, jdisc, je, nb, nwl,
296 DOUBLE PRECISION ATOLI, BNORM, GL, GU, PIVMIN, RTOLI, SAFEMN,
297 $ tmp1, tmp2, tnorm, ulp, wkill, wl, wlu, wu, wul
305 DOUBLE PRECISION DLAMCH
306 EXTERNAL lsame, ilaenv, dlamch
312 INTRINSIC abs, int, log, max, min, sqrt
320 IF( lsame( range,
'A' ) )
THEN
322 ELSE IF( lsame( range,
'V' ) )
THEN
324 ELSE IF( lsame( range,
'I' ) )
THEN
332 IF( lsame( order,
'B' ) )
THEN
334 ELSE IF( lsame( order,
'E' ) )
THEN
342 IF( irange.LE.0 )
THEN
344 ELSE IF( iorder.LE.0 )
THEN
346 ELSE IF( n.LT.0 )
THEN
348 ELSE IF( irange.EQ.2 )
THEN
351 ELSE IF( irange.EQ.3 .AND. ( il.LT.1 .OR. il.GT.max( 1, n ) ) )
354 ELSE IF( irange.EQ.3 .AND. ( iu.LT.min( n, il ) .OR. iu.GT.n ) )
360 CALL xerbla(
'DSTEBZ', -info )
378 IF( irange.EQ.3 .AND. il.EQ.1 .AND. iu.EQ.n )
385 safemn = dlamch(
'S' )
388 nb = ilaenv( 1,
'DSTEBZ',
' ', n, -1, -1, -1 )
397 IF( irange.EQ.2 .AND. ( vl.GE.d( 1 ) .OR. vu.LT.d( 1 ) ) )
THEN
415 IF( abs( d( j )*d( j-1 ) )*ulp**2+safemn.GT.tmp1 )
THEN
416 isplit( nsplit ) = j - 1
421 pivmin = max( pivmin, tmp1 )
425 pivmin = pivmin*safemn
429 IF( irange.EQ.3 )
THEN
442 tmp2 = sqrt( work( j ) )
443 gu = max( gu, d( j )+tmp1+tmp2 )
444 gl = min( gl, d( j )-tmp1-tmp2 )
448 gu = max( gu, d( n )+tmp1 )
449 gl = min( gl, d( n )-tmp1 )
450 tnorm = max( abs( gl ), abs( gu ) )
451 gl = gl - fudge*tnorm*ulp*n - fudge*two*pivmin
452 gu = gu + fudge*tnorm*ulp*n + fudge*pivmin
456 itmax = int( ( log( tnorm+pivmin )-log( pivmin ) ) /
458 IF( abstol.LE.zero )
THEN
477 CALL dlaebz( 3, itmax, n, 2, 2, nb, atoli, rtoli, pivmin, d, e,
478 $ work, iwork( 5 ), work( n+1 ), work( n+5 ), iout,
479 $ iwork, w, iblock, iinfo )
481 IF( iwork( 6 ).EQ.iu )
THEN
497 IF( nwl.LT.0 .OR. nwl.GE.n .OR. nwu.LT.1 .OR. nwu.GT.n )
THEN
505 tnorm = max( abs( d( 1 ) )+abs( e( 1 ) ),
506 $ abs( d( n ) )+abs( e( n-1 ) ) )
509 tnorm = max( tnorm, abs( d( j ) )+abs( e( j-1 ) )+
513 IF( abstol.LE.zero )
THEN
519 IF( irange.EQ.2 )
THEN
548 IF( irange.EQ.1 .OR. wl.GE.d( ibegin )-pivmin )
550 IF( irange.EQ.1 .OR. wu.GE.d( ibegin )-pivmin )
552 IF( irange.EQ.1 .OR. ( wl.LT.d( ibegin )-pivmin .AND. wu.GE.
553 $ d( ibegin )-pivmin ) )
THEN
569 DO 40 j = ibegin, iend - 1
571 gu = max( gu, d( j )+tmp1+tmp2 )
572 gl = min( gl, d( j )-tmp1-tmp2 )
576 gu = max( gu, d( iend )+tmp1 )
577 gl = min( gl, d( iend )-tmp1 )
578 bnorm = max( abs( gl ), abs( gu ) )
579 gl = gl - fudge*bnorm*ulp*in - fudge*pivmin
580 gu = gu + fudge*bnorm*ulp*in + fudge*pivmin
584 IF( abstol.LE.zero )
THEN
585 atoli = ulp*max( abs( gl ), abs( gu ) )
590 IF( irange.GT.1 )
THEN
606 CALL dlaebz( 1, 0, in, in, 1, nb, atoli, rtoli, pivmin,
607 $ d( ibegin ), e( ibegin ), work( ibegin ),
608 $ idumma, work( n+1 ), work( n+2*in+1 ), im,
609 $ iwork, w( m+1 ), iblock( m+1 ), iinfo )
611 nwl = nwl + iwork( 1 )
612 nwu = nwu + iwork( in+1 )
613 iwoff = m - iwork( 1 )
617 itmax = int( ( log( gu-gl+pivmin )-log( pivmin ) ) /
619 CALL dlaebz( 2, itmax, in, in, 1, nb, atoli, rtoli, pivmin,
620 $ d( ibegin ), e( ibegin ), work( ibegin ),
621 $ idumma, work( n+1 ), work( n+2*in+1 ), iout,
622 $ iwork, w( m+1 ), iblock( m+1 ), iinfo )
628 tmp1 = half*( work( j+n )+work( j+in+n ) )
632 IF( j.GT.iout-iinfo )
THEN
638 DO 50 je = iwork( j ) + 1 + iwoff,
639 $ iwork( j+in ) + iwoff
652 IF( irange.EQ.3 )
THEN
654 idiscl = il - 1 - nwl
657 IF( idiscl.GT.0 .OR. idiscu.GT.0 )
THEN
659 IF( w( je ).LE.wlu .AND. idiscl.GT.0 )
THEN
661 ELSE IF( w( je ).GE.wul .AND. idiscu.GT.0 )
THEN
666 iblock( im ) = iblock( je )
671 IF( idiscl.GT.0 .OR. idiscu.GT.0 )
THEN
683 IF( idiscl.GT.0 )
THEN
685 DO 100 jdisc = 1, idiscl
688 IF( iblock( je ).NE.0 .AND.
689 $ ( w( je ).LT.wkill .OR. iw.EQ.0 ) )
THEN
697 IF( idiscu.GT.0 )
THEN
700 DO 120 jdisc = 1, idiscu
703 IF( iblock( je ).NE.0 .AND.
704 $ ( w( je ).GT.wkill .OR. iw.EQ.0 ) )
THEN
714 IF( iblock( je ).NE.0 )
THEN
717 iblock( im ) = iblock( je )
722 IF( idiscl.LT.0 .OR. idiscu.LT.0 )
THEN
731 IF( iorder.EQ.1 .AND. nsplit.GT.1 )
THEN
736 IF( w( j ).LT.tmp1 )
THEN
745 iblock( ie ) = iblock( je )
subroutine xerbla(SRNAME, INFO)
XERBLA
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 dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ