File:  [local] / rpl / lapack / lapack / dlarrc.f
Revision 1.3: download - view: text, annotated - select for diffs - revision graph
Fri Aug 6 15:28:42 2010 UTC (13 years, 9 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Cohérence

    1:       SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN,
    2:      $                            EIGCNT, LCNT, RCNT, INFO )
    3: *
    4: *  -- LAPACK auxiliary routine (version 3.2) --
    5: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    6: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    7: *     November 2006
    8: *
    9: *     .. Scalar Arguments ..
   10:       CHARACTER          JOBT
   11:       INTEGER            EIGCNT, INFO, LCNT, N, RCNT
   12:       DOUBLE PRECISION   PIVMIN, VL, VU
   13: *     ..
   14: *     .. Array Arguments ..
   15:       DOUBLE PRECISION   D( * ), E( * )
   16: *     ..
   17: *
   18: *  Purpose
   19: *  =======
   20: *
   21: *  Find the number of eigenvalues of the symmetric tridiagonal matrix T
   22: *  that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
   23: *  if JOBT = 'L'.
   24: *
   25: *  Arguments
   26: *  =========
   27: *
   28: *  JOBT    (input) CHARACTER*1
   29: *          = 'T':  Compute Sturm count for matrix T.
   30: *          = 'L':  Compute Sturm count for matrix L D L^T.
   31: *
   32: *  N       (input) INTEGER
   33: *          The order of the matrix. N > 0.
   34: *
   35: *  VL      (input) DOUBLE PRECISION
   36: *  VU      (input) DOUBLE PRECISION
   37: *          The lower and upper bounds for the eigenvalues.
   38: *
   39: *  D       (input) DOUBLE PRECISION array, dimension (N)
   40: *          JOBT = 'T': The N diagonal elements of the tridiagonal matrix T.
   41: *          JOBT = 'L': The N diagonal elements of the diagonal matrix D.
   42: *
   43: *  E       (input) DOUBLE PRECISION array, dimension (N)
   44: *          JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
   45: *          JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
   46: *
   47: *  PIVMIN  (input) DOUBLE PRECISION
   48: *          The minimum pivot in the Sturm sequence for T.
   49: *
   50: *  EIGCNT  (output) INTEGER
   51: *          The number of eigenvalues of the symmetric tridiagonal matrix T
   52: *          that are in the interval (VL,VU]
   53: *
   54: *  LCNT    (output) INTEGER
   55: *  RCNT    (output) INTEGER
   56: *          The left and right negcounts of the interval.
   57: *
   58: *  INFO    (output) INTEGER
   59: *
   60: *  Further Details
   61: *  ===============
   62: *
   63: *  Based on contributions by
   64: *     Beresford Parlett, University of California, Berkeley, USA
   65: *     Jim Demmel, University of California, Berkeley, USA
   66: *     Inderjit Dhillon, University of Texas, Austin, USA
   67: *     Osni Marques, LBNL/NERSC, USA
   68: *     Christof Voemel, University of California, Berkeley, USA
   69: *
   70: *  =====================================================================
   71: *
   72: *     .. Parameters ..
   73:       DOUBLE PRECISION   ZERO
   74:       PARAMETER          ( ZERO = 0.0D0 )
   75: *     ..
   76: *     .. Local Scalars ..
   77:       INTEGER            I
   78:       LOGICAL            MATT
   79:       DOUBLE PRECISION   LPIVOT, RPIVOT, SL, SU, TMP, TMP2
   80: 
   81: *     ..
   82: *     .. External Functions ..
   83:       LOGICAL            LSAME
   84:       EXTERNAL           LSAME
   85: *     ..
   86: *     .. Executable Statements ..
   87: *
   88:       INFO = 0
   89:       LCNT = 0
   90:       RCNT = 0
   91:       EIGCNT = 0
   92:       MATT = LSAME( JOBT, 'T' )
   93: 
   94: 
   95:       IF (MATT) THEN
   96: *        Sturm sequence count on T
   97:          LPIVOT = D( 1 ) - VL
   98:          RPIVOT = D( 1 ) - VU
   99:          IF( LPIVOT.LE.ZERO ) THEN
  100:             LCNT = LCNT + 1
  101:          ENDIF
  102:          IF( RPIVOT.LE.ZERO ) THEN
  103:             RCNT = RCNT + 1
  104:          ENDIF
  105:          DO 10 I = 1, N-1
  106:             TMP = E(I)**2
  107:             LPIVOT = ( D( I+1 )-VL ) - TMP/LPIVOT
  108:             RPIVOT = ( D( I+1 )-VU ) - TMP/RPIVOT
  109:             IF( LPIVOT.LE.ZERO ) THEN
  110:                LCNT = LCNT + 1
  111:             ENDIF
  112:             IF( RPIVOT.LE.ZERO ) THEN
  113:                RCNT = RCNT + 1
  114:             ENDIF
  115:  10      CONTINUE
  116:       ELSE
  117: *        Sturm sequence count on L D L^T
  118:          SL = -VL
  119:          SU = -VU
  120:          DO 20 I = 1, N - 1
  121:             LPIVOT = D( I ) + SL
  122:             RPIVOT = D( I ) + SU
  123:             IF( LPIVOT.LE.ZERO ) THEN
  124:                LCNT = LCNT + 1
  125:             ENDIF
  126:             IF( RPIVOT.LE.ZERO ) THEN
  127:                RCNT = RCNT + 1
  128:             ENDIF
  129:             TMP = E(I) * D(I) * E(I)
  130: *
  131:             TMP2 = TMP / LPIVOT
  132:             IF( TMP2.EQ.ZERO ) THEN
  133:                SL =  TMP - VL
  134:             ELSE
  135:                SL = SL*TMP2 - VL
  136:             END IF
  137: *
  138:             TMP2 = TMP / RPIVOT
  139:             IF( TMP2.EQ.ZERO ) THEN
  140:                SU =  TMP - VU
  141:             ELSE
  142:                SU = SU*TMP2 - VU
  143:             END IF
  144:  20      CONTINUE
  145:          LPIVOT = D( N ) + SL
  146:          RPIVOT = D( N ) + SU
  147:          IF( LPIVOT.LE.ZERO ) THEN
  148:             LCNT = LCNT + 1
  149:          ENDIF
  150:          IF( RPIVOT.LE.ZERO ) THEN
  151:             RCNT = RCNT + 1
  152:          ENDIF
  153:       ENDIF
  154:       EIGCNT = RCNT - LCNT
  155: 
  156:       RETURN
  157: *
  158: *     end of DLARRC
  159: *
  160:       END

CVSweb interface <joel.bertrand@systella.fr>