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