OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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*> \ingroup complex16_eig
370*
371* =====================================================================
372 SUBROUTINE zdrvsg2stg( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
373 $ NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
374 $ BB, AP, BP, WORK, NWORK, RWORK, LRWORK,
375 $ IWORK, LIWORK, RESULT, INFO )
376*
377 IMPLICIT NONE
378*
379* -- LAPACK test routine --
380* -- LAPACK is a software package provided by Univ. of Tennessee, --
381* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
382*
383* .. Scalar Arguments ..
384 INTEGER INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
385 $ NSIZES, NTYPES, NWORK
386 DOUBLE PRECISION THRESH
387* ..
388* .. Array Arguments ..
389 LOGICAL DOTYPE( * )
390 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
391 DOUBLE PRECISION D( * ), D2( * ), RESULT( * ), RWORK( * )
392 COMPLEX*16 A( LDA, * ), AB( LDA, * ), AP( * ),
393 $ b( ldb, * ), bb( ldb, * ), bp( * ), work( * ),
394 $ z( ldz, * )
395* ..
396*
397* =====================================================================
398*
399* .. Parameters ..
400 DOUBLE PRECISION ZERO, ONE, TEN
401 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0, ten = 10.0d+0 )
402 COMPLEX*16 CZERO, CONE
403 parameter( czero = ( 0.0d+0, 0.0d+0 ),
404 $ cone = ( 1.0d+0, 0.0d+0 ) )
405 INTEGER MAXTYP
406 parameter( maxtyp = 21 )
407* ..
408* .. Local Scalars ..
409 LOGICAL BADNN
410 CHARACTER UPLO
411 INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
412 $ itype, iu, j, jcol, jsize, jtype, ka, ka9, kb,
413 $ kb9, m, mtypes, n, nerrs, nmats, nmax, ntest,
414 $ ntestt
415 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
416 $ RTUNFL, ULP, ULPINV, UNFL, VL, VU, TEMP1, TEMP2
417* ..
418* .. Local Arrays ..
419 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
420 $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
421 $ KTYPE( MAXTYP )
422* ..
423* .. External Functions ..
424 LOGICAL LSAME
425 DOUBLE PRECISION DLAMCH, DLARND
426 EXTERNAL LSAME, DLAMCH, DLARND
427* ..
428* .. External Subroutines ..
429 EXTERNAL dlabad, dlafts, dlasum, xerbla, zhbgv, zhbgvd,
430 $ zhbgvx, zhegv, zhegvd, zhegvx, zhpgv, zhpgvd,
431 $ zhpgvx, zlacpy, zlaset, zlatmr, zlatms, zsgt01,
432 $ zhegv_2stage
433* ..
434* .. Intrinsic Functions ..
435 INTRINSIC abs, dble, max, min, sqrt
436* ..
437* .. Data statements ..
438 DATA ktype / 1, 2, 5*4, 5*5, 3*8, 6*9 /
439 DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
440 $ 2, 3, 6*1 /
441 DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
442 $ 0, 0, 6*4 /
443* ..
444* .. Executable Statements ..
445*
446* 1) Check for errors
447*
448 ntestt = 0
449 info = 0
450*
451 badnn = .false.
452 nmax = 0
453 DO 10 j = 1, nsizes
454 nmax = max( nmax, nn( j ) )
455 IF( nn( j ).LT.0 )
456 $ badnn = .true.
457 10 CONTINUE
458*
459* Check for errors
460*
461 IF( nsizes.LT.0 ) THEN
462 info = -1
463 ELSE IF( badnn ) THEN
464 info = -2
465 ELSE IF( ntypes.LT.0 ) THEN
466 info = -3
467 ELSE IF( lda.LE.1 .OR. lda.LT.nmax ) THEN
468 info = -9
469 ELSE IF( ldz.LE.1 .OR. ldz.LT.nmax ) THEN
470 info = -16
471 ELSE IF( 2*max( nmax, 2 )**2.GT.nwork ) THEN
472 info = -21
473 ELSE IF( 2*max( nmax, 2 )**2.GT.lrwork ) THEN
474 info = -23
475 ELSE IF( 2*max( nmax, 2 )**2.GT.liwork ) THEN
476 info = -25
477 END IF
478*
479 IF( info.NE.0 ) THEN
480 CALL xerbla( 'ZDRVSG2STG', -info )
481 RETURN
482 END IF
483*
484* Quick return if possible
485*
486 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
487 $ RETURN
488*
489* More Important constants
490*
491 unfl = dlamch( 'Safe minimum' )
492 ovfl = dlamch( 'Overflow' )
493 CALL dlabad( unfl, ovfl )
494 ulp = dlamch( 'Epsilon' )*dlamch( 'Base' )
495 ulpinv = one / ulp
496 rtunfl = sqrt( unfl )
497 rtovfl = sqrt( ovfl )
498*
499 DO 20 i = 1, 4
500 iseed2( i ) = iseed( i )
501 20 CONTINUE
502*
503* Loop over sizes, types
504*
505 nerrs = 0
506 nmats = 0
507*
508 DO 650 jsize = 1, nsizes
509 n = nn( jsize )
510 aninv = one / dble( max( 1, n ) )
511*
512 IF( nsizes.NE.1 ) THEN
513 mtypes = min( maxtyp, ntypes )
514 ELSE
515 mtypes = min( maxtyp+1, ntypes )
516 END IF
517*
518 ka9 = 0
519 kb9 = 0
520 DO 640 jtype = 1, mtypes
521 IF( .NOT.dotype( jtype ) )
522 $ GO TO 640
523 nmats = nmats + 1
524 ntest = 0
525*
526 DO 30 j = 1, 4
527 ioldsd( j ) = iseed( j )
528 30 CONTINUE
529*
530* 2) Compute "A"
531*
532* Control parameters:
533*
534* KMAGN KMODE KTYPE
535* =1 O(1) clustered 1 zero
536* =2 large clustered 2 identity
537* =3 small exponential (none)
538* =4 arithmetic diagonal, w/ eigenvalues
539* =5 random log hermitian, w/ eigenvalues
540* =6 random (none)
541* =7 random diagonal
542* =8 random hermitian
543* =9 banded, w/ eigenvalues
544*
545 IF( mtypes.GT.maxtyp )
546 $ GO TO 90
547*
548 itype = ktype( jtype )
549 imode = kmode( jtype )
550*
551* Compute norm
552*
553 GO TO ( 40, 50, 60 )kmagn( jtype )
554*
555 40 CONTINUE
556 anorm = one
557 GO TO 70
558*
559 50 CONTINUE
560 anorm = ( rtovfl*ulp )*aninv
561 GO TO 70
562*
563 60 CONTINUE
564 anorm = rtunfl*n*ulpinv
565 GO TO 70
566*
567 70 CONTINUE
568*
569 iinfo = 0
570 cond = ulpinv
571*
572* Special Matrices -- Identity & Jordan block
573*
574 IF( itype.EQ.1 ) THEN
575*
576* Zero
577*
578 ka = 0
579 kb = 0
580 CALL zlaset( 'Full', lda, n, czero, czero, a, lda )
581*
582 ELSE IF( itype.EQ.2 ) THEN
583*
584* Identity
585*
586 ka = 0
587 kb = 0
588 CALL zlaset( 'Full', lda, n, czero, czero, a, lda )
589 DO 80 jcol = 1, n
590 a( jcol, jcol ) = anorm
591 80 CONTINUE
592*
593 ELSE IF( itype.EQ.4 ) THEN
594*
595* Diagonal Matrix, [Eigen]values Specified
596*
597 ka = 0
598 kb = 0
599 CALL zlatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
600 $ anorm, 0, 0, 'N', a, lda, work, iinfo )
601*
602 ELSE IF( itype.EQ.5 ) THEN
603*
604* Hermitian, eigenvalues specified
605*
606 ka = max( 0, n-1 )
607 kb = ka
608 CALL zlatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
609 $ anorm, n, n, 'N', a, lda, work, iinfo )
610*
611 ELSE IF( itype.EQ.7 ) THEN
612*
613* Diagonal, random eigenvalues
614*
615 ka = 0
616 kb = 0
617 CALL zlatmr( n, n, 'S', iseed, 'H', work, 6, one, cone,
618 $ 'T', 'N', work( n+1 ), 1, one,
619 $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
620 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
621*
622 ELSE IF( itype.EQ.8 ) THEN
623*
624* Hermitian, random eigenvalues
625*
626 ka = max( 0, n-1 )
627 kb = ka
628 CALL zlatmr( n, n, 'S', iseed, 'H', work, 6, one, cone,
629 $ 'T', 'N', work( n+1 ), 1, one,
630 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
631 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
632*
633 ELSE IF( itype.EQ.9 ) THEN
634*
635* Hermitian banded, eigenvalues specified
636*
637* The following values are used for the half-bandwidths:
638*
639* ka = 1 kb = 1
640* ka = 2 kb = 1
641* ka = 2 kb = 2
642* ka = 3 kb = 1
643* ka = 3 kb = 2
644* ka = 3 kb = 3
645*
646 kb9 = kb9 + 1
647 IF( kb9.GT.ka9 ) THEN
648 ka9 = ka9 + 1
649 kb9 = 1
650 END IF
651 ka = max( 0, min( n-1, ka9 ) )
652 kb = max( 0, min( n-1, kb9 ) )
653 CALL zlatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
654 $ anorm, ka, ka, 'N', a, lda, work, iinfo )
655*
656 ELSE
657*
658 iinfo = 1
659 END IF
660*
661 IF( iinfo.NE.0 ) THEN
662 WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
663 $ ioldsd
664 info = abs( iinfo )
665 RETURN
666 END IF
667*
668 90 CONTINUE
669*
670 abstol = unfl + unfl
671 IF( n.LE.1 ) THEN
672 il = 1
673 iu = n
674 ELSE
675 il = 1 + int( ( n-1 )*dlarnd( 1, iseed2 ) )
676 iu = 1 + int( ( n-1 )*dlarnd( 1, iseed2 ) )
677 IF( il.GT.iu ) THEN
678 itemp = il
679 il = iu
680 iu = itemp
681 END IF
682 END IF
683*
684* 3) Call ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD, CHBGVD,
685* ZHEGVX, ZHPGVX and ZHBGVX, do tests.
686*
687* loop over the three generalized problems
688* IBTYPE = 1: A*x = (lambda)*B*x
689* IBTYPE = 2: A*B*x = (lambda)*x
690* IBTYPE = 3: B*A*x = (lambda)*x
691*
692 DO 630 ibtype = 1, 3
693*
694* loop over the setting UPLO
695*
696 DO 620 ibuplo = 1, 2
697 IF( ibuplo.EQ.1 )
698 $ uplo = 'U'
699 IF( ibuplo.EQ.2 )
700 $ uplo = 'L'
701*
702* Generate random well-conditioned positive definite
703* matrix B, of bandwidth not greater than that of A.
704*
705 CALL zlatms( n, n, 'U', iseed, 'P', rwork, 5, ten,
706 $ one, kb, kb, uplo, b, ldb, work( n+1 ),
707 $ iinfo )
708*
709* Test ZHEGV
710*
711 ntest = ntest + 1
712*
713 CALL zlacpy( ' ', n, n, a, lda, z, ldz )
714 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
715*
716 CALL zhegv( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
717 $ work, nwork, rwork, iinfo )
718 IF( iinfo.NE.0 ) THEN
719 WRITE( nounit, fmt = 9999 )'ZHEGV(V,' // uplo //
720 $ ')', iinfo, n, jtype, ioldsd
721 info = abs( iinfo )
722 IF( iinfo.LT.0 ) THEN
723 RETURN
724 ELSE
725 result( ntest ) = ulpinv
726 GO TO 100
727 END IF
728 END IF
729*
730* Do Test
731*
732 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
733 $ ldz, d, work, rwork, result( ntest ) )
734*
735* Test ZHEGV_2STAGE
736*
737 ntest = ntest + 1
738*
739 CALL zlacpy( ' ', n, n, a, lda, z, ldz )
740 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
741*
742 CALL zhegv_2stage( ibtype, 'N', uplo, n, z, ldz,
743 $ bb, ldb, d2, work, nwork, rwork,
744 $ iinfo )
745 IF( iinfo.NE.0 ) THEN
746 WRITE( nounit, fmt = 9999 )
747 $ 'ZHEGV_2STAGE(V,' // uplo //
748 $ ')', iinfo, n, jtype, ioldsd
749 info = abs( iinfo )
750 IF( iinfo.LT.0 ) THEN
751 RETURN
752 ELSE
753 result( ntest ) = ulpinv
754 GO TO 100
755 END IF
756 END IF
757*
758* Do Test
759*
760C CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
761C $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
762*
763* Do Tests | D1 - D2 | / ( |D1| ulp )
764* D1 computed using the standard 1-stage reduction as reference
765* D2 computed using the 2-stage reduction
766*
767 temp1 = zero
768 temp2 = zero
769 DO 151 j = 1, n
770 temp1 = max( temp1, abs( d( j ) ),
771 $ abs( d2( j ) ) )
772 temp2 = max( temp2, abs( d( j )-d2( j ) ) )
773 151 CONTINUE
774*
775 result( ntest ) = temp2 /
776 $ max( unfl, ulp*max( temp1, temp2 ) )
777*
778* Test ZHEGVD
779*
780 ntest = ntest + 1
781*
782 CALL zlacpy( ' ', n, n, a, lda, z, ldz )
783 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
784*
785 CALL zhegvd( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
786 $ work, nwork, rwork, lrwork, iwork,
787 $ liwork, iinfo )
788 IF( iinfo.NE.0 ) THEN
789 WRITE( nounit, fmt = 9999 )'ZHEGVD(V,' // uplo //
790 $ ')', iinfo, n, jtype, ioldsd
791 info = abs( iinfo )
792 IF( iinfo.LT.0 ) THEN
793 RETURN
794 ELSE
795 result( ntest ) = ulpinv
796 GO TO 100
797 END IF
798 END IF
799*
800* Do Test
801*
802 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
803 $ ldz, d, work, rwork, result( ntest ) )
804*
805* Test ZHEGVX
806*
807 ntest = ntest + 1
808*
809 CALL zlacpy( ' ', n, n, a, lda, ab, lda )
810 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
811*
812 CALL zhegvx( ibtype, 'V', 'A', uplo, n, ab, lda, bb,
813 $ ldb, vl, vu, il, iu, abstol, m, d, z,
814 $ ldz, work, nwork, rwork, iwork( n+1 ),
815 $ iwork, iinfo )
816 IF( iinfo.NE.0 ) THEN
817 WRITE( nounit, fmt = 9999 )'ZHEGVX(V,A' // uplo //
818 $ ')', iinfo, n, jtype, ioldsd
819 info = abs( iinfo )
820 IF( iinfo.LT.0 ) THEN
821 RETURN
822 ELSE
823 result( ntest ) = ulpinv
824 GO TO 100
825 END IF
826 END IF
827*
828* Do Test
829*
830 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
831 $ ldz, d, work, rwork, result( ntest ) )
832*
833 ntest = ntest + 1
834*
835 CALL zlacpy( ' ', n, n, a, lda, ab, lda )
836 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
837*
838* since we do not know the exact eigenvalues of this
839* eigenpair, we just set VL and VU as constants.
840* It is quite possible that there are no eigenvalues
841* in this interval.
842*
843 vl = zero
844 vu = anorm
845 CALL zhegvx( ibtype, 'V', 'V', uplo, n, ab, lda, bb,
846 $ ldb, vl, vu, il, iu, abstol, m, d, z,
847 $ ldz, work, nwork, rwork, iwork( n+1 ),
848 $ iwork, iinfo )
849 IF( iinfo.NE.0 ) THEN
850 WRITE( nounit, fmt = 9999 )'ZHEGVX(V,V,' //
851 $ uplo // ')', iinfo, n, jtype, ioldsd
852 info = abs( iinfo )
853 IF( iinfo.LT.0 ) THEN
854 RETURN
855 ELSE
856 result( ntest ) = ulpinv
857 GO TO 100
858 END IF
859 END IF
860*
861* Do Test
862*
863 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
864 $ ldz, d, work, rwork, result( ntest ) )
865*
866 ntest = ntest + 1
867*
868 CALL zlacpy( ' ', n, n, a, lda, ab, lda )
869 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
870*
871 CALL zhegvx( ibtype, 'V', 'I', uplo, n, ab, lda, bb,
872 $ ldb, vl, vu, il, iu, abstol, m, d, z,
873 $ ldz, work, nwork, rwork, iwork( n+1 ),
874 $ iwork, iinfo )
875 IF( iinfo.NE.0 ) THEN
876 WRITE( nounit, fmt = 9999 )'ZHEGVX(V,I,' //
877 $ uplo // ')', iinfo, n, jtype, ioldsd
878 info = abs( iinfo )
879 IF( iinfo.LT.0 ) THEN
880 RETURN
881 ELSE
882 result( ntest ) = ulpinv
883 GO TO 100
884 END IF
885 END IF
886*
887* Do Test
888*
889 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
890 $ ldz, d, work, rwork, result( ntest ) )
891*
892 100 CONTINUE
893*
894* Test ZHPGV
895*
896 ntest = ntest + 1
897*
898* Copy the matrices into packed storage.
899*
900 IF( lsame( uplo, 'U' ) ) THEN
901 ij = 1
902 DO 120 j = 1, n
903 DO 110 i = 1, j
904 ap( ij ) = a( i, j )
905 bp( ij ) = b( i, j )
906 ij = ij + 1
907 110 CONTINUE
908 120 CONTINUE
909 ELSE
910 ij = 1
911 DO 140 j = 1, n
912 DO 130 i = j, n
913 ap( ij ) = a( i, j )
914 bp( ij ) = b( i, j )
915 ij = ij + 1
916 130 CONTINUE
917 140 CONTINUE
918 END IF
919*
920 CALL zhpgv( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
921 $ work, rwork, iinfo )
922 IF( iinfo.NE.0 ) THEN
923 WRITE( nounit, fmt = 9999 )'ZHPGV(V,' // uplo //
924 $ ')', iinfo, n, jtype, ioldsd
925 info = abs( iinfo )
926 IF( iinfo.LT.0 ) THEN
927 RETURN
928 ELSE
929 result( ntest ) = ulpinv
930 GO TO 310
931 END IF
932 END IF
933*
934* Do Test
935*
936 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
937 $ ldz, d, work, rwork, result( ntest ) )
938*
939* Test ZHPGVD
940*
941 ntest = ntest + 1
942*
943* Copy the matrices into packed storage.
944*
945 IF( lsame( uplo, 'U' ) ) THEN
946 ij = 1
947 DO 160 j = 1, n
948 DO 150 i = 1, j
949 ap( ij ) = a( i, j )
950 bp( ij ) = b( i, j )
951 ij = ij + 1
952 150 CONTINUE
953 160 CONTINUE
954 ELSE
955 ij = 1
956 DO 180 j = 1, n
957 DO 170 i = j, n
958 ap( ij ) = a( i, j )
959 bp( ij ) = b( i, j )
960 ij = ij + 1
961 170 CONTINUE
962 180 CONTINUE
963 END IF
964*
965 CALL zhpgvd( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
966 $ work, nwork, rwork, lrwork, iwork,
967 $ liwork, iinfo )
968 IF( iinfo.NE.0 ) THEN
969 WRITE( nounit, fmt = 9999 )'ZHPGVD(V,' // uplo //
970 $ ')', iinfo, n, jtype, ioldsd
971 info = abs( iinfo )
972 IF( iinfo.LT.0 ) THEN
973 RETURN
974 ELSE
975 result( ntest ) = ulpinv
976 GO TO 310
977 END IF
978 END IF
979*
980* Do Test
981*
982 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
983 $ ldz, d, work, rwork, result( ntest ) )
984*
985* Test ZHPGVX
986*
987 ntest = ntest + 1
988*
989* Copy the matrices into packed storage.
990*
991 IF( lsame( uplo, 'U' ) ) THEN
992 ij = 1
993 DO 200 j = 1, n
994 DO 190 i = 1, j
995 ap( ij ) = a( i, j )
996 bp( ij ) = b( i, j )
997 ij = ij + 1
998 190 CONTINUE
999 200 CONTINUE
1000 ELSE
1001 ij = 1
1002 DO 220 j = 1, n
1003 DO 210 i = j, n
1004 ap( ij ) = a( i, j )
1005 bp( ij ) = b( i, j )
1006 ij = ij + 1
1007 210 CONTINUE
1008 220 CONTINUE
1009 END IF
1010*
1011 CALL zhpgvx( ibtype, 'V', 'A', uplo, n, ap, bp, vl,
1012 $ vu, il, iu, abstol, m, d, z, ldz, work,
1013 $ rwork, iwork( n+1 ), iwork, info )
1014 IF( iinfo.NE.0 ) THEN
1015 WRITE( nounit, fmt = 9999 )'ZHPGVX(V,A' // uplo //
1016 $ ')', iinfo, n, jtype, ioldsd
1017 info = abs( iinfo )
1018 IF( iinfo.LT.0 ) THEN
1019 RETURN
1020 ELSE
1021 result( ntest ) = ulpinv
1022 GO TO 310
1023 END IF
1024 END IF
1025*
1026* Do Test
1027*
1028 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1029 $ ldz, d, work, rwork, result( ntest ) )
1030*
1031 ntest = ntest + 1
1032*
1033* Copy the matrices into packed storage.
1034*
1035 IF( lsame( uplo, 'U' ) ) THEN
1036 ij = 1
1037 DO 240 j = 1, n
1038 DO 230 i = 1, j
1039 ap( ij ) = a( i, j )
1040 bp( ij ) = b( i, j )
1041 ij = ij + 1
1042 230 CONTINUE
1043 240 CONTINUE
1044 ELSE
1045 ij = 1
1046 DO 260 j = 1, n
1047 DO 250 i = j, n
1048 ap( ij ) = a( i, j )
1049 bp( ij ) = b( i, j )
1050 ij = ij + 1
1051 250 CONTINUE
1052 260 CONTINUE
1053 END IF
1054*
1055 vl = zero
1056 vu = anorm
1057 CALL zhpgvx( ibtype, 'V', 'V', uplo, n, ap, bp, vl,
1058 $ vu, il, iu, abstol, m, d, z, ldz, work,
1059 $ rwork, iwork( n+1 ), iwork, info )
1060 IF( iinfo.NE.0 ) THEN
1061 WRITE( nounit, fmt = 9999 )'ZHPGVX(V,V' // uplo //
1062 $ ')', iinfo, n, jtype, ioldsd
1063 info = abs( iinfo )
1064 IF( iinfo.LT.0 ) THEN
1065 RETURN
1066 ELSE
1067 result( ntest ) = ulpinv
1068 GO TO 310
1069 END IF
1070 END IF
1071*
1072* Do Test
1073*
1074 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1075 $ ldz, d, work, rwork, result( ntest ) )
1076*
1077 ntest = ntest + 1
1078*
1079* Copy the matrices into packed storage.
1080*
1081 IF( lsame( uplo, 'U' ) ) THEN
1082 ij = 1
1083 DO 280 j = 1, n
1084 DO 270 i = 1, j
1085 ap( ij ) = a( i, j )
1086 bp( ij ) = b( i, j )
1087 ij = ij + 1
1088 270 CONTINUE
1089 280 CONTINUE
1090 ELSE
1091 ij = 1
1092 DO 300 j = 1, n
1093 DO 290 i = j, n
1094 ap( ij ) = a( i, j )
1095 bp( ij ) = b( i, j )
1096 ij = ij + 1
1097 290 CONTINUE
1098 300 CONTINUE
1099 END IF
1100*
1101 CALL zhpgvx( ibtype, 'V', 'I', uplo, n, ap, bp, vl,
1102 $ vu, il, iu, abstol, m, d, z, ldz, work,
1103 $ rwork, iwork( n+1 ), iwork, info )
1104 IF( iinfo.NE.0 ) THEN
1105 WRITE( nounit, fmt = 9999 )'ZHPGVX(V,I' // uplo //
1106 $ ')', 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 310
1113 END IF
1114 END IF
1115*
1116* Do Test
1117*
1118 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1119 $ ldz, d, work, rwork, result( ntest ) )
1120*
1121 310 CONTINUE
1122*
1123 IF( ibtype.EQ.1 ) THEN
1124*
1125* TEST ZHBGV
1126*
1127 ntest = ntest + 1
1128*
1129* Copy the matrices into band storage.
1130*
1131 IF( lsame( uplo, 'U' ) ) THEN
1132 DO 340 j = 1, n
1133 DO 320 i = max( 1, j-ka ), j
1134 ab( ka+1+i-j, j ) = a( i, j )
1135 320 CONTINUE
1136 DO 330 i = max( 1, j-kb ), j
1137 bb( kb+1+i-j, j ) = b( i, j )
1138 330 CONTINUE
1139 340 CONTINUE
1140 ELSE
1141 DO 370 j = 1, n
1142 DO 350 i = j, min( n, j+ka )
1143 ab( 1+i-j, j ) = a( i, j )
1144 350 CONTINUE
1145 DO 360 i = j, min( n, j+kb )
1146 bb( 1+i-j, j ) = b( i, j )
1147 360 CONTINUE
1148 370 CONTINUE
1149 END IF
1150*
1151 CALL zhbgv( 'V', uplo, n, ka, kb, ab, lda, bb, ldb,
1152 $ d, z, ldz, work, rwork, iinfo )
1153 IF( iinfo.NE.0 ) THEN
1154 WRITE( nounit, fmt = 9999 )'ZHBGV(V,' //
1155 $ uplo // ')', iinfo, n, jtype, ioldsd
1156 info = abs( iinfo )
1157 IF( iinfo.LT.0 ) THEN
1158 RETURN
1159 ELSE
1160 result( ntest ) = ulpinv
1161 GO TO 620
1162 END IF
1163 END IF
1164*
1165* Do Test
1166*
1167 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1168 $ ldz, d, work, rwork, result( ntest ) )
1169*
1170* TEST ZHBGVD
1171*
1172 ntest = ntest + 1
1173*
1174* Copy the matrices into band storage.
1175*
1176 IF( lsame( uplo, 'U' ) ) THEN
1177 DO 400 j = 1, n
1178 DO 380 i = max( 1, j-ka ), j
1179 ab( ka+1+i-j, j ) = a( i, j )
1180 380 CONTINUE
1181 DO 390 i = max( 1, j-kb ), j
1182 bb( kb+1+i-j, j ) = b( i, j )
1183 390 CONTINUE
1184 400 CONTINUE
1185 ELSE
1186 DO 430 j = 1, n
1187 DO 410 i = j, min( n, j+ka )
1188 ab( 1+i-j, j ) = a( i, j )
1189 410 CONTINUE
1190 DO 420 i = j, min( n, j+kb )
1191 bb( 1+i-j, j ) = b( i, j )
1192 420 CONTINUE
1193 430 CONTINUE
1194 END IF
1195*
1196 CALL zhbgvd( 'V', uplo, n, ka, kb, ab, lda, bb,
1197 $ ldb, d, z, ldz, work, nwork, rwork,
1198 $ lrwork, iwork, liwork, iinfo )
1199 IF( iinfo.NE.0 ) THEN
1200 WRITE( nounit, fmt = 9999 )'ZHBGVD(V,' //
1201 $ uplo // ')', iinfo, n, jtype, ioldsd
1202 info = abs( iinfo )
1203 IF( iinfo.LT.0 ) THEN
1204 RETURN
1205 ELSE
1206 result( ntest ) = ulpinv
1207 GO TO 620
1208 END IF
1209 END IF
1210*
1211* Do Test
1212*
1213 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1214 $ ldz, d, work, rwork, result( ntest ) )
1215*
1216* Test ZHBGVX
1217*
1218 ntest = ntest + 1
1219*
1220* Copy the matrices into band storage.
1221*
1222 IF( lsame( uplo, 'U' ) ) THEN
1223 DO 460 j = 1, n
1224 DO 440 i = max( 1, j-ka ), j
1225 ab( ka+1+i-j, j ) = a( i, j )
1226 440 CONTINUE
1227 DO 450 i = max( 1, j-kb ), j
1228 bb( kb+1+i-j, j ) = b( i, j )
1229 450 CONTINUE
1230 460 CONTINUE
1231 ELSE
1232 DO 490 j = 1, n
1233 DO 470 i = j, min( n, j+ka )
1234 ab( 1+i-j, j ) = a( i, j )
1235 470 CONTINUE
1236 DO 480 i = j, min( n, j+kb )
1237 bb( 1+i-j, j ) = b( i, j )
1238 480 CONTINUE
1239 490 CONTINUE
1240 END IF
1241*
1242 CALL zhbgvx( 'V', 'A', uplo, n, ka, kb, ab, lda,
1243 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1244 $ iu, abstol, m, d, z, ldz, work, rwork,
1245 $ iwork( n+1 ), iwork, iinfo )
1246 IF( iinfo.NE.0 ) THEN
1247 WRITE( nounit, fmt = 9999 )'ZHBGVX(V,A' //
1248 $ uplo // ')', iinfo, n, jtype, ioldsd
1249 info = abs( iinfo )
1250 IF( iinfo.LT.0 ) THEN
1251 RETURN
1252 ELSE
1253 result( ntest ) = ulpinv
1254 GO TO 620
1255 END IF
1256 END IF
1257*
1258* Do Test
1259*
1260 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1261 $ ldz, d, work, rwork, result( ntest ) )
1262*
1263 ntest = ntest + 1
1264*
1265* Copy the matrices into band storage.
1266*
1267 IF( lsame( uplo, 'U' ) ) THEN
1268 DO 520 j = 1, n
1269 DO 500 i = max( 1, j-ka ), j
1270 ab( ka+1+i-j, j ) = a( i, j )
1271 500 CONTINUE
1272 DO 510 i = max( 1, j-kb ), j
1273 bb( kb+1+i-j, j ) = b( i, j )
1274 510 CONTINUE
1275 520 CONTINUE
1276 ELSE
1277 DO 550 j = 1, n
1278 DO 530 i = j, min( n, j+ka )
1279 ab( 1+i-j, j ) = a( i, j )
1280 530 CONTINUE
1281 DO 540 i = j, min( n, j+kb )
1282 bb( 1+i-j, j ) = b( i, j )
1283 540 CONTINUE
1284 550 CONTINUE
1285 END IF
1286*
1287 vl = zero
1288 vu = anorm
1289 CALL zhbgvx( 'V', 'V', uplo, n, ka, kb, ab, lda,
1290 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1291 $ iu, abstol, m, d, z, ldz, work, rwork,
1292 $ iwork( n+1 ), iwork, iinfo )
1293 IF( iinfo.NE.0 ) THEN
1294 WRITE( nounit, fmt = 9999 )'ZHBGVX(V,V' //
1295 $ uplo // ')', iinfo, n, jtype, ioldsd
1296 info = abs( iinfo )
1297 IF( iinfo.LT.0 ) THEN
1298 RETURN
1299 ELSE
1300 result( ntest ) = ulpinv
1301 GO TO 620
1302 END IF
1303 END IF
1304*
1305* Do Test
1306*
1307 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1308 $ ldz, d, work, rwork, result( ntest ) )
1309*
1310 ntest = ntest + 1
1311*
1312* Copy the matrices into band storage.
1313*
1314 IF( lsame( uplo, 'U' ) ) THEN
1315 DO 580 j = 1, n
1316 DO 560 i = max( 1, j-ka ), j
1317 ab( ka+1+i-j, j ) = a( i, j )
1318 560 CONTINUE
1319 DO 570 i = max( 1, j-kb ), j
1320 bb( kb+1+i-j, j ) = b( i, j )
1321 570 CONTINUE
1322 580 CONTINUE
1323 ELSE
1324 DO 610 j = 1, n
1325 DO 590 i = j, min( n, j+ka )
1326 ab( 1+i-j, j ) = a( i, j )
1327 590 CONTINUE
1328 DO 600 i = j, min( n, j+kb )
1329 bb( 1+i-j, j ) = b( i, j )
1330 600 CONTINUE
1331 610 CONTINUE
1332 END IF
1333*
1334 CALL zhbgvx( 'V', 'I', uplo, n, ka, kb, ab, lda,
1335 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1336 $ iu, abstol, m, d, z, ldz, work, rwork,
1337 $ iwork( n+1 ), iwork, iinfo )
1338 IF( iinfo.NE.0 ) THEN
1339 WRITE( nounit, fmt = 9999 )'ZHBGVX(V,I' //
1340 $ uplo // ')', IINFO, N, JTYPE, IOLDSD
1341 INFO = ABS( IINFO )
1342.LT. IF( IINFO0 ) THEN
1343 RETURN
1344 ELSE
1345 RESULT( NTEST ) = ULPINV
1346 GO TO 620
1347 END IF
1348 END IF
1349*
1350* Do Test
1351*
1352 CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
1353 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
1354*
1355 END IF
1356*
1357 620 CONTINUE
1358 630 CONTINUE
1359*
1360* End of Loop -- Check for RESULT(j) > THRESH
1361*
1362 NTESTT = NTESTT + NTEST
1363 CALL DLAFTS( 'zsg', N, N, JTYPE, NTEST, RESULT, IOLDSD,
1364 $ THRESH, NOUNIT, NERRS )
1365 640 CONTINUE
1366 650 CONTINUE
1367*
1368* Summary
1369*
1370 CALL DLASUM( 'zsg', NOUNIT, NERRS, NTESTT )
1371*
1372 RETURN
1373*
1374 9999 FORMAT( ' zdrvsg2stg: ', A, ' returned info=', I6, '.', / 9X,
1375 $ 'n=', I6, ', jtype=', I6, ', iseed=(', 3( I5, ',' ), I5, ')' )
1376*
1377* End of ZDRVSG2STG
1378*
1379 END
dlabad
subroutine dlabad(small, large)
DLABAD
Definition dlabad.f:74
xerbla
subroutine xerbla(srname, info)
XERBLA
Definition xerbla.f:60
zhegvd
subroutine zhegvd(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork, lrwork, iwork, liwork, info)
ZHEGVD
Definition zhegvd.f:249
zhegv_2stage
subroutine zhegv_2stage(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork, info)
ZHEGV_2STAGE
Definition zhegv_2stage.f:232
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:307
zhegv
subroutine zhegv(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork, info)
ZHEGV
Definition zhegv.f:181
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:103
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:106
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:300
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:252
zhpgvd
subroutine zhpgvd(itype, jobz, uplo, n, ap, bp, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
ZHPGVD
Definition zhpgvd.f:231
zhbgv
subroutine zhbgv(jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, rwork, info)
ZHBGV
Definition zhbgv.f:183
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:277
zhpgv
subroutine zhpgv(itype, jobz, uplo, n, ap, bp, w, z, ldz, work, rwork, info)
ZHPGV
Definition zhpgv.f:165
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:376
zsgt01
subroutine zsgt01(itype, uplo, n, m, a, lda, b, ldb, z, ldz, d, work, rwork, result)
ZSGT01
Definition zsgt01.f:152
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:490
zlatms
subroutine zlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
ZLATMS
Definition zlatms.f:332
dlasum
subroutine dlasum(type, iounit, ie, nrun)
DLASUM
Definition dlasum.f:43
dlafts
subroutine dlafts(type, m, n, imat, ntests, result, iseed, thresh, iounit, ie)
DLAFTS
Definition dlafts.f:99
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21