LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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.
Date
November 2011

Definition at line 89 of file ssvdct.f.

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

Here is the caller graph for this function: