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