dlarrd.f

Go to the documentation of this file.

*> \brief \b DLARRD computes the eigenvalues of a symmetric tridiagonal matrix to suitable accuracy.
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at 
*            http://www.netlib.org/lapack/explore-html/ 
*
*> \htmlonly
*> Download DLARRD + dependencies 
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrd.f"> 
*> [TGZ]</a> 
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrd.f"> 
*> [ZIP]</a> 
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrd.f"> 
*> [TXT]</a>
*> \endhtmlonly 
*
*  Definition:
*  ===========
*
*       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 )
* 
*       .. Scalar Arguments ..
*       CHARACTER          ORDER, RANGE
*       INTEGER            IL, INFO, IU, M, N, NSPLIT
*       DOUBLE PRECISION    PIVMIN, RELTOL, VL, VU, WL, WU
*       ..
*       .. Array Arguments ..
*       INTEGER            IBLOCK( * ), INDEXW( * ),
*      $                   ISPLIT( * ), IWORK( * )
*       DOUBLE PRECISION   D( * ), E( * ), E2( * ),
*      $                   GERS( * ), W( * ), WERR( * ), WORK( * )
*       ..
*  
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> DLARRD computes the eigenvalues of a symmetric tridiagonal
*> matrix T to suitable accuracy. This is an auxiliary code to be
*> called from DSTEMR.
*> The user may ask for all eigenvalues, all eigenvalues
*> in the half-open interval (VL, VU], or the IL-th through IU-th
*> eigenvalues.
*>
*> To avoid overflow, the matrix must be scaled so that its
*> largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest
*> accuracy, it should not be much smaller than that.
*>
*> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
*> Matrix", Report CS41, Computer Science Dept., Stanford
*> University, July 21, 1966.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] RANGE
*> \verbatim
*>          RANGE is CHARACTER*1
*>          = 'A': ("All")   all eigenvalues will be found.
*>          = 'V': ("Value") all eigenvalues in the half-open interval
*>                           (VL, VU] will be found.
*>          = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
*>                           entire matrix) will be found.
*> \endverbatim
*>
*> \param[in] ORDER
*> \verbatim
*>          ORDER is CHARACTER*1
*>          = 'B': ("By Block") the eigenvalues will be grouped by
*>                              split-off block (see IBLOCK, ISPLIT) and
*>                              ordered from smallest to largest within
*>                              the block.
*>          = 'E': ("Entire matrix")
*>                              the eigenvalues for the entire matrix
*>                              will be ordered from smallest to
*>                              largest.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*>          N is INTEGER
*>          The order of the tridiagonal matrix T.  N >= 0.
*> \endverbatim
*>
*> \param[in] VL
*> \verbatim
*>          VL is DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] VU
*> \verbatim
*>          VU is DOUBLE PRECISION
*>          If RANGE='V', the lower and upper bounds of the interval to
*>          be searched for eigenvalues.  Eigenvalues less than or equal
*>          to VL, or greater than VU, will not be returned.  VL < VU.
*>          Not referenced if RANGE = 'A' or 'I'.
*> \endverbatim
*>
*> \param[in] IL
*> \verbatim
*>          IL is INTEGER
*> \endverbatim
*>
*> \param[in] IU
*> \verbatim
*>          IU is INTEGER
*>          If RANGE='I', the indices (in ascending order) of the
*>          smallest and largest eigenvalues to be returned.
*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
*>          Not referenced if RANGE = 'A' or 'V'.
*> \endverbatim
*>
*> \param[in] GERS
*> \verbatim
*>          GERS is DOUBLE PRECISION array, dimension (2*N)
*>          The N Gerschgorin intervals (the i-th Gerschgorin interval
*>          is (GERS(2*i-1), GERS(2*i)).
*> \endverbatim
*>
*> \param[in] RELTOL
*> \verbatim
*>          RELTOL is DOUBLE PRECISION
*>          The minimum relative width of an interval.  When an interval
*>          is narrower than RELTOL times the larger (in
*>          magnitude) endpoint, then it is considered to be
*>          sufficiently small, i.e., converged.  Note: this should
*>          always be at least radix*machine epsilon.
*> \endverbatim
*>
*> \param[in] D
*> \verbatim
*>          D is DOUBLE PRECISION array, dimension (N)
*>          The n diagonal elements of the tridiagonal matrix T.
*> \endverbatim
*>
*> \param[in] E
*> \verbatim
*>          E is DOUBLE PRECISION array, dimension (N-1)
*>          The (n-1) off-diagonal elements of the tridiagonal matrix T.
*> \endverbatim
*>
*> \param[in] E2
*> \verbatim
*>          E2 is DOUBLE PRECISION array, dimension (N-1)
*>          The (n-1) squared off-diagonal elements of the tridiagonal matrix T.
*> \endverbatim
*>
*> \param[in] PIVMIN
*> \verbatim
*>          PIVMIN is DOUBLE PRECISION
*>          The minimum pivot allowed in the Sturm sequence for T.
*> \endverbatim
*>
*> \param[in] NSPLIT
*> \verbatim
*>          NSPLIT is INTEGER
*>          The number of diagonal blocks in the matrix T.
*>          1 <= NSPLIT <= N.
*> \endverbatim
*>
*> \param[in] ISPLIT
*> \verbatim
*>          ISPLIT is INTEGER array, dimension (N)
*>          The splitting points, at which T breaks up into submatrices.
*>          The first submatrix consists of rows/columns 1 to ISPLIT(1),
*>          the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
*>          etc., and the NSPLIT-th consists of rows/columns
*>          ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
*>          (Only the first NSPLIT elements will actually be used, but
*>          since the user cannot know a priori what value NSPLIT will
*>          have, N words must be reserved for ISPLIT.)
*> \endverbatim
*>
*> \param[out] M
*> \verbatim
*>          M is INTEGER
*>          The actual number of eigenvalues found. 0 <= M <= N.
*>          (See also the description of INFO=2,3.)
*> \endverbatim
*>
*> \param[out] W
*> \verbatim
*>          W is DOUBLE PRECISION array, dimension (N)
*>          On exit, the first M elements of W will contain the
*>          eigenvalue approximations. DLARRD computes an interval
*>          I_j = (a_j, b_j] that includes eigenvalue j. The eigenvalue
*>          approximation is given as the interval midpoint
*>          W(j)= ( a_j + b_j)/2. The corresponding error is bounded by
*>          WERR(j) = abs( a_j - b_j)/2
*> \endverbatim
*>
*> \param[out] WERR
*> \verbatim
*>          WERR is DOUBLE PRECISION array, dimension (N)
*>          The error bound on the corresponding eigenvalue approximation
*>          in W.
*> \endverbatim
*>
*> \param[out] WL
*> \verbatim
*>          WL is DOUBLE PRECISION
*> \endverbatim
*>
*> \param[out] WU
*> \verbatim
*>          WU is DOUBLE PRECISION
*>          The interval (WL, WU] contains all the wanted eigenvalues.
*>          If RANGE='V', then WL=VL and WU=VU.
*>          If RANGE='A', then WL and WU are the global Gerschgorin bounds
*>                        on the spectrum.
*>          If RANGE='I', then WL and WU are computed by DLAEBZ from the
*>                        index range specified.
*> \endverbatim
*>
*> \param[out] IBLOCK
*> \verbatim
*>          IBLOCK is INTEGER array, dimension (N)
*>          At each row/column j where E(j) is zero or small, the
*>          matrix T is considered to split into a block diagonal
*>          matrix.  On exit, if INFO = 0, IBLOCK(i) specifies to which
*>          block (from 1 to the number of blocks) the eigenvalue W(i)
*>          belongs.  (DLARRD may use the remaining N-M elements as
*>          workspace.)
*> \endverbatim
*>
*> \param[out] INDEXW
*> \verbatim
*>          INDEXW is INTEGER array, dimension (N)
*>          The indices of the eigenvalues within each block (submatrix);
*>          for example, INDEXW(i)= j and IBLOCK(i)=k imply that the
*>          i-th eigenvalue W(i) is the j-th eigenvalue in block k.
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*>          WORK is DOUBLE PRECISION array, dimension (4*N)
*> \endverbatim
*>
*> \param[out] IWORK
*> \verbatim
*>          IWORK is INTEGER array, dimension (3*N)
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*>          INFO is INTEGER
*>          = 0:  successful exit
*>          < 0:  if INFO = -i, the i-th argument had an illegal value
*>          > 0:  some or all of the eigenvalues failed to converge or
*>                were not computed:
*>                =1 or 3: Bisection failed to converge for some
*>                        eigenvalues; these eigenvalues are flagged by a
*>                        negative block number.  The effect is that the
*>                        eigenvalues may not be as accurate as the
*>                        absolute and relative tolerances.  This is
*>                        generally caused by unexpectedly inaccurate
*>                        arithmetic.
*>                =2 or 3: RANGE='I' only: Not all of the eigenvalues
*>                        IL:IU were found.
*>                        Effect: M < IU+1-IL
*>                        Cause:  non-monotonic arithmetic, causing the
*>                                Sturm sequence to be non-monotonic.
*>                        Cure:   recalculate, using RANGE='A', and pick
*>                                out eigenvalues IL:IU.  In some cases,
*>                                increasing the PARAMETER "FUDGE" may
*>                                make things work.
*>                = 4:    RANGE='I', and the Gershgorin interval
*>                        initially used was too small.  No eigenvalues
*>                        were computed.
*>                        Probable cause: your machine has sloppy
*>                                        floating-point arithmetic.
*>                        Cure: Increase the PARAMETER "FUDGE",
*>                              recompile, and try again.
*> \endverbatim
*
*> \par Internal Parameters:
*  =========================
*>
*> \verbatim
*>  FUDGE   DOUBLE PRECISION, default = 2
*>          A "fudge factor" to widen the Gershgorin intervals.  Ideally,
*>          a value of 1 should work, but on machines with sloppy
*>          arithmetic, this needs to be larger.  The default for
*>          publicly released versions should be large enough to handle
*>          the worst machine around.  Note that this has no effect
*>          on accuracy of the solution.
*> \endverbatim
*>
*> \par Contributors:
*  ==================
*>
*>     W. Kahan, University of California, Berkeley, USA \n
*>     Beresford Parlett, University of California, Berkeley, USA \n
*>     Jim Demmel, University of California, Berkeley, USA \n
*>     Inderjit Dhillon, University of Texas, Austin, USA \n
*>     Osni Marques, LBNL/NERSC, USA \n
*>     Christof Voemel, University of California, Berkeley, USA \n
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee 
*> \author Univ. of California Berkeley 
*> \author Univ. of Colorado Denver 
*> \author NAG Ltd. 
*
*> \date September 2012
*
*> \ingroup auxOTHERauxiliary
*
*  =====================================================================
      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 )
