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