LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ 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.
Date
December 2016

Definition at line 103 of file sstech.f.

103 *
104 * -- LAPACK test routine (version 3.7.0) --
105 * -- LAPACK is a software package provided by Univ. of Tennessee, --
106 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
107 * December 2016
108 *
109 * .. Scalar Arguments ..
110  INTEGER info, n
111  REAL tol
112 * ..
113 * .. Array Arguments ..
114  REAL a( * ), b( * ), eig( * ), work( * )
115 * ..
116 *
117 * =====================================================================
118 *
119 * .. Parameters ..
120  REAL zero
121  parameter( zero = 0.0e0 )
122 * ..
123 * .. Local Scalars ..
124  INTEGER bpnt, count, i, isub, j, numl, numu, tpnt
125  REAL emin, eps, lower, mx, tuppr, unflep, upper
126 * ..
127 * .. External Functions ..
128  REAL slamch
129  EXTERNAL slamch
130 * ..
131 * .. External Subroutines ..
132  EXTERNAL sstect
133 * ..
134 * .. Intrinsic Functions ..
135  INTRINSIC abs, max
136 * ..
137 * .. Executable Statements ..
138 *
139 * Check input parameters
140 *
141  info = 0
142  IF( n.EQ.0 )
143  $ RETURN
144  IF( n.LT.0 ) THEN
145  info = -1
146  RETURN
147  END IF
148  IF( tol.LT.zero ) THEN
149  info = -5
150  RETURN
151  END IF
152 *
153 * Get machine constants
154 *
155  eps = slamch( 'Epsilon' )*slamch( 'Base' )
156  unflep = slamch( 'Safe minimum' ) / eps
157  eps = tol*eps
158 *
159 * Compute maximum absolute eigenvalue, error tolerance
160 *
161  mx = abs( eig( 1 ) )
162  DO 10 i = 2, n
163  mx = max( mx, abs( eig( i ) ) )
164  10 CONTINUE
165  eps = max( eps*mx, unflep )
166 *
167 * Sort eigenvalues from EIG into WORK
168 *
169  DO 20 i = 1, n
170  work( i ) = eig( i )
171  20 CONTINUE
172  DO 40 i = 1, n - 1
173  isub = 1
174  emin = work( 1 )
175  DO 30 j = 2, n + 1 - i
176  IF( work( j ).LT.emin ) THEN
177  isub = j
178  emin = work( j )
179  END IF
180  30 CONTINUE
181  IF( isub.NE.n+1-i ) THEN
182  work( isub ) = work( n+1-i )
183  work( n+1-i ) = emin
184  END IF
185  40 CONTINUE
186 *
187 * TPNT points to singular value at right endpoint of interval
188 * BPNT points to singular value at left endpoint of interval
189 *
190  tpnt = 1
191  bpnt = 1
192 *
193 * Begin loop over all intervals
194 *
195  50 CONTINUE
196  upper = work( tpnt ) + eps
197  lower = work( bpnt ) - eps
198 *
199 * Begin loop merging overlapping intervals
200 *
201  60 CONTINUE
202  IF( bpnt.EQ.n )
203  $ GO TO 70
204  tuppr = work( bpnt+1 ) + eps
205  IF( tuppr.LT.lower )
206  $ GO TO 70
207 *
208 * Merge
209 *
210  bpnt = bpnt + 1
211  lower = work( bpnt ) - eps
212  GO TO 60
213  70 CONTINUE
214 *
215 * Count singular values in interval [ LOWER, UPPER ]
216 *
217  CALL sstect( n, a, b, lower, numl )
218  CALL sstect( n, a, b, upper, numu )
219  count = numu - numl
220  IF( count.NE.bpnt-tpnt+1 ) THEN
221 *
222 * Wrong number of singular values in interval
223 *
224  info = tpnt
225  GO TO 80
226  END IF
227  tpnt = bpnt + 1
228  bpnt = tpnt
229  IF( tpnt.LE.n )
230  $ GO TO 50
231  80 CONTINUE
232  RETURN
233 *
234 * End of SSTECH
235 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sstect(N, A, B, SHIFT, NUM)
SSTECT
Definition: sstect.f:84
Here is the call graph for this function:
Here is the caller graph for this function: