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