LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sstech.f
Go to the documentation of this file.
1*> \brief \b SSTECH
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 SSTECH( N, A, B, EIG, TOL, WORK, INFO )
12*
13* .. Scalar Arguments ..
14* INTEGER INFO, N
15* REAL TOL
16* ..
17* .. Array Arguments ..
18* REAL A( * ), B( * ), EIG( * ), WORK( * )
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> Let T be the tridiagonal matrix with diagonal entries A(1) ,...,
28*> A(N) and offdiagonal entries B(1) ,..., B(N-1)). SSTECH checks to
29*> see if EIG(1) ,..., EIG(N) are indeed accurate eigenvalues of T.
30*> It does this by expanding each EIG(I) into an interval
31*> [SVD(I) - EPS, SVD(I) + EPS], merging overlapping intervals if
32*> any, and using Sturm sequences to count and verify whether each
33*> resulting interval has the correct number of eigenvalues (using
34*> SSTECT). Here EPS = TOL*MACHEPS*MAXEIG, where MACHEPS is the
35*> machine precision and MAXEIG is the absolute value of the largest
36*> eigenvalue. If each interval contains the correct number of
37*> eigenvalues, INFO = 0 is returned, otherwise INFO is the index of
38*> the first eigenvalue in the first bad interval.
39*> \endverbatim
40*
41* Arguments:
42* ==========
43*
44*> \param[in] N
45*> \verbatim
46*> N is INTEGER
47*> The dimension of the tridiagonal matrix T.
48*> \endverbatim
49*>
50*> \param[in] A
51*> \verbatim
52*> A is REAL array, dimension (N)
53*> The diagonal entries of the tridiagonal matrix T.
54*> \endverbatim
55*>
56*> \param[in] B
57*> \verbatim
58*> B is REAL array, dimension (N-1)
59*> The offdiagonal entries of the tridiagonal matrix T.
60*> \endverbatim
61*>
62*> \param[in] EIG
63*> \verbatim
64*> EIG is REAL array, dimension (N)
65*> The purported eigenvalues to be checked.
66*> \endverbatim
67*>
68*> \param[in] TOL
69*> \verbatim
70*> TOL is REAL
71*> Error tolerance for checking, a multiple of the
72*> machine precision.
73*> \endverbatim
74*>
75*> \param[out] WORK
76*> \verbatim
77*> WORK is REAL array, dimension (N)
78*> \endverbatim
79*>
80*> \param[out] INFO
81*> \verbatim
82*> INFO is INTEGER
83*> 0 if the eigenvalues are all correct (to within
84*> 1 +- TOL*MACHEPS*MAXEIG)
85*> >0 if the interval containing the INFO-th eigenvalue
86*> contains the incorrect number of eigenvalues.
87*> \endverbatim
88*
89* Authors:
90* ========
91*
92*> \author Univ. of Tennessee
93*> \author Univ. of California Berkeley
94*> \author Univ. of Colorado Denver
95*> \author NAG Ltd.
96*
97*> \ingroup single_eig
98*
99* =====================================================================
100 SUBROUTINE sstech( N, A, B, EIG, TOL, WORK, INFO )
101*
102* -- LAPACK test routine --
103* -- LAPACK is a software package provided by Univ. of Tennessee, --
104* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
105*
106* .. Scalar Arguments ..
107 INTEGER INFO, N
108 REAL TOL
109* ..
110* .. Array Arguments ..
111 REAL A( * ), B( * ), EIG( * ), WORK( * )
112* ..
113*
114* =====================================================================
115*
116* .. Parameters ..
117 REAL ZERO
118 parameter( zero = 0.0e0 )
119* ..
120* .. Local Scalars ..
121 INTEGER BPNT, COUNT, I, ISUB, J, NUML, NUMU, TPNT
122 REAL EMIN, EPS, LOWER, MX, TUPPR, UNFLEP, UPPER
123* ..
124* .. External Functions ..
125 REAL SLAMCH
126 EXTERNAL slamch
127* ..
128* .. External Subroutines ..
129 EXTERNAL sstect
130* ..
131* .. Intrinsic Functions ..
132 INTRINSIC abs, max
133* ..
134* .. Executable Statements ..
135*
136* Check input parameters
137*
138 info = 0
139 IF( n.EQ.0 )
140 $ RETURN
141 IF( n.LT.0 ) THEN
142 info = -1
143 RETURN
144 END IF
145 IF( tol.LT.zero ) THEN
146 info = -5
147 RETURN
148 END IF
149*
150* Get machine constants
151*
152 eps = slamch( 'Epsilon' )*slamch( 'Base' )
153 unflep = slamch( 'Safe minimum' ) / eps
154 eps = tol*eps
155*
156* Compute maximum absolute eigenvalue, error tolerance
157*
158 mx = abs( eig( 1 ) )
159 DO 10 i = 2, n
160 mx = max( mx, abs( eig( i ) ) )
161 10 CONTINUE
162 eps = max( eps*mx, unflep )
163*
164* Sort eigenvalues from EIG into WORK
165*
166 DO 20 i = 1, n
167 work( i ) = eig( i )
168 20 CONTINUE
169 DO 40 i = 1, n - 1
170 isub = 1
171 emin = work( 1 )
172 DO 30 j = 2, n + 1 - i
173 IF( work( j ).LT.emin ) THEN
174 isub = j
175 emin = work( j )
176 END IF
177 30 CONTINUE
178 IF( isub.NE.n+1-i ) THEN
179 work( isub ) = work( n+1-i )
180 work( n+1-i ) = emin
181 END IF
182 40 CONTINUE
183*
184* TPNT points to singular value at right endpoint of interval
185* BPNT points to singular value at left endpoint of interval
186*
187 tpnt = 1
188 bpnt = 1
189*
190* Begin loop over all intervals
191*
192 50 CONTINUE
193 upper = work( tpnt ) + eps
194 lower = work( bpnt ) - eps
195*
196* Begin loop merging overlapping intervals
197*
198 60 CONTINUE
199 IF( bpnt.EQ.n )
200 $ GO TO 70
201 tuppr = work( bpnt+1 ) + eps
202 IF( tuppr.LT.lower )
203 $ GO TO 70
204*
205* Merge
206*
207 bpnt = bpnt + 1
208 lower = work( bpnt ) - eps
209 GO TO 60
210 70 CONTINUE
211*
212* Count singular values in interval [ LOWER, UPPER ]
213*
214 CALL sstect( n, a, b, lower, numl )
215 CALL sstect( n, a, b, upper, numu )
216 count = numu - numl
217 IF( count.NE.bpnt-tpnt+1 ) THEN
218*
219* Wrong number of singular values in interval
220*
221 info = tpnt
222 GO TO 80
223 END IF
224 tpnt = bpnt + 1
225 bpnt = tpnt
226 IF( tpnt.LE.n )
227 $ GO TO 50
228 80 CONTINUE
229 RETURN
230*
231* End of SSTECH
232*
233 END
subroutine sstech(n, a, b, eig, tol, work, info)
SSTECH
Definition sstech.f:101
subroutine sstect(n, a, b, shift, num)
SSTECT
Definition sstect.f:82