LAPACK  3.7.0
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 *> \date December 2016
356 *
357 *> \ingroup real_eig
358 *
359 * =====================================================================
360  SUBROUTINE sdrvsg2stg( 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  REAL THRESH
376 * ..
377 * .. Array Arguments ..
378  LOGICAL DOTYPE( * )
379  INTEGER ISEED( 4 ), IWORK( * ), NN( * )
380  REAL 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  REAL ZERO, ONE, TEN
389  parameter ( zero = 0.0e0, one = 1.0e0, ten = 10.0e0 )
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  REAL 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  REAL SLAMCH, SLARND
411  EXTERNAL lsame, slamch, slarnd
412 * ..
413 * .. External Subroutines ..
414  EXTERNAL slabad, slacpy, slafts, slaset, slasum, slatmr,
415  $ slatms, ssbgv, ssbgvd, ssbgvx, ssgt01, sspgv,
416  $ sspgvd, sspgvx, ssygv, ssygvd, ssygvx, xerbla,
417  $ ssygv_2stage
418 * ..
419 * .. Intrinsic Functions ..
420  INTRINSIC abs, REAL, 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( 'SDRVSG2STG', -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 = slamch( 'Safe minimum' )
475  ovfl = slamch( 'Overflow' )
476  CALL slabad( unfl, ovfl )
477  ulp = slamch( 'Epsilon' )*slamch( '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 / REAL( 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 slaset( '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 slaset( '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 slatms( 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 slatms( 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 slatmr( 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 slatmr( 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 slatms( 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 )*slarnd( 1, iseed2 ) )
662  iu = 1 + int( ( n-1 )*slarnd( 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 SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD, SSBGVD,
671 * SSYGVX, SSPGVX, and SSBGVX, 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 slatms( n, n, 'U', iseed, 'P', work, 5, ten, one,
692  $ kb, kb, uplo, b, ldb, work( n+1 ),
693  $ iinfo )
694 *
695 * Test SSYGV
696 *
697  ntest = ntest + 1
698 *
699  CALL slacpy( ' ', n, n, a, lda, z, ldz )
700  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
701 *
702  CALL ssygv( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
703  $ work, nwork, iinfo )
704  IF( iinfo.NE.0 ) THEN
705  WRITE( nounit, fmt = 9999 )'SSYGV(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 ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
719  $ ldz, d, work, result( ntest ) )
720 *
721 * Test SSYGV_2STAGE
722 *
723  ntest = ntest + 1
724 *
725  CALL slacpy( ' ', n, n, a, lda, z, ldz )
726  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
727 *
728  CALL ssygv_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  $ 'SSYGV_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 SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
746 C $ LDZ, D, WORK, RESULT( NTEST ) )
747 *
748 *
749 * Do Tests | D1 - D2 | / ( |D1| ulp )
750 * D1 computed using the standard 1-stage reduction as reference
751 * D2 computed using the 2-stage reduction
752 *
753  temp1 = zero
754  temp2 = zero
755  DO 151 j = 1, n
756  temp1 = max( temp1, abs( d( j ) ),
757  $ abs( d2( j ) ) )
758  temp2 = max( temp2, abs( d( j )-d2( j ) ) )
759  151 CONTINUE
760 *
761  result( ntest ) = temp2 /
762  $ max( unfl, ulp*max( temp1, temp2 ) )
763 *
764 * Test SSYGVD
765 *
766  ntest = ntest + 1
767 *
768  CALL slacpy( ' ', n, n, a, lda, z, ldz )
769  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
770 *
771  CALL ssygvd( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
772  $ work, nwork, iwork, liwork, iinfo )
773  IF( iinfo.NE.0 ) THEN
774  WRITE( nounit, fmt = 9999 )'SSYGVD(V,' // uplo //
775  $ ')', iinfo, n, jtype, ioldsd
776  info = abs( iinfo )
777  IF( iinfo.LT.0 ) THEN
778  RETURN
779  ELSE
780  result( ntest ) = ulpinv
781  GO TO 100
782  END IF
783  END IF
784 *
785 * Do Test
786 *
787  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
788  $ ldz, d, work, result( ntest ) )
789 *
790 * Test SSYGVX
791 *
792  ntest = ntest + 1
793 *
794  CALL slacpy( ' ', n, n, a, lda, ab, lda )
795  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
796 *
797  CALL ssygvx( ibtype, 'V', 'A', uplo, n, ab, lda, bb,
798  $ ldb, vl, vu, il, iu, abstol, m, d, z,
799  $ ldz, work, nwork, iwork( n+1 ), iwork,
800  $ iinfo )
801  IF( iinfo.NE.0 ) THEN
802  WRITE( nounit, fmt = 9999 )'SSYGVX(V,A' // uplo //
803  $ ')', iinfo, n, jtype, ioldsd
804  info = abs( iinfo )
805  IF( iinfo.LT.0 ) THEN
806  RETURN
807  ELSE
808  result( ntest ) = ulpinv
809  GO TO 100
810  END IF
811  END IF
812 *
813 * Do Test
814 *
815  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
816  $ ldz, d, work, result( ntest ) )
817 *
818  ntest = ntest + 1
819 *
820  CALL slacpy( ' ', n, n, a, lda, ab, lda )
821  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
822 *
823 * since we do not know the exact eigenvalues of this
824 * eigenpair, we just set VL and VU as constants.
825 * It is quite possible that there are no eigenvalues
826 * in this interval.
827 *
828  vl = zero
829  vu = anorm
830  CALL ssygvx( ibtype, 'V', 'V', uplo, n, ab, lda, bb,
831  $ ldb, vl, vu, il, iu, abstol, m, d, z,
832  $ ldz, work, nwork, iwork( n+1 ), iwork,
833  $ iinfo )
834  IF( iinfo.NE.0 ) THEN
835  WRITE( nounit, fmt = 9999 )'SSYGVX(V,V,' //
836  $ uplo // ')', iinfo, n, jtype, ioldsd
837  info = abs( iinfo )
838  IF( iinfo.LT.0 ) THEN
839  RETURN
840  ELSE
841  result( ntest ) = ulpinv
842  GO TO 100
843  END IF
844  END IF
845 *
846 * Do Test
847 *
848  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
849  $ ldz, d, work, result( ntest ) )
850 *
851  ntest = ntest + 1
852 *
853  CALL slacpy( ' ', n, n, a, lda, ab, lda )
854  CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
855 *
856  CALL ssygvx( ibtype, 'V', 'I', uplo, n, ab, lda, bb,
857  $ ldb, vl, vu, il, iu, abstol, m, d, z,
858  $ ldz, work, nwork, iwork( n+1 ), iwork,
859  $ iinfo )
860  IF( iinfo.NE.0 ) THEN
861  WRITE( nounit, fmt = 9999 )'SSYGVX(V,I,' //
862  $ uplo // ')', iinfo, n, jtype, ioldsd
863  info = abs( iinfo )
864  IF( iinfo.LT.0 ) THEN
865  RETURN
866  ELSE
867  result( ntest ) = ulpinv
868  GO TO 100
869  END IF
870  END IF
871 *
872 * Do Test
873 *
874  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
875  $ ldz, d, work, result( ntest ) )
876 *
877  100 CONTINUE
878 *
879 * Test SSPGV
880 *
881  ntest = ntest + 1
882 *
883 * Copy the matrices into packed storage.
884 *
885  IF( lsame( uplo, 'U' ) ) THEN
886  ij = 1
887  DO 120 j = 1, n
888  DO 110 i = 1, j
889  ap( ij ) = a( i, j )
890  bp( ij ) = b( i, j )
891  ij = ij + 1
892  110 CONTINUE
893  120 CONTINUE
894  ELSE
895  ij = 1
896  DO 140 j = 1, n
897  DO 130 i = j, n
898  ap( ij ) = a( i, j )
899  bp( ij ) = b( i, j )
900  ij = ij + 1
901  130 CONTINUE
902  140 CONTINUE
903  END IF
904 *
905  CALL sspgv( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
906  $ work, iinfo )
907  IF( iinfo.NE.0 ) THEN
908  WRITE( nounit, fmt = 9999 )'SSPGV(V,' // uplo //
909  $ ')', iinfo, n, jtype, ioldsd
910  info = abs( iinfo )
911  IF( iinfo.LT.0 ) THEN
912  RETURN
913  ELSE
914  result( ntest ) = ulpinv
915  GO TO 310
916  END IF
917  END IF
918 *
919 * Do Test
920 *
921  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
922  $ ldz, d, work, result( ntest ) )
923 *
924 * Test SSPGVD
925 *
926  ntest = ntest + 1
927 *
928 * Copy the matrices into packed storage.
929 *
930  IF( lsame( uplo, 'U' ) ) THEN
931  ij = 1
932  DO 160 j = 1, n
933  DO 150 i = 1, j
934  ap( ij ) = a( i, j )
935  bp( ij ) = b( i, j )
936  ij = ij + 1
937  150 CONTINUE
938  160 CONTINUE
939  ELSE
940  ij = 1
941  DO 180 j = 1, n
942  DO 170 i = j, n
943  ap( ij ) = a( i, j )
944  bp( ij ) = b( i, j )
945  ij = ij + 1
946  170 CONTINUE
947  180 CONTINUE
948  END IF
949 *
950  CALL sspgvd( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
951  $ work, nwork, iwork, liwork, iinfo )
952  IF( iinfo.NE.0 ) THEN
953  WRITE( nounit, fmt = 9999 )'SSPGVD(V,' // uplo //
954  $ ')', iinfo, n, jtype, ioldsd
955  info = abs( iinfo )
956  IF( iinfo.LT.0 ) THEN
957  RETURN
958  ELSE
959  result( ntest ) = ulpinv
960  GO TO 310
961  END IF
962  END IF
963 *
964 * Do Test
965 *
966  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
967  $ ldz, d, work, result( ntest ) )
968 *
969 * Test SSPGVX
970 *
971  ntest = ntest + 1
972 *
973 * Copy the matrices into packed storage.
974 *
975  IF( lsame( uplo, 'U' ) ) THEN
976  ij = 1
977  DO 200 j = 1, n
978  DO 190 i = 1, j
979  ap( ij ) = a( i, j )
980  bp( ij ) = b( i, j )
981  ij = ij + 1
982  190 CONTINUE
983  200 CONTINUE
984  ELSE
985  ij = 1
986  DO 220 j = 1, n
987  DO 210 i = j, n
988  ap( ij ) = a( i, j )
989  bp( ij ) = b( i, j )
990  ij = ij + 1
991  210 CONTINUE
992  220 CONTINUE
993  END IF
994 *
995  CALL sspgvx( ibtype, 'V', 'A', uplo, n, ap, bp, vl,
996  $ vu, il, iu, abstol, m, d, z, ldz, work,
997  $ iwork( n+1 ), iwork, info )
998  IF( iinfo.NE.0 ) THEN
999  WRITE( nounit, fmt = 9999 )'SSPGVX(V,A' // uplo //
1000  $ ')', iinfo, n, jtype, ioldsd
1001  info = abs( iinfo )
1002  IF( iinfo.LT.0 ) THEN
1003  RETURN
1004  ELSE
1005  result( ntest ) = ulpinv
1006  GO TO 310
1007  END IF
1008  END IF
1009 *
1010 * Do Test
1011 *
1012  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1013  $ ldz, d, work, result( ntest ) )
1014 *
1015  ntest = ntest + 1
1016 *
1017 * Copy the matrices into packed storage.
1018 *
1019  IF( lsame( uplo, 'U' ) ) THEN
1020  ij = 1
1021  DO 240 j = 1, n
1022  DO 230 i = 1, j
1023  ap( ij ) = a( i, j )
1024  bp( ij ) = b( i, j )
1025  ij = ij + 1
1026  230 CONTINUE
1027  240 CONTINUE
1028  ELSE
1029  ij = 1
1030  DO 260 j = 1, n
1031  DO 250 i = j, n
1032  ap( ij ) = a( i, j )
1033  bp( ij ) = b( i, j )
1034  ij = ij + 1
1035  250 CONTINUE
1036  260 CONTINUE
1037  END IF
1038 *
1039  vl = zero
1040  vu = anorm
1041  CALL sspgvx( ibtype, 'V', 'V', uplo, n, ap, bp, vl,
1042  $ vu, il, iu, abstol, m, d, z, ldz, work,
1043  $ iwork( n+1 ), iwork, info )
1044  IF( iinfo.NE.0 ) THEN
1045  WRITE( nounit, fmt = 9999 )'SSPGVX(V,V' // uplo //
1046  $ ')', iinfo, n, jtype, ioldsd
1047  info = abs( iinfo )
1048  IF( iinfo.LT.0 ) THEN
1049  RETURN
1050  ELSE
1051  result( ntest ) = ulpinv
1052  GO TO 310
1053  END IF
1054  END IF
1055 *
1056 * Do Test
1057 *
1058  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1059  $ ldz, d, work, result( ntest ) )
1060 *
1061  ntest = ntest + 1
1062 *
1063 * Copy the matrices into packed storage.
1064 *
1065  IF( lsame( uplo, 'U' ) ) THEN
1066  ij = 1
1067  DO 280 j = 1, n
1068  DO 270 i = 1, j
1069  ap( ij ) = a( i, j )
1070  bp( ij ) = b( i, j )
1071  ij = ij + 1
1072  270 CONTINUE
1073  280 CONTINUE
1074  ELSE
1075  ij = 1
1076  DO 300 j = 1, n
1077  DO 290 i = j, n
1078  ap( ij ) = a( i, j )
1079  bp( ij ) = b( i, j )
1080  ij = ij + 1
1081  290 CONTINUE
1082  300 CONTINUE
1083  END IF
1084 *
1085  CALL sspgvx( ibtype, 'V', 'I', uplo, n, ap, bp, vl,
1086  $ vu, il, iu, abstol, m, d, z, ldz, work,
1087  $ iwork( n+1 ), iwork, info )
1088  IF( iinfo.NE.0 ) THEN
1089  WRITE( nounit, fmt = 9999 )'SSPGVX(V,I' // uplo //
1090  $ ')', iinfo, n, jtype, ioldsd
1091  info = abs( iinfo )
1092  IF( iinfo.LT.0 ) THEN
1093  RETURN
1094  ELSE
1095  result( ntest ) = ulpinv
1096  GO TO 310
1097  END IF
1098  END IF
1099 *
1100 * Do Test
1101 *
1102  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1103  $ ldz, d, work, result( ntest ) )
1104 *
1105  310 CONTINUE
1106 *
1107  IF( ibtype.EQ.1 ) THEN
1108 *
1109 * TEST SSBGV
1110 *
1111  ntest = ntest + 1
1112 *
1113 * Copy the matrices into band storage.
1114 *
1115  IF( lsame( uplo, 'U' ) ) THEN
1116  DO 340 j = 1, n
1117  DO 320 i = max( 1, j-ka ), j
1118  ab( ka+1+i-j, j ) = a( i, j )
1119  320 CONTINUE
1120  DO 330 i = max( 1, j-kb ), j
1121  bb( kb+1+i-j, j ) = b( i, j )
1122  330 CONTINUE
1123  340 CONTINUE
1124  ELSE
1125  DO 370 j = 1, n
1126  DO 350 i = j, min( n, j+ka )
1127  ab( 1+i-j, j ) = a( i, j )
1128  350 CONTINUE
1129  DO 360 i = j, min( n, j+kb )
1130  bb( 1+i-j, j ) = b( i, j )
1131  360 CONTINUE
1132  370 CONTINUE
1133  END IF
1134 *
1135  CALL ssbgv( 'V', uplo, n, ka, kb, ab, lda, bb, ldb,
1136  $ d, z, ldz, work, iinfo )
1137  IF( iinfo.NE.0 ) THEN
1138  WRITE( nounit, fmt = 9999 )'SSBGV(V,' //
1139  $ uplo // ')', iinfo, n, jtype, ioldsd
1140  info = abs( iinfo )
1141  IF( iinfo.LT.0 ) THEN
1142  RETURN
1143  ELSE
1144  result( ntest ) = ulpinv
1145  GO TO 620
1146  END IF
1147  END IF
1148 *
1149 * Do Test
1150 *
1151  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1152  $ ldz, d, work, result( ntest ) )
1153 *
1154 * TEST SSBGVD
1155 *
1156  ntest = ntest + 1
1157 *
1158 * Copy the matrices into band storage.
1159 *
1160  IF( lsame( uplo, 'U' ) ) THEN
1161  DO 400 j = 1, n
1162  DO 380 i = max( 1, j-ka ), j
1163  ab( ka+1+i-j, j ) = a( i, j )
1164  380 CONTINUE
1165  DO 390 i = max( 1, j-kb ), j
1166  bb( kb+1+i-j, j ) = b( i, j )
1167  390 CONTINUE
1168  400 CONTINUE
1169  ELSE
1170  DO 430 j = 1, n
1171  DO 410 i = j, min( n, j+ka )
1172  ab( 1+i-j, j ) = a( i, j )
1173  410 CONTINUE
1174  DO 420 i = j, min( n, j+kb )
1175  bb( 1+i-j, j ) = b( i, j )
1176  420 CONTINUE
1177  430 CONTINUE
1178  END IF
1179 *
1180  CALL ssbgvd( 'V', uplo, n, ka, kb, ab, lda, bb,
1181  $ ldb, d, z, ldz, work, nwork, iwork,
1182  $ liwork, iinfo )
1183  IF( iinfo.NE.0 ) THEN
1184  WRITE( nounit, fmt = 9999 )'SSBGVD(V,' //
1185  $ uplo // ')', iinfo, n, jtype, ioldsd
1186  info = abs( iinfo )
1187  IF( iinfo.LT.0 ) THEN
1188  RETURN
1189  ELSE
1190  result( ntest ) = ulpinv
1191  GO TO 620
1192  END IF
1193  END IF
1194 *
1195 * Do Test
1196 *
1197  CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1198  $ ldz, d, work, result( ntest ) )
1199 *
1200 * Test SSBGVX
1201 *
1202  ntest = ntest + 1
1203 *
1204 * Copy the matrices into band storage.
1205 *
1206  IF( lsame( uplo, 'U' ) ) THEN
1207  DO 460 j = 1, n
1208  DO 440 i = max( 1, j-ka ), j
1209  ab( ka+1+i-j, j ) = a( i, j )
1210  440 CONTINUE
1211  DO 450 i = max( 1, j-kb ), j
1212  bb( kb+1+i-j, j ) = b( i, j )
1213  450 CONTINUE
1214  460 CONTINUE
1215  ELSE
1216  DO 490 j = 1, n
1217  DO 470 i = j, min( n, j+ka )
1218  ab( 1+i-j, j ) = a( i, j )
1219  470 CONTINUE
1220  DO 480 i = j, min( n, j+kb )
1221  bb( 1+i-j, j ) = b( i, j )
1222  480 CONTINUE
1223  490 CONTINUE
1224  END IF
1225 *
1226  CALL ssbgvx( 'V', 'A', uplo, n, ka, kb, ab, lda,
1227  $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1228  $ iu, abstol, m, d, z, ldz, work,
1229  $ iwork( n+1 ), iwork, iinfo )
1230  IF( iinfo.NE.0 ) THEN
1231  WRITE( nounit, fmt = 9999 )'SSBGVX(V,A' //
1232  $ uplo // ')', iinfo, n, jtype, ioldsd
1233  info = abs( iinfo )
1234  IF( iinfo.LT.0 ) THEN
1235  RETURN
1236  ELSE
1237  result( ntest ) = ulpinv
1238  GO TO 620
1239  END IF
1240  END IF
1241 *
1242 * Do Test
1243 *
1244  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1245  $ ldz, d, work, result( ntest ) )
1246 *
1247 *
1248  ntest = ntest + 1
1249 *
1250 * Copy the matrices into band storage.
1251 *
1252  IF( lsame( uplo, 'U' ) ) THEN
1253  DO 520 j = 1, n
1254  DO 500 i = max( 1, j-ka ), j
1255  ab( ka+1+i-j, j ) = a( i, j )
1256  500 CONTINUE
1257  DO 510 i = max( 1, j-kb ), j
1258  bb( kb+1+i-j, j ) = b( i, j )
1259  510 CONTINUE
1260  520 CONTINUE
1261  ELSE
1262  DO 550 j = 1, n
1263  DO 530 i = j, min( n, j+ka )
1264  ab( 1+i-j, j ) = a( i, j )
1265  530 CONTINUE
1266  DO 540 i = j, min( n, j+kb )
1267  bb( 1+i-j, j ) = b( i, j )
1268  540 CONTINUE
1269  550 CONTINUE
1270  END IF
1271 *
1272  vl = zero
1273  vu = anorm
1274  CALL ssbgvx( 'V', 'V', uplo, n, ka, kb, ab, lda,
1275  $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1276  $ iu, abstol, m, d, z, ldz, work,
1277  $ iwork( n+1 ), iwork, iinfo )
1278  IF( iinfo.NE.0 ) THEN
1279  WRITE( nounit, fmt = 9999 )'SSBGVX(V,V' //
1280  $ uplo // ')', iinfo, n, jtype, ioldsd
1281  info = abs( iinfo )
1282  IF( iinfo.LT.0 ) THEN
1283  RETURN
1284  ELSE
1285  result( ntest ) = ulpinv
1286  GO TO 620
1287  END IF
1288  END IF
1289 *
1290 * Do Test
1291 *
1292  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1293  $ ldz, d, work, result( ntest ) )
1294 *
1295  ntest = ntest + 1
1296 *
1297 * Copy the matrices into band storage.
1298 *
1299  IF( lsame( uplo, 'U' ) ) THEN
1300  DO 580 j = 1, n
1301  DO 560 i = max( 1, j-ka ), j
1302  ab( ka+1+i-j, j ) = a( i, j )
1303  560 CONTINUE
1304  DO 570 i = max( 1, j-kb ), j
1305  bb( kb+1+i-j, j ) = b( i, j )
1306  570 CONTINUE
1307  580 CONTINUE
1308  ELSE
1309  DO 610 j = 1, n
1310  DO 590 i = j, min( n, j+ka )
1311  ab( 1+i-j, j ) = a( i, j )
1312  590 CONTINUE
1313  DO 600 i = j, min( n, j+kb )
1314  bb( 1+i-j, j ) = b( i, j )
1315  600 CONTINUE
1316  610 CONTINUE
1317  END IF
1318 *
1319  CALL ssbgvx( 'V', 'I', uplo, n, ka, kb, ab, lda,
1320  $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1321  $ iu, abstol, m, d, z, ldz, work,
1322  $ iwork( n+1 ), iwork, iinfo )
1323  IF( iinfo.NE.0 ) THEN
1324  WRITE( nounit, fmt = 9999 )'SSBGVX(V,I' //
1325  $ uplo // ')', iinfo, n, jtype, ioldsd
1326  info = abs( iinfo )
1327  IF( iinfo.LT.0 ) THEN
1328  RETURN
1329  ELSE
1330  result( ntest ) = ulpinv
1331  GO TO 620
1332  END IF
1333  END IF
1334 *
1335 * Do Test
1336 *
1337  CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1338  $ ldz, d, work, result( ntest ) )
1339 *
1340  END IF
1341 *
1342  620 CONTINUE
1343  630 CONTINUE
1344 *
1345 * End of Loop -- Check for RESULT(j) > THRESH
1346 *
1347  ntestt = ntestt + ntest
1348  CALL slafts( 'SSG', n, n, jtype, ntest, result, ioldsd,
1349  $ thresh, nounit, nerrs )
1350  640 CONTINUE
1351  650 CONTINUE
1352 *
1353 * Summary
1354 *
1355  CALL slasum( 'SSG', nounit, nerrs, ntestt )
1356 *
1357  RETURN
1358 *
1359 * End of SDRVSG2STG
1360 *
1361  9999 FORMAT( ' SDRVSG2STG: ', a, ' returned INFO=', i6, '.', / 9x,
1362  $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1363  END
ssgt01
subroutine ssgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RESULT)
SSGT01
Definition: ssgt01.f:148
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:274
ssygv
subroutine ssygv(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, INFO)
SSYGV
Definition: ssygv.f:177
ssbgvd
subroutine ssbgvd(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSBGVD
Definition: ssbgvd.f:229
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:473
sspgv
subroutine sspgv(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, INFO)
SSPGV
Definition: sspgv.f:163
slafts
subroutine slafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
SLAFTS
Definition: slafts.f:101
slatms
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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:112
ssbgv
subroutine ssbgv(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, INFO)
SSBGV
Definition: ssbgv.f:179
ssygv_2stage
subroutine ssygv_2stage(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, INFO)
SSYGV_2STAGE
Definition: ssygv_2stage.f:228
slabad
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
sspgvd
subroutine sspgvd(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSPGVD
Definition: sspgvd.f:212
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:296
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:364
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:299
ssygvd
subroutine ssygvd(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, IWORK, LIWORK, INFO)
SSYGVD
Definition: ssygvd.f:229
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:105
slasum
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:42