LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
ddrvsg2stg.f
Go to the documentation of this file.
1 *> \brief \b DDRVSG2STG
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 DDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
12 * NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
13 * BB, AP, BP, WORK, NWORK, IWORK, LIWORK,
14 * RESULT, INFO )
15 *
16 * IMPLICIT NONE
17 * .. Scalar Arguments ..
18 * INTEGER INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
19 * $ NTYPES, NWORK
20 * DOUBLE PRECISION THRESH
21 * ..
22 * .. Array Arguments ..
23 * LOGICAL DOTYPE( * )
24 * INTEGER ISEED( 4 ), IWORK( * ), NN( * )
25 * DOUBLE PRECISION A( LDA, * ), AB( LDA, * ), AP( * ),
26 * $ B( LDB, * ), BB( LDB, * ), BP( * ), D( * ),
27 * $ RESULT( * ), WORK( * ), Z( LDZ, * )
28 * ..
29 *
30 *
31 *> \par Purpose:
32 * =============
33 *>
34 *> \verbatim
35 *>
36 *> DDRVSG2STG checks the real symmetric generalized eigenproblem
37 *> drivers.
38 *>
39 *> DSYGV computes all eigenvalues and, optionally,
40 *> eigenvectors of a real symmetric-definite generalized
41 *> eigenproblem.
42 *>
43 *> DSYGVD computes all eigenvalues and, optionally,
44 *> eigenvectors of a real symmetric-definite generalized
45 *> eigenproblem using a divide and conquer algorithm.
46 *>
47 *> DSYGVX computes selected eigenvalues and, optionally,
48 *> eigenvectors of a real symmetric-definite generalized
49 *> eigenproblem.
50 *>
51 *> DSPGV computes all eigenvalues and, optionally,
52 *> eigenvectors of a real symmetric-definite generalized
53 *> eigenproblem in packed storage.
54 *>
55 *> DSPGVD computes all eigenvalues and, optionally,
56 *> eigenvectors of a real symmetric-definite generalized
57 *> eigenproblem in packed storage using a divide and
58 *> conquer algorithm.
59 *>
60 *> DSPGVX computes selected eigenvalues and, optionally,
61 *> eigenvectors of a real symmetric-definite generalized
62 *> eigenproblem in packed storage.
63 *>
64 *> DSBGV computes all eigenvalues and, optionally,
65 *> eigenvectors of a real symmetric-definite banded
66 *> generalized eigenproblem.
67 *>
68 *> DSBGVD computes all eigenvalues and, optionally,
69 *> eigenvectors of a real symmetric-definite banded
70 *> generalized eigenproblem using a divide and conquer
71 *> algorithm.
72 *>
73 *> DSBGVX computes selected eigenvalues and, optionally,
74 *> eigenvectors of a real symmetric-definite banded
75 *> generalized eigenproblem.
76 *>
77 *> When DDRVSG2STG is called, a number of matrix "sizes" ("n's") and a
78 *> number of matrix "types" are specified. For each size ("n")
79 *> and each type of matrix, one matrix A of the given type will be
80 *> generated; a random well-conditioned matrix B is also generated
81 *> and the pair (A,B) is used to test the drivers.
82 *>
83 *> For each pair (A,B), the following tests are performed:
84 *>
85 *> (1) DSYGV with ITYPE = 1 and UPLO ='U':
86 *>
87 *> | A Z - B Z D | / ( |A| |Z| n ulp )
88 *> | D - D2 | / ( |D| ulp ) where D is computed by
89 *> DSYGV and D2 is computed by
90 *> DSYGV_2STAGE. This test is
91 *> only performed for DSYGV
92 *>
93 *> (2) as (1) but calling DSPGV
94 *> (3) as (1) but calling DSBGV
95 *> (4) as (1) but with UPLO = 'L'
96 *> (5) as (4) but calling DSPGV
97 *> (6) as (4) but calling DSBGV
98 *>
99 *> (7) DSYGV with ITYPE = 2 and UPLO ='U':
100 *>
101 *> | A B Z - Z D | / ( |A| |Z| n ulp )
102 *>
103 *> (8) as (7) but calling DSPGV
104 *> (9) as (7) but with UPLO = 'L'
105 *> (10) as (9) but calling DSPGV
106 *>
107 *> (11) DSYGV with ITYPE = 3 and UPLO ='U':
108 *>
109 *> | B A Z - Z D | / ( |A| |Z| n ulp )
110 *>
111 *> (12) as (11) but calling DSPGV
112 *> (13) as (11) but with UPLO = 'L'
113 *> (14) as (13) but calling DSPGV
114 *>
115 *> DSYGVD, DSPGVD and DSBGVD performed the same 14 tests.
116 *>
117 *> DSYGVX, DSPGVX and DSBGVX performed the above 14 tests with
118 *> the parameter RANGE = 'A', 'N' and 'I', respectively.
119 *>
120 *> The "sizes" are specified by an array NN(1:NSIZES); the value
121 *> of each element NN(j) specifies one size.
122 *> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
123 *> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
124 *> This type is used for the matrix A which has half-bandwidth KA.
125 *> B is generated as a well-conditioned positive definite matrix
126 *> with half-bandwidth KB (<= KA).
127 *> Currently, the list of possible types for A is:
128 *>
129 *> (1) The zero matrix.
130 *> (2) The identity matrix.
131 *>
132 *> (3) A diagonal matrix with evenly spaced entries
133 *> 1, ..., ULP and random signs.
134 *> (ULP = (first number larger than 1) - 1 )
135 *> (4) A diagonal matrix with geometrically spaced entries
136 *> 1, ..., ULP and random signs.
137 *> (5) A diagonal matrix with "clustered" entries
138 *> 1, ULP, ..., ULP and random signs.
139 *>
140 *> (6) Same as (4), but multiplied by SQRT( overflow threshold )
141 *> (7) Same as (4), but multiplied by SQRT( underflow threshold )
142 *>
143 *> (8) A matrix of the form U* D U, where U is orthogonal and
144 *> D has evenly spaced entries 1, ..., ULP with random signs
145 *> on the diagonal.
146 *>
147 *> (9) A matrix of the form U* D U, where U is orthogonal and
148 *> D has geometrically spaced entries 1, ..., ULP with random
149 *> signs on the diagonal.
150 *>
151 *> (10) A matrix of the form U* D U, where U is orthogonal and
152 *> D has "clustered" entries 1, ULP,..., ULP with random
153 *> signs on the diagonal.
154 *>
155 *> (11) Same as (8), but multiplied by SQRT( overflow threshold )
156 *> (12) Same as (8), but multiplied by SQRT( underflow threshold )
157 *>
158 *> (13) symmetric matrix with random entries chosen from (-1,1).
159 *> (14) Same as (13), but multiplied by SQRT( overflow threshold )
160 *> (15) Same as (13), but multiplied by SQRT( underflow threshold)
161 *>
162 *> (16) Same as (8), but with KA = 1 and KB = 1
163 *> (17) Same as (8), but with KA = 2 and KB = 1
164 *> (18) Same as (8), but with KA = 2 and KB = 2
165 *> (19) Same as (8), but with KA = 3 and KB = 1
166 *> (20) Same as (8), but with KA = 3 and KB = 2
167 *> (21) Same as (8), but with KA = 3 and KB = 3
168 *> \endverbatim
169 *
170 * Arguments:
171 * ==========
172 *
173 *> \verbatim
174 *> NSIZES INTEGER
175 *> The number of sizes of matrices to use. If it is zero,
176 *> DDRVSG2STG does nothing. It must be at least zero.
177 *> Not modified.
178 *>
179 *> NN INTEGER array, dimension (NSIZES)
180 *> An array containing the sizes to be used for the matrices.
181 *> Zero values will be skipped. The values must be at least
182 *> zero.
183 *> Not modified.
184 *>
185 *> NTYPES INTEGER
186 *> The number of elements in DOTYPE. If it is zero, DDRVSG2STG
187 *> does nothing. It must be at least zero. If it is MAXTYP+1
188 *> and NSIZES is 1, then an additional type, MAXTYP+1 is
189 *> defined, which is to use whatever matrix is in A. This
190 *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
191 *> DOTYPE(MAXTYP+1) is .TRUE. .
192 *> Not modified.
193 *>
194 *> DOTYPE LOGICAL array, dimension (NTYPES)
195 *> If DOTYPE(j) is .TRUE., then for each size in NN a
196 *> matrix of that size and of type j will be generated.
197 *> If NTYPES is smaller than the maximum number of types
198 *> defined (PARAMETER MAXTYP), then types NTYPES+1 through
199 *> MAXTYP will not be generated. If NTYPES is larger
200 *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
201 *> will be ignored.
202 *> Not modified.
203 *>
204 *> ISEED INTEGER array, dimension (4)
205 *> On entry ISEED specifies the seed of the random number
206 *> generator. The array elements should be between 0 and 4095;
207 *> if not they will be reduced mod 4096. Also, ISEED(4) must
208 *> be odd. The random number generator uses a linear
209 *> congruential sequence limited to small integers, and so
210 *> should produce machine independent random numbers. The
211 *> values of ISEED are changed on exit, and can be used in the
212 *> next call to DDRVSG2STG to continue the same random number
213 *> sequence.
214 *> Modified.
215 *>
216 *> THRESH DOUBLE PRECISION
217 *> A test will count as "failed" if the "error", computed as
218 *> described above, exceeds THRESH. Note that the error
219 *> is scaled to be O(1), so THRESH should be a reasonably
220 *> small multiple of 1, e.g., 10 or 100. In particular,
221 *> it should not depend on the precision (single vs. double)
222 *> or the size of the matrix. It must be at least zero.
223 *> Not modified.
224 *>
225 *> NOUNIT INTEGER
226 *> The FORTRAN unit number for printing out error messages
227 *> (e.g., if a routine returns IINFO not equal to 0.)
228 *> Not modified.
229 *>
230 *> A DOUBLE PRECISION array, dimension (LDA , max(NN))
231 *> Used to hold the matrix whose eigenvalues are to be
232 *> computed. On exit, A contains the last matrix actually
233 *> used.
234 *> Modified.
235 *>
236 *> LDA INTEGER
237 *> The leading dimension of A and AB. It must be at
238 *> least 1 and at least max( NN ).
239 *> Not modified.
240 *>
241 *> B DOUBLE PRECISION array, dimension (LDB , max(NN))
242 *> Used to hold the symmetric positive definite matrix for
243 *> the generailzed problem.
244 *> On exit, B contains the last matrix actually
245 *> used.
246 *> Modified.
247 *>
248 *> LDB INTEGER
249 *> The leading dimension of B and BB. It must be at
250 *> least 1 and at least max( NN ).
251 *> Not modified.
252 *>
253 *> D DOUBLE PRECISION array, dimension (max(NN))
254 *> The eigenvalues of A. On exit, the eigenvalues in D
255 *> correspond with the matrix in A.
256 *> Modified.
257 *>
258 *> Z DOUBLE PRECISION array, dimension (LDZ, max(NN))
259 *> The matrix of eigenvectors.
260 *> Modified.
261 *>
262 *> LDZ INTEGER
263 *> The leading dimension of Z. It must be at least 1 and
264 *> at least max( NN ).
265 *> Not modified.
266 *>
267 *> AB DOUBLE PRECISION array, dimension (LDA, max(NN))
268 *> Workspace.
269 *> Modified.
270 *>
271 *> BB DOUBLE PRECISION array, dimension (LDB, max(NN))
272 *> Workspace.
273 *> Modified.
274 *>
275 *> AP DOUBLE PRECISION array, dimension (max(NN)**2)
276 *> Workspace.
277 *> Modified.
278 *>
279 *> BP DOUBLE PRECISION array, dimension (max(NN)**2)
280 *> Workspace.
281 *> Modified.
282 *>
283 *> WORK DOUBLE PRECISION array, dimension (NWORK)
284 *> Workspace.
285 *> Modified.
286 *>
287 *> NWORK INTEGER
288 *> The number of entries in WORK. This must be at least
289 *> 1+5*N+2*N*lg(N)+3*N**2 where N = max( NN(j) ) and
290 *> lg( N ) = smallest integer k such that 2**k >= N.
291 *> Not modified.
292 *>
293 *> IWORK INTEGER array, dimension (LIWORK)
294 *> Workspace.
295 *> Modified.
296 *>
297 *> LIWORK INTEGER
298 *> The number of entries in WORK. This must be at least 6*N.
299 *> Not modified.
300 *>
301 *> RESULT DOUBLE PRECISION array, dimension (70)
302 *> The values computed by the 70 tests described above.
303 *> Modified.
304 *>
305 *> INFO INTEGER
306 *> If 0, then everything ran OK.
307 *> -1: NSIZES < 0
308 *> -2: Some NN(j) < 0
309 *> -3: NTYPES < 0
310 *> -5: THRESH < 0
311 *> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
312 *> -16: LDZ < 1 or LDZ < NMAX.
313 *> -21: NWORK too small.
314 *> -23: LIWORK too small.
315 *> If DLATMR, SLATMS, DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD,
316 *> DSBGVD, DSYGVX, DSPGVX or SSBGVX returns an error code,
317 *> the absolute value of it is returned.
318 *> Modified.
319 *>
320 *> ----------------------------------------------------------------------
321 *>
322 *> Some Local Variables and Parameters:
323 *> ---- ----- --------- --- ----------
324 *> ZERO, ONE Real 0 and 1.
325 *> MAXTYP The number of types defined.
326 *> NTEST The number of tests that have been run
327 *> on this matrix.
328 *> NTESTT The total number of tests for this call.
329 *> NMAX Largest value in NN.
330 *> NMATS The number of matrices generated so far.
331 *> NERRS The number of tests which have exceeded THRESH
332 *> so far (computed by DLAFTS).
333 *> COND, IMODE Values to be passed to the matrix generators.
334 *> ANORM Norm of A; passed to matrix generators.
335 *>
336 *> OVFL, UNFL Overflow and underflow thresholds.
337 *> ULP, ULPINV Finest relative precision and its inverse.
338 *> RTOVFL, RTUNFL Square roots of the previous 2 values.
339 *> The following four arrays decode JTYPE:
340 *> KTYPE(j) The general type (1-10) for type "j".
341 *> KMODE(j) The MODE value to be passed to the matrix
342 *> generator for type "j".
343 *> KMAGN(j) The order of magnitude ( O(1),
344 *> O(overflow^(1/2) ), O(underflow^(1/2) )
345 *> \endverbatim
346 *
347 * Authors:
348 * ========
349 *
350 *> \author Univ. of Tennessee
351 *> \author Univ. of California Berkeley
352 *> \author Univ. of Colorado Denver
353 *> \author NAG Ltd.
354 *
355 *> \date December 2016
356 *
357 *> \ingroup double_eig
358 *
359 * =====================================================================
360  SUBROUTINE ddrvsg2stg( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
361  $ nounit, a, lda, b, ldb, d, d2, z, ldz, ab,
362  $ bb, ap, bp, work, nwork, iwork, liwork,
363  $ result, info )
364 *
365  IMPLICIT NONE
366 *
367 * -- LAPACK test routine (version 3.7.0) --
368 * -- LAPACK is a software package provided by Univ. of Tennessee, --
369 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
370 * December 2016
371 *
372 * .. Scalar Arguments ..
373  INTEGER INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
374  $ ntypes, nwork
375  DOUBLE PRECISION THRESH
376 * ..
377 * .. Array Arguments ..
378  LOGICAL DOTYPE( * )
379  INTEGER ISEED( 4 ), IWORK( * ), NN( * )
380  DOUBLE PRECISION A( lda, * ), AB( lda, * ), AP( * ),
381  $ b( ldb, * ), bb( ldb, * ), bp( * ), d( * ),
382  $ d2( * ), result( * ), work( * ), z( ldz, * )
383 * ..
384 *
385 * =====================================================================
386 *
387 * .. Parameters ..
388  DOUBLE PRECISION ZERO, ONE, TEN
389  parameter ( zero = 0.0d0, one = 1.0d0, ten = 10.0d0 )
390  INTEGER MAXTYP
391  parameter ( maxtyp = 21 )
392 * ..
393 * .. Local Scalars ..
394  LOGICAL BADNN
395  CHARACTER UPLO
396  INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
397  $ itype, iu, j, jcol, jsize, jtype, ka, ka9, kb,
398  $ kb9, m, mtypes, n, nerrs, nmats, nmax, ntest,
399  $ ntestt
400  DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
401  $ rtunfl, ulp, ulpinv, unfl, vl, vu, temp1, temp2
402 * ..
403 * .. Local Arrays ..
404  INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
405  $ kmagn( maxtyp ), kmode( maxtyp ),
406  $ ktype( maxtyp )
407 * ..
408 * .. External Functions ..
409  LOGICAL LSAME
410  DOUBLE PRECISION DLAMCH, DLARND
411  EXTERNAL lsame, dlamch, dlarnd
412 * ..
413 * .. External Subroutines ..
414  EXTERNAL dlabad, dlacpy, dlafts, dlaset, dlasum, dlatmr,
415  $ dlatms, dsbgv, dsbgvd, dsbgvx, dsgt01, dspgv,
416  $ dspgvd, dspgvx, dsygv, dsygvd, dsygvx, xerbla,
417  $ dsygv_2stage
418 * ..
419 * .. Intrinsic Functions ..
420  INTRINSIC abs, dble, max, min, sqrt
421 * ..
422 * .. Data statements ..
423  DATA ktype / 1, 2, 5*4, 5*5, 3*8, 6*9 /
424  DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
425  $ 2, 3, 6*1 /
426  DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
427  $ 0, 0, 6*4 /
428 * ..
429 * .. Executable Statements ..
430 *
431 * 1) Check for errors
432 *
433  ntestt = 0
434  info = 0
435 *
436  badnn = .false.
437  nmax = 0
438  DO 10 j = 1, nsizes
439  nmax = max( nmax, nn( j ) )
440  IF( nn( j ).LT.0 )
441  $ badnn = .true.
442  10 CONTINUE
443 *
444 * Check for errors
445 *
446  IF( nsizes.LT.0 ) THEN
447  info = -1
448  ELSE IF( badnn ) THEN
449  info = -2
450  ELSE IF( ntypes.LT.0 ) THEN
451  info = -3
452  ELSE IF( lda.LE.1 .OR. lda.LT.nmax ) THEN
453  info = -9
454  ELSE IF( ldz.LE.1 .OR. ldz.LT.nmax ) THEN
455  info = -16
456  ELSE IF( 2*max( nmax, 3 )**2.GT.nwork ) THEN
457  info = -21
458  ELSE IF( 2*max( nmax, 3 )**2.GT.liwork ) THEN
459  info = -23
460  END IF
461 *
462  IF( info.NE.0 ) THEN
463  CALL xerbla( 'DDRVSG2STG', -info )
464  RETURN
465  END IF
466 *
467 * Quick return if possible
468 *
469  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
470  $ RETURN
471 *
472 * More Important constants
473 *
474  unfl = dlamch( 'Safe minimum' )
475  ovfl = dlamch( 'Overflow' )
476  CALL dlabad( unfl, ovfl )
477  ulp = dlamch( 'Epsilon' )*dlamch( 'Base' )
478  ulpinv = one / ulp
479  rtunfl = sqrt( unfl )
480  rtovfl = sqrt( ovfl )
481 *
482  DO 20 i = 1, 4
483  iseed2( i ) = iseed( i )
484  20 CONTINUE
485 *
486 * Loop over sizes, types
487 *
488  nerrs = 0
489  nmats = 0
490 *
491  DO 650 jsize = 1, nsizes
492  n = nn( jsize )
493  aninv = one / dble( max( 1, n ) )
494 *
495  IF( nsizes.NE.1 ) THEN
496  mtypes = min( maxtyp, ntypes )
497  ELSE
498  mtypes = min( maxtyp+1, ntypes )
499  END IF
500 *
501  ka9 = 0
502  kb9 = 0
503  DO 640 jtype = 1, mtypes
504  IF( .NOT.dotype( jtype ) )
505  $ GO TO 640
506  nmats = nmats + 1
507  ntest = 0
508 *
509  DO 30 j = 1, 4
510  ioldsd( j ) = iseed( j )
511  30 CONTINUE
512 *
513 * 2) Compute "A"
514 *
515 * Control parameters:
516 *
517 * KMAGN KMODE KTYPE
518 * =1 O(1) clustered 1 zero
519 * =2 large clustered 2 identity
520 * =3 small exponential (none)
521 * =4 arithmetic diagonal, w/ eigenvalues
522 * =5 random log hermitian, w/ eigenvalues
523 * =6 random (none)
524 * =7 random diagonal
525 * =8 random hermitian
526 * =9 banded, w/ eigenvalues
527 *
528  IF( mtypes.GT.maxtyp )
529  $ GO TO 90
530 *
531  itype = ktype( jtype )
532  imode = kmode( jtype )
533 *
534 * Compute norm
535 *
536  GO TO ( 40, 50, 60 )kmagn( jtype )
537 *
538  40 CONTINUE
539  anorm = one
540  GO TO 70
541 *
542  50 CONTINUE
543  anorm = ( rtovfl*ulp )*aninv
544  GO TO 70
545 *
546  60 CONTINUE
547  anorm = rtunfl*n*ulpinv
548  GO TO 70
549 *
550  70 CONTINUE
551 *
552  iinfo = 0
553  cond = ulpinv
554 *
555 * Special Matrices -- Identity & Jordan block
556 *
557  IF( itype.EQ.1 ) THEN
558 *
559 * Zero
560 *
561  ka = 0
562  kb = 0
563  CALL dlaset( 'Full', lda, n, zero, zero, a, lda )
564 *
565  ELSE IF( itype.EQ.2 ) THEN
566 *
567 * Identity
568 *
569  ka = 0
570  kb = 0
571  CALL dlaset( 'Full', lda, n, zero, zero, a, lda )
572  DO 80 jcol = 1, n
573  a( jcol, jcol ) = anorm
574  80 CONTINUE
575 *
576  ELSE IF( itype.EQ.4 ) THEN
577 *
578 * Diagonal Matrix, [Eigen]values Specified
579 *
580  ka = 0
581  kb = 0
582  CALL dlatms( n, n, 'S', iseed, 'S', work, imode, cond,
583  $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
584  $ iinfo )
585 *
586  ELSE IF( itype.EQ.5 ) THEN
587 *
588 * symmetric, eigenvalues specified
589 *
590  ka = max( 0, n-1 )
591  kb = ka
592  CALL dlatms( n, n, 'S', iseed, 'S', work, imode, cond,
593  $ anorm, n, n, 'N', a, lda, work( n+1 ),
594  $ iinfo )
595 *
596  ELSE IF( itype.EQ.7 ) THEN
597 *
598 * Diagonal, random eigenvalues
599 *
600  ka = 0
601  kb = 0
602  CALL dlatmr( n, n, 'S', iseed, 'S', work, 6, one, one,
603  $ 'T', 'N', work( n+1 ), 1, one,
604  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
605  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
606 *
607  ELSE IF( itype.EQ.8 ) THEN
608 *
609 * symmetric, random eigenvalues
610 *
611  ka = max( 0, n-1 )
612  kb = ka
613  CALL dlatmr( n, n, 'S', iseed, 'H', work, 6, one, one,
614  $ 'T', 'N', work( n+1 ), 1, one,
615  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
616  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
617 *
618  ELSE IF( itype.EQ.9 ) THEN
619 *
620 * symmetric banded, eigenvalues specified
621 *
622 * The following values are used for the half-bandwidths:
623 *
624 * ka = 1 kb = 1
625 * ka = 2 kb = 1
626 * ka = 2 kb = 2
627 * ka = 3 kb = 1
628 * ka = 3 kb = 2
629 * ka = 3 kb = 3
630 *
631  kb9 = kb9 + 1
632  IF( kb9.GT.ka9 ) THEN
633  ka9 = ka9 + 1
634  kb9 = 1
635  END IF
636  ka = max( 0, min( n-1, ka9 ) )
637  kb = max( 0, min( n-1, kb9 ) )
638  CALL dlatms( n, n, 'S', iseed, 'S', work, imode, cond,
639  $ anorm, ka, ka, 'N', a, lda, work( n+1 ),
640  $ iinfo )
641 *
642  ELSE
643 *
644  iinfo = 1
645  END IF
646 *
647  IF( iinfo.NE.0 ) THEN
648  WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
649  $ ioldsd
650  info = abs( iinfo )
651  RETURN
652  END IF
653 *
654  90 CONTINUE
655 *
656  abstol = unfl + unfl
657  IF( n.LE.1 ) THEN
658  il = 1
659  iu = n
660  ELSE
661  il = 1 + int( ( n-1 )*dlarnd( 1, iseed2 ) )
662  iu = 1 + int( ( n-1 )*dlarnd( 1, iseed2 ) )
663  IF( il.GT.iu ) THEN
664  itemp = il
665  il = iu
666  iu = itemp
667  END IF
668  END IF
669 *
670 * 3) Call DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD, SSBGVD,
671 * DSYGVX, DSPGVX, and DSBGVX, do tests.
672 *
673 * loop over the three generalized problems
674 * IBTYPE = 1: A*x = (lambda)*B*x
675 * IBTYPE = 2: A*B*x = (lambda)*x
676 * IBTYPE = 3: B*A*x = (lambda)*x
677 *
678  DO 630 ibtype = 1, 3
679 *
680 * loop over the setting UPLO
681 *
682  DO 620 ibuplo = 1, 2
683  IF( ibuplo.EQ.1 )
684  $ uplo = 'U'
685  IF( ibuplo.EQ.2 )
686  $ uplo = 'L'
687 *
688 * Generate random well-conditioned positive definite
689 * matrix B, of bandwidth not greater than that of A.
690 *
691  CALL dlatms( n, n, 'U', iseed, 'P', work, 5, ten, one,
692  $ kb, kb, uplo, b, ldb, work( n+1 ),
693  $ iinfo )
694 *
695 * Test DSYGV
696 *
697  ntest = ntest + 1
698 *
699  CALL dlacpy( ' ', n, n, a, lda, z, ldz )
700  CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
701 *
702  CALL dsygv( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
703  $ work, nwork, iinfo )
704  IF( iinfo.NE.0 ) THEN
705  WRITE( nounit, fmt = 9999 )'DSYGV(V,' // uplo //
706  $ ')', iinfo, n, jtype, ioldsd
707  info = abs( iinfo )
708  IF( iinfo.LT.0 ) THEN
709  RETURN
710  ELSE
711  result( ntest ) = ulpinv
712  GO TO 100
713  END IF
714  END IF
715 *
716 * Do Test
717 *
718  CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
719  $ ldz, d, work, result( ntest ) )
720 *
721 * Test DSYGV_2STAGE
722 *
723  ntest = ntest + 1
724 *
725  CALL dlacpy( ' ', n, n, a, lda, z, ldz )
726  CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
727 *
728  CALL dsygv_2stage( ibtype, 'N', uplo, n, z, ldz,
729  $ bb, ldb, d2, work, nwork, iinfo )
730  IF( iinfo.NE.0 ) THEN
731  WRITE( nounit, fmt = 9999 )
732  $ 'DSYGV_2STAGE(V,' // uplo //
733  $ ')', iinfo, n, jtype, ioldsd
734  info = abs( iinfo )
735  IF( iinfo.LT.0 ) THEN
736  RETURN
737  ELSE
738  result( ntest ) = ulpinv
739  GO TO 100
740  END IF
741  END IF
742 *
743 * Do Test
744 *
745 C CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
746 C $ LDZ, D, WORK, RESULT( NTEST ) )
747 *
748 * Do Tests | D1 - D2 | / ( |D1| ulp )
749 * D1 computed using the standard 1-stage reduction as reference
750 * D2 computed using the 2-stage reduction
751 *
752  temp1 = zero
753  temp2 = zero
754  DO 151 j = 1, n
755  temp1 = max( temp1, abs( d( j ) ),
756  $ abs( d2( j ) ) )
757  temp2 = max( temp2, abs( d( j )-d2( j ) ) )
758  151 CONTINUE
759 *
760  result( ntest ) = temp2 /
761  $ max( unfl, ulp*max( temp1, temp2 ) )
762 *
763 * Test DSYGVD
764 *
765  ntest = ntest + 1
766 *
767  CALL dlacpy( ' ', n, n, a, lda, z, ldz )
768  CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
769 *
770  CALL dsygvd( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
771  $ work, nwork, iwork, liwork, iinfo )
772  IF( iinfo.NE.0 ) THEN
773  WRITE( nounit, fmt = 9999 )'DSYGVD(V,' // uplo //
774  $ ')', iinfo, n, jtype, ioldsd
775  info = abs( iinfo )
776  IF( iinfo.LT.0 ) THEN
777  RETURN
778  ELSE
779  result( ntest ) = ulpinv
780  GO TO 100
781  END IF
782  END IF
783 *
784 * Do Test
785 *
786  CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
787  $ ldz, d, work, result( ntest ) )
788 *
789 * Test DSYGVX
790 *
791  ntest = ntest + 1
792 *
793  CALL dlacpy( ' ', n, n, a, lda, ab, lda )
794  CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
795 *
796  CALL dsygvx( ibtype, 'V', 'A', uplo, n, ab, lda, bb,
797  $ ldb, vl, vu, il, iu, abstol, m, d, z,
798  $ ldz, work, nwork, iwork( n+1 ), iwork,
799  $ iinfo )
800  IF( iinfo.NE.0 ) THEN
801  WRITE( nounit, fmt = 9999 )'DSYGVX(V,A' // uplo //
802  $ ')', iinfo, n, jtype, ioldsd
803  info = abs( iinfo )
804  IF( iinfo.LT.0 ) THEN
805  RETURN
806  ELSE
807  result( ntest ) = ulpinv
808  GO TO 100
809  END IF
810  END IF
811 *
812 * Do Test
813 *
814  CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
815  $ ldz, d, work, result( ntest ) )
816 *
817  ntest = ntest + 1
818 *
819  CALL dlacpy( ' ', n, n, a, lda, ab, lda )
820  CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
821 *
822 * since we do not know the exact eigenvalues of this
823 * eigenpair, we just set VL and VU as constants.
824 * It is quite possible that there are no eigenvalues
825 * in this interval.
826 *
827  vl = zero
828  vu = anorm
829  CALL dsygvx( ibtype, 'V', 'V', uplo, n, ab, lda, bb,
830  $ ldb, vl, vu, il, iu, abstol, m, d, z,
831  $ ldz, work, nwork, iwork( n+1 ), iwork,
832  $ iinfo )
833  IF( iinfo.NE.0 ) THEN
834  WRITE( nounit, fmt = 9999 )'DSYGVX(V,V,' //
835  $ uplo // ')', iinfo, n, jtype, ioldsd
836  info = abs( iinfo )
837  IF( iinfo.LT.0 ) THEN
838  RETURN
839  ELSE
840  result( ntest ) = ulpinv
841  GO TO 100
842  END IF
843  END IF
844 *
845 * Do Test
846 *
847  CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
848  $ ldz, d, work, result( ntest ) )
849 *
850  ntest = ntest + 1
851 *
852  CALL dlacpy( ' ', n, n, a, lda, ab, lda )
853  CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
854 *
855  CALL dsygvx( ibtype, 'V', 'I', uplo, n, ab, lda, bb,
856  $ ldb, vl, vu, il, iu, abstol, m, d, z,
857  $ ldz, work, nwork, iwork( n+1 ), iwork,
858  $ iinfo )
859  IF( iinfo.NE.0 ) THEN
860  WRITE( nounit, fmt = 9999 )'DSYGVX(V,I,' //
861  $ uplo // ')', iinfo, n, jtype, ioldsd
862  info = abs( iinfo )
863  IF( iinfo.LT.0 ) THEN
864  RETURN
865  ELSE
866  result( ntest ) = ulpinv
867  GO TO 100
868  END IF
869  END IF
870 *
871 * Do Test
872 *
873  CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
874  $ ldz, d, work, result( ntest ) )
875 *
876  100 CONTINUE
877 *
878 * Test DSPGV
879 *
880  ntest = ntest + 1
881 *
882 * Copy the matrices into packed storage.
883 *
884  IF( lsame( uplo, 'U' ) ) THEN
885  ij = 1
886  DO 120 j = 1, n
887  DO 110 i = 1, j
888  ap( ij ) = a( i, j )
889  bp( ij ) = b( i, j )
890  ij = ij + 1
891  110 CONTINUE
892  120 CONTINUE
893  ELSE
894  ij = 1
895  DO 140 j = 1, n
896  DO 130 i = j, n
897  ap( ij ) = a( i, j )
898  bp( ij ) = b( i, j )
899  ij = ij + 1
900  130 CONTINUE
901  140 CONTINUE
902  END IF
903 *
904  CALL dspgv( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
905  $ work, iinfo )
906  IF( iinfo.NE.0 ) THEN
907  WRITE( nounit, fmt = 9999 )'DSPGV(V,' // uplo //
908  $ ')', iinfo, n, jtype, ioldsd
909  info = abs( iinfo )
910  IF( iinfo.LT.0 ) THEN
911  RETURN
912  ELSE
913  result( ntest ) = ulpinv
914  GO TO 310
915  END IF
916  END IF
917 *
918 * Do Test
919 *
920  CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
921  $ ldz, d, work, result( ntest ) )
922 *
923 * Test DSPGVD
924 *
925  ntest = ntest + 1
926 *
927 * Copy the matrices into packed storage.
928 *
929  IF( lsame( uplo, 'U' ) ) THEN
930  ij = 1
931  DO 160 j = 1, n
932  DO 150 i = 1, j
933  ap( ij ) = a( i, j )
934  bp( ij ) = b( i, j )
935  ij = ij + 1
936  150 CONTINUE
937  160 CONTINUE
938  ELSE
939  ij = 1
940  DO 180 j = 1, n
941  DO 170 i = j, n
942  ap( ij ) = a( i, j )
943  bp( ij ) = b( i, j )
944  ij = ij + 1
945  170 CONTINUE
946  180 CONTINUE
947  END IF
948 *
949  CALL dspgvd( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
950  $ work, nwork, iwork, liwork, iinfo )
951  IF( iinfo.NE.0 ) THEN
952  WRITE( nounit, fmt = 9999 )'DSPGVD(V,' // uplo //
953  $ ')', iinfo, n, jtype, ioldsd
954  info = abs( iinfo )
955  IF( iinfo.LT.0 ) THEN
956  RETURN
957  ELSE
958  result( ntest ) = ulpinv
959  GO TO 310
960  END IF
961  END IF
962 *
963 * Do Test
964 *
965  CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
966  $ ldz, d, work, result( ntest ) )
967 *
968 * Test DSPGVX
969 *
970  ntest = ntest + 1
971 *
972 * Copy the matrices into packed storage.
973 *
974  IF( lsame( uplo, 'U' ) ) THEN
975  ij = 1
976  DO 200 j = 1, n
977  DO 190 i = 1, j
978  ap( ij ) = a( i, j )
979  bp( ij ) = b( i, j )
980  ij = ij + 1
981  190 CONTINUE
982  200 CONTINUE
983  ELSE
984  ij = 1
985  DO 220 j = 1, n
986  DO 210 i = j, n
987  ap( ij ) = a( i, j )
988  bp( ij ) = b( i, j )
989  ij = ij + 1
990  210 CONTINUE
991  220 CONTINUE
992  END IF
993 *
994  CALL dspgvx( ibtype, 'V', 'A', uplo, n, ap, bp, vl,
995  $ vu, il, iu, abstol, m, d, z, ldz, work,
996  $ iwork( n+1 ), iwork, info )
997  IF( iinfo.NE.0 ) THEN
998  WRITE( nounit, fmt = 9999 )'DSPGVX(V,A' // uplo //
999  $ ')', iinfo, n, jtype, ioldsd
1000  info = abs( iinfo )
1001  IF( iinfo.LT.0 ) THEN
1002  RETURN
1003  ELSE
1004  result( ntest ) = ulpinv
1005  GO TO 310
1006  END IF
1007  END IF
1008 *
1009 * Do Test
1010 *
1011  CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1012  $ ldz, d, work, result( ntest ) )
1013 *
1014  ntest = ntest + 1
1015 *
1016 * Copy the matrices into packed storage.
1017 *
1018  IF( lsame( uplo, 'U' ) ) THEN
1019  ij = 1
1020  DO 240 j = 1, n
1021  DO 230 i = 1, j
1022  ap( ij ) = a( i, j )
1023  bp( ij ) = b( i, j )
1024  ij = ij + 1
1025  230 CONTINUE
1026  240 CONTINUE
1027  ELSE
1028  ij = 1
1029  DO 260 j = 1, n
1030  DO 250 i = j, n
1031  ap( ij ) = a( i, j )
1032  bp( ij ) = b( i, j )
1033  ij = ij + 1
1034  250 CONTINUE
1035  260 CONTINUE
1036  END IF
1037 *
1038  vl = zero
1039  vu = anorm
1040  CALL dspgvx( ibtype, 'V', 'V', uplo, n, ap, bp, vl,
1041  $ vu, il, iu, abstol, m, d, z, ldz, work,
1042  $ iwork( n+1 ), iwork, info )
1043  IF( iinfo.NE.0 ) THEN
1044  WRITE( nounit, fmt = 9999 )'DSPGVX(V,V' // uplo //
1045  $ ')', iinfo, n, jtype, ioldsd
1046  info = abs( iinfo )
1047  IF( iinfo.LT.0 ) THEN
1048  RETURN
1049  ELSE
1050  result( ntest ) = ulpinv
1051  GO TO 310
1052  END IF
1053  END IF
1054 *
1055 * Do Test
1056 *
1057  CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1058  $ ldz, d, work, result( ntest ) )
1059 *
1060  ntest = ntest + 1
1061 *
1062 * Copy the matrices into packed storage.
1063 *
1064  IF( lsame( uplo, 'U' ) ) THEN
1065  ij = 1
1066  DO 280 j = 1, n
1067  DO 270 i = 1, j
1068  ap( ij ) = a( i, j )
1069  bp( ij ) = b( i, j )
1070  ij = ij + 1
1071  270 CONTINUE
1072  280 CONTINUE
1073  ELSE
1074  ij = 1
1075  DO 300 j = 1, n
1076  DO 290 i = j, n
1077  ap( ij ) = a( i, j )
1078  bp( ij ) = b( i, j )
1079  ij = ij + 1
1080  290 CONTINUE
1081  300 CONTINUE
1082  END IF
1083 *
1084  CALL dspgvx( ibtype, 'V', 'I', uplo, n, ap, bp, vl,
1085  $ vu, il, iu, abstol, m, d, z, ldz, work,
1086  $ iwork( n+1 ), iwork, info )
1087  IF( iinfo.NE.0 ) THEN
1088  WRITE( nounit, fmt = 9999 )'DSPGVX(V,I' // uplo //
1089  $ ')', iinfo, n, jtype, ioldsd
1090  info = abs( iinfo )
1091  IF( iinfo.LT.0 ) THEN
1092  RETURN
1093  ELSE
1094  result( ntest ) = ulpinv
1095  GO TO 310
1096  END IF
1097  END IF
1098 *
1099 * Do Test
1100 *
1101  CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1102  $ ldz, d, work, result( ntest ) )
1103 *
1104  310 CONTINUE
1105 *
1106  IF( ibtype.EQ.1 ) THEN
1107 *
1108 * TEST DSBGV
1109 *
1110  ntest = ntest + 1
1111 *
1112 * Copy the matrices into band storage.
1113 *
1114  IF( lsame( uplo, 'U' ) ) THEN
1115  DO 340 j = 1, n
1116  DO 320 i = max( 1, j-ka ), j
1117  ab( ka+1+i-j, j ) = a( i, j )
1118  320 CONTINUE
1119  DO 330 i = max( 1, j-kb ), j
1120  bb( kb+1+i-j, j ) = b( i, j )
1121  330 CONTINUE
1122  340 CONTINUE
1123  ELSE
1124  DO 370 j = 1, n
1125  DO 350 i = j, min( n, j+ka )
1126  ab( 1+i-j, j ) = a( i, j )
1127  350 CONTINUE
1128  DO 360 i = j, min( n, j+kb )
1129  bb( 1+i-j, j ) = b( i, j )
1130  360 CONTINUE
1131  370 CONTINUE
1132  END IF
1133 *
1134  CALL dsbgv( 'V', uplo, n, ka, kb, ab, lda, bb, ldb,
1135  $ d, z, ldz, work, iinfo )
1136  IF( iinfo.NE.0 ) THEN
1137  WRITE( nounit, fmt = 9999 )'DSBGV(V,' //
1138  $ uplo // ')', iinfo, n, jtype, ioldsd
1139  info = abs( iinfo )
1140  IF( iinfo.LT.0 ) THEN
1141  RETURN
1142  ELSE
1143  result( ntest ) = ulpinv
1144  GO TO 620
1145  END IF
1146  END IF
1147 *
1148 * Do Test
1149 *
1150  CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1151  $ ldz, d, work, result( ntest ) )
1152 *
1153 * TEST DSBGVD
1154 *
1155  ntest = ntest + 1
1156 *
1157 * Copy the matrices into band storage.
1158 *
1159  IF( lsame( uplo, 'U' ) ) THEN
1160  DO 400 j = 1, n
1161  DO 380 i = max( 1, j-ka ), j
1162  ab( ka+1+i-j, j ) = a( i, j )
1163  380 CONTINUE
1164  DO 390 i = max( 1, j-kb ), j
1165  bb( kb+1+i-j, j ) = b( i, j )
1166  390 CONTINUE
1167  400 CONTINUE
1168  ELSE
1169  DO 430 j = 1, n
1170  DO 410 i = j, min( n, j+ka )
1171  ab( 1+i-j, j ) = a( i, j )
1172  410 CONTINUE
1173  DO 420 i = j, min( n, j+kb )
1174  bb( 1+i-j, j ) = b( i, j )
1175  420 CONTINUE
1176  430 CONTINUE
1177  END IF
1178 *
1179  CALL dsbgvd( 'V', uplo, n, ka, kb, ab, lda, bb,
1180  $ ldb, d, z, ldz, work, nwork, iwork,
1181  $ liwork, iinfo )
1182  IF( iinfo.NE.0 ) THEN
1183  WRITE( nounit, fmt = 9999 )'DSBGVD(V,' //
1184  $ uplo // ')', iinfo, n, jtype, ioldsd
1185  info = abs( iinfo )
1186  IF( iinfo.LT.0 ) THEN
1187  RETURN
1188  ELSE
1189  result( ntest ) = ulpinv
1190  GO TO 620
1191  END IF
1192  END IF
1193 *
1194 * Do Test
1195 *
1196  CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1197  $ ldz, d, work, result( ntest ) )
1198 *
1199 * Test DSBGVX
1200 *
1201  ntest = ntest + 1
1202 *
1203 * Copy the matrices into band storage.
1204 *
1205  IF( lsame( uplo, 'U' ) ) THEN
1206  DO 460 j = 1, n
1207  DO 440 i = max( 1, j-ka ), j
1208  ab( ka+1+i-j, j ) = a( i, j )
1209  440 CONTINUE
1210  DO 450 i = max( 1, j-kb ), j
1211  bb( kb+1+i-j, j ) = b( i, j )
1212  450 CONTINUE
1213  460 CONTINUE
1214  ELSE
1215  DO 490 j = 1, n
1216  DO 470 i = j, min( n, j+ka )
1217  ab( 1+i-j, j ) = a( i, j )
1218  470 CONTINUE
1219  DO 480 i = j, min( n, j+kb )
1220  bb( 1+i-j, j ) = b( i, j )
1221  480 CONTINUE
1222  490 CONTINUE
1223  END IF
1224 *
1225  CALL dsbgvx( 'V', 'A', uplo, n, ka, kb, ab, lda,
1226  $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1227  $ iu, abstol, m, d, z, ldz, work,
1228  $ iwork( n+1 ), iwork, iinfo )
1229  IF( iinfo.NE.0 ) THEN
1230  WRITE( nounit, fmt = 9999 )'DSBGVX(V,A' //
1231  $ uplo // ')', iinfo, n, jtype, ioldsd
1232  info = abs( iinfo )
1233  IF( iinfo.LT.0 ) THEN
1234  RETURN
1235  ELSE
1236  result( ntest ) = ulpinv
1237  GO TO 620
1238  END IF
1239  END IF
1240 *
1241 * Do Test
1242 *
1243  CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1244  $ ldz, d, work, result( ntest ) )
1245 *
1246 *
1247  ntest = ntest + 1
1248 *
1249 * Copy the matrices into band storage.
1250 *
1251  IF( lsame( uplo, 'U' ) ) THEN
1252  DO 520 j = 1, n
1253  DO 500 i = max( 1, j-ka ), j
1254  ab( ka+1+i-j, j ) = a( i, j )
1255  500 CONTINUE
1256  DO 510 i = max( 1, j-kb ), j
1257  bb( kb+1+i-j, j ) = b( i, j )
1258  510 CONTINUE
1259  520 CONTINUE
1260  ELSE
1261  DO 550 j = 1, n
1262  DO 530 i = j, min( n, j+ka )
1263  ab( 1+i-j, j ) = a( i, j )
1264  530 CONTINUE
1265  DO 540 i = j, min( n, j+kb )
1266  bb( 1+i-j, j ) = b( i, j )
1267  540 CONTINUE
1268  550 CONTINUE
1269  END IF
1270 *
1271  vl = zero
1272  vu = anorm
1273  CALL dsbgvx( 'V', 'V', uplo, n, ka, kb, ab, lda,
1274  $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1275  $ iu, abstol, m, d, z, ldz, work,
1276  $ iwork( n+1 ), iwork, iinfo )
1277  IF( iinfo.NE.0 ) THEN
1278  WRITE( nounit, fmt = 9999 )'DSBGVX(V,V' //
1279  $ uplo // ')', iinfo, n, jtype, ioldsd
1280  info = abs( iinfo )
1281  IF( iinfo.LT.0 ) THEN
1282  RETURN
1283  ELSE
1284  result( ntest ) = ulpinv
1285  GO TO 620
1286  END IF
1287  END IF
1288 *
1289 * Do Test
1290 *
1291  CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1292  $ ldz, d, work, result( ntest ) )
1293 *
1294  ntest = ntest + 1
1295 *
1296 * Copy the matrices into band storage.
1297 *
1298  IF( lsame( uplo, 'U' ) ) THEN
1299  DO 580 j = 1, n
1300  DO 560 i = max( 1, j-ka ), j
1301  ab( ka+1+i-j, j ) = a( i, j )
1302  560 CONTINUE
1303  DO 570 i = max( 1, j-kb ), j
1304  bb( kb+1+i-j, j ) = b( i, j )
1305  570 CONTINUE
1306  580 CONTINUE
1307  ELSE
1308  DO 610 j = 1, n
1309  DO 590 i = j, min( n, j+ka )
1310  ab( 1+i-j, j ) = a( i, j )
1311  590 CONTINUE
1312  DO 600 i = j, min( n, j+kb )
1313  bb( 1+i-j, j ) = b( i, j )
1314  600 CONTINUE
1315  610 CONTINUE
1316  END IF
1317 *
1318  CALL dsbgvx( 'V', 'I', uplo, n, ka, kb, ab, lda,
1319  $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1320  $ iu, abstol, m, d, z, ldz, work,
1321  $ iwork( n+1 ), iwork, iinfo )
1322  IF( iinfo.NE.0 ) THEN
1323  WRITE( nounit, fmt = 9999 )'DSBGVX(V,I' //
1324  $ uplo // ')', iinfo, n, jtype, ioldsd
1325  info = abs( iinfo )
1326  IF( iinfo.LT.0 ) THEN
1327  RETURN
1328  ELSE
1329  result( ntest ) = ulpinv
1330  GO TO 620
1331  END IF
1332  END IF
1333 *
1334 * Do Test
1335 *
1336  CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1337  $ ldz, d, work, result( ntest ) )
1338 *
1339  END IF
1340 *
1341  620 CONTINUE
1342  630 CONTINUE
1343 *
1344 * End of Loop -- Check for RESULT(j) > THRESH
1345 *
1346  ntestt = ntestt + ntest
1347  CALL dlafts( 'DSG', n, n, jtype, ntest, result, ioldsd,
1348  $ thresh, nounit, nerrs )
1349  640 CONTINUE
1350  650 CONTINUE
1351 *
1352 * Summary
1353 *
1354  CALL dlasum( 'DSG', nounit, nerrs, ntestt )
1355 *
1356  RETURN
1357 *
1358 * End of DDRVSG2STG
1359 *
1360  9999 FORMAT( ' DDRVSG2STG: ', a, ' returned INFO=', i6, '.', / 9x,
1361  $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1362  END
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:105
dsygv_2stage
subroutine dsygv_2stage(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, INFO)
DSYGV_2STAGE
Definition: dsygv_2stage.f:228
dsygv
subroutine dsygv(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, INFO)
DSYGV
Definition: dsygv.f:177
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:473
dspgvd
subroutine dspgvd(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSPGVD
Definition: dspgvd.f:212
dsbgvx
subroutine dsbgvx(JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSBGVX
Definition: dsbgvx.f:296
ddrvsg2stg
subroutine ddrvsg2stg(NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB, BB, AP, BP, WORK, NWORK, IWORK, LIWORK, RESULT, INFO)
DDRVSG2STG
Definition: ddrvsg2stg.f:364
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:112
dsygvd
subroutine dsygvd(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, IWORK, LIWORK, INFO)
DSYGVD
Definition: dsygvd.f:229
dspgvx
subroutine dspgvx(ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSPGVX
Definition: dspgvx.f:274
dspgv
subroutine dspgv(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, INFO)
DSPGV
Definition: dspgv.f:163
dlafts
subroutine dlafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
DLAFTS
Definition: dlafts.f:101
dsygvx
subroutine dsygvx(ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
DSYGVX
Definition: dsygvx.f:299
dsbgvd
subroutine dsbgvd(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSBGVD
Definition: dsbgvd.f:229
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
dlasum
subroutine dlasum(TYPE, IOUNIT, IE, NRUN)
DLASUM
Definition: dlasum.f:45
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
dsgt01
subroutine dsgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RESULT)
DSGT01
Definition: dsgt01.f:148
dsbgv
subroutine dsbgv(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, INFO)
DSBGV
Definition: dsbgv.f:179