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