OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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
603c LIWEDC = 6 + 6*N + 5*N*LGN
604 liwedc = 3 + 5*n
605 ELSE
606 lwedc = 9
607c 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.NE. IF( IINFO0 ) 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.LE. IF( N1 ) 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.GT. IF( ILIU ) 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.LE. IF( JTYPE7 ) 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.NE. IF( IINFO0 ) THEN
784 WRITE( NOUNIT, FMT = 9999 )'dstev(v)', IINFO, N,
785 $ JTYPE, IOLDSD
786 INFO = ABS( IINFO )
787.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
815 WRITE( NOUNIT, FMT = 9999 )'dstev(n)', IINFO, N,
816 $ JTYPE, IOLDSD
817 INFO = ABS( IINFO )
818.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
852 WRITE( NOUNIT, FMT = 9999 )'dstevx(v,a)', IINFO, N,
853 $ JTYPE, IOLDSD
854 INFO = ABS( IINFO )
855.LT. IF( IINFO0 ) 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.GT. IF( N0 ) 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.NE. IF( IINFO0 ) THEN
890 WRITE( NOUNIT, FMT = 9999 )'dstevx(n,a)', IINFO, N,
891 $ JTYPE, IOLDSD
892 INFO = ABS( IINFO )
893.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
927 WRITE( NOUNIT, FMT = 9999 )'dstevr(v,a)', IINFO, N,
928 $ JTYPE, IOLDSD
929 INFO = ABS( IINFO )
930.LT. IF( IINFO0 ) THEN
931 RETURN
932 ELSE
933 RESULT( 7 ) = ULPINV
934 RESULT( 8 ) = ULPINV
935 GO TO 320
936 END IF
937 END IF
938.GT. IF( N0 ) 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.NE. IF( IINFO0 ) THEN
964 WRITE( NOUNIT, FMT = 9999 )'dstevr(n,a)', IINFO, N,
965 $ JTYPE, IOLDSD
966 INFO = ABS( IINFO )
967.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
1002 WRITE( NOUNIT, FMT = 9999 )'dstevx(v,i)', IINFO, N,
1003 $ JTYPE, IOLDSD
1004 INFO = ABS( IINFO )
1005.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
1036 WRITE( NOUNIT, FMT = 9999 )'dstevx(n,i)', IINFO, N,
1037 $ JTYPE, IOLDSD
1038 INFO = ABS( IINFO )
1039.LT. IF( IINFO0 ) 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.GT. IF( N0 ) THEN
1057.NE. IF( IL1 ) 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.NE. IF( IUN ) 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.NE. IF( IINFO0 ) THEN
1089 WRITE( NOUNIT, FMT = 9999 )'dstevx(v,v)', IINFO, N,
1090 $ JTYPE, IOLDSD
1091 INFO = ABS( IINFO )
1092.LT. IF( IINFO0 ) 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.EQ..AND..GT. IF( M20 N0 ) 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.NE. IF( IINFO0 ) THEN
1129 WRITE( NOUNIT, FMT = 9999 )'dstevx(n,v)', IINFO, N,
1130 $ JTYPE, IOLDSD
1131 INFO = ABS( IINFO )
1132.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
1159 WRITE( NOUNIT, FMT = 9999 )'dstevd(v)', IINFO, N,
1160 $ JTYPE, IOLDSD
1161 INFO = ABS( IINFO )
1162.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
1191 WRITE( NOUNIT, FMT = 9999 )'dstevd(n)', IINFO, N,
1192 $ JTYPE, IOLDSD
1193 INFO = ABS( IINFO )
1194.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
1508 WRITE( NOUNIT, FMT = 9999 )'dsyevx(n,a,' // UPLO //
1509 $ ')', IINFO, N, JTYPE, IOLDSD
1510 INFO = ABS( IINFO )
1511.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
2022 WRITE( NOUNIT, FMT = 9999 )'dspevx(n,v,' // UPLO //
2023 $ ')', IINFO, N, JTYPE, IOLDSD
2024 INFO = ABS( IINFO )
2025.LT. IF( IINFO0 ) THEN
2026 RETURN
2027 ELSE
2028 RESULT( NTEST ) = ULPINV
2029 GO TO 1080
2030 END IF
2031 END IF
2032*
2033.EQ..AND..GT. IF( M30 N0 ) 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.GT. IF( N0 ) 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.LE. IF( JTYPE7 ) THEN
2055 KD = 1
2056.GE..AND..LE. ELSE IF( JTYPE8 JTYPE15 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2084 WRITE( NOUNIT, FMT = 9999 )'dsbev(v,' // UPLO // ')',
2085 $ IINFO, N, JTYPE, IOLDSD
2086 INFO = ABS( IINFO )
2087.LT. IF( IINFO0 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2121 WRITE( NOUNIT, FMT = 9999 )'dsbev(n,' // UPLO // ')',
2122 $ IINFO, N, JTYPE, IOLDSD
2123 INFO = ABS( IINFO )
2124.LT. IF( IINFO0 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2167 WRITE( NOUNIT, FMT = 9999 )'dsbevx(v,a,' // UPLO //
2168 $ ')', IINFO, N, JTYPE, IOLDSD
2169 INFO = ABS( IINFO )
2170.LT. IF( IINFO0 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2206 WRITE( NOUNIT, FMT = 9999 )'dsbevx(n,a,' // UPLO //
2207 $ ')', IINFO, N, JTYPE, IOLDSD
2208 INFO = ABS( IINFO )
2209.LT. IF( IINFO0 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2249 WRITE( NOUNIT, FMT = 9999 )'dsbevx(v,i,' // UPLO //
2250 $ ')', IINFO, N, JTYPE, IOLDSD
2251 INFO = ABS( IINFO )
2252.LT. IF( IINFO0 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2288 WRITE( NOUNIT, FMT = 9999 )'dsbevx(n,i,' // UPLO //
2289 $ ')', IINFO, N, JTYPE, IOLDSD
2290 INFO = ABS( IINFO )
2291.LT. IF( IINFO0 ) 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.GT. IF( N0 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2332 WRITE( NOUNIT, FMT = 9999 )'dsbevx(v,v,' // UPLO //
2333 $ ')', IINFO, N, JTYPE, IOLDSD
2334 INFO = ABS( IINFO )
2335.LT. IF( IINFO0 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2371 WRITE( NOUNIT, FMT = 9999 )'dsbevx(n,v,' // UPLO //
2372 $ ')', IINFO, N, JTYPE, IOLDSD
2373 INFO = ABS( IINFO )
2374.LT. IF( IINFO0 ) THEN
2375 RETURN
2376 ELSE
2377 RESULT( NTEST ) = ULPINV
2378 GO TO 1460
2379 END IF
2380 END IF
2381*
2382.EQ..AND..GT. IF( M30 N0 ) 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.GT. IF( N0 ) 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.NE. IF( IINFO0 ) THEN
2410 WRITE( NOUNIT, FMT = 9999 )'dsyevd(v,' // UPLO //
2411 $ ')', IINFO, N, JTYPE, IOLDSD
2412 INFO = ABS( IINFO )
2413.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
2435 WRITE( NOUNIT, FMT = 9999 )'dsyevd(n,' // UPLO //
2436 $ ')', IINFO, N, JTYPE, IOLDSD
2437 INFO = ABS( IINFO )
2438.LT. IF( IINFO0 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2490 WRITE( NOUNIT, FMT = 9999 )'dspevd(v,' // UPLO //
2491 $ ')', IINFO, N, JTYPE, IOLDSD
2492 INFO = ABS( IINFO )
2493.LT. IF( IINFO0 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2533 WRITE( NOUNIT, FMT = 9999 )'dspevd(n,' // UPLO //
2534 $ ')', IINFO, N, JTYPE, IOLDSD
2535 INFO = ABS( IINFO )
2536.LT. IF( IINFO0 ) 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.LE. IF( JTYPE7 ) THEN
2559 KD = 1
2560.GE..AND..LE. ELSE IF( JTYPE8 JTYPE15 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2588 WRITE( NOUNIT, FMT = 9999 )'dsbevd(v,' // UPLO //
2589 $ ')', IINFO, N, JTYPE, IOLDSD
2590 INFO = ABS( IINFO )
2591.LT. IF( IINFO0 ) 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.EQ. IF( IUPLO1 ) 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.NE. IF( IINFO0 ) THEN
2625 WRITE( NOUNIT, FMT = 9999 )'dsbevd(n,' // UPLO //
2626 $ ')', IINFO, N, JTYPE, IOLDSD
2627 INFO = ABS( IINFO )
2628.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
2657 WRITE( NOUNIT, FMT = 9999 )'dsyevr(v,a,' // UPLO //
2658 $ ')', IINFO, N, JTYPE, IOLDSD
2659 INFO = ABS( IINFO )
2660.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
2683 WRITE( NOUNIT, FMT = 9999 )'dsyevr(n,a,' // UPLO //
2684 $ ')', IINFO, N, JTYPE, IOLDSD
2685 INFO = ABS( IINFO )
2686.LT. IF( IINFO0 ) 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.NE. IF( IINFO0 ) THEN
2714 WRITE( NOUNIT, FMT = 9999 )'dsyevr(v,i,' // UPLO //
2715 $ ')', IINFO, N, JTYPE, IOLDSD
2716 INFO = ABS( IINFO )
2717.LT. IF( IINFO0 ) 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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
dstt22
subroutine dstt22(n, m, kband, ad, ae, sd, se, u, ldu, work, ldwork, result)
DSTT22
Definition dstt22.f:139
dstt21
subroutine dstt21(n, kband, ad, ae, sd, se, u, ldu, work, result)
DSTT21
Definition dstt21.f:127
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
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
dsyt21
subroutine dsyt21(itype, uplo, n, kband, a, lda, d, e, u, ldu, v, ldv, tau, work, result)
DSYT21
Definition dsyt21.f:207
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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21