*
*  -- LAPACK auxiliary routine (version 3.4.2) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     September 2012
*
*     .. Scalar Arguments ..
      CHARACTER          order, range
      INTEGER            il, info, iu, m, n, nsplit
      DOUBLE PRECISION    pivmin, reltol, vl, vu, wl, wu
*     ..
*     .. Array Arguments ..
      INTEGER            iblock( * ), indexw( * ),
     $                   isplit( * ), iwork( * )
      DOUBLE PRECISION   d( * ), e( * ), e2( * ),
     $                   gers( * ), w( * ), werr( * ), work( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      DOUBLE PRECISION   zero, one, two, half, fudge
      parameter( zero = 0.0d0, one = 1.0d0,
     $                     two = 2.0d0, half = one/two,
     $                     fudge = two )
      INTEGER   allrng, valrng, indrng
      parameter( allrng = 1, valrng = 2, indrng = 3 )
*     ..
*     .. Local Scalars ..
      LOGICAL            ncnvrg, toofew
      INTEGER            i, ib, ibegin, idiscl, idiscu, ie, iend, iinfo,
     $                   im, in, ioff, iout, irange, itmax, itmp1,
     $                   itmp2, iw, iwoff, j, jblk, jdisc, je, jee, nb,
     $                   nwl, nwu
      DOUBLE PRECISION   atoli, eps, gl, gu, rtoli, tmp1, tmp2,
     $                   tnorm, uflow, wkill, wlu, wul

*     ..
*     .. Local Arrays ..
      INTEGER            idumma( 1 )
*     ..
*     .. External Functions ..
      LOGICAL            lsame
      INTEGER            ilaenv
      DOUBLE PRECISION   dlamch
      EXTERNAL           lsame, ilaenv, dlamch
*     ..
*     .. External Subroutines ..
      EXTERNAL           dlaebz
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, int, log, max, min
*     ..
*     .. Executable Statements ..
*
      info = 0
*
*     Decode RANGE
*
      IF( lsame( range, 'A' ) ) THEN
         irange = allrng
      ELSE IF( lsame( range, 'V' ) ) THEN
         irange = valrng
      ELSE IF( lsame( range, 'I' ) ) THEN
         irange = indrng
      ELSE
         irange = 0
      END IF
*
*     Check for Errors
*
      IF( irange.LE.0 ) THEN
         info = -1
      ELSE IF( .NOT.(lsame(order,'B').OR.lsame(order,'E')) ) THEN
         info = -2
      ELSE IF( n.LT.0 ) THEN
         info = -3
      ELSE IF( irange.EQ.valrng ) THEN
         IF( vl.GE.vu )
     $      info = -5
      ELSE IF( irange.EQ.indrng .AND.
     $        ( il.LT.1 .OR. il.GT.max( 1, n ) ) ) THEN
         info = -6
      ELSE IF( irange.EQ.indrng .AND.
     $        ( iu.LT.min( n, il ) .OR. iu.GT.n ) ) THEN
         info = -7
      END IF
*
      IF( info.NE.0 ) THEN
         return
      END IF

*     Initialize error flags
      info = 0
      ncnvrg = .false.
      toofew = .false.

*     Quick return if possible
      m = 0
      IF( n.EQ.0 ) return

*     Simplification:
      IF( irange.EQ.indrng .AND. il.EQ.1 .AND. iu.EQ.n ) irange = 1

*     Get machine constants
      eps = dlamch( 'P' )
      uflow = dlamch( 'U' )


*     Special Case when N=1
*     Treat case of 1x1 matrix for quick return
      IF( n.EQ.1 ) THEN
         IF( (irange.EQ.allrng).OR.
     $       ((irange.EQ.valrng).AND.(d(1).GT.vl).AND.(d(1).LE.vu)).OR.
     $       ((irange.EQ.indrng).AND.(il.EQ.1).AND.(iu.EQ.1)) ) THEN
            m = 1
            w(1) = d(1)
*           The computation error of the eigenvalue is zero
            werr(1) = zero
            iblock( 1 ) = 1
            indexw( 1 ) = 1
         ENDIF
         return
      END IF

*     NB is the minimum vector length for vector bisection, or 0
*     if only scalar is to be done.
      nb = ilaenv( 1, 'DSTEBZ', ' ', n, -1, -1, -1 )
      IF( nb.LE.1 ) nb = 0

*     Find global spectral radius
      gl = d(1)
      gu = d(1)
      DO 5 i = 1,n
         gl =  min( gl, gers( 2*i - 1))
         gu = max( gu, gers(2*i) )
 5    continue
*     Compute global Gerschgorin bounds and spectral diameter
      tnorm = max( abs( gl ), abs( gu ) )
      gl = gl - fudge*tnorm*eps*n - fudge*two*pivmin
      gu = gu + fudge*tnorm*eps*n + fudge*two*pivmin
*     [JAN/28/2009] remove the line below since SPDIAM variable not use
*     SPDIAM = GU - GL
*     Input arguments for DLAEBZ:
*     The relative tolerance.  An interval (a,b] lies within
*     "relative tolerance" if  b-a < RELTOL*max(|a|,|b|),
      rtoli = reltol
*     Set the absolute tolerance for interval convergence to zero to force
*     interval convergence based on relative size of the interval.
*     This is dangerous because intervals might not converge when RELTOL is
*     small. But at least a very small number should be selected so that for
*     strongly graded matrices, the code can get relatively accurate
*     eigenvalues.
      atoli = fudge*two*uflow + fudge*two*pivmin

      IF( irange.EQ.indrng ) THEN

*        RANGE='I': Compute an interval containing eigenvalues
*        IL through IU. The initial interval [GL,GU] from the global
*        Gerschgorin bounds GL and GU is refined by DLAEBZ.
         itmax = int( ( log( tnorm+pivmin )-log( pivmin ) ) /
     $           log( two ) ) + 2
         work( n+1 ) = gl
         work( n+2 ) = gl
         work( n+3 ) = gu
         work( n+4 ) = gu
         work( n+5 ) = gl
         work( n+6 ) = gu
         iwork( 1 ) = -1
         iwork( 2 ) = -1
         iwork( 3 ) = n + 1
         iwork( 4 ) = n + 1
         iwork( 5 ) = il - 1
         iwork( 6 ) = iu
*
         CALL dlaebz( 3, itmax, n, 2, 2, nb, atoli, rtoli, pivmin,
     $         d, e, e2, iwork( 5 ), work( n+1 ), work( n+5 ), iout,
     $                iwork, w, iblock, iinfo )
         IF( iinfo .NE. 0 ) THEN
            info = iinfo
            return
         END IF
*        On exit, output intervals may not be ordered by ascending negcount
         IF( iwork( 6 ).EQ.iu ) THEN
            wl = work( n+1 )
            wlu = work( n+3 )
            nwl = iwork( 1 )
            wu = work( n+4 )
            wul = work( n+2 )
            nwu = iwork( 4 )
         ELSE
            wl = work( n+2 )
            wlu = work( n+4 )
            nwl = iwork( 2 )
            wu = work( n+3 )
            wul = work( n+1 )
            nwu = iwork( 3 )
         END IF
*        On exit, the interval [WL, WLU] contains a value with negcount NWL,
*        and [WUL, WU] contains a value with negcount NWU.
         IF( nwl.LT.0 .OR. nwl.GE.n .OR. nwu.LT.1 .OR. nwu.GT.n ) THEN
            info = 4
            return
         END IF

      elseif( irange.EQ.valrng ) THEN
         wl = vl
         wu = vu

      elseif( irange.EQ.allrng ) THEN
         wl = gl
         wu = gu
      ENDIF



*     Find Eigenvalues -- Loop Over blocks and recompute NWL and NWU.
*     NWL accumulates the number of eigenvalues .le. WL,
*     NWU accumulates the number of eigenvalues .le. WU
      m = 0
      iend = 0
      info = 0
      nwl = 0
      nwu = 0
*
      DO 70 jblk = 1, nsplit
         ioff = iend
         ibegin = ioff + 1
         iend = isplit( jblk )
         in = iend - ioff
*
         IF( in.EQ.1 ) THEN
*           1x1 block
            IF( wl.GE.d( ibegin )-pivmin )
     $         nwl = nwl + 1
            IF( wu.GE.d( ibegin )-pivmin )
     $         nwu = nwu + 1
            IF( irange.EQ.allrng .OR.
     $           ( wl.LT.d( ibegin )-pivmin
     $             .AND. wu.GE. d( ibegin )-pivmin ) ) THEN
               m = m + 1
               w( m ) = d( ibegin )
               werr(m) = zero
*              The gap for a single block doesn't matter for the later
*              algorithm and is assigned an arbitrary large value
               iblock( m ) = jblk
               indexw( m ) = 1
            END IF

*        Disabled 2x2 case because of a failure on the following matrix
*        RANGE = 'I', IL = IU = 4
*          Original Tridiagonal, d = [
*           -0.150102010615740E+00
*           -0.849897989384260E+00
*           -0.128208148052635E-15
*            0.128257718286320E-15
*          ];
*          e = [
*           -0.357171383266986E+00
*           -0.180411241501588E-15
*           -0.175152352710251E-15
*          ];
*
*         ELSE IF( IN.EQ.2 ) THEN
**           2x2 block
*            DISC = SQRT( (HALF*(D(IBEGIN)-D(IEND)))**2 + E(IBEGIN)**2 )
*            TMP1 = HALF*(D(IBEGIN)+D(IEND))
*            L1 = TMP1 - DISC
*            IF( WL.GE. L1-PIVMIN )
*     $         NWL = NWL + 1
*            IF( WU.GE. L1-PIVMIN )
*     $         NWU = NWU + 1
*            IF( IRANGE.EQ.ALLRNG .OR. ( WL.LT.L1-PIVMIN .AND. WU.GE.
*     $          L1-PIVMIN ) ) THEN
*               M = M + 1
*               W( M ) = L1
**              The uncertainty of eigenvalues of a 2x2 matrix is very small
*               WERR( M ) = EPS * ABS( W( M ) ) * TWO
*               IBLOCK( M ) = JBLK
*               INDEXW( M ) = 1
*            ENDIF
*            L2 = TMP1 + DISC
*            IF( WL.GE. L2-PIVMIN )
*     $         NWL = NWL + 1
*            IF( WU.GE. L2-PIVMIN )
*     $         NWU = NWU + 1
*            IF( IRANGE.EQ.ALLRNG .OR. ( WL.LT.L2-PIVMIN .AND. WU.GE.
*     $          L2-PIVMIN ) ) THEN
*               M = M + 1
*               W( M ) = L2
**              The uncertainty of eigenvalues of a 2x2 matrix is very small
*               WERR( M ) = EPS * ABS( W( M ) ) * TWO
*               IBLOCK( M ) = JBLK
*               INDEXW( M ) = 2
*            ENDIF
         ELSE
*           General Case - block of size IN >= 2
*           Compute local Gerschgorin interval and use it as the initial
*           interval for DLAEBZ
            gu = d( ibegin )
            gl = d( ibegin )
            tmp1 = zero

            DO 40 j = ibegin, iend
               gl =  min( gl, gers( 2*j - 1))
               gu = max( gu, gers(2*j) )
   40       continue
*           [JAN/28/2009]
*           change SPDIAM by TNORM in lines 2 and 3 thereafter
*           line 1: remove computation of SPDIAM (not useful anymore)
*           SPDIAM = GU - GL
*           GL = GL - FUDGE*SPDIAM*EPS*IN - FUDGE*PIVMIN
*           GU = GU + FUDGE*SPDIAM*EPS*IN + FUDGE*PIVMIN
            gl = gl - fudge*tnorm*eps*in - fudge*pivmin
            gu = gu + fudge*tnorm*eps*in + fudge*pivmin
*
            IF( irange.GT.1 ) THEN
               IF( gu.LT.wl ) THEN
*                 the local block contains none of the wanted eigenvalues
                  nwl = nwl + in
                  nwu = nwu + in
                  go to 70
               END IF
*              refine search interval if possible, only range (WL,WU] matters
               gl = max( gl, wl )
               gu = min( gu, wu )
               IF( gl.GE.gu )
     $            go to 70
            END IF

*           Find negcount of initial interval boundaries GL and GU
            work( n+1 ) = gl
            work( n+in+1 ) = gu
            CALL dlaebz( 1, 0, in, in, 1, nb, atoli, rtoli, pivmin,
     $                   d( ibegin ), e( ibegin ), e2( ibegin ),
     $                   idumma, work( n+1 ), work( n+2*in+1 ), im,
     $                   iwork, w( m+1 ), iblock( m+1 ), iinfo )
            IF( iinfo .NE. 0 ) THEN
               info = iinfo
               return
            END IF
*
            nwl = nwl + iwork( 1 )
            nwu = nwu + iwork( in+1 )
            iwoff = m - iwork( 1 )

*           Compute Eigenvalues
            itmax = int( ( log( gu-gl+pivmin )-log( pivmin ) ) /
     $              log( two ) ) + 2
            CALL dlaebz( 2, itmax, in, in, 1, nb, atoli, rtoli, pivmin,
     $                   d( ibegin ), e( ibegin ), e2( ibegin ),
     $                   idumma, work( n+1 ), work( n+2*in+1 ), iout,
     $                   iwork, w( m+1 ), iblock( m+1 ), iinfo )
            IF( iinfo .NE. 0 ) THEN
               info = iinfo
               return
            END IF
*
*           Copy eigenvalues into W and IBLOCK
*           Use -JBLK for block number for unconverged eigenvalues.
*           Loop over the number of output intervals from DLAEBZ
            DO 60 j = 1, iout
*              eigenvalue approximation is middle point of interval
               tmp1 = half*( work( j+n )+work( j+in+n ) )
*              semi length of error interval
               tmp2 = half*abs( work( j+n )-work( j+in+n ) )
               IF( j.GT.iout-iinfo ) THEN
*                 Flag non-convergence.
                  ncnvrg = .true.
                  ib = -jblk
               ELSE
                  ib = jblk
               END IF
               DO 50 je = iwork( j ) + 1 + iwoff,
     $                 iwork( j+in ) + iwoff
                  w( je ) = tmp1
                  werr( je ) = tmp2
                  indexw( je ) = je - iwoff
                  iblock( je ) = ib
   50          continue
   60       continue
*
            m = m + im
         END IF
   70 continue

*     If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU
*     If NWL+1 < IL or NWU > IU, discard extra eigenvalues.
      IF( irange.EQ.indrng ) THEN
         idiscl = il - 1 - nwl
         idiscu = nwu - iu
*
         IF( idiscl.GT.0 ) THEN
            im = 0
            DO 80 je = 1, m
*              Remove some of the smallest eigenvalues from the left so that
*              at the end IDISCL =0. Move all eigenvalues up to the left.
               IF( w( je ).LE.wlu .AND. idiscl.GT.0 ) THEN
                  idiscl = idiscl - 1
               ELSE
                  im = im + 1
                  w( im ) = w( je )
                  werr( im ) = werr( je )
                  indexw( im ) = indexw( je )
                  iblock( im ) = iblock( je )
               END IF
 80         continue
            m = im
         END IF
         IF( idiscu.GT.0 ) THEN
*           Remove some of the largest eigenvalues from the right so that
*           at the end IDISCU =0. Move all eigenvalues up to the left.
            im=m+1
            DO 81 je = m, 1, -1
               IF( w( je ).GE.wul .AND. idiscu.GT.0 ) THEN
                  idiscu = idiscu - 1
               ELSE
                  im = im - 1
                  w( im ) = w( je )
                  werr( im ) = werr( je )
                  indexw( im ) = indexw( je )
                  iblock( im ) = iblock( je )
               END IF
 81         continue
            jee = 0
            DO 82 je = im, m
               jee = jee + 1
               w( jee ) = w( je )
               werr( jee ) = werr( je )
               indexw( jee ) = indexw( je )
               iblock( jee ) = iblock( je )
 82         continue
            m = m-im+1
         END IF

         IF( idiscl.GT.0 .OR. idiscu.GT.0 ) THEN
*           Code to deal with effects of bad arithmetic. (If N(w) is
*           monotone non-decreasing, this should never happen.)
*           Some low eigenvalues to be discarded are not in (WL,WLU],
*           or high eigenvalues to be discarded are not in (WUL,WU]
*           so just kill off the smallest IDISCL/largest IDISCU
*           eigenvalues, by marking the corresponding IBLOCK = 0
            IF( idiscl.GT.0 ) THEN
               wkill = wu
               DO 100 jdisc = 1, idiscl
                  iw = 0
                  DO 90 je = 1, m
                     IF( iblock( je ).NE.0 .AND.
     $                    ( w( je ).LT.wkill .OR. iw.EQ.0 ) ) THEN
                        iw = je
                        wkill = w( je )
                     END IF
 90               continue
                  iblock( iw ) = 0
 100           continue
            END IF
            IF( idiscu.GT.0 ) THEN
               wkill = wl
               DO 120 jdisc = 1, idiscu
                  iw = 0
                  DO 110 je = 1, m
                     IF( iblock( je ).NE.0 .AND.
     $                    ( w( je ).GE.wkill .OR. iw.EQ.0 ) ) THEN
                        iw = je
                        wkill = w( je )
                     END IF
 110              continue
                  iblock( iw ) = 0
 120           continue
            END IF
*           Now erase all eigenvalues with IBLOCK set to zero
            im = 0
            DO 130 je = 1, m
               IF( iblock( je ).NE.0 ) THEN
                  im = im + 1
                  w( im ) = w( je )
                  werr( im ) = werr( je )
                  indexw( im ) = indexw( je )
                  iblock( im ) = iblock( je )
               END IF
 130        continue
            m = im
         END IF
         IF( idiscl.LT.0 .OR. idiscu.LT.0 ) THEN
            toofew = .true.
         END IF
      END IF
*
      IF(( irange.EQ.allrng .AND. m.NE.n ).OR.
     $   ( irange.EQ.indrng .AND. m.NE.iu-il+1 ) ) THEN
         toofew = .true.
      END IF

*     If ORDER='B', do nothing the eigenvalues are already sorted by
*        block.
*     If ORDER='E', sort the eigenvalues from smallest to largest

      IF( lsame(order,'E') .AND. nsplit.GT.1 ) THEN
         DO 150 je = 1, m - 1
            ie = 0
            tmp1 = w( je )
            DO 140 j = je + 1, m
               IF( w( j ).LT.tmp1 ) THEN
                  ie = j
                  tmp1 = w( j )
               END IF
  140       continue
            IF( ie.NE.0 ) THEN
               tmp2 = werr( ie )
               itmp1 = iblock( ie )
               itmp2 = indexw( ie )
               w( ie ) = w( je )
               werr( ie ) = werr( je )
               iblock( ie ) = iblock( je )
               indexw( ie ) = indexw( je )
               w( je ) = tmp1
               werr( je ) = tmp2
               iblock( je ) = itmp1
               indexw( je ) = itmp2
            END IF
  150    continue
      END IF
*
      info = 0
      IF( ncnvrg )
     $   info = info + 1
      IF( toofew )
     $   info = info + 2
      return
*
*     End of DLARRD
*
      END