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