LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
sstect.f
Go to the documentation of this file.
1*> \brief \b SSTECT
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE SSTECT( N, A, B, SHIFT, NUM )
12*
13* .. Scalar Arguments ..
14* INTEGER N, NUM
15* REAL SHIFT
16* ..
17* .. Array Arguments ..
18* REAL A( * ), B( * )
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> SSTECT counts the number NUM of eigenvalues of a tridiagonal
28*> matrix T which are less than or equal to SHIFT. T has
29*> diagonal entries A(1), ... , A(N), and offdiagonal entries
30*> B(1), ..., B(N-1).
31*> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
32*> Matrix", Report CS41, Computer Science Dept., Stanford
33*> University, July 21, 1966
34*> \endverbatim
35*
36* Arguments:
37* ==========
38*
39*> \param[in] N
40*> \verbatim
41*> N is INTEGER
42*> The dimension of the tridiagonal matrix T.
43*> \endverbatim
44*>
45*> \param[in] A
46*> \verbatim
47*> A is REAL array, dimension (N)
48*> The diagonal entries of the tridiagonal matrix T.
49*> \endverbatim
50*>
51*> \param[in] B
52*> \verbatim
53*> B is REAL array, dimension (N-1)
54*> The offdiagonal entries of the tridiagonal matrix T.
55*> \endverbatim
56*>
57*> \param[in] SHIFT
58*> \verbatim
59*> SHIFT is REAL
60*> The shift, used as described under Purpose.
61*> \endverbatim
62*>
63*> \param[out] NUM
64*> \verbatim
65*> NUM is INTEGER
66*> The number of eigenvalues of T less than or equal
67*> to SHIFT.
68*> \endverbatim
69*
70* Authors:
71* ========
72*
73*> \author Univ. of Tennessee
74*> \author Univ. of California Berkeley
75*> \author Univ. of Colorado Denver
76*> \author NAG Ltd.
77*
78*> \ingroup single_eig
79*
80* =====================================================================
81 SUBROUTINE sstect( N, A, B, SHIFT, NUM )
82*
83* -- LAPACK test routine --
84* -- LAPACK is a software package provided by Univ. of Tennessee, --
85* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
86*
87* .. Scalar Arguments ..
88 INTEGER N, NUM
89 REAL SHIFT
90* ..
91* .. Array Arguments ..
92 REAL A( * ), B( * )
93* ..
94*
95* =====================================================================
96*
97* .. Parameters ..
98 REAL ZERO, ONE, THREE
99 parameter( zero = 0.0e0, one = 1.0e0, three = 3.0e0 )
100* ..
101* .. Local Scalars ..
102 INTEGER I
103 REAL M1, M2, MX, OVFL, SOV, SSHIFT, SSUN, SUN, TMP,
104 \$ TOM, U, UNFL
105* ..
106* .. External Functions ..
107 REAL SLAMCH
108 EXTERNAL slamch
109* ..
110* .. Intrinsic Functions ..
111 INTRINSIC abs, max, sqrt
112* ..
113* .. Executable Statements ..
114*
115* Get machine constants
116*
117 unfl = slamch( 'Safe minimum' )
118 ovfl = slamch( 'Overflow' )
119*
120* Find largest entry
121*
122 mx = abs( a( 1 ) )
123 DO 10 i = 1, n - 1
124 mx = max( mx, abs( a( i+1 ) ), abs( b( i ) ) )
125 10 CONTINUE
126*
127* Handle easy cases, including zero matrix
128*
129 IF( shift.GE.three*mx ) THEN
130 num = n
131 RETURN
132 END IF
133 IF( shift.LT.-three*mx ) THEN
134 num = 0
135 RETURN
136 END IF
137*
138* Compute scale factors as in Kahan's report
139* At this point, MX .NE. 0 so we can divide by it
140*
141 sun = sqrt( unfl )
142 ssun = sqrt( sun )
143 sov = sqrt( ovfl )
144 tom = ssun*sov
145 IF( mx.LE.one ) THEN
146 m1 = one / mx
147 m2 = tom
148 ELSE
149 m1 = one
150 m2 = tom / mx
151 END IF
152*
153* Begin counting
154*
155 num = 0
156 sshift = ( shift*m1 )*m2
157 u = ( a( 1 )*m1 )*m2 - sshift
158 IF( u.LE.sun ) THEN
159 IF( u.LE.zero ) THEN
160 num = num + 1
161 IF( u.GT.-sun )
162 \$ u = -sun
163 ELSE
164 u = sun
165 END IF
166 END IF
167 DO 20 i = 2, n
168 tmp = ( b( i-1 )*m1 )*m2
169 u = ( ( a( i )*m1 )*m2-tmp*( tmp / u ) ) - sshift
170 IF( u.LE.sun ) THEN
171 IF( u.LE.zero ) THEN
172 num = num + 1
173 IF( u.GT.-sun )
174 \$ u = -sun
175 ELSE
176 u = sun
177 END IF
178 END IF
179 20 CONTINUE
180 RETURN
181*
182* End of SSTECT
183*
184 END
subroutine sstect(N, A, B, SHIFT, NUM)
SSTECT
Definition: sstect.f:82