LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ ssvdct()

subroutine ssvdct ( integer  n,
real, dimension( * )  s,
real, dimension( * )  e,
real  shift,
integer  num 
)

SSVDCT

Purpose:
 SSVDCT counts the number NUM of eigenvalues of a 2*N by 2*N
 tridiagonal matrix T which are less than or equal to SHIFT.  T is
 formed by putting zeros on the diagonal and making the off-diagonals
 equal to S(1), E(1), S(2), E(2), ... , E(N-1), S(N).  If SHIFT is
 positive, NUM is equal to N plus the number of singular values of a
 bidiagonal matrix B less than or equal to SHIFT.  Here B has diagonal
 entries S(1), ..., S(N) and superdiagonal entries E(1), ... E(N-1).
 If SHIFT is negative, NUM is equal to the number of singular values
 of B greater than or equal to -SHIFT.

 See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
 Matrix", Report CS41, Computer Science Dept., Stanford University,
 July 21, 1966
Parameters
[in]N
          N is INTEGER
          The dimension of the bidiagonal matrix B.
[in]S
          S is REAL array, dimension (N)
          The diagonal entries of the bidiagonal matrix B.
[in]E
          E is REAL array of dimension (N-1)
          The superdiagonal entries of the bidiagonal matrix B.
[in]SHIFT
          SHIFT is REAL
          The shift, used as described under Purpose.
[out]NUM
          NUM is INTEGER
          The number of eigenvalues of T less than or equal to SHIFT.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 86 of file ssvdct.f.

87*
88* -- LAPACK test routine --
89* -- LAPACK is a software package provided by Univ. of Tennessee, --
90* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
91*
92* .. Scalar Arguments ..
93 INTEGER N, NUM
94 REAL SHIFT
95* ..
96* .. Array Arguments ..
97 REAL E( * ), S( * )
98* ..
99*
100* =====================================================================
101*
102* .. Parameters ..
103 REAL ONE
104 parameter( one = 1.0e0 )
105 REAL ZERO
106 parameter( zero = 0.0e0 )
107* ..
108* .. Local Scalars ..
109 INTEGER I
110 REAL M1, M2, MX, OVFL, SOV, SSHIFT, SSUN, SUN, TMP,
111 $ TOM, U, UNFL
112* ..
113* .. External Functions ..
114 REAL SLAMCH
115 EXTERNAL slamch
116* ..
117* .. Intrinsic Functions ..
118 INTRINSIC abs, max, sqrt
119* ..
120* .. Executable Statements ..
121*
122* Get machine constants
123*
124 unfl = 2*slamch( 'Safe minimum' )
125 ovfl = one / unfl
126*
127* Find largest entry
128*
129 mx = abs( s( 1 ) )
130 DO 10 i = 1, n - 1
131 mx = max( mx, abs( s( i+1 ) ), abs( e( i ) ) )
132 10 CONTINUE
133*
134 IF( mx.EQ.zero ) THEN
135 IF( shift.LT.zero ) THEN
136 num = 0
137 ELSE
138 num = 2*n
139 END IF
140 RETURN
141 END IF
142*
143* Compute scale factors as in Kahan's report
144*
145 sun = sqrt( unfl )
146 ssun = sqrt( sun )
147 sov = sqrt( ovfl )
148 tom = ssun*sov
149 IF( mx.LE.one ) THEN
150 m1 = one / mx
151 m2 = tom
152 ELSE
153 m1 = one
154 m2 = tom / mx
155 END IF
156*
157* Begin counting
158*
159 u = one
160 num = 0
161 sshift = ( shift*m1 )*m2
162 u = -sshift
163 IF( u.LE.sun ) THEN
164 IF( u.LE.zero ) THEN
165 num = num + 1
166 IF( u.GT.-sun )
167 $ u = -sun
168 ELSE
169 u = sun
170 END IF
171 END IF
172 tmp = ( s( 1 )*m1 )*m2
173 u = -tmp*( tmp / u ) - sshift
174 IF( u.LE.sun ) THEN
175 IF( u.LE.zero ) THEN
176 num = num + 1
177 IF( u.GT.-sun )
178 $ u = -sun
179 ELSE
180 u = sun
181 END IF
182 END IF
183 DO 20 i = 1, n - 1
184 tmp = ( e( i )*m1 )*m2
185 u = -tmp*( tmp / u ) - sshift
186 IF( u.LE.sun ) THEN
187 IF( u.LE.zero ) THEN
188 num = num + 1
189 IF( u.GT.-sun )
190 $ u = -sun
191 ELSE
192 u = sun
193 END IF
194 END IF
195 tmp = ( s( i+1 )*m1 )*m2
196 u = -tmp*( tmp / u ) - sshift
197 IF( u.LE.sun ) THEN
198 IF( u.LE.zero ) THEN
199 num = num + 1
200 IF( u.GT.-sun )
201 $ u = -sun
202 ELSE
203 u = sun
204 END IF
205 END IF
206 20 CONTINUE
207 RETURN
208*
209* End of SSVDCT
210*
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
Here is the caller graph for this function: