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