File:  [local] / rpl / lapack / lapack / dlarrc.f
Revision 1.12: download - view: text, annotated - select for diffs - revision graph
Fri Dec 14 14:22:34 2012 UTC (11 years, 5 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_16, rpl-4_1_15, rpl-4_1_14, rpl-4_1_13, rpl-4_1_12, rpl-4_1_11, HEAD
Mise à jour de lapack.

    1: *> \brief \b DLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix.
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download DLARRC + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrc.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrc.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrc.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN,
   22: *                                   EIGCNT, LCNT, RCNT, INFO )
   23:    24: *       .. Scalar Arguments ..
   25: *       CHARACTER          JOBT
   26: *       INTEGER            EIGCNT, INFO, LCNT, N, RCNT
   27: *       DOUBLE PRECISION   PIVMIN, VL, VU
   28: *       ..
   29: *       .. Array Arguments ..
   30: *       DOUBLE PRECISION   D( * ), E( * )
   31: *       ..
   32: *  
   33: *
   34: *> \par Purpose:
   35: *  =============
   36: *>
   37: *> \verbatim
   38: *>
   39: *> Find the number of eigenvalues of the symmetric tridiagonal matrix T
   40: *> that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
   41: *> if JOBT = 'L'.
   42: *> \endverbatim
   43: *
   44: *  Arguments:
   45: *  ==========
   46: *
   47: *> \param[in] JOBT
   48: *> \verbatim
   49: *>          JOBT is CHARACTER*1
   50: *>          = 'T':  Compute Sturm count for matrix T.
   51: *>          = 'L':  Compute Sturm count for matrix L D L^T.
   52: *> \endverbatim
   53: *>
   54: *> \param[in] N
   55: *> \verbatim
   56: *>          N is INTEGER
   57: *>          The order of the matrix. N > 0.
   58: *> \endverbatim
   59: *>
   60: *> \param[in] VL
   61: *> \verbatim
   62: *>          VL is DOUBLE PRECISION
   63: *> \endverbatim
   64: *>
   65: *> \param[in] VU
   66: *> \verbatim
   67: *>          VU is DOUBLE PRECISION
   68: *>          The lower and upper bounds for the eigenvalues.
   69: *> \endverbatim
   70: *>
   71: *> \param[in] D
   72: *> \verbatim
   73: *>          D is DOUBLE PRECISION array, dimension (N)
   74: *>          JOBT = 'T': The N diagonal elements of the tridiagonal matrix T.
   75: *>          JOBT = 'L': The N diagonal elements of the diagonal matrix D.
   76: *> \endverbatim
   77: *>
   78: *> \param[in] E
   79: *> \verbatim
   80: *>          E is DOUBLE PRECISION array, dimension (N)
   81: *>          JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
   82: *>          JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
   83: *> \endverbatim
   84: *>
   85: *> \param[in] PIVMIN
   86: *> \verbatim
   87: *>          PIVMIN is DOUBLE PRECISION
   88: *>          The minimum pivot in the Sturm sequence for T.
   89: *> \endverbatim
   90: *>
   91: *> \param[out] EIGCNT
   92: *> \verbatim
   93: *>          EIGCNT is INTEGER
   94: *>          The number of eigenvalues of the symmetric tridiagonal matrix T
   95: *>          that are in the interval (VL,VU]
   96: *> \endverbatim
   97: *>
   98: *> \param[out] LCNT
   99: *> \verbatim
  100: *>          LCNT is INTEGER
  101: *> \endverbatim
  102: *>
  103: *> \param[out] RCNT
  104: *> \verbatim
  105: *>          RCNT is INTEGER
  106: *>          The left and right negcounts of the interval.
  107: *> \endverbatim
  108: *>
  109: *> \param[out] INFO
  110: *> \verbatim
  111: *>          INFO is INTEGER
  112: *> \endverbatim
  113: *
  114: *  Authors:
  115: *  ========
  116: *
  117: *> \author Univ. of Tennessee 
  118: *> \author Univ. of California Berkeley 
  119: *> \author Univ. of Colorado Denver 
  120: *> \author NAG Ltd. 
  121: *
  122: *> \date September 2012
  123: *
  124: *> \ingroup auxOTHERauxiliary
  125: *
  126: *> \par Contributors:
  127: *  ==================
  128: *>
  129: *> Beresford Parlett, University of California, Berkeley, USA \n
  130: *> Jim Demmel, University of California, Berkeley, USA \n
  131: *> Inderjit Dhillon, University of Texas, Austin, USA \n
  132: *> Osni Marques, LBNL/NERSC, USA \n
  133: *> Christof Voemel, University of California, Berkeley, USA
  134: *
  135: *  =====================================================================
  136:       SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN,
  137:      $                            EIGCNT, LCNT, RCNT, INFO )
  138: *
  139: *  -- LAPACK auxiliary routine (version 3.4.2) --
  140: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  141: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  142: *     September 2012
  143: *
  144: *     .. Scalar Arguments ..
  145:       CHARACTER          JOBT
  146:       INTEGER            EIGCNT, INFO, LCNT, N, RCNT
  147:       DOUBLE PRECISION   PIVMIN, VL, VU
  148: *     ..
  149: *     .. Array Arguments ..
  150:       DOUBLE PRECISION   D( * ), E( * )
  151: *     ..
  152: *
  153: *  =====================================================================
  154: *
  155: *     .. Parameters ..
  156:       DOUBLE PRECISION   ZERO
  157:       PARAMETER          ( ZERO = 0.0D0 )
  158: *     ..
  159: *     .. Local Scalars ..
  160:       INTEGER            I
  161:       LOGICAL            MATT
  162:       DOUBLE PRECISION   LPIVOT, RPIVOT, SL, SU, TMP, TMP2
  163: 
  164: *     ..
  165: *     .. External Functions ..
  166:       LOGICAL            LSAME
  167:       EXTERNAL           LSAME
  168: *     ..
  169: *     .. Executable Statements ..
  170: *
  171:       INFO = 0
  172:       LCNT = 0
  173:       RCNT = 0
  174:       EIGCNT = 0
  175:       MATT = LSAME( JOBT, 'T' )
  176: 
  177: 
  178:       IF (MATT) THEN
  179: *        Sturm sequence count on T
  180:          LPIVOT = D( 1 ) - VL
  181:          RPIVOT = D( 1 ) - VU
  182:          IF( LPIVOT.LE.ZERO ) THEN
  183:             LCNT = LCNT + 1
  184:          ENDIF
  185:          IF( RPIVOT.LE.ZERO ) THEN
  186:             RCNT = RCNT + 1
  187:          ENDIF
  188:          DO 10 I = 1, N-1
  189:             TMP = E(I)**2
  190:             LPIVOT = ( D( I+1 )-VL ) - TMP/LPIVOT
  191:             RPIVOT = ( D( I+1 )-VU ) - TMP/RPIVOT
  192:             IF( LPIVOT.LE.ZERO ) THEN
  193:                LCNT = LCNT + 1
  194:             ENDIF
  195:             IF( RPIVOT.LE.ZERO ) THEN
  196:                RCNT = RCNT + 1
  197:             ENDIF
  198:  10      CONTINUE
  199:       ELSE
  200: *        Sturm sequence count on L D L^T
  201:          SL = -VL
  202:          SU = -VU
  203:          DO 20 I = 1, N - 1
  204:             LPIVOT = D( I ) + SL
  205:             RPIVOT = D( I ) + SU
  206:             IF( LPIVOT.LE.ZERO ) THEN
  207:                LCNT = LCNT + 1
  208:             ENDIF
  209:             IF( RPIVOT.LE.ZERO ) THEN
  210:                RCNT = RCNT + 1
  211:             ENDIF
  212:             TMP = E(I) * D(I) * E(I)
  213: *
  214:             TMP2 = TMP / LPIVOT
  215:             IF( TMP2.EQ.ZERO ) THEN
  216:                SL =  TMP - VL
  217:             ELSE
  218:                SL = SL*TMP2 - VL
  219:             END IF
  220: *
  221:             TMP2 = TMP / RPIVOT
  222:             IF( TMP2.EQ.ZERO ) THEN
  223:                SU =  TMP - VU
  224:             ELSE
  225:                SU = SU*TMP2 - VU
  226:             END IF
  227:  20      CONTINUE
  228:          LPIVOT = D( N ) + SL
  229:          RPIVOT = D( N ) + SU
  230:          IF( LPIVOT.LE.ZERO ) THEN
  231:             LCNT = LCNT + 1
  232:          ENDIF
  233:          IF( RPIVOT.LE.ZERO ) THEN
  234:             RCNT = RCNT + 1
  235:          ENDIF
  236:       ENDIF
  237:       EIGCNT = RCNT - LCNT
  238: 
  239:       RETURN
  240: *
  241: *     end of DLARRC
  242: *
  243:       END

CVSweb interface <joel.bertrand@systella.fr>