LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
ddrvst2stg.f
Go to the documentation of this file.
1 *> \brief \b DDRVST2STG
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 DDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
12 * NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1,
13 * WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK,
14 * IWORK, LIWORK, RESULT, INFO )
15 *
16 * .. Scalar Arguments ..
17 * INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
18 * $ NTYPES
19 * DOUBLE PRECISION THRESH
20 * ..
21 * .. Array Arguments ..
22 * LOGICAL DOTYPE( * )
23 * INTEGER ISEED( 4 ), IWORK( * ), NN( * )
24 * DOUBLE PRECISION A( LDA, * ), D1( * ), D2( * ), D3( * ),
25 * $ D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ),
26 * $ U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ),
27 * $ WA3( * ), WORK( * ), Z( LDU, * )
28 * ..
29 *
30 *
31 *> \par Purpose:
32 * =============
33 *>
34 *> \verbatim
35 *>
36 *> DDRVST2STG checks the symmetric eigenvalue problem drivers.
37 *>
38 *> DSTEV computes all eigenvalues and, optionally,
39 *> eigenvectors of a real symmetric tridiagonal matrix.
40 *>
41 *> DSTEVX computes selected eigenvalues and, optionally,
42 *> eigenvectors of a real symmetric tridiagonal matrix.
43 *>
44 *> DSTEVR computes selected eigenvalues and, optionally,
45 *> eigenvectors of a real symmetric tridiagonal matrix
46 *> using the Relatively Robust Representation where it can.
47 *>
48 *> DSYEV computes all eigenvalues and, optionally,
49 *> eigenvectors of a real symmetric matrix.
50 *>
51 *> DSYEVX computes selected eigenvalues and, optionally,
52 *> eigenvectors of a real symmetric matrix.
53 *>
54 *> DSYEVR computes selected eigenvalues and, optionally,
55 *> eigenvectors of a real symmetric matrix
56 *> using the Relatively Robust Representation where it can.
57 *>
58 *> DSPEV computes all eigenvalues and, optionally,
59 *> eigenvectors of a real symmetric matrix in packed
60 *> storage.
61 *>
62 *> DSPEVX computes selected eigenvalues and, optionally,
63 *> eigenvectors of a real symmetric matrix in packed
64 *> storage.
65 *>
66 *> DSBEV computes all eigenvalues and, optionally,
67 *> eigenvectors of a real symmetric band matrix.
68 *>
69 *> DSBEVX computes selected eigenvalues and, optionally,
70 *> eigenvectors of a real symmetric band matrix.
71 *>
72 *> DSYEVD computes all eigenvalues and, optionally,
73 *> eigenvectors of a real symmetric matrix using
74 *> a divide and conquer algorithm.
75 *>
76 *> DSPEVD computes all eigenvalues and, optionally,
77 *> eigenvectors of a real symmetric matrix in packed
78 *> storage, using a divide and conquer algorithm.
79 *>
80 *> DSBEVD computes all eigenvalues and, optionally,
81 *> eigenvectors of a real symmetric band matrix,
82 *> using a divide and conquer algorithm.
83 *>
84 *> When DDRVST2STG is called, a number of matrix "sizes" ("n's") and a
85 *> number of matrix "types" are specified. For each size ("n")
86 *> and each type of matrix, one matrix will be generated and used
87 *> to test the appropriate drivers. For each matrix and each
88 *> driver routine called, the following tests will be performed:
89 *>
90 *> (1) | A - Z D Z' | / ( |A| n ulp )
91 *>
92 *> (2) | I - Z Z' | / ( n ulp )
93 *>
94 *> (3) | D1 - D2 | / ( |D1| ulp )
95 *>
96 *> where Z is the matrix of eigenvectors returned when the
97 *> eigenvector option is given and D1 and D2 are the eigenvalues
98 *> returned with and without the eigenvector option.
99 *>
100 *> The "sizes" are specified by an array NN(1:NSIZES); the value of
101 *> each element NN(j) specifies one size.
102 *> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
103 *> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
104 *> Currently, the list of possible types is:
105 *>
106 *> (1) The zero matrix.
107 *> (2) The identity matrix.
108 *>
109 *> (3) A diagonal matrix with evenly spaced eigenvalues
110 *> 1, ..., ULP and random signs.
111 *> (ULP = (first number larger than 1) - 1 )
112 *> (4) A diagonal matrix with geometrically spaced eigenvalues
113 *> 1, ..., ULP and random signs.
114 *> (5) A diagonal matrix with "clustered" eigenvalues
115 *> 1, ULP, ..., ULP and random signs.
116 *>
117 *> (6) Same as (4), but multiplied by SQRT( overflow threshold )
118 *> (7) Same as (4), but multiplied by SQRT( underflow threshold )
119 *>
120 *> (8) A matrix of the form U' D U, where U is orthogonal and
121 *> D has evenly spaced entries 1, ..., ULP with random signs
122 *> on the diagonal.
123 *>
124 *> (9) A matrix of the form U' D U, where U is orthogonal and
125 *> D has geometrically spaced entries 1, ..., ULP with random
126 *> signs on the diagonal.
127 *>
128 *> (10) A matrix of the form U' D U, where U is orthogonal and
129 *> D has "clustered" entries 1, ULP,..., ULP with random
130 *> signs on the diagonal.
131 *>
132 *> (11) Same as (8), but multiplied by SQRT( overflow threshold )
133 *> (12) Same as (8), but multiplied by SQRT( underflow threshold )
134 *>
135 *> (13) Symmetric matrix with random entries chosen from (-1,1).
136 *> (14) Same as (13), but multiplied by SQRT( overflow threshold )
137 *> (15) Same as (13), but multiplied by SQRT( underflow threshold )
138 *> (16) A band matrix with half bandwidth randomly chosen between
139 *> 0 and N-1, with evenly spaced eigenvalues 1, ..., ULP
140 *> with random signs.
141 *> (17) Same as (16), but multiplied by SQRT( overflow threshold )
142 *> (18) Same as (16), but multiplied by SQRT( underflow threshold )
143 *> \endverbatim
144 *
145 * Arguments:
146 * ==========
147 *
148 *> \verbatim
149 *> NSIZES INTEGER
150 *> The number of sizes of matrices to use. If it is zero,
151 *> DDRVST2STG does nothing. It must be at least zero.
152 *> Not modified.
153 *>
154 *> NN INTEGER array, dimension (NSIZES)
155 *> An array containing the sizes to be used for the matrices.
156 *> Zero values will be skipped. The values must be at least
157 *> zero.
158 *> Not modified.
159 *>
160 *> NTYPES INTEGER
161 *> The number of elements in DOTYPE. If it is zero, DDRVST2STG
162 *> does nothing. It must be at least zero. If it is MAXTYP+1
163 *> and NSIZES is 1, then an additional type, MAXTYP+1 is
164 *> defined, which is to use whatever matrix is in A. This
165 *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
166 *> DOTYPE(MAXTYP+1) is .TRUE. .
167 *> Not modified.
168 *>
169 *> DOTYPE LOGICAL array, dimension (NTYPES)
170 *> If DOTYPE(j) is .TRUE., then for each size in NN a
171 *> matrix of that size and of type j will be generated.
172 *> If NTYPES is smaller than the maximum number of types
173 *> defined (PARAMETER MAXTYP), then types NTYPES+1 through
174 *> MAXTYP will not be generated. If NTYPES is larger
175 *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
176 *> will be ignored.
177 *> Not modified.
178 *>
179 *> ISEED INTEGER array, dimension (4)
180 *> On entry ISEED specifies the seed of the random number
181 *> generator. The array elements should be between 0 and 4095;
182 *> if not they will be reduced mod 4096. Also, ISEED(4) must
183 *> be odd. The random number generator uses a linear
184 *> congruential sequence limited to small integers, and so
185 *> should produce machine independent random numbers. The
186 *> values of ISEED are changed on exit, and can be used in the
187 *> next call to DDRVST2STG to continue the same random number
188 *> sequence.
189 *> Modified.
190 *>
191 *> THRESH DOUBLE PRECISION
192 *> A test will count as "failed" if the "error", computed as
193 *> described above, exceeds THRESH. Note that the error
194 *> is scaled to be O(1), so THRESH should be a reasonably
195 *> small multiple of 1, e.g., 10 or 100. In particular,
196 *> it should not depend on the precision (single vs. double)
197 *> or the size of the matrix. It must be at least zero.
198 *> Not modified.
199 *>
200 *> NOUNIT INTEGER
201 *> The FORTRAN unit number for printing out error messages
202 *> (e.g., if a routine returns IINFO not equal to 0.)
203 *> Not modified.
204 *>
205 *> A DOUBLE PRECISION array, dimension (LDA , max(NN))
206 *> Used to hold the matrix whose eigenvalues are to be
207 *> computed. On exit, A contains the last matrix actually
208 *> used.
209 *> Modified.
210 *>
211 *> LDA INTEGER
212 *> The leading dimension of A. It must be at
213 *> least 1 and at least max( NN ).
214 *> Not modified.
215 *>
216 *> D1 DOUBLE PRECISION array, dimension (max(NN))
217 *> The eigenvalues of A, as computed by DSTEQR simlutaneously
218 *> with Z. On exit, the eigenvalues in D1 correspond with the
219 *> matrix in A.
220 *> Modified.
221 *>
222 *> D2 DOUBLE PRECISION array, dimension (max(NN))
223 *> The eigenvalues of A, as computed by DSTEQR if Z is not
224 *> computed. On exit, the eigenvalues in D2 correspond with
225 *> the matrix in A.
226 *> Modified.
227 *>
228 *> D3 DOUBLE PRECISION array, dimension (max(NN))
229 *> The eigenvalues of A, as computed by DSTERF. On exit, the
230 *> eigenvalues in D3 correspond with the matrix in A.
231 *> Modified.
232 *>
233 *> D4 DOUBLE PRECISION array, dimension
234 *>
235 *> EVEIGS DOUBLE PRECISION array, dimension (max(NN))
236 *> The eigenvalues as computed by DSTEV('N', ... )
237 *> (I reserve the right to change this to the output of
238 *> whichever algorithm computes the most accurate eigenvalues).
239 *>
240 *> WA1 DOUBLE PRECISION array, dimension
241 *>
242 *> WA2 DOUBLE PRECISION array, dimension
243 *>
244 *> WA3 DOUBLE PRECISION array, dimension
245 *>
246 *> U DOUBLE PRECISION array, dimension (LDU, max(NN))
247 *> The orthogonal matrix computed by DSYTRD + DORGTR.
248 *> Modified.
249 *>
250 *> LDU INTEGER
251 *> The leading dimension of U, Z, and V. It must be at
252 *> least 1 and at least max( NN ).
253 *> Not modified.
254 *>
255 *> V DOUBLE PRECISION array, dimension (LDU, max(NN))
256 *> The Housholder vectors computed by DSYTRD in reducing A to
257 *> tridiagonal form.
258 *> Modified.
259 *>
260 *> TAU DOUBLE PRECISION array, dimension (max(NN))
261 *> The Householder factors computed by DSYTRD in reducing A
262 *> to tridiagonal form.
263 *> Modified.
264 *>
265 *> Z DOUBLE PRECISION array, dimension (LDU, max(NN))
266 *> The orthogonal matrix of eigenvectors computed by DSTEQR,
267 *> DPTEQR, and DSTEIN.
268 *> Modified.
269 *>
270 *> WORK DOUBLE PRECISION array, dimension (LWORK)
271 *> Workspace.
272 *> Modified.
273 *>
274 *> LWORK INTEGER
275 *> The number of entries in WORK. This must be at least
276 *> 1 + 4 * Nmax + 2 * Nmax * lg Nmax + 4 * Nmax**2
277 *> where Nmax = max( NN(j), 2 ) and lg = log base 2.
278 *> Not modified.
279 *>
280 *> IWORK INTEGER array,
281 *> dimension (6 + 6*Nmax + 5 * Nmax * lg Nmax )
282 *> where Nmax = max( NN(j), 2 ) and lg = log base 2.
283 *> Workspace.
284 *> Modified.
285 *>
286 *> RESULT DOUBLE PRECISION array, dimension (105)
287 *> The values computed by the tests described above.
288 *> The values are currently limited to 1/ulp, to avoid
289 *> overflow.
290 *> Modified.
291 *>
292 *> INFO INTEGER
293 *> If 0, then everything ran OK.
294 *> -1: NSIZES < 0
295 *> -2: Some NN(j) < 0
296 *> -3: NTYPES < 0
297 *> -5: THRESH < 0
298 *> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
299 *> -16: LDU < 1 or LDU < NMAX.
300 *> -21: LWORK too small.
301 *> If DLATMR, DLATMS, DSYTRD, DORGTR, DSTEQR, DSTERF,
302 *> or DORMTR returns an error code, the
303 *> absolute value of it is returned.
304 *> Modified.
305 *>
306 *>-----------------------------------------------------------------------
307 *>
308 *> Some Local Variables and Parameters:
309 *> ---- ----- --------- --- ----------
310 *> ZERO, ONE Real 0 and 1.
311 *> MAXTYP The number of types defined.
312 *> NTEST The number of tests performed, or which can
313 *> be performed so far, for the current matrix.
314 *> NTESTT The total number of tests performed so far.
315 *> NMAX Largest value in NN.
316 *> NMATS The number of matrices generated so far.
317 *> NERRS The number of tests which have exceeded THRESH
318 *> so far (computed by DLAFTS).
319 *> COND, IMODE Values to be passed to the matrix generators.
320 *> ANORM Norm of A; passed to matrix generators.
321 *>
322 *> OVFL, UNFL Overflow and underflow thresholds.
323 *> ULP, ULPINV Finest relative precision and its inverse.
324 *> RTOVFL, RTUNFL Square roots of the previous 2 values.
325 *> The following four arrays decode JTYPE:
326 *> KTYPE(j) The general type (1-10) for type "j".
327 *> KMODE(j) The MODE value to be passed to the matrix
328 *> generator for type "j".
329 *> KMAGN(j) The order of magnitude ( O(1),
330 *> O(overflow^(1/2) ), O(underflow^(1/2) )
331 *>
332 *> The tests performed are: Routine tested
333 *> 1= | A - U S U' | / ( |A| n ulp ) DSTEV('V', ... )
334 *> 2= | I - U U' | / ( n ulp ) DSTEV('V', ... )
335 *> 3= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEV('N', ... )
336 *> 4= | A - U S U' | / ( |A| n ulp ) DSTEVX('V','A', ... )
337 *> 5= | I - U U' | / ( n ulp ) DSTEVX('V','A', ... )
338 *> 6= |D(with Z) - EVEIGS| / (|D| ulp) DSTEVX('N','A', ... )
339 *> 7= | A - U S U' | / ( |A| n ulp ) DSTEVR('V','A', ... )
340 *> 8= | I - U U' | / ( n ulp ) DSTEVR('V','A', ... )
341 *> 9= |D(with Z) - EVEIGS| / (|D| ulp) DSTEVR('N','A', ... )
342 *> 10= | A - U S U' | / ( |A| n ulp ) DSTEVX('V','I', ... )
343 *> 11= | I - U U' | / ( n ulp ) DSTEVX('V','I', ... )
344 *> 12= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVX('N','I', ... )
345 *> 13= | A - U S U' | / ( |A| n ulp ) DSTEVX('V','V', ... )
346 *> 14= | I - U U' | / ( n ulp ) DSTEVX('V','V', ... )
347 *> 15= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVX('N','V', ... )
348 *> 16= | A - U S U' | / ( |A| n ulp ) DSTEVD('V', ... )
349 *> 17= | I - U U' | / ( n ulp ) DSTEVD('V', ... )
350 *> 18= |D(with Z) - EVEIGS| / (|D| ulp) DSTEVD('N', ... )
351 *> 19= | A - U S U' | / ( |A| n ulp ) DSTEVR('V','I', ... )
352 *> 20= | I - U U' | / ( n ulp ) DSTEVR('V','I', ... )
353 *> 21= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVR('N','I', ... )
354 *> 22= | A - U S U' | / ( |A| n ulp ) DSTEVR('V','V', ... )
355 *> 23= | I - U U' | / ( n ulp ) DSTEVR('V','V', ... )
356 *> 24= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVR('N','V', ... )
357 *>
358 *> 25= | A - U S U' | / ( |A| n ulp ) DSYEV('L','V', ... )
359 *> 26= | I - U U' | / ( n ulp ) DSYEV('L','V', ... )
360 *> 27= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEV_2STAGE('L','N', ... )
361 *> 28= | A - U S U' | / ( |A| n ulp ) DSYEVX('L','V','A', ... )
362 *> 29= | I - U U' | / ( n ulp ) DSYEVX('L','V','A', ... )
363 *> 30= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVX_2STAGE('L','N','A', ... )
364 *> 31= | A - U S U' | / ( |A| n ulp ) DSYEVX('L','V','I', ... )
365 *> 32= | I - U U' | / ( n ulp ) DSYEVX('L','V','I', ... )
366 *> 33= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVX_2STAGE('L','N','I', ... )
367 *> 34= | A - U S U' | / ( |A| n ulp ) DSYEVX('L','V','V', ... )
368 *> 35= | I - U U' | / ( n ulp ) DSYEVX('L','V','V', ... )
369 *> 36= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVX_2STAGE('L','N','V', ... )
370 *> 37= | A - U S U' | / ( |A| n ulp ) DSPEV('L','V', ... )
371 *> 38= | I - U U' | / ( n ulp ) DSPEV('L','V', ... )
372 *> 39= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEV('L','N', ... )
373 *> 40= | A - U S U' | / ( |A| n ulp ) DSPEVX('L','V','A', ... )
374 *> 41= | I - U U' | / ( n ulp ) DSPEVX('L','V','A', ... )
375 *> 42= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVX('L','N','A', ... )
376 *> 43= | A - U S U' | / ( |A| n ulp ) DSPEVX('L','V','I', ... )
377 *> 44= | I - U U' | / ( n ulp ) DSPEVX('L','V','I', ... )
378 *> 45= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVX('L','N','I', ... )
379 *> 46= | A - U S U' | / ( |A| n ulp ) DSPEVX('L','V','V', ... )
380 *> 47= | I - U U' | / ( n ulp ) DSPEVX('L','V','V', ... )
381 *> 48= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVX('L','N','V', ... )
382 *> 49= | A - U S U' | / ( |A| n ulp ) DSBEV('L','V', ... )
383 *> 50= | I - U U' | / ( n ulp ) DSBEV('L','V', ... )
384 *> 51= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEV_2STAGE('L','N', ... )
385 *> 52= | A - U S U' | / ( |A| n ulp ) DSBEVX('L','V','A', ... )
386 *> 53= | I - U U' | / ( n ulp ) DSBEVX('L','V','A', ... )
387 *> 54= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVX_2STAGE('L','N','A', ... )
388 *> 55= | A - U S U' | / ( |A| n ulp ) DSBEVX('L','V','I', ... )
389 *> 56= | I - U U' | / ( n ulp ) DSBEVX('L','V','I', ... )
390 *> 57= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVX_2STAGE('L','N','I', ... )
391 *> 58= | A - U S U' | / ( |A| n ulp ) DSBEVX('L','V','V', ... )
392 *> 59= | I - U U' | / ( n ulp ) DSBEVX('L','V','V', ... )
393 *> 60= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVX_2STAGE('L','N','V', ... )
394 *> 61= | A - U S U' | / ( |A| n ulp ) DSYEVD('L','V', ... )
395 *> 62= | I - U U' | / ( n ulp ) DSYEVD('L','V', ... )
396 *> 63= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVD_2STAGE('L','N', ... )
397 *> 64= | A - U S U' | / ( |A| n ulp ) DSPEVD('L','V', ... )
398 *> 65= | I - U U' | / ( n ulp ) DSPEVD('L','V', ... )
399 *> 66= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVD('L','N', ... )
400 *> 67= | A - U S U' | / ( |A| n ulp ) DSBEVD('L','V', ... )
401 *> 68= | I - U U' | / ( n ulp ) DSBEVD('L','V', ... )
402 *> 69= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVD_2STAGE('L','N', ... )
403 *> 70= | A - U S U' | / ( |A| n ulp ) DSYEVR('L','V','A', ... )
404 *> 71= | I - U U' | / ( n ulp ) DSYEVR('L','V','A', ... )
405 *> 72= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVR_2STAGE('L','N','A', ... )
406 *> 73= | A - U S U' | / ( |A| n ulp ) DSYEVR('L','V','I', ... )
407 *> 74= | I - U U' | / ( n ulp ) DSYEVR('L','V','I', ... )
408 *> 75= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVR_2STAGE('L','N','I', ... )
409 *> 76= | A - U S U' | / ( |A| n ulp ) DSYEVR('L','V','V', ... )
410 *> 77= | I - U U' | / ( n ulp ) DSYEVR('L','V','V', ... )
411 *> 78= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVR_2STAGE('L','N','V', ... )
412 *>
413 *> Tests 25 through 78 are repeated (as tests 79 through 132)
414 *> with UPLO='U'
415 *>
416 *> To be added in 1999
417 *>
418 *> 79= | A - U S U' | / ( |A| n ulp ) DSPEVR('L','V','A', ... )
419 *> 80= | I - U U' | / ( n ulp ) DSPEVR('L','V','A', ... )
420 *> 81= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVR('L','N','A', ... )
421 *> 82= | A - U S U' | / ( |A| n ulp ) DSPEVR('L','V','I', ... )
422 *> 83= | I - U U' | / ( n ulp ) DSPEVR('L','V','I', ... )
423 *> 84= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVR('L','N','I', ... )
424 *> 85= | A - U S U' | / ( |A| n ulp ) DSPEVR('L','V','V', ... )
425 *> 86= | I - U U' | / ( n ulp ) DSPEVR('L','V','V', ... )
426 *> 87= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVR('L','N','V', ... )
427 *> 88= | A - U S U' | / ( |A| n ulp ) DSBEVR('L','V','A', ... )
428 *> 89= | I - U U' | / ( n ulp ) DSBEVR('L','V','A', ... )
429 *> 90= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVR('L','N','A', ... )
430 *> 91= | A - U S U' | / ( |A| n ulp ) DSBEVR('L','V','I', ... )
431 *> 92= | I - U U' | / ( n ulp ) DSBEVR('L','V','I', ... )
432 *> 93= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVR('L','N','I', ... )
433 *> 94= | A - U S U' | / ( |A| n ulp ) DSBEVR('L','V','V', ... )
434 *> 95= | I - U U' | / ( n ulp ) DSBEVR('L','V','V', ... )
435 *> 96= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVR('L','N','V', ... )
436 *> \endverbatim
437 *
438 * Authors:
439 * ========
440 *
441 *> \author Univ. of Tennessee
442 *> \author Univ. of California Berkeley
443 *> \author Univ. of Colorado Denver
444 *> \author NAG Ltd.
445 *
446 *> \ingroup double_eig
447 *
448 * =====================================================================
449  SUBROUTINE ddrvst2stg( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
450  $ NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1,
451  $ WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK,
452  $ IWORK, LIWORK, RESULT, INFO )
453 *
454 * -- LAPACK test routine --
455 * -- LAPACK is a software package provided by Univ. of Tennessee, --
456 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
457 *
458 * .. Scalar Arguments ..
459  INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
460  $ NTYPES
461  DOUBLE PRECISION THRESH
462 * ..
463 * .. Array Arguments ..
464  LOGICAL DOTYPE( * )
465  INTEGER ISEED( 4 ), IWORK( * ), NN( * )
466  DOUBLE PRECISION A( LDA, * ), D1( * ), D2( * ), D3( * ),
467  $ d4( * ), eveigs( * ), result( * ), tau( * ),
468  $ u( ldu, * ), v( ldu, * ), wa1( * ), wa2( * ),
469  $ wa3( * ), work( * ), z( ldu, * )
470 * ..
471 *
472 * =====================================================================
473 *
474 * .. Parameters ..
475  DOUBLE PRECISION ZERO, ONE, TWO, TEN
476  PARAMETER ( ZERO = 0.0d0, one = 1.0d0, two = 2.0d0,
477  $ ten = 10.0d0 )
478  DOUBLE PRECISION HALF
479  parameter( half = 0.5d0 )
480  INTEGER MAXTYP
481  parameter( maxtyp = 18 )
482 * ..
483 * .. Local Scalars ..
484  LOGICAL BADNN
485  CHARACTER UPLO
486  INTEGER I, IDIAG, IHBW, IINFO, IL, IMODE, INDX, IROW,
487  $ itemp, itype, iu, iuplo, j, j1, j2, jcol,
488  $ jsize, jtype, kd, lgn, liwedc, lwedc, m, m2,
489  $ m3, mtypes, n, nerrs, nmats, nmax, ntest,
490  $ ntestt
491  DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
492  $ RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL,
493  $ VL, VU
494 * ..
495 * .. Local Arrays ..
496  INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
497  $ ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
498  $ KTYPE( MAXTYP )
499 * ..
500 * .. External Functions ..
501  DOUBLE PRECISION DLAMCH, DLARND, DSXT1
502  EXTERNAL DLAMCH, DLARND, DSXT1
503 * ..
504 * .. External Subroutines ..
505  EXTERNAL alasvm, dlabad, dlacpy, dlafts, dlaset, dlatmr,
506  $ dlatms, dsbev, dsbevd, dsbevx, dspev, dspevd,
507  $ dspevx, dstev, dstevd, dstevr, dstevx, dstt21,
508  $ dstt22, dsyev, dsyevd, dsyevr, dsyevx, dsyt21,
509  $ dsyevd_2stage, dsyevr_2stage, dsyevx_2stage,
510  $ dsyev_2stage, dsbev_2stage, dsbevd_2stage,
511  $ dsbevx_2stage, dsytrd_2stage, dsytrd_sy2sb,
512  $ dsytrd_sb2st, dsyt22, xerbla
513 * ..
514 * .. Scalars in Common ..
515  CHARACTER*32 SRNAMT
516 * ..
517 * .. Common blocks ..
518  COMMON / srnamc / srnamt
519 * ..
520 * .. Intrinsic Functions ..
521  INTRINSIC abs, dble, int, log, max, min, sqrt
522 * ..
523 * .. Data statements ..
524  DATA ktype / 1, 2, 5*4, 5*5, 3*8, 3*9 /
525  DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
526  $ 2, 3, 1, 2, 3 /
527  DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
528  $ 0, 0, 4, 4, 4 /
529 * ..
530 * .. Executable Statements ..
531 *
532 * Keep ftrnchek happy
533 *
534  vl = zero
535  vu = zero
536 *
537 * 1) Check for errors
538 *
539  ntestt = 0
540  info = 0
541 *
542  badnn = .false.
543  nmax = 1
544  DO 10 j = 1, nsizes
545  nmax = max( nmax, nn( j ) )
546  IF( nn( j ).LT.0 )
547  $ badnn = .true.
548  10 CONTINUE
549 *
550 * Check for errors
551 *
552  IF( nsizes.LT.0 ) THEN
553  info = -1
554  ELSE IF( badnn ) THEN
555  info = -2
556  ELSE IF( ntypes.LT.0 ) THEN
557  info = -3
558  ELSE IF( lda.LT.nmax ) THEN
559  info = -9
560  ELSE IF( ldu.LT.nmax ) THEN
561  info = -16
562  ELSE IF( 2*max( 2, nmax )**2.GT.lwork ) THEN
563  info = -21
564  END IF
565 *
566  IF( info.NE.0 ) THEN
567  CALL xerbla( 'DDRVST2STG', -info )
568  RETURN
569  END IF
570 *
571 * Quick return if nothing to do
572 *
573  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
574  $ RETURN
575 *
576 * More Important constants
577 *
578  unfl = dlamch( 'Safe minimum' )
579  ovfl = dlamch( 'Overflow' )
580  CALL dlabad( unfl, ovfl )
581  ulp = dlamch( 'Epsilon' )*dlamch( 'Base' )
582  ulpinv = one / ulp
583  rtunfl = sqrt( unfl )
584  rtovfl = sqrt( ovfl )
585 *
586 * Loop over sizes, types
587 *
588  DO 20 i = 1, 4
589  iseed2( i ) = iseed( i )
590  iseed3( i ) = iseed( i )
591  20 CONTINUE
592 *
593  nerrs = 0
594  nmats = 0
595 *
596 *
597  DO 1740 jsize = 1, nsizes
598  n = nn( jsize )
599  IF( n.GT.0 ) THEN
600  lgn = int( log( dble( n ) ) / log( two ) )
601  IF( 2**lgn.LT.n )
602  $ lgn = lgn + 1
603  IF( 2**lgn.LT.n )
604  $ lgn = lgn + 1
605  lwedc = 1 + 4*n + 2*n*lgn + 4*n**2
606 c LIWEDC = 6 + 6*N + 5*N*LGN
607  liwedc = 3 + 5*n
608  ELSE
609  lwedc = 9
610 c LIWEDC = 12
611  liwedc = 8
612  END IF
613  aninv = one / dble( max( 1, n ) )
614 *
615  IF( nsizes.NE.1 ) THEN
616  mtypes = min( maxtyp, ntypes )
617  ELSE
618  mtypes = min( maxtyp+1, ntypes )
619  END IF
620 *
621  DO 1730 jtype = 1, mtypes
622 *
623  IF( .NOT.dotype( jtype ) )
624  $ GO TO 1730
625  nmats = nmats + 1
626  ntest = 0
627 *
628  DO 30 j = 1, 4
629  ioldsd( j ) = iseed( j )
630  30 CONTINUE
631 *
632 * 2) Compute "A"
633 *
634 * Control parameters:
635 *
636 * KMAGN KMODE KTYPE
637 * =1 O(1) clustered 1 zero
638 * =2 large clustered 2 identity
639 * =3 small exponential (none)
640 * =4 arithmetic diagonal, (w/ eigenvalues)
641 * =5 random log symmetric, w/ eigenvalues
642 * =6 random (none)
643 * =7 random diagonal
644 * =8 random symmetric
645 * =9 band symmetric, w/ eigenvalues
646 *
647  IF( mtypes.GT.maxtyp )
648  $ GO TO 110
649 *
650  itype = ktype( jtype )
651  imode = kmode( jtype )
652 *
653 * Compute norm
654 *
655  GO TO ( 40, 50, 60 )kmagn( jtype )
656 *
657  40 CONTINUE
658  anorm = one
659  GO TO 70
660 *
661  50 CONTINUE
662  anorm = ( rtovfl*ulp )*aninv
663  GO TO 70
664 *
665  60 CONTINUE
666  anorm = rtunfl*n*ulpinv
667  GO TO 70
668 *
669  70 CONTINUE
670 *
671  CALL dlaset( 'Full', lda, n, zero, zero, a, lda )
672  iinfo = 0
673  cond = ulpinv
674 *
675 * Special Matrices -- Identity & Jordan block
676 *
677 * Zero
678 *
679  IF( itype.EQ.1 ) THEN
680  iinfo = 0
681 *
682  ELSE IF( itype.EQ.2 ) THEN
683 *
684 * Identity
685 *
686  DO 80 jcol = 1, n
687  a( jcol, jcol ) = anorm
688  80 CONTINUE
689 *
690  ELSE IF( itype.EQ.4 ) THEN
691 *
692 * Diagonal Matrix, [Eigen]values Specified
693 *
694  CALL dlatms( n, n, 'S', iseed, 'S', work, imode, cond,
695  $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
696  $ iinfo )
697 *
698  ELSE IF( itype.EQ.5 ) THEN
699 *
700 * Symmetric, eigenvalues specified
701 *
702  CALL dlatms( n, n, 'S', iseed, 'S', work, imode, cond,
703  $ anorm, n, n, 'N', a, lda, work( n+1 ),
704  $ iinfo )
705 *
706  ELSE IF( itype.EQ.7 ) THEN
707 *
708 * Diagonal, random eigenvalues
709 *
710  idumma( 1 ) = 1
711  CALL dlatmr( n, n, 'S', iseed, 'S', work, 6, one, one,
712  $ 'T', 'N', work( n+1 ), 1, one,
713  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
714  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
715 *
716  ELSE IF( itype.EQ.8 ) THEN
717 *
718 * Symmetric, random eigenvalues
719 *
720  idumma( 1 ) = 1
721  CALL dlatmr( n, n, 'S', iseed, 'S', work, 6, one, one,
722  $ 'T', 'N', work( n+1 ), 1, one,
723  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
724  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
725 *
726  ELSE IF( itype.EQ.9 ) THEN
727 *
728 * Symmetric banded, eigenvalues specified
729 *
730  ihbw = int( ( n-1 )*dlarnd( 1, iseed3 ) )
731  CALL dlatms( n, n, 'S', iseed, 'S', work, imode, cond,
732  $ anorm, ihbw, ihbw, 'Z', u, ldu, work( n+1 ),
733  $ iinfo )
734 *
735 * Store as dense matrix for most routines.
736 *
737  CALL dlaset( 'Full', lda, n, zero, zero, a, lda )
738  DO 100 idiag = -ihbw, ihbw
739  irow = ihbw - idiag + 1
740  j1 = max( 1, idiag+1 )
741  j2 = min( n, n+idiag )
742  DO 90 j = j1, j2
743  i = j - idiag
744  a( i, j ) = u( irow, j )
745  90 CONTINUE
746  100 CONTINUE
747  ELSE
748  iinfo = 1
749  END IF
750 *
751  IF( iinfo.NE.0 ) THEN
752  WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
753  $ ioldsd
754  info = abs( iinfo )
755  RETURN
756  END IF
757 *
758  110 CONTINUE
759 *
760  abstol = unfl + unfl
761  IF( n.LE.1 ) THEN
762  il = 1
763  iu = n
764  ELSE
765  il = 1 + int( ( n-1 )*dlarnd( 1, iseed2 ) )
766  iu = 1 + int( ( n-1 )*dlarnd( 1, iseed2 ) )
767  IF( il.GT.iu ) THEN
768  itemp = il
769  il = iu
770  iu = itemp
771  END IF
772  END IF
773 *
774 * 3) If matrix is tridiagonal, call DSTEV and DSTEVX.
775 *
776  IF( jtype.LE.7 ) THEN
777  ntest = 1
778  DO 120 i = 1, n
779  d1( i ) = dble( a( i, i ) )
780  120 CONTINUE
781  DO 130 i = 1, n - 1
782  d2( i ) = dble( a( i+1, i ) )
783  130 CONTINUE
784  srnamt = 'DSTEV'
785  CALL dstev( 'V', n, d1, d2, z, ldu, work, iinfo )
786  IF( iinfo.NE.0 ) THEN
787  WRITE( nounit, fmt = 9999 )'DSTEV(V)', iinfo, n,
788  $ jtype, ioldsd
789  info = abs( iinfo )
790  IF( iinfo.LT.0 ) THEN
791  RETURN
792  ELSE
793  result( 1 ) = ulpinv
794  result( 2 ) = ulpinv
795  result( 3 ) = ulpinv
796  GO TO 180
797  END IF
798  END IF
799 *
800 * Do tests 1 and 2.
801 *
802  DO 140 i = 1, n
803  d3( i ) = dble( a( i, i ) )
804  140 CONTINUE
805  DO 150 i = 1, n - 1
806  d4( i ) = dble( a( i+1, i ) )
807  150 CONTINUE
808  CALL dstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
809  $ result( 1 ) )
810 *
811  ntest = 3
812  DO 160 i = 1, n - 1
813  d4( i ) = dble( a( i+1, i ) )
814  160 CONTINUE
815  srnamt = 'DSTEV'
816  CALL dstev( 'N', n, d3, d4, z, ldu, work, iinfo )
817  IF( iinfo.NE.0 ) THEN
818  WRITE( nounit, fmt = 9999 )'DSTEV(N)', iinfo, n,
819  $ jtype, ioldsd
820  info = abs( iinfo )
821  IF( iinfo.LT.0 ) THEN
822  RETURN
823  ELSE
824  result( 3 ) = ulpinv
825  GO TO 180
826  END IF
827  END IF
828 *
829 * Do test 3.
830 *
831  temp1 = zero
832  temp2 = zero
833  DO 170 j = 1, n
834  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
835  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
836  170 CONTINUE
837  result( 3 ) = temp2 / max( unfl,
838  $ ulp*max( temp1, temp2 ) )
839 *
840  180 CONTINUE
841 *
842  ntest = 4
843  DO 190 i = 1, n
844  eveigs( i ) = d3( i )
845  d1( i ) = dble( a( i, i ) )
846  190 CONTINUE
847  DO 200 i = 1, n - 1
848  d2( i ) = dble( a( i+1, i ) )
849  200 CONTINUE
850  srnamt = 'DSTEVX'
851  CALL dstevx( 'V', 'A', n, d1, d2, vl, vu, il, iu, abstol,
852  $ m, wa1, z, ldu, work, iwork, iwork( 5*n+1 ),
853  $ iinfo )
854  IF( iinfo.NE.0 ) THEN
855  WRITE( nounit, fmt = 9999 )'DSTEVX(V,A)', iinfo, n,
856  $ jtype, ioldsd
857  info = abs( iinfo )
858  IF( iinfo.LT.0 ) THEN
859  RETURN
860  ELSE
861  result( 4 ) = ulpinv
862  result( 5 ) = ulpinv
863  result( 6 ) = ulpinv
864  GO TO 250
865  END IF
866  END IF
867  IF( n.GT.0 ) THEN
868  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
869  ELSE
870  temp3 = zero
871  END IF
872 *
873 * Do tests 4 and 5.
874 *
875  DO 210 i = 1, n
876  d3( i ) = dble( a( i, i ) )
877  210 CONTINUE
878  DO 220 i = 1, n - 1
879  d4( i ) = dble( a( i+1, i ) )
880  220 CONTINUE
881  CALL dstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
882  $ result( 4 ) )
883 *
884  ntest = 6
885  DO 230 i = 1, n - 1
886  d4( i ) = dble( a( i+1, i ) )
887  230 CONTINUE
888  srnamt = 'DSTEVX'
889  CALL dstevx( 'N', 'A', n, d3, d4, vl, vu, il, iu, abstol,
890  $ m2, wa2, z, ldu, work, iwork,
891  $ iwork( 5*n+1 ), iinfo )
892  IF( iinfo.NE.0 ) THEN
893  WRITE( nounit, fmt = 9999 )'DSTEVX(N,A)', iinfo, n,
894  $ jtype, ioldsd
895  info = abs( iinfo )
896  IF( iinfo.LT.0 ) THEN
897  RETURN
898  ELSE
899  result( 6 ) = ulpinv
900  GO TO 250
901  END IF
902  END IF
903 *
904 * Do test 6.
905 *
906  temp1 = zero
907  temp2 = zero
908  DO 240 j = 1, n
909  temp1 = max( temp1, abs( wa2( j ) ),
910  $ abs( eveigs( j ) ) )
911  temp2 = max( temp2, abs( wa2( j )-eveigs( j ) ) )
912  240 CONTINUE
913  result( 6 ) = temp2 / max( unfl,
914  $ ulp*max( temp1, temp2 ) )
915 *
916  250 CONTINUE
917 *
918  ntest = 7
919  DO 260 i = 1, n
920  d1( i ) = dble( a( i, i ) )
921  260 CONTINUE
922  DO 270 i = 1, n - 1
923  d2( i ) = dble( a( i+1, i ) )
924  270 CONTINUE
925  srnamt = 'DSTEVR'
926  CALL dstevr( 'V', 'A', n, d1, d2, vl, vu, il, iu, abstol,
927  $ m, wa1, z, ldu, iwork, work, lwork,
928  $ iwork(2*n+1), liwork-2*n, iinfo )
929  IF( iinfo.NE.0 ) THEN
930  WRITE( nounit, fmt = 9999 )'DSTEVR(V,A)', iinfo, n,
931  $ jtype, ioldsd
932  info = abs( iinfo )
933  IF( iinfo.LT.0 ) THEN
934  RETURN
935  ELSE
936  result( 7 ) = ulpinv
937  result( 8 ) = ulpinv
938  GO TO 320
939  END IF
940  END IF
941  IF( n.GT.0 ) THEN
942  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
943  ELSE
944  temp3 = zero
945  END IF
946 *
947 * Do tests 7 and 8.
948 *
949  DO 280 i = 1, n
950  d3( i ) = dble( a( i, i ) )
951  280 CONTINUE
952  DO 290 i = 1, n - 1
953  d4( i ) = dble( a( i+1, i ) )
954  290 CONTINUE
955  CALL dstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
956  $ result( 7 ) )
957 *
958  ntest = 9
959  DO 300 i = 1, n - 1
960  d4( i ) = dble( a( i+1, i ) )
961  300 CONTINUE
962  srnamt = 'DSTEVR'
963  CALL dstevr( 'N', 'A', n, d3, d4, vl, vu, il, iu, abstol,
964  $ m2, wa2, z, ldu, iwork, work, lwork,
965  $ iwork(2*n+1), liwork-2*n, iinfo )
966  IF( iinfo.NE.0 ) THEN
967  WRITE( nounit, fmt = 9999 )'DSTEVR(N,A)', iinfo, n,
968  $ jtype, ioldsd
969  info = abs( iinfo )
970  IF( iinfo.LT.0 ) THEN
971  RETURN
972  ELSE
973  result( 9 ) = ulpinv
974  GO TO 320
975  END IF
976  END IF
977 *
978 * Do test 9.
979 *
980  temp1 = zero
981  temp2 = zero
982  DO 310 j = 1, n
983  temp1 = max( temp1, abs( wa2( j ) ),
984  $ abs( eveigs( j ) ) )
985  temp2 = max( temp2, abs( wa2( j )-eveigs( j ) ) )
986  310 CONTINUE
987  result( 9 ) = temp2 / max( unfl,
988  $ ulp*max( temp1, temp2 ) )
989 *
990  320 CONTINUE
991 *
992 *
993  ntest = 10
994  DO 330 i = 1, n
995  d1( i ) = dble( a( i, i ) )
996  330 CONTINUE
997  DO 340 i = 1, n - 1
998  d2( i ) = dble( a( i+1, i ) )
999  340 CONTINUE
1000  srnamt = 'DSTEVX'
1001  CALL dstevx( 'V', 'I', n, d1, d2, vl, vu, il, iu, abstol,
1002  $ m2, wa2, z, ldu, work, iwork,
1003  $ iwork( 5*n+1 ), iinfo )
1004  IF( iinfo.NE.0 ) THEN
1005  WRITE( nounit, fmt = 9999 )'DSTEVX(V,I)', iinfo, n,
1006  $ jtype, ioldsd
1007  info = abs( iinfo )
1008  IF( iinfo.LT.0 ) THEN
1009  RETURN
1010  ELSE
1011  result( 10 ) = ulpinv
1012  result( 11 ) = ulpinv
1013  result( 12 ) = ulpinv
1014  GO TO 380
1015  END IF
1016  END IF
1017 *
1018 * Do tests 10 and 11.
1019 *
1020  DO 350 i = 1, n
1021  d3( i ) = dble( a( i, i ) )
1022  350 CONTINUE
1023  DO 360 i = 1, n - 1
1024  d4( i ) = dble( a( i+1, i ) )
1025  360 CONTINUE
1026  CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1027  $ max( 1, m2 ), result( 10 ) )
1028 *
1029 *
1030  ntest = 12
1031  DO 370 i = 1, n - 1
1032  d4( i ) = dble( a( i+1, i ) )
1033  370 CONTINUE
1034  srnamt = 'DSTEVX'
1035  CALL dstevx( 'N', 'I', n, d3, d4, vl, vu, il, iu, abstol,
1036  $ m3, wa3, z, ldu, work, iwork,
1037  $ iwork( 5*n+1 ), iinfo )
1038  IF( iinfo.NE.0 ) THEN
1039  WRITE( nounit, fmt = 9999 )'DSTEVX(N,I)', iinfo, n,
1040  $ jtype, ioldsd
1041  info = abs( iinfo )
1042  IF( iinfo.LT.0 ) THEN
1043  RETURN
1044  ELSE
1045  result( 12 ) = ulpinv
1046  GO TO 380
1047  END IF
1048  END IF
1049 *
1050 * Do test 12.
1051 *
1052  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1053  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1054  result( 12 ) = ( temp1+temp2 ) / max( unfl, ulp*temp3 )
1055 *
1056  380 CONTINUE
1057 *
1058  ntest = 12
1059  IF( n.GT.0 ) THEN
1060  IF( il.NE.1 ) THEN
1061  vl = wa1( il ) - max( half*
1062  $ ( wa1( il )-wa1( il-1 ) ), ten*ulp*temp3,
1063  $ ten*rtunfl )
1064  ELSE
1065  vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
1066  $ ten*ulp*temp3, ten*rtunfl )
1067  END IF
1068  IF( iu.NE.n ) THEN
1069  vu = wa1( iu ) + max( half*
1070  $ ( wa1( iu+1 )-wa1( iu ) ), ten*ulp*temp3,
1071  $ ten*rtunfl )
1072  ELSE
1073  vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
1074  $ ten*ulp*temp3, ten*rtunfl )
1075  END IF
1076  ELSE
1077  vl = zero
1078  vu = one
1079  END IF
1080 *
1081  DO 390 i = 1, n
1082  d1( i ) = dble( a( i, i ) )
1083  390 CONTINUE
1084  DO 400 i = 1, n - 1
1085  d2( i ) = dble( a( i+1, i ) )
1086  400 CONTINUE
1087  srnamt = 'DSTEVX'
1088  CALL dstevx( 'V', 'V', n, d1, d2, vl, vu, il, iu, abstol,
1089  $ m2, wa2, z, ldu, work, iwork,
1090  $ iwork( 5*n+1 ), iinfo )
1091  IF( iinfo.NE.0 ) THEN
1092  WRITE( nounit, fmt = 9999 )'DSTEVX(V,V)', iinfo, n,
1093  $ jtype, ioldsd
1094  info = abs( iinfo )
1095  IF( iinfo.LT.0 ) THEN
1096  RETURN
1097  ELSE
1098  result( 13 ) = ulpinv
1099  result( 14 ) = ulpinv
1100  result( 15 ) = ulpinv
1101  GO TO 440
1102  END IF
1103  END IF
1104 *
1105  IF( m2.EQ.0 .AND. n.GT.0 ) THEN
1106  result( 13 ) = ulpinv
1107  result( 14 ) = ulpinv
1108  result( 15 ) = ulpinv
1109  GO TO 440
1110  END IF
1111 *
1112 * Do tests 13 and 14.
1113 *
1114  DO 410 i = 1, n
1115  d3( i ) = dble( a( i, i ) )
1116  410 CONTINUE
1117  DO 420 i = 1, n - 1
1118  d4( i ) = dble( a( i+1, i ) )
1119  420 CONTINUE
1120  CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1121  $ max( 1, m2 ), result( 13 ) )
1122 *
1123  ntest = 15
1124  DO 430 i = 1, n - 1
1125  d4( i ) = dble( a( i+1, i ) )
1126  430 CONTINUE
1127  srnamt = 'DSTEVX'
1128  CALL dstevx( 'N', 'V', n, d3, d4, vl, vu, il, iu, abstol,
1129  $ m3, wa3, z, ldu, work, iwork,
1130  $ iwork( 5*n+1 ), iinfo )
1131  IF( iinfo.NE.0 ) THEN
1132  WRITE( nounit, fmt = 9999 )'DSTEVX(N,V)', iinfo, n,
1133  $ jtype, ioldsd
1134  info = abs( iinfo )
1135  IF( iinfo.LT.0 ) THEN
1136  RETURN
1137  ELSE
1138  result( 15 ) = ulpinv
1139  GO TO 440
1140  END IF
1141  END IF
1142 *
1143 * Do test 15.
1144 *
1145  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1146  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1147  result( 15 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1148 *
1149  440 CONTINUE
1150 *
1151  ntest = 16
1152  DO 450 i = 1, n
1153  d1( i ) = dble( a( i, i ) )
1154  450 CONTINUE
1155  DO 460 i = 1, n - 1
1156  d2( i ) = dble( a( i+1, i ) )
1157  460 CONTINUE
1158  srnamt = 'DSTEVD'
1159  CALL dstevd( 'V', n, d1, d2, z, ldu, work, lwedc, iwork,
1160  $ liwedc, iinfo )
1161  IF( iinfo.NE.0 ) THEN
1162  WRITE( nounit, fmt = 9999 )'DSTEVD(V)', iinfo, n,
1163  $ jtype, ioldsd
1164  info = abs( iinfo )
1165  IF( iinfo.LT.0 ) THEN
1166  RETURN
1167  ELSE
1168  result( 16 ) = ulpinv
1169  result( 17 ) = ulpinv
1170  result( 18 ) = ulpinv
1171  GO TO 510
1172  END IF
1173  END IF
1174 *
1175 * Do tests 16 and 17.
1176 *
1177  DO 470 i = 1, n
1178  d3( i ) = dble( a( i, i ) )
1179  470 CONTINUE
1180  DO 480 i = 1, n - 1
1181  d4( i ) = dble( a( i+1, i ) )
1182  480 CONTINUE
1183  CALL dstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
1184  $ result( 16 ) )
1185 *
1186  ntest = 18
1187  DO 490 i = 1, n - 1
1188  d4( i ) = dble( a( i+1, i ) )
1189  490 CONTINUE
1190  srnamt = 'DSTEVD'
1191  CALL dstevd( 'N', n, d3, d4, z, ldu, work, lwedc, iwork,
1192  $ liwedc, iinfo )
1193  IF( iinfo.NE.0 ) THEN
1194  WRITE( nounit, fmt = 9999 )'DSTEVD(N)', iinfo, n,
1195  $ jtype, ioldsd
1196  info = abs( iinfo )
1197  IF( iinfo.LT.0 ) THEN
1198  RETURN
1199  ELSE
1200  result( 18 ) = ulpinv
1201  GO TO 510
1202  END IF
1203  END IF
1204 *
1205 * Do test 18.
1206 *
1207  temp1 = zero
1208  temp2 = zero
1209  DO 500 j = 1, n
1210  temp1 = max( temp1, abs( eveigs( j ) ),
1211  $ abs( d3( j ) ) )
1212  temp2 = max( temp2, abs( eveigs( j )-d3( j ) ) )
1213  500 CONTINUE
1214  result( 18 ) = temp2 / max( unfl,
1215  $ ulp*max( temp1, temp2 ) )
1216 *
1217  510 CONTINUE
1218 *
1219  ntest = 19
1220  DO 520 i = 1, n
1221  d1( i ) = dble( a( i, i ) )
1222  520 CONTINUE
1223  DO 530 i = 1, n - 1
1224  d2( i ) = dble( a( i+1, i ) )
1225  530 CONTINUE
1226  srnamt = 'DSTEVR'
1227  CALL dstevr( 'V', 'I', n, d1, d2, vl, vu, il, iu, abstol,
1228  $ m2, wa2, z, ldu, iwork, work, lwork,
1229  $ iwork(2*n+1), liwork-2*n, iinfo )
1230  IF( iinfo.NE.0 ) THEN
1231  WRITE( nounit, fmt = 9999 )'DSTEVR(V,I)', iinfo, n,
1232  $ jtype, ioldsd
1233  info = abs( iinfo )
1234  IF( iinfo.LT.0 ) THEN
1235  RETURN
1236  ELSE
1237  result( 19 ) = ulpinv
1238  result( 20 ) = ulpinv
1239  result( 21 ) = ulpinv
1240  GO TO 570
1241  END IF
1242  END IF
1243 *
1244 * DO tests 19 and 20.
1245 *
1246  DO 540 i = 1, n
1247  d3( i ) = dble( a( i, i ) )
1248  540 CONTINUE
1249  DO 550 i = 1, n - 1
1250  d4( i ) = dble( a( i+1, i ) )
1251  550 CONTINUE
1252  CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1253  $ max( 1, m2 ), result( 19 ) )
1254 *
1255 *
1256  ntest = 21
1257  DO 560 i = 1, n - 1
1258  d4( i ) = dble( a( i+1, i ) )
1259  560 CONTINUE
1260  srnamt = 'DSTEVR'
1261  CALL dstevr( 'N', 'I', n, d3, d4, vl, vu, il, iu, abstol,
1262  $ m3, wa3, z, ldu, iwork, work, lwork,
1263  $ iwork(2*n+1), liwork-2*n, iinfo )
1264  IF( iinfo.NE.0 ) THEN
1265  WRITE( nounit, fmt = 9999 )'DSTEVR(N,I)', iinfo, n,
1266  $ jtype, ioldsd
1267  info = abs( iinfo )
1268  IF( iinfo.LT.0 ) THEN
1269  RETURN
1270  ELSE
1271  result( 21 ) = ulpinv
1272  GO TO 570
1273  END IF
1274  END IF
1275 *
1276 * Do test 21.
1277 *
1278  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1279  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1280  result( 21 ) = ( temp1+temp2 ) / max( unfl, ulp*temp3 )
1281 *
1282  570 CONTINUE
1283 *
1284  ntest = 21
1285  IF( n.GT.0 ) THEN
1286  IF( il.NE.1 ) THEN
1287  vl = wa1( il ) - max( half*
1288  $ ( wa1( il )-wa1( il-1 ) ), ten*ulp*temp3,
1289  $ ten*rtunfl )
1290  ELSE
1291  vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
1292  $ ten*ulp*temp3, ten*rtunfl )
1293  END IF
1294  IF( iu.NE.n ) THEN
1295  vu = wa1( iu ) + max( half*
1296  $ ( wa1( iu+1 )-wa1( iu ) ), ten*ulp*temp3,
1297  $ ten*rtunfl )
1298  ELSE
1299  vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
1300  $ ten*ulp*temp3, ten*rtunfl )
1301  END IF
1302  ELSE
1303  vl = zero
1304  vu = one
1305  END IF
1306 *
1307  DO 580 i = 1, n
1308  d1( i ) = dble( a( i, i ) )
1309  580 CONTINUE
1310  DO 590 i = 1, n - 1
1311  d2( i ) = dble( a( i+1, i ) )
1312  590 CONTINUE
1313  srnamt = 'DSTEVR'
1314  CALL dstevr( 'V', 'V', n, d1, d2, vl, vu, il, iu, abstol,
1315  $ m2, wa2, z, ldu, iwork, work, lwork,
1316  $ iwork(2*n+1), liwork-2*n, iinfo )
1317  IF( iinfo.NE.0 ) THEN
1318  WRITE( nounit, fmt = 9999 )'DSTEVR(V,V)', iinfo, n,
1319  $ jtype, ioldsd
1320  info = abs( iinfo )
1321  IF( iinfo.LT.0 ) THEN
1322  RETURN
1323  ELSE
1324  result( 22 ) = ulpinv
1325  result( 23 ) = ulpinv
1326  result( 24 ) = ulpinv
1327  GO TO 630
1328  END IF
1329  END IF
1330 *
1331  IF( m2.EQ.0 .AND. n.GT.0 ) THEN
1332  result( 22 ) = ulpinv
1333  result( 23 ) = ulpinv
1334  result( 24 ) = ulpinv
1335  GO TO 630
1336  END IF
1337 *
1338 * Do tests 22 and 23.
1339 *
1340  DO 600 i = 1, n
1341  d3( i ) = dble( a( i, i ) )
1342  600 CONTINUE
1343  DO 610 i = 1, n - 1
1344  d4( i ) = dble( a( i+1, i ) )
1345  610 CONTINUE
1346  CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1347  $ max( 1, m2 ), result( 22 ) )
1348 *
1349  ntest = 24
1350  DO 620 i = 1, n - 1
1351  d4( i ) = dble( a( i+1, i ) )
1352  620 CONTINUE
1353  srnamt = 'DSTEVR'
1354  CALL dstevr( 'N', 'V', n, d3, d4, vl, vu, il, iu, abstol,
1355  $ m3, wa3, z, ldu, iwork, work, lwork,
1356  $ iwork(2*n+1), liwork-2*n, iinfo )
1357  IF( iinfo.NE.0 ) THEN
1358  WRITE( nounit, fmt = 9999 )'DSTEVR(N,V)', iinfo, n,
1359  $ jtype, ioldsd
1360  info = abs( iinfo )
1361  IF( iinfo.LT.0 ) THEN
1362  RETURN
1363  ELSE
1364  result( 24 ) = ulpinv
1365  GO TO 630
1366  END IF
1367  END IF
1368 *
1369 * Do test 24.
1370 *
1371  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1372  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1373  result( 24 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1374 *
1375  630 CONTINUE
1376 *
1377 *
1378 *
1379  ELSE
1380 *
1381  DO 640 i = 1, 24
1382  result( i ) = zero
1383  640 CONTINUE
1384  ntest = 24
1385  END IF
1386 *
1387 * Perform remaining tests storing upper or lower triangular
1388 * part of matrix.
1389 *
1390  DO 1720 iuplo = 0, 1
1391  IF( iuplo.EQ.0 ) THEN
1392  uplo = 'L'
1393  ELSE
1394  uplo = 'U'
1395  END IF
1396 *
1397 * 4) Call DSYEV and DSYEVX.
1398 *
1399  CALL dlacpy( ' ', n, n, a, lda, v, ldu )
1400 *
1401  ntest = ntest + 1
1402  srnamt = 'DSYEV'
1403  CALL dsyev( 'V', uplo, n, a, ldu, d1, work, lwork,
1404  $ iinfo )
1405  IF( iinfo.NE.0 ) THEN
1406  WRITE( nounit, fmt = 9999 )'DSYEV(V,' // uplo // ')',
1407  $ iinfo, n, jtype, ioldsd
1408  info = abs( iinfo )
1409  IF( iinfo.LT.0 ) THEN
1410  RETURN
1411  ELSE
1412  result( ntest ) = ulpinv
1413  result( ntest+1 ) = ulpinv
1414  result( ntest+2 ) = ulpinv
1415  GO TO 660
1416  END IF
1417  END IF
1418 *
1419 * Do tests 25 and 26 (or +54)
1420 *
1421  CALL dsyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
1422  $ ldu, tau, work, result( ntest ) )
1423 *
1424  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
1425 *
1426  ntest = ntest + 2
1427  srnamt = 'DSYEV_2STAGE'
1428  CALL dsyev_2stage( 'N', uplo, n, a, ldu, d3, work, lwork,
1429  $ iinfo )
1430  IF( iinfo.NE.0 ) THEN
1431  WRITE( nounit, fmt = 9999 )
1432  $ 'DSYEV_2STAGE(N,' // uplo // ')',
1433  $ iinfo, n, jtype, ioldsd
1434  info = abs( iinfo )
1435  IF( iinfo.LT.0 ) THEN
1436  RETURN
1437  ELSE
1438  result( ntest ) = ulpinv
1439  GO TO 660
1440  END IF
1441  END IF
1442 *
1443 * Do test 27 (or +54)
1444 *
1445  temp1 = zero
1446  temp2 = zero
1447  DO 650 j = 1, n
1448  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
1449  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
1450  650 CONTINUE
1451  result( ntest ) = temp2 / max( unfl,
1452  $ ulp*max( temp1, temp2 ) )
1453 *
1454  660 CONTINUE
1455  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
1456 *
1457  ntest = ntest + 1
1458 *
1459  IF( n.GT.0 ) THEN
1460  temp3 = max( abs( d1( 1 ) ), abs( d1( n ) ) )
1461  IF( il.NE.1 ) THEN
1462  vl = d1( il ) - max( half*( d1( il )-d1( il-1 ) ),
1463  $ ten*ulp*temp3, ten*rtunfl )
1464  ELSE IF( n.GT.0 ) THEN
1465  vl = d1( 1 ) - max( half*( d1( n )-d1( 1 ) ),
1466  $ ten*ulp*temp3, ten*rtunfl )
1467  END IF
1468  IF( iu.NE.n ) THEN
1469  vu = d1( iu ) + max( half*( d1( iu+1 )-d1( iu ) ),
1470  $ ten*ulp*temp3, ten*rtunfl )
1471  ELSE IF( n.GT.0 ) THEN
1472  vu = d1( n ) + max( half*( d1( n )-d1( 1 ) ),
1473  $ ten*ulp*temp3, ten*rtunfl )
1474  END IF
1475  ELSE
1476  temp3 = zero
1477  vl = zero
1478  vu = one
1479  END IF
1480 *
1481  srnamt = 'DSYEVX'
1482  CALL dsyevx( 'V', 'A', uplo, n, a, ldu, vl, vu, il, iu,
1483  $ abstol, m, wa1, z, ldu, work, lwork, iwork,
1484  $ iwork( 5*n+1 ), iinfo )
1485  IF( iinfo.NE.0 ) THEN
1486  WRITE( nounit, fmt = 9999 )'DSYEVX(V,A,' // uplo //
1487  $ ')', iinfo, n, jtype, ioldsd
1488  info = abs( iinfo )
1489  IF( iinfo.LT.0 ) THEN
1490  RETURN
1491  ELSE
1492  result( ntest ) = ulpinv
1493  result( ntest+1 ) = ulpinv
1494  result( ntest+2 ) = ulpinv
1495  GO TO 680
1496  END IF
1497  END IF
1498 *
1499 * Do tests 28 and 29 (or +54)
1500 *
1501  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
1502 *
1503  CALL dsyt21( 1, uplo, n, 0, a, ldu, d1, d2, z, ldu, v,
1504  $ ldu, tau, work, result( ntest ) )
1505 *
1506  ntest = ntest + 2
1507  srnamt = 'DSYEVX_2STAGE'
1508  CALL dsyevx_2stage( 'N', 'A', uplo, n, a, ldu, vl, vu,
1509  $ il, iu, abstol, m2, wa2, z, ldu, work,
1510  $ lwork, iwork, iwork( 5*n+1 ), iinfo )
1511  IF( iinfo.NE.0 ) THEN
1512  WRITE( nounit, fmt = 9999 )
1513  $ 'DSYEVX_2STAGE(N,A,' // uplo //
1514  $ ')', iinfo, n, jtype, ioldsd
1515  info = abs( iinfo )
1516  IF( iinfo.LT.0 ) THEN
1517  RETURN
1518  ELSE
1519  result( ntest ) = ulpinv
1520  GO TO 680
1521  END IF
1522  END IF
1523 *
1524 * Do test 30 (or +54)
1525 *
1526  temp1 = zero
1527  temp2 = zero
1528  DO 670 j = 1, n
1529  temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
1530  temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
1531  670 CONTINUE
1532  result( ntest ) = temp2 / max( unfl,
1533  $ ulp*max( temp1, temp2 ) )
1534 *
1535  680 CONTINUE
1536 *
1537  ntest = ntest + 1
1538  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
1539  srnamt = 'DSYEVX'
1540  CALL dsyevx( 'V', 'I', uplo, n, a, ldu, vl, vu, il, iu,
1541  $ abstol, m2, wa2, z, ldu, work, lwork, iwork,
1542  $ iwork( 5*n+1 ), iinfo )
1543  IF( iinfo.NE.0 ) THEN
1544  WRITE( nounit, fmt = 9999 )'DSYEVX(V,I,' // uplo //
1545  $ ')', iinfo, n, jtype, ioldsd
1546  info = abs( iinfo )
1547  IF( iinfo.LT.0 ) THEN
1548  RETURN
1549  ELSE
1550  result( ntest ) = ulpinv
1551  result( ntest+1 ) = ulpinv
1552  result( ntest+2 ) = ulpinv
1553  GO TO 690
1554  END IF
1555  END IF
1556 *
1557 * Do tests 31 and 32 (or +54)
1558 *
1559  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
1560 *
1561  CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1562  $ v, ldu, tau, work, result( ntest ) )
1563 *
1564  ntest = ntest + 2
1565  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
1566  srnamt = 'DSYEVX_2STAGE'
1567  CALL dsyevx_2stage( 'N', 'I', uplo, n, a, ldu, vl, vu,
1568  $ il, iu, abstol, m3, wa3, z, ldu, work,
1569  $ lwork, iwork, iwork( 5*n+1 ), iinfo )
1570  IF( iinfo.NE.0 ) THEN
1571  WRITE( nounit, fmt = 9999 )
1572  $ 'DSYEVX_2STAGE(N,I,' // uplo //
1573  $ ')', iinfo, n, jtype, ioldsd
1574  info = abs( iinfo )
1575  IF( iinfo.LT.0 ) THEN
1576  RETURN
1577  ELSE
1578  result( ntest ) = ulpinv
1579  GO TO 690
1580  END IF
1581  END IF
1582 *
1583 * Do test 33 (or +54)
1584 *
1585  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1586  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1587  result( ntest ) = ( temp1+temp2 ) /
1588  $ max( unfl, ulp*temp3 )
1589  690 CONTINUE
1590 *
1591  ntest = ntest + 1
1592  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
1593  srnamt = 'DSYEVX'
1594  CALL dsyevx( 'V', 'V', uplo, n, a, ldu, vl, vu, il, iu,
1595  $ abstol, m2, wa2, z, ldu, work, lwork, iwork,
1596  $ iwork( 5*n+1 ), iinfo )
1597  IF( iinfo.NE.0 ) THEN
1598  WRITE( nounit, fmt = 9999 )'DSYEVX(V,V,' // uplo //
1599  $ ')', iinfo, n, jtype, ioldsd
1600  info = abs( iinfo )
1601  IF( iinfo.LT.0 ) THEN
1602  RETURN
1603  ELSE
1604  result( ntest ) = ulpinv
1605  result( ntest+1 ) = ulpinv
1606  result( ntest+2 ) = ulpinv
1607  GO TO 700
1608  END IF
1609  END IF
1610 *
1611 * Do tests 34 and 35 (or +54)
1612 *
1613  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
1614 *
1615  CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1616  $ v, ldu, tau, work, result( ntest ) )
1617 *
1618  ntest = ntest + 2
1619  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
1620  srnamt = 'DSYEVX_2STAGE'
1621  CALL dsyevx_2stage( 'N', 'V', uplo, n, a, ldu, vl, vu,
1622  $ il, iu, abstol, m3, wa3, z, ldu, work,
1623  $ lwork, iwork, iwork( 5*n+1 ), iinfo )
1624  IF( iinfo.NE.0 ) THEN
1625  WRITE( nounit, fmt = 9999 )
1626  $ 'DSYEVX_2STAGE(N,V,' // uplo //
1627  $ ')', iinfo, n, jtype, ioldsd
1628  info = abs( iinfo )
1629  IF( iinfo.LT.0 ) THEN
1630  RETURN
1631  ELSE
1632  result( ntest ) = ulpinv
1633  GO TO 700
1634  END IF
1635  END IF
1636 *
1637  IF( m3.EQ.0 .AND. n.GT.0 ) THEN
1638  result( ntest ) = ulpinv
1639  GO TO 700
1640  END IF
1641 *
1642 * Do test 36 (or +54)
1643 *
1644  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1645  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1646  IF( n.GT.0 ) THEN
1647  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
1648  ELSE
1649  temp3 = zero
1650  END IF
1651  result( ntest ) = ( temp1+temp2 ) /
1652  $ max( unfl, temp3*ulp )
1653 *
1654  700 CONTINUE
1655 *
1656 * 5) Call DSPEV and DSPEVX.
1657 *
1658  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
1659 *
1660 * Load array WORK with the upper or lower triangular
1661 * part of the matrix in packed form.
1662 *
1663  IF( iuplo.EQ.1 ) THEN
1664  indx = 1
1665  DO 720 j = 1, n
1666  DO 710 i = 1, j
1667  work( indx ) = a( i, j )
1668  indx = indx + 1
1669  710 CONTINUE
1670  720 CONTINUE
1671  ELSE
1672  indx = 1
1673  DO 740 j = 1, n
1674  DO 730 i = j, n
1675  work( indx ) = a( i, j )
1676  indx = indx + 1
1677  730 CONTINUE
1678  740 CONTINUE
1679  END IF
1680 *
1681  ntest = ntest + 1
1682  srnamt = 'DSPEV'
1683  CALL dspev( 'V', uplo, n, work, d1, z, ldu, v, iinfo )
1684  IF( iinfo.NE.0 ) THEN
1685  WRITE( nounit, fmt = 9999 )'DSPEV(V,' // uplo // ')',
1686  $ iinfo, n, jtype, ioldsd
1687  info = abs( iinfo )
1688  IF( iinfo.LT.0 ) THEN
1689  RETURN
1690  ELSE
1691  result( ntest ) = ulpinv
1692  result( ntest+1 ) = ulpinv
1693  result( ntest+2 ) = ulpinv
1694  GO TO 800
1695  END IF
1696  END IF
1697 *
1698 * Do tests 37 and 38 (or +54)
1699 *
1700  CALL dsyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
1701  $ ldu, tau, work, result( ntest ) )
1702 *
1703  IF( iuplo.EQ.1 ) THEN
1704  indx = 1
1705  DO 760 j = 1, n
1706  DO 750 i = 1, j
1707  work( indx ) = a( i, j )
1708  indx = indx + 1
1709  750 CONTINUE
1710  760 CONTINUE
1711  ELSE
1712  indx = 1
1713  DO 780 j = 1, n
1714  DO 770 i = j, n
1715  work( indx ) = a( i, j )
1716  indx = indx + 1
1717  770 CONTINUE
1718  780 CONTINUE
1719  END IF
1720 *
1721  ntest = ntest + 2
1722  srnamt = 'DSPEV'
1723  CALL dspev( 'N', uplo, n, work, d3, z, ldu, v, iinfo )
1724  IF( iinfo.NE.0 ) THEN
1725  WRITE( nounit, fmt = 9999 )'DSPEV(N,' // uplo // ')',
1726  $ iinfo, n, jtype, ioldsd
1727  info = abs( iinfo )
1728  IF( iinfo.LT.0 ) THEN
1729  RETURN
1730  ELSE
1731  result( ntest ) = ulpinv
1732  GO TO 800
1733  END IF
1734  END IF
1735 *
1736 * Do test 39 (or +54)
1737 *
1738  temp1 = zero
1739  temp2 = zero
1740  DO 790 j = 1, n
1741  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
1742  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
1743  790 CONTINUE
1744  result( ntest ) = temp2 / max( unfl,
1745  $ ulp*max( temp1, temp2 ) )
1746 *
1747 * Load array WORK with the upper or lower triangular part
1748 * of the matrix in packed form.
1749 *
1750  800 CONTINUE
1751  IF( iuplo.EQ.1 ) THEN
1752  indx = 1
1753  DO 820 j = 1, n
1754  DO 810 i = 1, j
1755  work( indx ) = a( i, j )
1756  indx = indx + 1
1757  810 CONTINUE
1758  820 CONTINUE
1759  ELSE
1760  indx = 1
1761  DO 840 j = 1, n
1762  DO 830 i = j, n
1763  work( indx ) = a( i, j )
1764  indx = indx + 1
1765  830 CONTINUE
1766  840 CONTINUE
1767  END IF
1768 *
1769  ntest = ntest + 1
1770 *
1771  IF( n.GT.0 ) THEN
1772  temp3 = max( abs( d1( 1 ) ), abs( d1( n ) ) )
1773  IF( il.NE.1 ) THEN
1774  vl = d1( il ) - max( half*( d1( il )-d1( il-1 ) ),
1775  $ ten*ulp*temp3, ten*rtunfl )
1776  ELSE IF( n.GT.0 ) THEN
1777  vl = d1( 1 ) - max( half*( d1( n )-d1( 1 ) ),
1778  $ ten*ulp*temp3, ten*rtunfl )
1779  END IF
1780  IF( iu.NE.n ) THEN
1781  vu = d1( iu ) + max( half*( d1( iu+1 )-d1( iu ) ),
1782  $ ten*ulp*temp3, ten*rtunfl )
1783  ELSE IF( n.GT.0 ) THEN
1784  vu = d1( n ) + max( half*( d1( n )-d1( 1 ) ),
1785  $ ten*ulp*temp3, ten*rtunfl )
1786  END IF
1787  ELSE
1788  temp3 = zero
1789  vl = zero
1790  vu = one
1791  END IF
1792 *
1793  srnamt = 'DSPEVX'
1794  CALL dspevx( 'V', 'A', uplo, n, work, vl, vu, il, iu,
1795  $ abstol, m, wa1, z, ldu, v, iwork,
1796  $ iwork( 5*n+1 ), iinfo )
1797  IF( iinfo.NE.0 ) THEN
1798  WRITE( nounit, fmt = 9999 )'DSPEVX(V,A,' // uplo //
1799  $ ')', iinfo, n, jtype, ioldsd
1800  info = abs( iinfo )
1801  IF( iinfo.LT.0 ) THEN
1802  RETURN
1803  ELSE
1804  result( ntest ) = ulpinv
1805  result( ntest+1 ) = ulpinv
1806  result( ntest+2 ) = ulpinv
1807  GO TO 900
1808  END IF
1809  END IF
1810 *
1811 * Do tests 40 and 41 (or +54)
1812 *
1813  CALL dsyt21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
1814  $ ldu, tau, work, result( ntest ) )
1815 *
1816  ntest = ntest + 2
1817 *
1818  IF( iuplo.EQ.1 ) THEN
1819  indx = 1
1820  DO 860 j = 1, n
1821  DO 850 i = 1, j
1822  work( indx ) = a( i, j )
1823  indx = indx + 1
1824  850 CONTINUE
1825  860 CONTINUE
1826  ELSE
1827  indx = 1
1828  DO 880 j = 1, n
1829  DO 870 i = j, n
1830  work( indx ) = a( i, j )
1831  indx = indx + 1
1832  870 CONTINUE
1833  880 CONTINUE
1834  END IF
1835 *
1836  srnamt = 'DSPEVX'
1837  CALL dspevx( 'N', 'A', uplo, n, work, vl, vu, il, iu,
1838  $ abstol, m2, wa2, z, ldu, v, iwork,
1839  $ iwork( 5*n+1 ), iinfo )
1840  IF( iinfo.NE.0 ) THEN
1841  WRITE( nounit, fmt = 9999 )'DSPEVX(N,A,' // uplo //
1842  $ ')', iinfo, n, jtype, ioldsd
1843  info = abs( iinfo )
1844  IF( iinfo.LT.0 ) THEN
1845  RETURN
1846  ELSE
1847  result( ntest ) = ulpinv
1848  GO TO 900
1849  END IF
1850  END IF
1851 *
1852 * Do test 42 (or +54)
1853 *
1854  temp1 = zero
1855  temp2 = zero
1856  DO 890 j = 1, n
1857  temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
1858  temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
1859  890 CONTINUE
1860  result( ntest ) = temp2 / max( unfl,
1861  $ ulp*max( temp1, temp2 ) )
1862 *
1863  900 CONTINUE
1864  IF( iuplo.EQ.1 ) THEN
1865  indx = 1
1866  DO 920 j = 1, n
1867  DO 910 i = 1, j
1868  work( indx ) = a( i, j )
1869  indx = indx + 1
1870  910 CONTINUE
1871  920 CONTINUE
1872  ELSE
1873  indx = 1
1874  DO 940 j = 1, n
1875  DO 930 i = j, n
1876  work( indx ) = a( i, j )
1877  indx = indx + 1
1878  930 CONTINUE
1879  940 CONTINUE
1880  END IF
1881 *
1882  ntest = ntest + 1
1883 *
1884  srnamt = 'DSPEVX'
1885  CALL dspevx( 'V', 'I', uplo, n, work, vl, vu, il, iu,
1886  $ abstol, m2, wa2, z, ldu, v, iwork,
1887  $ iwork( 5*n+1 ), iinfo )
1888  IF( iinfo.NE.0 ) THEN
1889  WRITE( nounit, fmt = 9999 )'DSPEVX(V,I,' // uplo //
1890  $ ')', iinfo, n, jtype, ioldsd
1891  info = abs( iinfo )
1892  IF( iinfo.LT.0 ) THEN
1893  RETURN
1894  ELSE
1895  result( ntest ) = ulpinv
1896  result( ntest+1 ) = ulpinv
1897  result( ntest+2 ) = ulpinv
1898  GO TO 990
1899  END IF
1900  END IF
1901 *
1902 * Do tests 43 and 44 (or +54)
1903 *
1904  CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1905  $ v, ldu, tau, work, result( ntest ) )
1906 *
1907  ntest = ntest + 2
1908 *
1909  IF( iuplo.EQ.1 ) THEN
1910  indx = 1
1911  DO 960 j = 1, n
1912  DO 950 i = 1, j
1913  work( indx ) = a( i, j )
1914  indx = indx + 1
1915  950 CONTINUE
1916  960 CONTINUE
1917  ELSE
1918  indx = 1
1919  DO 980 j = 1, n
1920  DO 970 i = j, n
1921  work( indx ) = a( i, j )
1922  indx = indx + 1
1923  970 CONTINUE
1924  980 CONTINUE
1925  END IF
1926 *
1927  srnamt = 'DSPEVX'
1928  CALL dspevx( 'N', 'I', uplo, n, work, vl, vu, il, iu,
1929  $ abstol, m3, wa3, z, ldu, v, iwork,
1930  $ iwork( 5*n+1 ), iinfo )
1931  IF( iinfo.NE.0 ) THEN
1932  WRITE( nounit, fmt = 9999 )'DSPEVX(N,I,' // uplo //
1933  $ ')', iinfo, n, jtype, ioldsd
1934  info = abs( iinfo )
1935  IF( iinfo.LT.0 ) THEN
1936  RETURN
1937  ELSE
1938  result( ntest ) = ulpinv
1939  GO TO 990
1940  END IF
1941  END IF
1942 *
1943  IF( m3.EQ.0 .AND. n.GT.0 ) THEN
1944  result( ntest ) = ulpinv
1945  GO TO 990
1946  END IF
1947 *
1948 * Do test 45 (or +54)
1949 *
1950  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1951  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1952  IF( n.GT.0 ) THEN
1953  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
1954  ELSE
1955  temp3 = zero
1956  END IF
1957  result( ntest ) = ( temp1+temp2 ) /
1958  $ max( unfl, temp3*ulp )
1959 *
1960  990 CONTINUE
1961  IF( iuplo.EQ.1 ) THEN
1962  indx = 1
1963  DO 1010 j = 1, n
1964  DO 1000 i = 1, j
1965  work( indx ) = a( i, j )
1966  indx = indx + 1
1967  1000 CONTINUE
1968  1010 CONTINUE
1969  ELSE
1970  indx = 1
1971  DO 1030 j = 1, n
1972  DO 1020 i = j, n
1973  work( indx ) = a( i, j )
1974  indx = indx + 1
1975  1020 CONTINUE
1976  1030 CONTINUE
1977  END IF
1978 *
1979  ntest = ntest + 1
1980 *
1981  srnamt = 'DSPEVX'
1982  CALL dspevx( 'V', 'V', uplo, n, work, vl, vu, il, iu,
1983  $ abstol, m2, wa2, z, ldu, v, iwork,
1984  $ iwork( 5*n+1 ), iinfo )
1985  IF( iinfo.NE.0 ) THEN
1986  WRITE( nounit, fmt = 9999 )'DSPEVX(V,V,' // uplo //
1987  $ ')', iinfo, n, jtype, ioldsd
1988  info = abs( iinfo )
1989  IF( iinfo.LT.0 ) THEN
1990  RETURN
1991  ELSE
1992  result( ntest ) = ulpinv
1993  result( ntest+1 ) = ulpinv
1994  result( ntest+2 ) = ulpinv
1995  GO TO 1080
1996  END IF
1997  END IF
1998 *
1999 * Do tests 46 and 47 (or +54)
2000 *
2001  CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2002  $ v, ldu, tau, work, result( ntest ) )
2003 *
2004  ntest = ntest + 2
2005 *
2006  IF( iuplo.EQ.1 ) THEN
2007  indx = 1
2008  DO 1050 j = 1, n
2009  DO 1040 i = 1, j
2010  work( indx ) = a( i, j )
2011  indx = indx + 1
2012  1040 CONTINUE
2013  1050 CONTINUE
2014  ELSE
2015  indx = 1
2016  DO 1070 j = 1, n
2017  DO 1060 i = j, n
2018  work( indx ) = a( i, j )
2019  indx = indx + 1
2020  1060 CONTINUE
2021  1070 CONTINUE
2022  END IF
2023 *
2024  srnamt = 'DSPEVX'
2025  CALL dspevx( 'N', 'V', uplo, n, work, vl, vu, il, iu,
2026  $ abstol, m3, wa3, z, ldu, v, iwork,
2027  $ iwork( 5*n+1 ), iinfo )
2028  IF( iinfo.NE.0 ) THEN
2029  WRITE( nounit, fmt = 9999 )'DSPEVX(N,V,' // uplo //
2030  $ ')', iinfo, n, jtype, ioldsd
2031  info = abs( iinfo )
2032  IF( iinfo.LT.0 ) THEN
2033  RETURN
2034  ELSE
2035  result( ntest ) = ulpinv
2036  GO TO 1080
2037  END IF
2038  END IF
2039 *
2040  IF( m3.EQ.0 .AND. n.GT.0 ) THEN
2041  result( ntest ) = ulpinv
2042  GO TO 1080
2043  END IF
2044 *
2045 * Do test 48 (or +54)
2046 *
2047  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2048  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2049  IF( n.GT.0 ) THEN
2050  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2051  ELSE
2052  temp3 = zero
2053  END IF
2054  result( ntest ) = ( temp1+temp2 ) /
2055  $ max( unfl, temp3*ulp )
2056 *
2057  1080 CONTINUE
2058 *
2059 * 6) Call DSBEV and DSBEVX.
2060 *
2061  IF( jtype.LE.7 ) THEN
2062  kd = 1
2063  ELSE IF( jtype.GE.8 .AND. jtype.LE.15 ) THEN
2064  kd = max( n-1, 0 )
2065  ELSE
2066  kd = ihbw
2067  END IF
2068 *
2069 * Load array V with the upper or lower triangular part
2070 * of the matrix in band form.
2071 *
2072  IF( iuplo.EQ.1 ) THEN
2073  DO 1100 j = 1, n
2074  DO 1090 i = max( 1, j-kd ), j
2075  v( kd+1+i-j, j ) = a( i, j )
2076  1090 CONTINUE
2077  1100 CONTINUE
2078  ELSE
2079  DO 1120 j = 1, n
2080  DO 1110 i = j, min( n, j+kd )
2081  v( 1+i-j, j ) = a( i, j )
2082  1110 CONTINUE
2083  1120 CONTINUE
2084  END IF
2085 *
2086  ntest = ntest + 1
2087  srnamt = 'DSBEV'
2088  CALL dsbev( 'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
2089  $ iinfo )
2090  IF( iinfo.NE.0 ) THEN
2091  WRITE( nounit, fmt = 9999 )'DSBEV(V,' // uplo // ')',
2092  $ iinfo, n, jtype, ioldsd
2093  info = abs( iinfo )
2094  IF( iinfo.LT.0 ) THEN
2095  RETURN
2096  ELSE
2097  result( ntest ) = ulpinv
2098  result( ntest+1 ) = ulpinv
2099  result( ntest+2 ) = ulpinv
2100  GO TO 1180
2101  END IF
2102  END IF
2103 *
2104 * Do tests 49 and 50 (or ... )
2105 *
2106  CALL dsyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
2107  $ ldu, tau, work, result( ntest ) )
2108 *
2109  IF( iuplo.EQ.1 ) THEN
2110  DO 1140 j = 1, n
2111  DO 1130 i = max( 1, j-kd ), j
2112  v( kd+1+i-j, j ) = a( i, j )
2113  1130 CONTINUE
2114  1140 CONTINUE
2115  ELSE
2116  DO 1160 j = 1, n
2117  DO 1150 i = j, min( n, j+kd )
2118  v( 1+i-j, j ) = a( i, j )
2119  1150 CONTINUE
2120  1160 CONTINUE
2121  END IF
2122 *
2123  ntest = ntest + 2
2124  srnamt = 'DSBEV_2STAGE'
2125  CALL dsbev_2stage( 'N', uplo, n, kd, v, ldu, d3, z, ldu,
2126  $ work, lwork, iinfo )
2127  IF( iinfo.NE.0 ) THEN
2128  WRITE( nounit, fmt = 9999 )
2129  $ 'DSBEV_2STAGE(N,' // uplo // ')',
2130  $ iinfo, n, jtype, ioldsd
2131  info = abs( iinfo )
2132  IF( iinfo.LT.0 ) THEN
2133  RETURN
2134  ELSE
2135  result( ntest ) = ulpinv
2136  GO TO 1180
2137  END IF
2138  END IF
2139 *
2140 * Do test 51 (or +54)
2141 *
2142  temp1 = zero
2143  temp2 = zero
2144  DO 1170 j = 1, n
2145  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2146  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2147  1170 CONTINUE
2148  result( ntest ) = temp2 / max( unfl,
2149  $ ulp*max( temp1, temp2 ) )
2150 *
2151 * Load array V with the upper or lower triangular part
2152 * of the matrix in band form.
2153 *
2154  1180 CONTINUE
2155  IF( iuplo.EQ.1 ) THEN
2156  DO 1200 j = 1, n
2157  DO 1190 i = max( 1, j-kd ), j
2158  v( kd+1+i-j, j ) = a( i, j )
2159  1190 CONTINUE
2160  1200 CONTINUE
2161  ELSE
2162  DO 1220 j = 1, n
2163  DO 1210 i = j, min( n, j+kd )
2164  v( 1+i-j, j ) = a( i, j )
2165  1210 CONTINUE
2166  1220 CONTINUE
2167  END IF
2168 *
2169  ntest = ntest + 1
2170  srnamt = 'DSBEVX'
2171  CALL dsbevx( 'V', 'A', uplo, n, kd, v, ldu, u, ldu, vl,
2172  $ vu, il, iu, abstol, m, wa2, z, ldu, work,
2173  $ iwork, iwork( 5*n+1 ), iinfo )
2174  IF( iinfo.NE.0 ) THEN
2175  WRITE( nounit, fmt = 9999 )'DSBEVX(V,A,' // uplo //
2176  $ ')', iinfo, n, jtype, ioldsd
2177  info = abs( iinfo )
2178  IF( iinfo.LT.0 ) THEN
2179  RETURN
2180  ELSE
2181  result( ntest ) = ulpinv
2182  result( ntest+1 ) = ulpinv
2183  result( ntest+2 ) = ulpinv
2184  GO TO 1280
2185  END IF
2186  END IF
2187 *
2188 * Do tests 52 and 53 (or +54)
2189 *
2190  CALL dsyt21( 1, uplo, n, 0, a, ldu, wa2, d2, z, ldu, v,
2191  $ ldu, tau, work, result( ntest ) )
2192 *
2193  ntest = ntest + 2
2194 *
2195  IF( iuplo.EQ.1 ) THEN
2196  DO 1240 j = 1, n
2197  DO 1230 i = max( 1, j-kd ), j
2198  v( kd+1+i-j, j ) = a( i, j )
2199  1230 CONTINUE
2200  1240 CONTINUE
2201  ELSE
2202  DO 1260 j = 1, n
2203  DO 1250 i = j, min( n, j+kd )
2204  v( 1+i-j, j ) = a( i, j )
2205  1250 CONTINUE
2206  1260 CONTINUE
2207  END IF
2208 *
2209  srnamt = 'DSBEVX_2STAGE'
2210  CALL dsbevx_2stage( 'N', 'A', uplo, n, kd, v, ldu,
2211  $ u, ldu, vl, vu, il, iu, abstol, m3, wa3,
2212  $ z, ldu, work, lwork, iwork, iwork( 5*n+1 ),
2213  $ iinfo )
2214  IF( iinfo.NE.0 ) THEN
2215  WRITE( nounit, fmt = 9999 )
2216  $ 'DSBEVX_2STAGE(N,A,' // uplo //
2217  $ ')', iinfo, n, jtype, ioldsd
2218  info = abs( iinfo )
2219  IF( iinfo.LT.0 ) THEN
2220  RETURN
2221  ELSE
2222  result( ntest ) = ulpinv
2223  GO TO 1280
2224  END IF
2225  END IF
2226 *
2227 * Do test 54 (or +54)
2228 *
2229  temp1 = zero
2230  temp2 = zero
2231  DO 1270 j = 1, n
2232  temp1 = max( temp1, abs( wa2( j ) ), abs( wa3( j ) ) )
2233  temp2 = max( temp2, abs( wa2( j )-wa3( j ) ) )
2234  1270 CONTINUE
2235  result( ntest ) = temp2 / max( unfl,
2236  $ ulp*max( temp1, temp2 ) )
2237 *
2238  1280 CONTINUE
2239  ntest = ntest + 1
2240  IF( iuplo.EQ.1 ) THEN
2241  DO 1300 j = 1, n
2242  DO 1290 i = max( 1, j-kd ), j
2243  v( kd+1+i-j, j ) = a( i, j )
2244  1290 CONTINUE
2245  1300 CONTINUE
2246  ELSE
2247  DO 1320 j = 1, n
2248  DO 1310 i = j, min( n, j+kd )
2249  v( 1+i-j, j ) = a( i, j )
2250  1310 CONTINUE
2251  1320 CONTINUE
2252  END IF
2253 *
2254  srnamt = 'DSBEVX'
2255  CALL dsbevx( 'V', 'I', uplo, n, kd, v, ldu, u, ldu, vl,
2256  $ vu, il, iu, abstol, m2, wa2, z, ldu, work,
2257  $ iwork, iwork( 5*n+1 ), iinfo )
2258  IF( iinfo.NE.0 ) THEN
2259  WRITE( nounit, fmt = 9999 )'DSBEVX(V,I,' // uplo //
2260  $ ')', iinfo, n, jtype, ioldsd
2261  info = abs( iinfo )
2262  IF( iinfo.LT.0 ) THEN
2263  RETURN
2264  ELSE
2265  result( ntest ) = ulpinv
2266  result( ntest+1 ) = ulpinv
2267  result( ntest+2 ) = ulpinv
2268  GO TO 1370
2269  END IF
2270  END IF
2271 *
2272 * Do tests 55 and 56 (or +54)
2273 *
2274  CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2275  $ v, ldu, tau, work, result( ntest ) )
2276 *
2277  ntest = ntest + 2
2278 *
2279  IF( iuplo.EQ.1 ) THEN
2280  DO 1340 j = 1, n
2281  DO 1330 i = max( 1, j-kd ), j
2282  v( kd+1+i-j, j ) = a( i, j )
2283  1330 CONTINUE
2284  1340 CONTINUE
2285  ELSE
2286  DO 1360 j = 1, n
2287  DO 1350 i = j, min( n, j+kd )
2288  v( 1+i-j, j ) = a( i, j )
2289  1350 CONTINUE
2290  1360 CONTINUE
2291  END IF
2292 *
2293  srnamt = 'DSBEVX_2STAGE'
2294  CALL dsbevx_2stage( 'N', 'I', uplo, n, kd, v, ldu,
2295  $ u, ldu, vl, vu, il, iu, abstol, m3, wa3,
2296  $ z, ldu, work, lwork, iwork, iwork( 5*n+1 ),
2297  $ iinfo )
2298  IF( iinfo.NE.0 ) THEN
2299  WRITE( nounit, fmt = 9999 )
2300  $ 'DSBEVX_2STAGE(N,I,' // uplo //
2301  $ ')', iinfo, n, jtype, ioldsd
2302  info = abs( iinfo )
2303  IF( iinfo.LT.0 ) THEN
2304  RETURN
2305  ELSE
2306  result( ntest ) = ulpinv
2307  GO TO 1370
2308  END IF
2309  END IF
2310 *
2311 * Do test 57 (or +54)
2312 *
2313  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2314  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2315  IF( n.GT.0 ) THEN
2316  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2317  ELSE
2318  temp3 = zero
2319  END IF
2320  result( ntest ) = ( temp1+temp2 ) /
2321  $ max( unfl, temp3*ulp )
2322 *
2323  1370 CONTINUE
2324  ntest = ntest + 1
2325  IF( iuplo.EQ.1 ) THEN
2326  DO 1390 j = 1, n
2327  DO 1380 i = max( 1, j-kd ), j
2328  v( kd+1+i-j, j ) = a( i, j )
2329  1380 CONTINUE
2330  1390 CONTINUE
2331  ELSE
2332  DO 1410 j = 1, n
2333  DO 1400 i = j, min( n, j+kd )
2334  v( 1+i-j, j ) = a( i, j )
2335  1400 CONTINUE
2336  1410 CONTINUE
2337  END IF
2338 *
2339  srnamt = 'DSBEVX'
2340  CALL dsbevx( 'V', 'V', uplo, n, kd, v, ldu, u, ldu, vl,
2341  $ vu, il, iu, abstol, m2, wa2, z, ldu, work,
2342  $ iwork, iwork( 5*n+1 ), iinfo )
2343  IF( iinfo.NE.0 ) THEN
2344  WRITE( nounit, fmt = 9999 )'DSBEVX(V,V,' // uplo //
2345  $ ')', iinfo, n, jtype, ioldsd
2346  info = abs( iinfo )
2347  IF( iinfo.LT.0 ) THEN
2348  RETURN
2349  ELSE
2350  result( ntest ) = ulpinv
2351  result( ntest+1 ) = ulpinv
2352  result( ntest+2 ) = ulpinv
2353  GO TO 1460
2354  END IF
2355  END IF
2356 *
2357 * Do tests 58 and 59 (or +54)
2358 *
2359  CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2360  $ v, ldu, tau, work, result( ntest ) )
2361 *
2362  ntest = ntest + 2
2363 *
2364  IF( iuplo.EQ.1 ) THEN
2365  DO 1430 j = 1, n
2366  DO 1420 i = max( 1, j-kd ), j
2367  v( kd+1+i-j, j ) = a( i, j )
2368  1420 CONTINUE
2369  1430 CONTINUE
2370  ELSE
2371  DO 1450 j = 1, n
2372  DO 1440 i = j, min( n, j+kd )
2373  v( 1+i-j, j ) = a( i, j )
2374  1440 CONTINUE
2375  1450 CONTINUE
2376  END IF
2377 *
2378  srnamt = 'DSBEVX_2STAGE'
2379  CALL dsbevx_2stage( 'N', 'V', uplo, n, kd, v, ldu,
2380  $ u, ldu, vl, vu, il, iu, abstol, m3, wa3,
2381  $ z, ldu, work, lwork, iwork, iwork( 5*n+1 ),
2382  $ iinfo )
2383  IF( iinfo.NE.0 ) THEN
2384  WRITE( nounit, fmt = 9999 )
2385  $ 'DSBEVX_2STAGE(N,V,' // uplo //
2386  $ ')', iinfo, n, jtype, ioldsd
2387  info = abs( iinfo )
2388  IF( iinfo.LT.0 ) THEN
2389  RETURN
2390  ELSE
2391  result( ntest ) = ulpinv
2392  GO TO 1460
2393  END IF
2394  END IF
2395 *
2396  IF( m3.EQ.0 .AND. n.GT.0 ) THEN
2397  result( ntest ) = ulpinv
2398  GO TO 1460
2399  END IF
2400 *
2401 * Do test 60 (or +54)
2402 *
2403  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2404  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2405  IF( n.GT.0 ) THEN
2406  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2407  ELSE
2408  temp3 = zero
2409  END IF
2410  result( ntest ) = ( temp1+temp2 ) /
2411  $ max( unfl, temp3*ulp )
2412 *
2413  1460 CONTINUE
2414 *
2415 * 7) Call DSYEVD
2416 *
2417  CALL dlacpy( ' ', n, n, a, lda, v, ldu )
2418 *
2419  ntest = ntest + 1
2420  srnamt = 'DSYEVD'
2421  CALL dsyevd( 'V', uplo, n, a, ldu, d1, work, lwedc,
2422  $ iwork, liwedc, iinfo )
2423  IF( iinfo.NE.0 ) THEN
2424  WRITE( nounit, fmt = 9999 )'DSYEVD(V,' // uplo //
2425  $ ')', iinfo, n, jtype, ioldsd
2426  info = abs( iinfo )
2427  IF( iinfo.LT.0 ) THEN
2428  RETURN
2429  ELSE
2430  result( ntest ) = ulpinv
2431  result( ntest+1 ) = ulpinv
2432  result( ntest+2 ) = ulpinv
2433  GO TO 1480
2434  END IF
2435  END IF
2436 *
2437 * Do tests 61 and 62 (or +54)
2438 *
2439  CALL dsyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
2440  $ ldu, tau, work, result( ntest ) )
2441 *
2442  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
2443 *
2444  ntest = ntest + 2
2445  srnamt = 'DSYEVD_2STAGE'
2446  CALL dsyevd_2stage( 'N', uplo, n, a, ldu, d3, work,
2447  $ lwork, iwork, liwedc, iinfo )
2448  IF( iinfo.NE.0 ) THEN
2449  WRITE( nounit, fmt = 9999 )
2450  $ 'DSYEVD_2STAGE(N,' // uplo //
2451  $ ')', iinfo, n, jtype, ioldsd
2452  info = abs( iinfo )
2453  IF( iinfo.LT.0 ) THEN
2454  RETURN
2455  ELSE
2456  result( ntest ) = ulpinv
2457  GO TO 1480
2458  END IF
2459  END IF
2460 *
2461 * Do test 63 (or +54)
2462 *
2463  temp1 = zero
2464  temp2 = zero
2465  DO 1470 j = 1, n
2466  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2467  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2468  1470 CONTINUE
2469  result( ntest ) = temp2 / max( unfl,
2470  $ ulp*max( temp1, temp2 ) )
2471 *
2472  1480 CONTINUE
2473 *
2474 * 8) Call DSPEVD.
2475 *
2476  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
2477 *
2478 * Load array WORK with the upper or lower triangular
2479 * part of the matrix in packed form.
2480 *
2481  IF( iuplo.EQ.1 ) THEN
2482  indx = 1
2483  DO 1500 j = 1, n
2484  DO 1490 i = 1, j
2485  work( indx ) = a( i, j )
2486  indx = indx + 1
2487  1490 CONTINUE
2488  1500 CONTINUE
2489  ELSE
2490  indx = 1
2491  DO 1520 j = 1, n
2492  DO 1510 i = j, n
2493  work( indx ) = a( i, j )
2494  indx = indx + 1
2495  1510 CONTINUE
2496  1520 CONTINUE
2497  END IF
2498 *
2499  ntest = ntest + 1
2500  srnamt = 'DSPEVD'
2501  CALL dspevd( 'V', uplo, n, work, d1, z, ldu,
2502  $ work( indx ), lwedc-indx+1, iwork, liwedc,
2503  $ iinfo )
2504  IF( iinfo.NE.0 ) THEN
2505  WRITE( nounit, fmt = 9999 )'DSPEVD(V,' // uplo //
2506  $ ')', iinfo, n, jtype, ioldsd
2507  info = abs( iinfo )
2508  IF( iinfo.LT.0 ) THEN
2509  RETURN
2510  ELSE
2511  result( ntest ) = ulpinv
2512  result( ntest+1 ) = ulpinv
2513  result( ntest+2 ) = ulpinv
2514  GO TO 1580
2515  END IF
2516  END IF
2517 *
2518 * Do tests 64 and 65 (or +54)
2519 *
2520  CALL dsyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
2521  $ ldu, tau, work, result( ntest ) )
2522 *
2523  IF( iuplo.EQ.1 ) THEN
2524  indx = 1
2525  DO 1540 j = 1, n
2526  DO 1530 i = 1, j
2527 *
2528  work( indx ) = a( i, j )
2529  indx = indx + 1
2530  1530 CONTINUE
2531  1540 CONTINUE
2532  ELSE
2533  indx = 1
2534  DO 1560 j = 1, n
2535  DO 1550 i = j, n
2536  work( indx ) = a( i, j )
2537  indx = indx + 1
2538  1550 CONTINUE
2539  1560 CONTINUE
2540  END IF
2541 *
2542  ntest = ntest + 2
2543  srnamt = 'DSPEVD'
2544  CALL dspevd( 'N', uplo, n, work, d3, z, ldu,
2545  $ work( indx ), lwedc-indx+1, iwork, liwedc,
2546  $ iinfo )
2547  IF( iinfo.NE.0 ) THEN
2548  WRITE( nounit, fmt = 9999 )'DSPEVD(N,' // uplo //
2549  $ ')', iinfo, n, jtype, ioldsd
2550  info = abs( iinfo )
2551  IF( iinfo.LT.0 ) THEN
2552  RETURN
2553  ELSE
2554  result( ntest ) = ulpinv
2555  GO TO 1580
2556  END IF
2557  END IF
2558 *
2559 * Do test 66 (or +54)
2560 *
2561  temp1 = zero
2562  temp2 = zero
2563  DO 1570 j = 1, n
2564  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2565  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2566  1570 CONTINUE
2567  result( ntest ) = temp2 / max( unfl,
2568  $ ulp*max( temp1, temp2 ) )
2569  1580 CONTINUE
2570 *
2571 * 9) Call DSBEVD.
2572 *
2573  IF( jtype.LE.7 ) THEN
2574  kd = 1
2575  ELSE IF( jtype.GE.8 .AND. jtype.LE.15 ) THEN
2576  kd = max( n-1, 0 )
2577  ELSE
2578  kd = ihbw
2579  END IF
2580 *
2581 * Load array V with the upper or lower triangular part
2582 * of the matrix in band form.
2583 *
2584  IF( iuplo.EQ.1 ) THEN
2585  DO 1600 j = 1, n
2586  DO 1590 i = max( 1, j-kd ), j
2587  v( kd+1+i-j, j ) = a( i, j )
2588  1590 CONTINUE
2589  1600 CONTINUE
2590  ELSE
2591  DO 1620 j = 1, n
2592  DO 1610 i = j, min( n, j+kd )
2593  v( 1+i-j, j ) = a( i, j )
2594  1610 CONTINUE
2595  1620 CONTINUE
2596  END IF
2597 *
2598  ntest = ntest + 1
2599  srnamt = 'DSBEVD'
2600  CALL dsbevd( 'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
2601  $ lwedc, iwork, liwedc, iinfo )
2602  IF( iinfo.NE.0 ) THEN
2603  WRITE( nounit, fmt = 9999 )'DSBEVD(V,' // uplo //
2604  $ ')', iinfo, n, jtype, ioldsd
2605  info = abs( iinfo )
2606  IF( iinfo.LT.0 ) THEN
2607  RETURN
2608  ELSE
2609  result( ntest ) = ulpinv
2610  result( ntest+1 ) = ulpinv
2611  result( ntest+2 ) = ulpinv
2612  GO TO 1680
2613  END IF
2614  END IF
2615 *
2616 * Do tests 67 and 68 (or +54)
2617 *
2618  CALL dsyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
2619  $ ldu, tau, work, result( ntest ) )
2620 *
2621  IF( iuplo.EQ.1 ) THEN
2622  DO 1640 j = 1, n
2623  DO 1630 i = max( 1, j-kd ), j
2624  v( kd+1+i-j, j ) = a( i, j )
2625  1630 CONTINUE
2626  1640 CONTINUE
2627  ELSE
2628  DO 1660 j = 1, n
2629  DO 1650 i = j, min( n, j+kd )
2630  v( 1+i-j, j ) = a( i, j )
2631  1650 CONTINUE
2632  1660 CONTINUE
2633  END IF
2634 *
2635  ntest = ntest + 2
2636  srnamt = 'DSBEVD_2STAGE'
2637  CALL dsbevd_2stage( 'N', uplo, n, kd, v, ldu, d3, z, ldu,
2638  $ work, lwork, iwork, liwedc, iinfo )
2639  IF( iinfo.NE.0 ) THEN
2640  WRITE( nounit, fmt = 9999 )
2641  $ 'DSBEVD_2STAGE(N,' // uplo //
2642  $ ')', iinfo, n, jtype, ioldsd
2643  info = abs( iinfo )
2644  IF( iinfo.LT.0 ) THEN
2645  RETURN
2646  ELSE
2647  result( ntest ) = ulpinv
2648  GO TO 1680
2649  END IF
2650  END IF
2651 *
2652 * Do test 69 (or +54)
2653 *
2654  temp1 = zero
2655  temp2 = zero
2656  DO 1670 j = 1, n
2657  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2658  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2659  1670 CONTINUE
2660  result( ntest ) = temp2 / max( unfl,
2661  $ ulp*max( temp1, temp2 ) )
2662 *
2663  1680 CONTINUE
2664 *
2665 *
2666  CALL dlacpy( ' ', n, n, a, lda, v, ldu )
2667  ntest = ntest + 1
2668  srnamt = 'DSYEVR'
2669  CALL dsyevr( 'V', 'A', uplo, n, a, ldu, vl, vu, il, iu,
2670  $ abstol, m, wa1, z, ldu, iwork, work, lwork,
2671  $ iwork(2*n+1), liwork-2*n, iinfo )
2672  IF( iinfo.NE.0 ) THEN
2673  WRITE( nounit, fmt = 9999 )'DSYEVR(V,A,' // uplo //
2674  $ ')', iinfo, n, jtype, ioldsd
2675  info = abs( iinfo )
2676  IF( iinfo.LT.0 ) THEN
2677  RETURN
2678  ELSE
2679  result( ntest ) = ulpinv
2680  result( ntest+1 ) = ulpinv
2681  result( ntest+2 ) = ulpinv
2682  GO TO 1700
2683  END IF
2684  END IF
2685 *
2686 * Do tests 70 and 71 (or ... )
2687 *
2688  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
2689 *
2690  CALL dsyt21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
2691  $ ldu, tau, work, result( ntest ) )
2692 *
2693  ntest = ntest + 2
2694  srnamt = 'DSYEVR_2STAGE'
2695  CALL dsyevr_2stage( 'N', 'A', uplo, n, a, ldu, vl, vu,
2696  $ il, iu, abstol, m2, wa2, z, ldu, iwork,
2697  $ work, lwork, iwork(2*n+1), liwork-2*n,
2698  $ iinfo )
2699  IF( iinfo.NE.0 ) THEN
2700  WRITE( nounit, fmt = 9999 )
2701  $ 'DSYEVR_2STAGE(N,A,' // uplo //
2702  $ ')', iinfo, n, jtype, ioldsd
2703  info = abs( iinfo )
2704  IF( iinfo.LT.0 ) THEN
2705  RETURN
2706  ELSE
2707  result( ntest ) = ulpinv
2708  GO TO 1700
2709  END IF
2710  END IF
2711 *
2712 * Do test 72 (or ... )
2713 *
2714  temp1 = zero
2715  temp2 = zero
2716  DO 1690 j = 1, n
2717  temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
2718  temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
2719  1690 CONTINUE
2720  result( ntest ) = temp2 / max( unfl,
2721  $ ulp*max( temp1, temp2 ) )
2722 *
2723  1700 CONTINUE
2724 *
2725  ntest = ntest + 1
2726  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
2727  srnamt = 'DSYEVR'
2728  CALL dsyevr( 'V', 'I', uplo, n, a, ldu, vl, vu, il, iu,
2729  $ abstol, m2, wa2, z, ldu, iwork, work, lwork,
2730  $ iwork(2*n+1), liwork-2*n, iinfo )
2731  IF( iinfo.NE.0 ) THEN
2732  WRITE( nounit, fmt = 9999 )'DSYEVR(V,I,' // uplo //
2733  $ ')', iinfo, n, jtype, ioldsd
2734  info = abs( iinfo )
2735  IF( iinfo.LT.0 ) THEN
2736  RETURN
2737  ELSE
2738  result( ntest ) = ulpinv
2739  result( ntest+1 ) = ulpinv
2740  result( ntest+2 ) = ulpinv
2741  GO TO 1710
2742  END IF
2743  END IF
2744 *
2745 * Do tests 73 and 74 (or +54)
2746 *
2747  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
2748 *
2749  CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2750  $ v, ldu, tau, work, result( ntest ) )
2751 *
2752  ntest = ntest + 2
2753  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
2754  srnamt = 'DSYEVR_2STAGE'
2755  CALL dsyevr_2stage( 'N', 'I', uplo, n, a, ldu, vl, vu,
2756  $ il, iu, abstol, m3, wa3, z, ldu, iwork,
2757  $ work, lwork, iwork(2*n+1), liwork-2*n,
2758  $ iinfo )
2759  IF( iinfo.NE.0 ) THEN
2760  WRITE( nounit, fmt = 9999 )
2761  $ 'DSYEVR_2STAGE(N,I,' // uplo //
2762  $ ')', iinfo, n, jtype, ioldsd
2763  info = abs( iinfo )
2764  IF( iinfo.LT.0 ) THEN
2765  RETURN
2766  ELSE
2767  result( ntest ) = ulpinv
2768  GO TO 1710
2769  END IF
2770  END IF
2771 *
2772 * Do test 75 (or +54)
2773 *
2774  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2775  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2776  result( ntest ) = ( temp1+temp2 ) /
2777  $ max( unfl, ulp*temp3 )
2778  1710 CONTINUE
2779 *
2780  ntest = ntest + 1
2781  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
2782  srnamt = 'DSYEVR'
2783  CALL dsyevr( 'V', 'V', uplo, n, a, ldu, vl, vu, il, iu,
2784  $ abstol, m2, wa2, z, ldu, iwork, work, lwork,
2785  $ iwork(2*n+1), liwork-2*n, iinfo )
2786  IF( iinfo.NE.0 ) THEN
2787  WRITE( nounit, fmt = 9999 )'DSYEVR(V,V,' // uplo //
2788  $ ')', iinfo, n, jtype, ioldsd
2789  info = abs( iinfo )
2790  IF( iinfo.LT.0 ) THEN
2791  RETURN
2792  ELSE
2793  result( ntest ) = ulpinv
2794  result( ntest+1 ) = ulpinv
2795  result( ntest+2 ) = ulpinv
2796  GO TO 700
2797  END IF
2798  END IF
2799 *
2800 * Do tests 76 and 77 (or +54)
2801 *
2802  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
2803 *
2804  CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2805  $ v, ldu, tau, work, result( ntest ) )
2806 *
2807  ntest = ntest + 2
2808  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
2809  srnamt = 'DSYEVR_2STAGE'
2810  CALL dsyevr_2stage( 'N', 'V', uplo, n, a, ldu, vl, vu,
2811  $ il, iu, abstol, m3, wa3, z, ldu, iwork,
2812  $ work, lwork, iwork(2*n+1), liwork-2*n,
2813  $ iinfo )
2814  IF( iinfo.NE.0 ) THEN
2815  WRITE( nounit, fmt = 9999 )
2816  $ 'DSYEVR_2STAGE(N,V,' // uplo //
2817  $ ')', iinfo, n, jtype, ioldsd
2818  info = abs( iinfo )
2819  IF( iinfo.LT.0 ) THEN
2820  RETURN
2821  ELSE
2822  result( ntest ) = ulpinv
2823  GO TO 700
2824  END IF
2825  END IF
2826 *
2827  IF( m3.EQ.0 .AND. n.GT.0 ) THEN
2828  result( ntest ) = ulpinv
2829  GO TO 700
2830  END IF
2831 *
2832 * Do test 78 (or +54)
2833 *
2834  temp1 = dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2835  temp2 = dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2836  IF( n.GT.0 ) THEN
2837  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2838  ELSE
2839  temp3 = zero
2840  END IF
2841  result( ntest ) = ( temp1+temp2 ) /
2842  $ max( unfl, temp3*ulp )
2843 *
2844  CALL dlacpy( ' ', n, n, v, ldu, a, lda )
2845 *
2846  1720 CONTINUE
2847 *
2848 * End of Loop -- Check for RESULT(j) > THRESH
2849 *
2850  ntestt = ntestt + ntest
2851 *
2852  CALL dlafts( 'DST', n, n, jtype, ntest, result, ioldsd,
2853  $ thresh, nounit, nerrs )
2854 *
2855  1730 CONTINUE
2856  1740 CONTINUE
2857 *
2858 * Summary
2859 *
2860  CALL alasvm( 'DST', nounit, nerrs, ntestt, 0 )
2861 *
2862  9999 FORMAT( ' DDRVST2STG: ', a, ' returned INFO=', i6, '.', / 9x,
2863  $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
2864 *
2865  RETURN
2866 *
2867 * End of DDRVST2STG
2868 *
2869  END
dsytrd_sb2st
subroutine dsytrd_sb2st(STAGE1, VECT, UPLO, N, KD, AB, LDAB, D, E, HOUS, LHOUS, WORK, LWORK, INFO)
DSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric tridiagonal form T
Definition: dsytrd_sb2st.F:230
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:74
dlacpy
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:103
dlaset
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: dlaset.f:110
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:73
dlafts
subroutine dlafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
DLAFTS
Definition: dlafts.f:99
ddrvst2stg
subroutine ddrvst2stg(NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1, WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK, IWORK, LIWORK, RESULT, INFO)
DDRVST2STG
Definition: ddrvst2stg.f:453
dsyt22
subroutine dsyt22(ITYPE, UPLO, N, M, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
DSYT22
Definition: dsyt22.f:157
dstt22
subroutine dstt22(N, M, KBAND, AD, AE, SD, SE, U, LDU, WORK, LDWORK, RESULT)
DSTT22
Definition: dstt22.f:139
dsyt21
subroutine dsyt21(ITYPE, UPLO, N, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
DSYT21
Definition: dsyt21.f:207
dstt21
subroutine dstt21(N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RESULT)
DSTT21
Definition: dstt21.f:127
dlatmr
subroutine dlatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
DLATMR
Definition: dlatmr.f:471
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:321
dspevx
subroutine dspevx(JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition: dspevx.f:234
dstevd
subroutine dstevd(JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition: dstevd.f:163
dstevr
subroutine dstevr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition: dstevr.f:304
dsbevx
subroutine dsbevx(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition: dsbevx.f:265
dspevd
subroutine dspevd(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition: dspevd.f:178
dstevx
subroutine dstevx(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition: dstevx.f:227
dsbevd_2stage
subroutine dsbevd_2stage(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER ...
Definition: dsbevd_2stage.f:234
dspev
subroutine dspev(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO)
DSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices
Definition: dspev.f:130
dsbev_2stage
subroutine dsbev_2stage(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, INFO)
DSBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER m...
Definition: dsbev_2stage.f:204
dstev
subroutine dstev(JOBZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices
Definition: dstev.f:116
dsbevx_2stage
subroutine dsbevx_2stage(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
DSBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER ...
Definition: dsbevx_2stage.f:322
dsbev
subroutine dsbev(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, INFO)
DSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices
Definition: dsbev.f:146
dsbevd
subroutine dsbevd(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition: dsbevd.f:193
dsytrd_sy2sb
subroutine dsytrd_sy2sb(UPLO, N, KD, A, LDA, AB, LDAB, TAU, WORK, LWORK, INFO)
DSYTRD_SY2SB
Definition: dsytrd_sy2sb.f:243
dsytrd_2stage
subroutine dsytrd_2stage(VECT, UPLO, N, A, LDA, D, E, TAU, HOUS2, LHOUS2, WORK, LWORK, INFO)
DSYTRD_2STAGE
Definition: dsytrd_2stage.f:224
dsyev
subroutine dsyev(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO)
DSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices
Definition: dsyev.f:132
dsyevx
subroutine dsyevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
DSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices
Definition: dsyevx.f:253
dsyevd
subroutine dsyevd(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, INFO)
DSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices
Definition: dsyevd.f:185
dsyevr_2stage
subroutine dsyevr_2stage(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSYEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY mat...
Definition: dsyevr_2stage.f:381
dsyevx_2stage
subroutine dsyevx_2stage(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
DSYEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY mat...
Definition: dsyevx_2stage.f:300
dsyev_2stage
subroutine dsyev_2stage(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO)
DSYEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matr...
Definition: dsyev_2stage.f:183
dsyevr
subroutine dsyevr(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices
Definition: dsyevr.f:334
dsyevd_2stage
subroutine dsyevd_2stage(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, INFO)
DSYEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY mat...
Definition: dsyevd_2stage.f:227