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