262 SUBROUTINE sstebz( 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
277 INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * )
278 REAL D( * ), E( * ), W( * ), WORK( * )
284 REAL ZERO, ONE, TWO, HALF
285 parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
286 $ half = 1.0e0 / two )
288 parameter( fudge = 2.1e0, relfac = 2.0e0 )
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 REAL ATOLI, BNORM, GL, GU, PIVMIN, RTOLI, SAFEMN,
297 $ tmp1, tmp2, tnorm, ulp, wkill, wl, wlu, wu, wul
306 EXTERNAL lsame, ilaenv, slamch
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
349 IF( vl.GE.vu ) info = -5
350 ELSE IF( irange.EQ.3 .AND. ( il.LT.1 .OR. il.GT.max( 1, n ) ) )
353 ELSE IF( irange.EQ.3 .AND. ( iu.LT.min( n, il ) .OR. iu.GT.n ) )
359 CALL xerbla(
'SSTEBZ', -info )
377 IF( irange.EQ.3 .AND. il.EQ.1 .AND. iu.EQ.n )
384 safemn = slamch(
'S' )
387 nb = ilaenv( 1,
'SSTEBZ',
' ', n, -1, -1, -1 )
396 IF( irange.EQ.2 .AND. ( vl.GE.d( 1 ) .OR. vu.LT.d( 1 ) ) )
THEN
414 IF( abs( d( j )*d( j-1 ) )*ulp**2+safemn.GT.tmp1 )
THEN
415 isplit( nsplit ) = j - 1
420 pivmin = max( pivmin, tmp1 )
424 pivmin = pivmin*safemn
428 IF( irange.EQ.3 )
THEN
441 tmp2 = sqrt( work( j ) )
442 gu = max( gu, d( j )+tmp1+tmp2 )
443 gl = min( gl, d( j )-tmp1-tmp2 )
447 gu = max( gu, d( n )+tmp1 )
448 gl = min( gl, d( n )-tmp1 )
449 tnorm = max( abs( gl ), abs( gu ) )
450 gl = gl - fudge*tnorm*ulp*n - fudge*two*pivmin
451 gu = gu + fudge*tnorm*ulp*n + fudge*pivmin
455 itmax = int( ( log( tnorm+pivmin )-log( pivmin ) ) /
457 IF( abstol.LE.zero )
THEN
476 CALL slaebz( 3, itmax, n, 2, 2, nb, atoli, rtoli, pivmin, d, e,
477 $ work, iwork( 5 ), work( n+1 ), work( n+5 ), iout,
478 $ iwork, w, iblock, iinfo )
480 IF( iwork( 6 ).EQ.iu )
THEN
496 IF( nwl.LT.0 .OR. nwl.GE.n .OR. nwu.LT.1 .OR. nwu.GT.n )
THEN
504 tnorm = max( abs( d( 1 ) )+abs( e( 1 ) ),
505 $ abs( d( n ) )+abs( e( n-1 ) ) )
508 tnorm = max( tnorm, abs( d( j ) )+abs( e( j-1 ) )+
512 IF( abstol.LE.zero )
THEN
518 IF( irange.EQ.2 )
THEN
547 IF( irange.EQ.1 .OR. wl.GE.d( ibegin )-pivmin )
549 IF( irange.EQ.1 .OR. wu.GE.d( ibegin )-pivmin )
551 IF( irange.EQ.1 .OR. ( wl.LT.d( ibegin )-pivmin .AND. wu.GE.
552 $ d( ibegin )-pivmin ) )
THEN
568 DO 40 j = ibegin, iend - 1
570 gu = max( gu, d( j )+tmp1+tmp2 )
571 gl = min( gl, d( j )-tmp1-tmp2 )
575 gu = max( gu, d( iend )+tmp1 )
576 gl = min( gl, d( iend )-tmp1 )
577 bnorm = max( abs( gl ), abs( gu ) )
578 gl = gl - fudge*bnorm*ulp*in - fudge*pivmin
579 gu = gu + fudge*bnorm*ulp*in + fudge*pivmin
583 IF( abstol.LE.zero )
THEN
584 atoli = ulp*max( abs( gl ), abs( gu ) )
589 IF( irange.GT.1 )
THEN
605 CALL slaebz( 1, 0, in, in, 1, nb, atoli, rtoli, pivmin,
606 $ d( ibegin ), e( ibegin ), work( ibegin ),
607 $ idumma, work( n+1 ), work( n+2*in+1 ), im,
608 $ iwork, w( m+1 ), iblock( m+1 ), iinfo )
610 nwl = nwl + iwork( 1 )
611 nwu = nwu + iwork( in+1 )
612 iwoff = m - iwork( 1 )
616 itmax = int( ( log( gu-gl+pivmin )-log( pivmin ) ) /
618 CALL slaebz( 2, itmax, in, in, 1, nb, atoli, rtoli, pivmin,
619 $ d( ibegin ), e( ibegin ), work( ibegin ),
620 $ idumma, work( n+1 ), work( n+2*in+1 ), iout,
621 $ iwork, w( m+1 ), iblock( m+1 ), iinfo )
627 tmp1 = half*( work( j+n )+work( j+in+n ) )
631 IF( j.GT.iout-iinfo )
THEN
637 DO 50 je = iwork( j ) + 1 + iwoff,
638 $ iwork( j+in ) + iwoff
651 IF( irange.EQ.3 )
THEN
653 idiscl = il - 1 - nwl
656 IF( idiscl.GT.0 .OR. idiscu.GT.0 )
THEN
658 IF( w( je ).LE.wlu .AND. idiscl.GT.0 )
THEN
660 ELSE IF( w( je ).GE.wul .AND. idiscu.GT.0 )
THEN
665 iblock( im ) = iblock( je )
670 IF( idiscl.GT.0 .OR. idiscu.GT.0 )
THEN
682 IF( idiscl.GT.0 )
THEN
684 DO 100 jdisc = 1, idiscl
687 IF( iblock( je ).NE.0 .AND.
688 $ ( w( je ).LT.wkill .OR. iw.EQ.0 ) )
THEN
696 IF( idiscu.GT.0 )
THEN
699 DO 120 jdisc = 1, idiscu
702 IF( iblock( je ).NE.0 .AND.
703 $ ( w( je ).GT.wkill .OR. iw.EQ.0 ) )
THEN
713 IF( iblock( je ).NE.0 )
THEN
716 iblock( im ) = iblock( je )
721 IF( idiscl.LT.0 .OR. idiscu.LT.0 )
THEN
730 IF( iorder.EQ.1 .AND. nsplit.GT.1 )
THEN
735 IF( w( j ).LT.tmp1 )
THEN
744 iblock( ie ) = iblock( je )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine slaebz(IJOB, NITMAX, N, MMAX, MINP, NBMIN, ABSTOL, RELTOL, PIVMIN, D, E, E2, NVAL, AB, C, MOUT, NAB, WORK, IWORK, INFO)
SLAEBZ computes the number of eigenvalues of a real symmetric tridiagonal matrix which are less than ...