LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
slarrc.f
Go to the documentation of this file.
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 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 REAL
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 slarrc( 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  REAL pivmin, vl, vu
148 * ..
149 * .. Array Arguments ..
150  REAL d( * ), e( * )
151 * ..
152 *
153 * =====================================================================
154 *
155 * .. Parameters ..
156  REAL zero
157  parameter( zero = 0.0e0 )
158 * ..
159 * .. Local Scalars ..
160  INTEGER i
161  LOGICAL matt
162  REAL 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 SLARRC
242 *
243  END