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