LAPACK  3.9.0
LAPACK: Linear Algebra PACKage
zdrvsg2stg.f
Go to the documentation of this file.
1 *> \brief \b ZDRVSG2STG
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 ZDRVSG2STG( 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 * DOUBLE PRECISION THRESH
22 * ..
23 * .. Array Arguments ..
24 * LOGICAL DOTYPE( * )
25 * INTEGER ISEED( 4 ), IWORK( * ), NN( * )
26 * DOUBLE PRECISION D( * ), RESULT( * ), RWORK( * )
27 * COMPLEX*16 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 *> ZDRVSG2STG checks the complex Hermitian generalized eigenproblem
39 *> drivers.
40 *>
41 *> ZHEGV computes all eigenvalues and, optionally,
42 *> eigenvectors of a complex Hermitian-definite generalized
43 *> eigenproblem.
44 *>
45 *> ZHEGVD computes all eigenvalues and, optionally,
46 *> eigenvectors of a complex Hermitian-definite generalized
47 *> eigenproblem using a divide and conquer algorithm.
48 *>
49 *> ZHEGVX computes selected eigenvalues and, optionally,
50 *> eigenvectors of a complex Hermitian-definite generalized
51 *> eigenproblem.
52 *>
53 *> ZHPGV computes all eigenvalues and, optionally,
54 *> eigenvectors of a complex Hermitian-definite generalized
55 *> eigenproblem in packed storage.
56 *>
57 *> ZHPGVD 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 *> ZHPGVX computes selected eigenvalues and, optionally,
63 *> eigenvectors of a complex Hermitian-definite generalized
64 *> eigenproblem in packed storage.
65 *>
66 *> ZHBGV computes all eigenvalues and, optionally,
67 *> eigenvectors of a complex Hermitian-definite banded
68 *> generalized eigenproblem.
69 *>
70 *> ZHBGVD 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 *> ZHBGVX computes selected eigenvalues and, optionally,
76 *> eigenvectors of a complex Hermitian-definite banded
77 *> generalized eigenproblem.
78 *>
79 *> When ZDRVSG2STG 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) ZHEGV 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 *> ZHEGV and D2 is computed by
92 *> ZHEGV_2STAGE. This test is
93 *> only performed for DSYGV
94 *>
95 *> (2) as (1) but calling ZHPGV
96 *> (3) as (1) but calling ZHBGV
97 *> (4) as (1) but with UPLO = 'L'
98 *> (5) as (4) but calling ZHPGV
99 *> (6) as (4) but calling ZHBGV
100 *>
101 *> (7) ZHEGV with ITYPE = 2 and UPLO ='U':
102 *>
103 *> | A B Z - Z D | / ( |A| |Z| n ulp )
104 *>
105 *> (8) as (7) but calling ZHPGV
106 *> (9) as (7) but with UPLO = 'L'
107 *> (10) as (9) but calling ZHPGV
108 *>
109 *> (11) ZHEGV with ITYPE = 3 and UPLO ='U':
110 *>
111 *> | B A Z - Z D | / ( |A| |Z| n ulp )
112 *>
113 *> (12) as (11) but calling ZHPGV
114 *> (13) as (11) but with UPLO = 'L'
115 *> (14) as (13) but calling ZHPGV
116 *>
117 *> ZHEGVD, ZHPGVD and ZHBGVD performed the same 14 tests.
118 *>
119 *> ZHEGVX, ZHPGVX and ZHBGVX 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 *> ZDRVSG2STG 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, ZDRVSG2STG
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 ZDRVSG2STG to continue the same random number
215 *> sequence.
216 *> Modified.
217 *>
218 *> THRESH DOUBLE PRECISION
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*16 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*16 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 DOUBLE PRECISION 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*16 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*16 array, dimension (LDA, max(NN))
270 *> Workspace.
271 *> Modified.
272 *>
273 *> BB COMPLEX*16 array, dimension (LDB, max(NN))
274 *> Workspace.
275 *> Modified.
276 *>
277 *> AP COMPLEX*16 array, dimension (max(NN)**2)
278 *> Workspace.
279 *> Modified.
280 *>
281 *> BP COMPLEX*16 array, dimension (max(NN)**2)
282 *> Workspace.
283 *> Modified.
284 *>
285 *> WORK COMPLEX*16 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 ZLATMR, CLATMS, ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD,
330 *> ZHPGVD, ZHEGVX, CHPGVX, ZHBGVX 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 DLAFTS).
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 complex16_eig
372 *
373 * =====================================================================
374  SUBROUTINE zdrvsg2stg( 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  DOUBLE PRECISION THRESH
390 * ..
391 * .. Array Arguments ..
392  LOGICAL DOTYPE( * )
393  INTEGER ISEED( 4 ), IWORK( * ), NN( * )
394  DOUBLE PRECISION D( * ), D2( * ), RESULT( * ), RWORK( * )
395  COMPLEX*16 A( LDA, * ), AB( LDA, * ), AP( * ),
396  $ b( ldb, * ), bb( ldb, * ), bp( * ), work( * ),
397  $ z( ldz, * )
398 * ..
399 *
400 * =====================================================================
401 *
402 * .. Parameters ..
403  DOUBLE PRECISION ZERO, ONE, TEN
404  PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0, ten = 10.0d+0 )
405  COMPLEX*16 CZERO, CONE
406  parameter( czero = ( 0.0d+0, 0.0d+0 ),
407  $ cone = ( 1.0d+0, 0.0d+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  DOUBLE PRECISION 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  DOUBLE PRECISION DLAMCH, DLARND
429  EXTERNAL LSAME, DLAMCH, DLARND
430 * ..
431 * .. External Subroutines ..
432  EXTERNAL dlabad, dlafts, dlasum, xerbla, zhbgv, zhbgvd,
433  $ zhbgvx, zhegv, zhegvd, zhegvx, zhpgv, zhpgvd,
434  $ zhpgvx, zlacpy, zlaset, zlatmr, zlatms, zsgt01,
435  $ zhegv_2stage
436 * ..
437 * .. Intrinsic Functions ..
438  INTRINSIC abs, dble, 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( 'ZDRVSG2STG', -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 = dlamch( 'Safe minimum' )
495  ovfl = dlamch( 'Overflow' )
496  CALL dlabad( unfl, ovfl )
497  ulp = dlamch( 'Epsilon' )*dlamch( '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 / dble( 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 zlaset( '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 zlaset( '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 zlatms( 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 zlatms( 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 zlatmr( 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 zlatmr( 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 zlatms( 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 )*dlarnd( 1, iseed2 ) )
679  iu = 1 + int( ( n-1 )*dlarnd( 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 ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD, CHBGVD,
688 * ZHEGVX, ZHPGVX and ZHBGVX, 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 zlatms( n, n, 'U', iseed, 'P', rwork, 5, ten,
709  $ one, kb, kb, uplo, b, ldb, work( n+1 ),
710  $ iinfo )
711 *
712 * Test ZHEGV
713 *
714  ntest = ntest + 1
715 *
716  CALL zlacpy( ' ', n, n, a, lda, z, ldz )
717  CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
718 *
719  CALL zhegv( 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 )'ZHEGV(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 zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
736  $ ldz, d, work, rwork, result( ntest ) )
737 *
738 * Test ZHEGV_2STAGE
739 *
740  ntest = ntest + 1
741 *
742  CALL zlacpy( ' ', n, n, a, lda, z, ldz )
743  CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
744 *
745  CALL zhegv_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  $ 'ZHEGV_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 ZSGT01( 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 ZHEGVD
782 *
783  ntest = ntest + 1
784 *
785  CALL zlacpy( ' ', n, n, a, lda, z, ldz )
786  CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
787 *
788  CALL zhegvd( 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 )'ZHEGVD(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 zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
806  $ ldz, d, work, rwork, result( ntest ) )
807 *
808 * Test ZHEGVX
809 *
810  ntest = ntest + 1
811 *
812  CALL zlacpy( ' ', n, n, a, lda, ab, lda )
813  CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
814 *
815  CALL zhegvx( 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 )'ZHEGVX(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 zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
834  $ ldz, d, work, rwork, result( ntest ) )
835 *
836  ntest = ntest + 1
837 *
838  CALL zlacpy( ' ', n, n, a, lda, ab, lda )
839  CALL zlacpy( 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 zhegvx( 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 )'ZHEGVX(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 zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
867  $ ldz, d, work, rwork, result( ntest ) )
868 *
869  ntest = ntest + 1
870 *
871  CALL zlacpy( ' ', n, n, a, lda, ab, lda )
872  CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
873 *
874  CALL zhegvx( 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 )'ZHEGVX(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 zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
893  $ ldz, d, work, rwork, result( ntest ) )
894 *
895  100 CONTINUE
896 *
897 * Test ZHPGV
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 zhpgv( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
924  $ work, rwork, iinfo )
925  IF( iinfo.NE.0 ) THEN
926  WRITE( nounit, fmt = 9999 )'ZHPGV(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 zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
940  $ ldz, d, work, rwork, result( ntest ) )
941 *
942 * Test ZHPGVD
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 zhpgvd( 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 )'ZHPGVD(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 zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
986  $ ldz, d, work, rwork, result( ntest ) )
987 *
988 * Test ZHPGVX
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 zhpgvx( 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 )'ZHPGVX(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 zsgt01( 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 zhpgvx( 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 )'ZHPGVX(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 zsgt01( 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 zhpgvx( 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 )'ZHPGVX(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 zsgt01( 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 ZHBGV
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 zhbgv( '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 )'ZHBGV(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 zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1171  $ ldz, d, work, rwork, result( ntest ) )
1172 *
1173 * TEST ZHBGVD
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 zhbgvd( '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 )'ZHBGVD(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 zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1217  $ ldz, d, work, rwork, result( ntest ) )
1218 *
1219 * Test ZHBGVX
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 zhbgvx( '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 )'ZHBGVX(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 zsgt01( 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 zhbgvx( '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 )'ZHBGVX(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 zsgt01( 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 zhbgvx( '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 )'ZHBGVX(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 zsgt01( 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 dlafts( 'ZSG', n, n, jtype, ntest, result, ioldsd,
1367  $ thresh, nounit, nerrs )
1368  640 CONTINUE
1369  650 CONTINUE
1370 *
1371 * Summary
1372 *
1373  CALL dlasum( 'ZSG', nounit, nerrs, ntestt )
1374 *
1375  RETURN
1376 *
1377  9999 FORMAT( ' ZDRVSG2STG: ', a, ' returned INFO=', i6, '.', / 9x,
1378  $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1379 *
1380 * End of ZDRVSG2STG
1381 *
1382  END
dlasum
subroutine dlasum(TYPE, IOUNIT, IE, NRUN)
DLASUM
Definition: dlasum.f:45
zsgt01
subroutine zsgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RWORK, RESULT)
ZSGT01
Definition: zsgt01.f:154
zhbgv
subroutine zhbgv(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, RWORK, INFO)
ZHBGV
Definition: zhbgv.f:185
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
zhpgvd
subroutine zhpgvd(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZHPGVD
Definition: zhpgvd.f:233
zdrvsg2stg
subroutine zdrvsg2stg(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)
ZDRVSG2STG
Definition: zdrvsg2stg.f:378
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
zhpgv
subroutine zhpgv(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, RWORK, INFO)
ZHPGV
Definition: zhpgv.f:167
zhegv_2stage
subroutine zhegv_2stage(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, RWORK, INFO)
ZHEGV_2STAGE
Definition: zhegv_2stage.f:234
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
zhegv
subroutine zhegv(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, RWORK, INFO)
ZHEGV
Definition: zhegv.f:183
zhegvd
subroutine zhegvd(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZHEGVD
Definition: zhegvd.f:251
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
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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
dlafts
subroutine dlafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
DLAFTS
Definition: dlafts.f:101
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
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
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
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334