SRC/slarrc.f

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