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

◆ sstech()

subroutine sstech ( integer  n,
real, dimension( * )  a,
real, dimension( * )  b,
real, dimension( * )  eig,
real  tol,
real, dimension( * )  work,
integer  info 
)

SSTECH

Purpose:
    Let T be the tridiagonal matrix with diagonal entries A(1) ,...,
    A(N) and offdiagonal entries B(1) ,..., B(N-1)).  SSTECH checks to
    see if EIG(1) ,..., EIG(N) are indeed accurate eigenvalues of T.
    It does this by expanding each EIG(I) into an interval
    [SVD(I) - EPS, SVD(I) + EPS], merging overlapping intervals if
    any, and using Sturm sequences to count and verify whether each
    resulting interval has the correct number of eigenvalues (using
    SSTECT).  Here EPS = TOL*MACHEPS*MAXEIG, where MACHEPS is the
    machine precision and MAXEIG is the absolute value of the largest
    eigenvalue. If each interval contains the correct number of
    eigenvalues, INFO = 0 is returned, otherwise INFO is the index of
    the first eigenvalue in the first bad interval.
Parameters
[in]N
          N is INTEGER
          The dimension of the tridiagonal matrix T.
[in]A
          A is REAL array, dimension (N)
          The diagonal entries of the tridiagonal matrix T.
[in]B
          B is REAL array, dimension (N-1)
          The offdiagonal entries of the tridiagonal matrix T.
[in]EIG
          EIG is REAL array, dimension (N)
          The purported eigenvalues to be checked.
[in]TOL
          TOL is REAL
          Error tolerance for checking, a multiple of the
          machine precision.
[out]WORK
          WORK is REAL array, dimension (N)
[out]INFO
          INFO is INTEGER
          0  if the eigenvalues are all correct (to within
             1 +- TOL*MACHEPS*MAXEIG)
          >0 if the interval containing the INFO-th eigenvalue
             contains the incorrect number of eigenvalues.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 100 of file sstech.f.

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*
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
subroutine sstect(n, a, b, shift, num)
SSTECT
Definition sstect.f:82
Here is the call graph for this function:
Here is the caller graph for this function: