LAPACK  3.9.1
LAPACK: Linear Algebra PACKage
sdrvsg2stg.f
Go to the documentation of this file.
1 *> \brief \b SDRVSG2STG
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 SDRVSG2STG( 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 * REAL THRESH
21 * ..
22 * .. Array Arguments ..
23 * LOGICAL DOTYPE( * )
24 * INTEGER ISEED( 4 ), IWORK( * ), NN( * )
25 * REAL 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 *> SDRVSG2STG checks the real symmetric generalized eigenproblem
37 *> drivers.
38 *>
39 *> SSYGV computes all eigenvalues and, optionally,
40 *> eigenvectors of a real symmetric-definite generalized
41 *> eigenproblem.
42 *>
43 *> SSYGVD computes all eigenvalues and, optionally,
44 *> eigenvectors of a real symmetric-definite generalized
45 *> eigenproblem using a divide and conquer algorithm.
46 *>
47 *> SSYGVX computes selected eigenvalues and, optionally,
48 *> eigenvectors of a real symmetric-definite generalized
49 *> eigenproblem.
50 *>
51 *> SSPGV computes all eigenvalues and, optionally,
52 *> eigenvectors of a real symmetric-definite generalized
53 *> eigenproblem in packed storage.
54 *>
55 *> SSPGVD 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 *> SSPGVX computes selected eigenvalues and, optionally,
61 *> eigenvectors of a real symmetric-definite generalized
62 *> eigenproblem in packed storage.
63 *>
64 *> SSBGV computes all eigenvalues and, optionally,
65 *> eigenvectors of a real symmetric-definite banded
66 *> generalized eigenproblem.
67 *>
68 *> SSBGVD 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 *> SSBGVX computes selected eigenvalues and, optionally,
74 *> eigenvectors of a real symmetric-definite banded
75 *> generalized eigenproblem.
76 *>
77 *> When SDRVSG2STG 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) SSYGV 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 *> SSYGV and D2 is computed by
90 *> SSYGV_2STAGE. This test is
91 *> only performed for SSYGV
92 *>
93 *> (2) as (1) but calling SSPGV
94 *> (3) as (1) but calling SSBGV
95 *> (4) as (1) but with UPLO = 'L'
96 *> (5) as (4) but calling SSPGV
97 *> (6) as (4) but calling SSBGV
98 *>
99 *> (7) SSYGV with ITYPE = 2 and UPLO ='U':
100 *>
101 *> | A B Z - Z D | / ( |A| |Z| n ulp )
102 *>
103 *> (8) as (7) but calling SSPGV
104 *> (9) as (7) but with UPLO = 'L'
105 *> (10) as (9) but calling SSPGV
106 *>
107 *> (11) SSYGV with ITYPE = 3 and UPLO ='U':
108 *>
109 *> | B A Z - Z D | / ( |A| |Z| n ulp )
110 *>
111 *> (12) as (11) but calling SSPGV
112 *> (13) as (11) but with UPLO = 'L'
113 *> (14) as (13) but calling SSPGV
114 *>
115 *> SSYGVD, SSPGVD and SSBGVD performed the same 14 tests.
116 *>
117 *> SSYGVX, SSPGVX and SSBGVX 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 *> SDRVSG2STG 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, SDRVSG2STG
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 SDRVSG2STG to continue the same random number
213 *> sequence.
214 *> Modified.
215 *>
216 *> THRESH REAL
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. real)
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 REAL 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 REAL 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 REAL 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 REAL 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 REAL array, dimension (LDA, max(NN))
268 *> Workspace.
269 *> Modified.
270 *>
271 *> BB REAL array, dimension (LDB, max(NN))
272 *> Workspace.
273 *> Modified.
274 *>
275 *> AP REAL array, dimension (max(NN)**2)
276 *> Workspace.
277 *> Modified.
278 *>
279 *> BP REAL array, dimension (max(NN)**2)
280 *> Workspace.
281 *> Modified.
282 *>
283 *> WORK REAL 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 REAL 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 SLATMR, SLATMS, SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD,
316 *> SSBGVD, SSYGVX, SSPGVX 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 SLAFTS).
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 *> \ingroup real_eig
356 *
357 * =====================================================================
358  SUBROUTINE sdrvsg2stg( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
359  $ NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
360  $ BB, AP, BP, WORK, NWORK, IWORK, LIWORK,
361  $ RESULT, INFO )
362 *
363  IMPLICIT NONE
364 *
365 * -- LAPACK test routine --
366 * -- LAPACK is a software package provided by Univ. of Tennessee, --
367 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
368 *
369 * .. Scalar Arguments ..
370  INTEGER INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
371  $ NTYPES, NWORK
372  REAL THRESH
373 * ..
374 * .. Array Arguments ..
375  LOGICAL DOTYPE( * )
376  INTEGER ISEED( 4 ), IWORK( * ), NN( * )
377  REAL A( LDA, * ), AB( LDA, * ), AP( * ),
378  $ b( ldb, * ), bb( ldb, * ), bp( * ), d( * ),
379  $ d2( * ), result( * ), work( * ), z( ldz, * )
380 * ..
381 *
382 * =====================================================================
383 *
384 * .. Parameters ..
385  REAL ZERO, ONE, TEN
386  PARAMETER ( ZERO = 0.0e0, one = 1.0e0, ten = 10.0e0 )
387  INTEGER MAXTYP
388  parameter( maxtyp = 21 )
389 * ..
390 * .. Local Scalars ..
391  LOGICAL BADNN
392  CHARACTER UPLO
393  INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
394  $ itype, iu, j, jcol, jsize, jtype, ka, ka9, kb,
395  $ kb9, m, mtypes, n, nerrs, nmats, nmax, ntest,
396  $ ntestt
397  REAL ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
398  $ RTUNFL, ULP, ULPINV, UNFL, VL, VU, TEMP1, TEMP2
399 * ..
400 * .. Local Arrays ..
401  INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
402  $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
403  $ KTYPE( MAXTYP )
404 * ..
405 * .. External Functions ..
406  LOGICAL LSAME
407  REAL SLAMCH, SLARND
408  EXTERNAL LSAME, SLAMCH, SLARND
409 * ..
410 * .. External Subroutines ..
411  EXTERNAL slabad, slacpy, slafts, slaset, slasum, slatmr,
412  $ slatms, ssbgv, ssbgvd, ssbgvx, ssgt01, sspgv,
413  $ sspgvd, sspgvx, ssygv, ssygvd, ssygvx, xerbla,
414  $ ssygv_2stage
415 * ..
416 * .. Intrinsic Functions ..
417  INTRINSIC abs, real, max, min, sqrt
418 * ..
419 * .. Data statements ..
420  DATA ktype / 1, 2, 5*4, 5*5, 3*8, 6*9 /
421  DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
422  $ 2, 3, 6*1 /
423  DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
424  $ 0, 0, 6*4 /
425 * ..
426 * .. Executable Statements ..
427 *
428 * 1) Check for errors
429 *
430  ntestt = 0
431  info = 0
432 *
433  badnn = .false.
434  nmax = 0
435  DO 10 j = 1, nsizes
436  nmax = max( nmax, nn( j ) )
437  IF( nn( j ).LT.0 )
438  $ badnn = .true.
439  10 CONTINUE
440 *
441 * Check for errors
442 *
443  IF( nsizes.LT.0 ) THEN
444  info = -1
445  ELSE IF( badnn ) THEN
446  info = -2
447  ELSE IF( ntypes.LT.0 ) THEN
448  info = -3
449  ELSE IF( lda.LE.1 .OR. lda.LT.nmax ) THEN
450  info = -9
451  ELSE IF( ldz.LE.1 .OR. ldz.LT.nmax ) THEN
452  info = -16
453  ELSE IF( 2*max( nmax, 3 )**2.GT.nwork ) THEN
454  info = -21
455  ELSE IF( 2*max( nmax, 3 )**2.GT.liwork ) THEN
456  info = -23
457  END IF
458 *
459  IF( info.NE.0 ) THEN
460  CALL xerbla( 'SDRVSG2STG', -info )
461  RETURN
462  END IF
463 *
464 * Quick return if possible
465 *
466  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
467  $ RETURN
468 *
469 * More Important constants
470 *
471  unfl = slamch( 'Safe minimum' )
472  ovfl = slamch( 'Overflow' )
473  CALL slabad( unfl, ovfl )
474  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
475  ulpinv = one / ulp
476  rtunfl = sqrt( unfl )
477  rtovfl = sqrt( ovfl )
478 *
479  DO 20 i = 1, 4
480  iseed2( i ) = iseed( i )
481  20 CONTINUE
482 *
483 * Loop over sizes, types
484 *
485  nerrs = 0
486  nmats = 0
487 *
488  DO 650 jsize = 1, nsizes
489  n = nn( jsize )
490  aninv = one / real( max( 1, n ) )
491 *
492  IF( nsizes.NE.1 ) THEN
493  mtypes = min( maxtyp, ntypes )
494  ELSE
495  mtypes = min( maxtyp+1, ntypes )
496  END IF
497 *
498  ka9 = 0
499  kb9 = 0
500  DO 640 jtype = 1, mtypes
501  IF( .NOT.dotype( jtype ) )
502  $ GO TO 640
503  nmats = nmats + 1
504  ntest = 0
505 *
506  DO 30 j = 1, 4
507  ioldsd( j ) = iseed( j )
508  30 CONTINUE
509 *
510 * 2) Compute "A"
511 *
512 * Control parameters:
513 *
514 * KMAGN KMODE KTYPE
515 * =1 O(1) clustered 1 zero
516 * =2 large clustered 2 identity
517 * =3 small exponential (none)
518 * =4 arithmetic diagonal, w/ eigenvalues
519 * =5 random log hermitian, w/ eigenvalues
520 * =6 random (none)
521 * =7 random diagonal
522 * =8 random hermitian
523 * =9 banded, w/ eigenvalues
524 *
525  IF( mtypes.GT.maxtyp )
526  $ GO TO 90
527 *
528  itype = ktype( jtype )
529  imode = kmode( jtype )
530 *
531 * Compute norm
532 *
533  GO TO ( 40, 50, 60 )kmagn( jtype )
534 *
535  40 CONTINUE
536  anorm = one
537  GO TO 70
538 *
539  50 CONTINUE
540  anorm = ( rtovfl*ulp )*aninv
541  GO TO 70
542 *
543  60 CONTINUE
544  anorm = rtunfl*n*ulpinv
545  GO TO 70
546 *
547  70 CONTINUE
548 *
549  iinfo = 0
550  cond = ulpinv
551 *
552 * Special Matrices -- Identity & Jordan block
553 *
554  IF( itype.EQ.1 ) THEN
555 *
556 * Zero
557 *
558  ka = 0
559  kb = 0
560  CALL slaset( 'Full', lda, n, zero, zero, a, lda )
561 *
562  ELSE IF( itype.EQ.2 ) THEN
563 *
564 * Identity
565 *
566  ka = 0
567  kb = 0
568  CALL slaset( 'Full', lda, n, zero, zero, a, lda )
569  DO 80 jcol = 1, n
570  a( jcol, jcol ) = anorm
571  80 CONTINUE
572 *
573  ELSE IF( itype.EQ.4 ) THEN
574 *
575 * Diagonal Matrix, [Eigen]values Specified
576 *
577  ka = 0
578  kb = 0
579  CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
580  $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
581  $ iinfo )
582 *
583  ELSE IF( itype.EQ.5 ) THEN
584 *
585 * symmetric, eigenvalues specified
586 *
587  ka = max( 0, n-1 )
588  kb = ka
589  CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
590  $ anorm, n, n, 'N', a, lda, work( n+1 ),
591  $ iinfo )
592 *
593  ELSE IF( itype.EQ.7 ) THEN
594 *
595 * Diagonal, random eigenvalues
596 *
597  ka = 0
598  kb = 0
599  CALL slatmr( n, n, 'S', iseed, 'S', work, 6, one, one,
600  $ 'T', 'N', work( n+1 ), 1, one,
601  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
602  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
603 *
604  ELSE IF( itype.EQ.8 ) THEN
605 *
606 * symmetric, random eigenvalues
607 *
608  ka = max( 0, n-1 )
609  kb = ka
610  CALL slatmr( n, n, 'S', iseed, 'H', work, 6, one, one,
611  $ 'T', 'N', work( n+1 ), 1, one,
612  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
613  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
614 *
615  ELSE IF( itype.EQ.9 ) THEN
616 *
617 * symmetric banded, eigenvalues specified
618 *
619 * The following values are used for the half-bandwidths:
620 *
621 * ka = 1 kb = 1
622 * ka = 2 kb = 1
623 * ka = 2 kb = 2
624 * ka = 3 kb = 1
625 * ka = 3 kb = 2
626 * ka = 3 kb = 3
627 *
628  kb9 = kb9 + 1
629  IF( kb9.GT.ka9 ) THEN
630  ka9 = ka9 + 1
631  kb9 = 1
632  END IF
633  ka = max( 0, min( n-1, ka9 ) )
634  kb = max( 0, min( n-1, kb9 ) )
635  CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
636  $ anorm, ka, ka, 'N', a, lda, work( n+1 ),
637  $ iinfo )
638 *
639  ELSE
640 *
641  iinfo = 1
642  END IF
643 *
644  IF( iinfo.NE.0 ) THEN
645  WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
646  $ ioldsd
647  info = abs( iinfo )
648  RETURN
649  END IF
650 *
651  90 CONTINUE
652 *
653  abstol = unfl + unfl
654  IF( n.LE.1 ) THEN
655  il = 1
656  iu = n
657  ELSE
658  il = 1 + int( ( n-1 )*slarnd( 1, iseed2 ) )
659  iu = 1 + int( ( n-1 )*slarnd( 1, iseed2 ) )
660  IF( il.GT.iu ) THEN
661  itemp = il
662  il = iu
663  iu = itemp
664  END IF
665  END IF
666 *
667 * 3) Call SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD, SSBGVD,
668 * SSYGVX, SSPGVX, and SSBGVX, do tests.
669 *
670 * loop over the three generalized problems
671 * IBTYPE = 1: A*x = (lambda)*B*x
672 * IBTYPE = 2: A*B*x = (lambda)*x
673 * IBTYPE = 3: B*A*x = (lambda)*x
674 *
675  DO 630 ibtype = 1, 3
676 *
677 * loop over the setting UPLO
678 *
679  DO 620 ibuplo = 1, 2
680  IF( ibuplo.EQ.1 )
681  $ uplo = 'U'
682  IF( ibuplo.EQ.2 )
683  $ uplo = 'L'
684 *
685 * Generate random well-conditioned positive definite
686 * matrix B, of bandwidth not greater than that of A.
687 *
688  CALL slatms( n, n, 'U', iseed, 'P', work, 5, ten, one,
689  $ kb, kb, uplo, b, ldb, work( n+1 ),
690  $ iinfo )
691 *
692 * Test SSYGV
693 *
694  ntest = ntest + 1
695 *
696  CALL slacpy( ' ', n, n, a, lda, z, ldz )
697  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
698 *
699  CALL ssygv( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
700  $ work, nwork, iinfo )
701  IF( iinfo.NE.0 ) THEN
702  WRITE( nounit, fmt = 9999 )'SSYGV(V,' // uplo //
703  $ ')', iinfo, n, jtype, ioldsd
704  info = abs( iinfo )
705  IF( iinfo.LT.0 ) THEN
706  RETURN
707  ELSE
708  result( ntest ) = ulpinv
709  GO TO 100
710  END IF
711  END IF
712 *
713 * Do Test
714 *
715  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
716  $ ldz, d, work, result( ntest ) )
717 *
718 * Test SSYGV_2STAGE
719 *
720  ntest = ntest + 1
721 *
722  CALL slacpy( ' ', n, n, a, lda, z, ldz )
723  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
724 *
725  CALL ssygv_2stage( ibtype, 'N', uplo, n, z, ldz,
726  $ bb, ldb, d2, work, nwork, iinfo )
727  IF( iinfo.NE.0 ) THEN
728  WRITE( nounit, fmt = 9999 )
729  $ 'SSYGV_2STAGE(V,' // uplo //
730  $ ')', iinfo, n, jtype, ioldsd
731  info = abs( iinfo )
732  IF( iinfo.LT.0 ) THEN
733  RETURN
734  ELSE
735  result( ntest ) = ulpinv
736  GO TO 100
737  END IF
738  END IF
739 *
740 * Do Test
741 *
742 C CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
743 C $ LDZ, D, WORK, RESULT( NTEST ) )
744 *
745 *
746 * Do Tests | D1 - D2 | / ( |D1| ulp )
747 * D1 computed using the standard 1-stage reduction as reference
748 * D2 computed using the 2-stage reduction
749 *
750  temp1 = zero
751  temp2 = zero
752  DO 151 j = 1, n
753  temp1 = max( temp1, abs( d( j ) ),
754  $ abs( d2( j ) ) )
755  temp2 = max( temp2, abs( d( j )-d2( j ) ) )
756  151 CONTINUE
757 *
758  result( ntest ) = temp2 /
759  $ max( unfl, ulp*max( temp1, temp2 ) )
760 *
761 * Test SSYGVD
762 *
763  ntest = ntest + 1
764 *
765  CALL slacpy( ' ', n, n, a, lda, z, ldz )
766  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
767 *
768  CALL ssygvd( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
769  $ work, nwork, iwork, liwork, iinfo )
770  IF( iinfo.NE.0 ) THEN
771  WRITE( nounit, fmt = 9999 )'SSYGVD(V,' // uplo //
772  $ ')', iinfo, n, jtype, ioldsd
773  info = abs( iinfo )
774  IF( iinfo.LT.0 ) THEN
775  RETURN
776  ELSE
777  result( ntest ) = ulpinv
778  GO TO 100
779  END IF
780  END IF
781 *
782 * Do Test
783 *
784  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
785  $ ldz, d, work, result( ntest ) )
786 *
787 * Test SSYGVX
788 *
789  ntest = ntest + 1
790 *
791  CALL slacpy( ' ', n, n, a, lda, ab, lda )
792  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
793 *
794  CALL ssygvx( ibtype, 'V', 'A', uplo, n, ab, lda, bb,
795  $ ldb, vl, vu, il, iu, abstol, m, d, z,
796  $ ldz, work, nwork, iwork( n+1 ), iwork,
797  $ iinfo )
798  IF( iinfo.NE.0 ) THEN
799  WRITE( nounit, fmt = 9999 )'SSYGVX(V,A' // uplo //
800  $ ')', iinfo, n, jtype, ioldsd
801  info = abs( iinfo )
802  IF( iinfo.LT.0 ) THEN
803  RETURN
804  ELSE
805  result( ntest ) = ulpinv
806  GO TO 100
807  END IF
808  END IF
809 *
810 * Do Test
811 *
812  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
813  $ ldz, d, work, result( ntest ) )
814 *
815  ntest = ntest + 1
816 *
817  CALL slacpy( ' ', n, n, a, lda, ab, lda )
818  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
819 *
820 * since we do not know the exact eigenvalues of this
821 * eigenpair, we just set VL and VU as constants.
822 * It is quite possible that there are no eigenvalues
823 * in this interval.
824 *
825  vl = zero
826  vu = anorm
827  CALL ssygvx( ibtype, 'V', 'V', uplo, n, ab, lda, bb,
828  $ ldb, vl, vu, il, iu, abstol, m, d, z,
829  $ ldz, work, nwork, iwork( n+1 ), iwork,
830  $ iinfo )
831  IF( iinfo.NE.0 ) THEN
832  WRITE( nounit, fmt = 9999 )'SSYGVX(V,V,' //
833  $ uplo // ')', iinfo, n, jtype, ioldsd
834  info = abs( iinfo )
835  IF( iinfo.LT.0 ) THEN
836  RETURN
837  ELSE
838  result( ntest ) = ulpinv
839  GO TO 100
840  END IF
841  END IF
842 *
843 * Do Test
844 *
845  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
846  $ ldz, d, work, result( ntest ) )
847 *
848  ntest = ntest + 1
849 *
850  CALL slacpy( ' ', n, n, a, lda, ab, lda )
851  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
852 *
853  CALL ssygvx( ibtype, 'V', 'I', uplo, n, ab, lda, bb,
854  $ ldb, vl, vu, il, iu, abstol, m, d, z,
855  $ ldz, work, nwork, iwork( n+1 ), iwork,
856  $ iinfo )
857  IF( iinfo.NE.0 ) THEN
858  WRITE( nounit, fmt = 9999 )'SSYGVX(V,I,' //
859  $ uplo // ')', iinfo, n, jtype, ioldsd
860  info = abs( iinfo )
861  IF( iinfo.LT.0 ) THEN
862  RETURN
863  ELSE
864  result( ntest ) = ulpinv
865  GO TO 100
866  END IF
867  END IF
868 *
869 * Do Test
870 *
871  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
872  $ ldz, d, work, result( ntest ) )
873 *
874  100 CONTINUE
875 *
876 * Test SSPGV
877 *
878  ntest = ntest + 1
879 *
880 * Copy the matrices into packed storage.
881 *
882  IF( lsame( uplo, 'U' ) ) THEN
883  ij = 1
884  DO 120 j = 1, n
885  DO 110 i = 1, j
886  ap( ij ) = a( i, j )
887  bp( ij ) = b( i, j )
888  ij = ij + 1
889  110 CONTINUE
890  120 CONTINUE
891  ELSE
892  ij = 1
893  DO 140 j = 1, n
894  DO 130 i = j, n
895  ap( ij ) = a( i, j )
896  bp( ij ) = b( i, j )
897  ij = ij + 1
898  130 CONTINUE
899  140 CONTINUE
900  END IF
901 *
902  CALL sspgv( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
903  $ work, iinfo )
904  IF( iinfo.NE.0 ) THEN
905  WRITE( nounit, fmt = 9999 )'SSPGV(V,' // uplo //
906  $ ')', iinfo, n, jtype, ioldsd
907  info = abs( iinfo )
908  IF( iinfo.LT.0 ) THEN
909  RETURN
910  ELSE
911  result( ntest ) = ulpinv
912  GO TO 310
913  END IF
914  END IF
915 *
916 * Do Test
917 *
918  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
919  $ ldz, d, work, result( ntest ) )
920 *
921 * Test SSPGVD
922 *
923  ntest = ntest + 1
924 *
925 * Copy the matrices into packed storage.
926 *
927  IF( lsame( uplo, 'U' ) ) THEN
928  ij = 1
929  DO 160 j = 1, n
930  DO 150 i = 1, j
931  ap( ij ) = a( i, j )
932  bp( ij ) = b( i, j )
933  ij = ij + 1
934  150 CONTINUE
935  160 CONTINUE
936  ELSE
937  ij = 1
938  DO 180 j = 1, n
939  DO 170 i = j, n
940  ap( ij ) = a( i, j )
941  bp( ij ) = b( i, j )
942  ij = ij + 1
943  170 CONTINUE
944  180 CONTINUE
945  END IF
946 *
947  CALL sspgvd( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
948  $ work, nwork, iwork, liwork, iinfo )
949  IF( iinfo.NE.0 ) THEN
950  WRITE( nounit, fmt = 9999 )'SSPGVD(V,' // uplo //
951  $ ')', iinfo, n, jtype, ioldsd
952  info = abs( iinfo )
953  IF( iinfo.LT.0 ) THEN
954  RETURN
955  ELSE
956  result( ntest ) = ulpinv
957  GO TO 310
958  END IF
959  END IF
960 *
961 * Do Test
962 *
963  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
964  $ ldz, d, work, result( ntest ) )
965 *
966 * Test SSPGVX
967 *
968  ntest = ntest + 1
969 *
970 * Copy the matrices into packed storage.
971 *
972  IF( lsame( uplo, 'U' ) ) THEN
973  ij = 1
974  DO 200 j = 1, n
975  DO 190 i = 1, j
976  ap( ij ) = a( i, j )
977  bp( ij ) = b( i, j )
978  ij = ij + 1
979  190 CONTINUE
980  200 CONTINUE
981  ELSE
982  ij = 1
983  DO 220 j = 1, n
984  DO 210 i = j, n
985  ap( ij ) = a( i, j )
986  bp( ij ) = b( i, j )
987  ij = ij + 1
988  210 CONTINUE
989  220 CONTINUE
990  END IF
991 *
992  CALL sspgvx( ibtype, 'V', 'A', uplo, n, ap, bp, vl,
993  $ vu, il, iu, abstol, m, d, z, ldz, work,
994  $ iwork( n+1 ), iwork, info )
995  IF( iinfo.NE.0 ) THEN
996  WRITE( nounit, fmt = 9999 )'SSPGVX(V,A' // uplo //
997  $ ')', iinfo, n, jtype, ioldsd
998  info = abs( iinfo )
999  IF( iinfo.LT.0 ) THEN
1000  RETURN
1001  ELSE
1002  result( ntest ) = ulpinv
1003  GO TO 310
1004  END IF
1005  END IF
1006 *
1007 * Do Test
1008 *
1009  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1010  $ ldz, d, work, result( ntest ) )
1011 *
1012  ntest = ntest + 1
1013 *
1014 * Copy the matrices into packed storage.
1015 *
1016  IF( lsame( uplo, 'U' ) ) THEN
1017  ij = 1
1018  DO 240 j = 1, n
1019  DO 230 i = 1, j
1020  ap( ij ) = a( i, j )
1021  bp( ij ) = b( i, j )
1022  ij = ij + 1
1023  230 CONTINUE
1024  240 CONTINUE
1025  ELSE
1026  ij = 1
1027  DO 260 j = 1, n
1028  DO 250 i = j, n
1029  ap( ij ) = a( i, j )
1030  bp( ij ) = b( i, j )
1031  ij = ij + 1
1032  250 CONTINUE
1033  260 CONTINUE
1034  END IF
1035 *
1036  vl = zero
1037  vu = anorm
1038  CALL sspgvx( ibtype, 'V', 'V', uplo, n, ap, bp, vl,
1039  $ vu, il, iu, abstol, m, d, z, ldz, work,
1040  $ iwork( n+1 ), iwork, info )
1041  IF( iinfo.NE.0 ) THEN
1042  WRITE( nounit, fmt = 9999 )'SSPGVX(V,V' // uplo //
1043  $ ')', iinfo, n, jtype, ioldsd
1044  info = abs( iinfo )
1045  IF( iinfo.LT.0 ) THEN
1046  RETURN
1047  ELSE
1048  result( ntest ) = ulpinv
1049  GO TO 310
1050  END IF
1051  END IF
1052 *
1053 * Do Test
1054 *
1055  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1056  $ ldz, d, work, result( ntest ) )
1057 *
1058  ntest = ntest + 1
1059 *
1060 * Copy the matrices into packed storage.
1061 *
1062  IF( lsame( uplo, 'U' ) ) THEN
1063  ij = 1
1064  DO 280 j = 1, n
1065  DO 270 i = 1, j
1066  ap( ij ) = a( i, j )
1067  bp( ij ) = b( i, j )
1068  ij = ij + 1
1069  270 CONTINUE
1070  280 CONTINUE
1071  ELSE
1072  ij = 1
1073  DO 300 j = 1, n
1074  DO 290 i = j, n
1075  ap( ij ) = a( i, j )
1076  bp( ij ) = b( i, j )
1077  ij = ij + 1
1078  290 CONTINUE
1079  300 CONTINUE
1080  END IF
1081 *
1082  CALL sspgvx( ibtype, 'V', 'I', uplo, n, ap, bp, vl,
1083  $ vu, il, iu, abstol, m, d, z, ldz, work,
1084  $ iwork( n+1 ), iwork, info )
1085  IF( iinfo.NE.0 ) THEN
1086  WRITE( nounit, fmt = 9999 )'SSPGVX(V,I' // uplo //
1087  $ ')', iinfo, n, jtype, ioldsd
1088  info = abs( iinfo )
1089  IF( iinfo.LT.0 ) THEN
1090  RETURN
1091  ELSE
1092  result( ntest ) = ulpinv
1093  GO TO 310
1094  END IF
1095  END IF
1096 *
1097 * Do Test
1098 *
1099  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1100  $ ldz, d, work, result( ntest ) )
1101 *
1102  310 CONTINUE
1103 *
1104  IF( ibtype.EQ.1 ) THEN
1105 *
1106 * TEST SSBGV
1107 *
1108  ntest = ntest + 1
1109 *
1110 * Copy the matrices into band storage.
1111 *
1112  IF( lsame( uplo, 'U' ) ) THEN
1113  DO 340 j = 1, n
1114  DO 320 i = max( 1, j-ka ), j
1115  ab( ka+1+i-j, j ) = a( i, j )
1116  320 CONTINUE
1117  DO 330 i = max( 1, j-kb ), j
1118  bb( kb+1+i-j, j ) = b( i, j )
1119  330 CONTINUE
1120  340 CONTINUE
1121  ELSE
1122  DO 370 j = 1, n
1123  DO 350 i = j, min( n, j+ka )
1124  ab( 1+i-j, j ) = a( i, j )
1125  350 CONTINUE
1126  DO 360 i = j, min( n, j+kb )
1127  bb( 1+i-j, j ) = b( i, j )
1128  360 CONTINUE
1129  370 CONTINUE
1130  END IF
1131 *
1132  CALL ssbgv( 'V', uplo, n, ka, kb, ab, lda, bb, ldb,
1133  $ d, z, ldz, work, iinfo )
1134  IF( iinfo.NE.0 ) THEN
1135  WRITE( nounit, fmt = 9999 )'SSBGV(V,' //
1136  $ uplo // ')', iinfo, n, jtype, ioldsd
1137  info = abs( iinfo )
1138  IF( iinfo.LT.0 ) THEN
1139  RETURN
1140  ELSE
1141  result( ntest ) = ulpinv
1142  GO TO 620
1143  END IF
1144  END IF
1145 *
1146 * Do Test
1147 *
1148  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1149  $ ldz, d, work, result( ntest ) )
1150 *
1151 * TEST SSBGVD
1152 *
1153  ntest = ntest + 1
1154 *
1155 * Copy the matrices into band storage.
1156 *
1157  IF( lsame( uplo, 'U' ) ) THEN
1158  DO 400 j = 1, n
1159  DO 380 i = max( 1, j-ka ), j
1160  ab( ka+1+i-j, j ) = a( i, j )
1161  380 CONTINUE
1162  DO 390 i = max( 1, j-kb ), j
1163  bb( kb+1+i-j, j ) = b( i, j )
1164  390 CONTINUE
1165  400 CONTINUE
1166  ELSE
1167  DO 430 j = 1, n
1168  DO 410 i = j, min( n, j+ka )
1169  ab( 1+i-j, j ) = a( i, j )
1170  410 CONTINUE
1171  DO 420 i = j, min( n, j+kb )
1172  bb( 1+i-j, j ) = b( i, j )
1173  420 CONTINUE
1174  430 CONTINUE
1175  END IF
1176 *
1177  CALL ssbgvd( 'V', uplo, n, ka, kb, ab, lda, bb,
1178  $ ldb, d, z, ldz, work, nwork, iwork,
1179  $ liwork, iinfo )
1180  IF( iinfo.NE.0 ) THEN
1181  WRITE( nounit, fmt = 9999 )'SSBGVD(V,' //
1182  $ uplo // ')', iinfo, n, jtype, ioldsd
1183  info = abs( iinfo )
1184  IF( iinfo.LT.0 ) THEN
1185  RETURN
1186  ELSE
1187  result( ntest ) = ulpinv
1188  GO TO 620
1189  END IF
1190  END IF
1191 *
1192 * Do Test
1193 *
1194  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1195  $ ldz, d, work, result( ntest ) )
1196 *
1197 * Test SSBGVX
1198 *
1199  ntest = ntest + 1
1200 *
1201 * Copy the matrices into band storage.
1202 *
1203  IF( lsame( uplo, 'U' ) ) THEN
1204  DO 460 j = 1, n
1205  DO 440 i = max( 1, j-ka ), j
1206  ab( ka+1+i-j, j ) = a( i, j )
1207  440 CONTINUE
1208  DO 450 i = max( 1, j-kb ), j
1209  bb( kb+1+i-j, j ) = b( i, j )
1210  450 CONTINUE
1211  460 CONTINUE
1212  ELSE
1213  DO 490 j = 1, n
1214  DO 470 i = j, min( n, j+ka )
1215  ab( 1+i-j, j ) = a( i, j )
1216  470 CONTINUE
1217  DO 480 i = j, min( n, j+kb )
1218  bb( 1+i-j, j ) = b( i, j )
1219  480 CONTINUE
1220  490 CONTINUE
1221  END IF
1222 *
1223  CALL ssbgvx( 'V', 'A', uplo, n, ka, kb, ab, lda,
1224  $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1225  $ iu, abstol, m, d, z, ldz, work,
1226  $ iwork( n+1 ), iwork, iinfo )
1227  IF( iinfo.NE.0 ) THEN
1228  WRITE( nounit, fmt = 9999 )'SSBGVX(V,A' //
1229  $ uplo // ')', iinfo, n, jtype, ioldsd
1230  info = abs( iinfo )
1231  IF( iinfo.LT.0 ) THEN
1232  RETURN
1233  ELSE
1234  result( ntest ) = ulpinv
1235  GO TO 620
1236  END IF
1237  END IF
1238 *
1239 * Do Test
1240 *
1241  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1242  $ ldz, d, work, result( ntest ) )
1243 *
1244 *
1245  ntest = ntest + 1
1246 *
1247 * Copy the matrices into band storage.
1248 *
1249  IF( lsame( uplo, 'U' ) ) THEN
1250  DO 520 j = 1, n
1251  DO 500 i = max( 1, j-ka ), j
1252  ab( ka+1+i-j, j ) = a( i, j )
1253  500 CONTINUE
1254  DO 510 i = max( 1, j-kb ), j
1255  bb( kb+1+i-j, j ) = b( i, j )
1256  510 CONTINUE
1257  520 CONTINUE
1258  ELSE
1259  DO 550 j = 1, n
1260  DO 530 i = j, min( n, j+ka )
1261  ab( 1+i-j, j ) = a( i, j )
1262  530 CONTINUE
1263  DO 540 i = j, min( n, j+kb )
1264  bb( 1+i-j, j ) = b( i, j )
1265  540 CONTINUE
1266  550 CONTINUE
1267  END IF
1268 *
1269  vl = zero
1270  vu = anorm
1271  CALL ssbgvx( 'V', 'V', uplo, n, ka, kb, ab, lda,
1272  $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1273  $ iu, abstol, m, d, z, ldz, work,
1274  $ iwork( n+1 ), iwork, iinfo )
1275  IF( iinfo.NE.0 ) THEN
1276  WRITE( nounit, fmt = 9999 )'SSBGVX(V,V' //
1277  $ uplo // ')', iinfo, n, jtype, ioldsd
1278  info = abs( iinfo )
1279  IF( iinfo.LT.0 ) THEN
1280  RETURN
1281  ELSE
1282  result( ntest ) = ulpinv
1283  GO TO 620
1284  END IF
1285  END IF
1286 *
1287 * Do Test
1288 *
1289  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1290  $ ldz, d, work, result( ntest ) )
1291 *
1292  ntest = ntest + 1
1293 *
1294 * Copy the matrices into band storage.
1295 *
1296  IF( lsame( uplo, 'U' ) ) THEN
1297  DO 580 j = 1, n
1298  DO 560 i = max( 1, j-ka ), j
1299  ab( ka+1+i-j, j ) = a( i, j )
1300  560 CONTINUE
1301  DO 570 i = max( 1, j-kb ), j
1302  bb( kb+1+i-j, j ) = b( i, j )
1303  570 CONTINUE
1304  580 CONTINUE
1305  ELSE
1306  DO 610 j = 1, n
1307  DO 590 i = j, min( n, j+ka )
1308  ab( 1+i-j, j ) = a( i, j )
1309  590 CONTINUE
1310  DO 600 i = j, min( n, j+kb )
1311  bb( 1+i-j, j ) = b( i, j )
1312  600 CONTINUE
1313  610 CONTINUE
1314  END IF
1315 *
1316  CALL ssbgvx( 'V', 'I', uplo, n, ka, kb, ab, lda,
1317  $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1318  $ iu, abstol, m, d, z, ldz, work,
1319  $ iwork( n+1 ), iwork, iinfo )
1320  IF( iinfo.NE.0 ) THEN
1321  WRITE( nounit, fmt = 9999 )'SSBGVX(V,I' //
1322  $ uplo // ')', iinfo, n, jtype, ioldsd
1323  info = abs( iinfo )
1324  IF( iinfo.LT.0 ) THEN
1325  RETURN
1326  ELSE
1327  result( ntest ) = ulpinv
1328  GO TO 620
1329  END IF
1330  END IF
1331 *
1332 * Do Test
1333 *
1334  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1335  $ ldz, d, work, result( ntest ) )
1336 *
1337  END IF
1338 *
1339  620 CONTINUE
1340  630 CONTINUE
1341 *
1342 * End of Loop -- Check for RESULT(j) > THRESH
1343 *
1344  ntestt = ntestt + ntest
1345  CALL slafts( 'SSG', n, n, jtype, ntest, result, ioldsd,
1346  $ thresh, nounit, nerrs )
1347  640 CONTINUE
1348  650 CONTINUE
1349 *
1350 * Summary
1351 *
1352  CALL slasum( 'SSG', nounit, nerrs, ntestt )
1353 *
1354  RETURN
1355 *
1356 * End of SDRVSG2STG
1357 *
1358  9999 FORMAT( ' SDRVSG2STG: ', a, ' returned INFO=', i6, '.', / 9x,
1359  $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1360  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
slatms
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:321
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
ssbgvd
subroutine ssbgvd(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSBGVD
Definition: ssbgvd.f:227
ssbgv
subroutine ssbgv(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, INFO)
SSBGV
Definition: ssbgv.f:177
ssbgvx
subroutine ssbgvx(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)
SSBGVX
Definition: ssbgvx.f:294
sspgvx
subroutine sspgvx(ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSPGVX
Definition: sspgvx.f:272
sspgvd
subroutine sspgvd(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSPGVD
Definition: sspgvd.f:210
sspgv
subroutine sspgv(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, INFO)
SSPGV
Definition: sspgv.f:160
ssygv
subroutine ssygv(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, INFO)
SSYGV
Definition: ssygv.f:175
ssygvx
subroutine ssygvx(ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
SSYGVX
Definition: ssygvx.f:297
ssygv_2stage
subroutine ssygv_2stage(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, INFO)
SSYGV_2STAGE
Definition: ssygv_2stage.f:226
ssygvd
subroutine ssygvd(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, IWORK, LIWORK, INFO)
SSYGVD
Definition: ssygvd.f:227
ssgt01
subroutine ssgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RESULT)
SSGT01
Definition: ssgt01.f:146
slafts
subroutine slafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
SLAFTS
Definition: slafts.f:99
sdrvsg2stg
subroutine sdrvsg2stg(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)
SDRVSG2STG
Definition: sdrvsg2stg.f:362
slasum
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:41