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