LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sdrvsg2stg.f
Go to the documentation of this file.
1*> \brief \b SDRVSG2STG
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 SDRVSG2STG( 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* REAL THRESH
21* ..
22* .. Array Arguments ..
23* LOGICAL DOTYPE( * )
24* INTEGER ISEED( 4 ), IWORK( * ), NN( * )
25* REAL 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*> SDRVSG2STG checks the real symmetric generalized eigenproblem
37*> drivers.
38*>
39*> SSYGV computes all eigenvalues and, optionally,
40*> eigenvectors of a real symmetric-definite generalized
41*> eigenproblem.
42*>
43*> SSYGVD computes all eigenvalues and, optionally,
44*> eigenvectors of a real symmetric-definite generalized
45*> eigenproblem using a divide and conquer algorithm.
46*>
47*> SSYGVX computes selected eigenvalues and, optionally,
48*> eigenvectors of a real symmetric-definite generalized
49*> eigenproblem.
50*>
51*> SSPGV computes all eigenvalues and, optionally,
52*> eigenvectors of a real symmetric-definite generalized
53*> eigenproblem in packed storage.
54*>
55*> SSPGVD 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*> SSPGVX computes selected eigenvalues and, optionally,
61*> eigenvectors of a real symmetric-definite generalized
62*> eigenproblem in packed storage.
63*>
64*> SSBGV computes all eigenvalues and, optionally,
65*> eigenvectors of a real symmetric-definite banded
66*> generalized eigenproblem.
67*>
68*> SSBGVD 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*> SSBGVX computes selected eigenvalues and, optionally,
74*> eigenvectors of a real symmetric-definite banded
75*> generalized eigenproblem.
76*>
77*> When SDRVSG2STG 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) SSYGV 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*> SSYGV and D2 is computed by
90*> SSYGV_2STAGE. This test is
91*> only performed for SSYGV
92*>
93*> (2) as (1) but calling SSPGV
94*> (3) as (1) but calling SSBGV
95*> (4) as (1) but with UPLO = 'L'
96*> (5) as (4) but calling SSPGV
97*> (6) as (4) but calling SSBGV
98*>
99*> (7) SSYGV with ITYPE = 2 and UPLO ='U':
100*>
101*> | A B Z - Z D | / ( |A| |Z| n ulp )
102*>
103*> (8) as (7) but calling SSPGV
104*> (9) as (7) but with UPLO = 'L'
105*> (10) as (9) but calling SSPGV
106*>
107*> (11) SSYGV with ITYPE = 3 and UPLO ='U':
108*>
109*> | B A Z - Z D | / ( |A| |Z| n ulp )
110*>
111*> (12) as (11) but calling SSPGV
112*> (13) as (11) but with UPLO = 'L'
113*> (14) as (13) but calling SSPGV
114*>
115*> SSYGVD, SSPGVD and SSBGVD performed the same 14 tests.
116*>
117*> SSYGVX, SSPGVX and SSBGVX 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*> SDRVSG2STG 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, SDRVSG2STG
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 SDRVSG2STG to continue the same random number
213*> sequence.
214*> Modified.
215*>
216*> THRESH REAL
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. real)
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 REAL 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 REAL 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 REAL 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 REAL 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 REAL array, dimension (LDA, max(NN))
268*> Workspace.
269*> Modified.
270*>
271*> BB REAL array, dimension (LDB, max(NN))
272*> Workspace.
273*> Modified.
274*>
275*> AP REAL array, dimension (max(NN)**2)
276*> Workspace.
277*> Modified.
278*>
279*> BP REAL array, dimension (max(NN)**2)
280*> Workspace.
281*> Modified.
282*>
283*> WORK REAL 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 REAL 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 SLATMR, SLATMS, SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD,
316*> SSBGVD, SSYGVX, SSPGVX 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 SLAFTS).
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 real_eig
356*
357* =====================================================================
358 SUBROUTINE sdrvsg2stg( 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 REAL THRESH
373* ..
374* .. Array Arguments ..
375 LOGICAL DOTYPE( * )
376 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
377 REAL 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 REAL ZERO, ONE, TEN
386 PARAMETER ( ZERO = 0.0e0, one = 1.0e0, ten = 10.0e0 )
387 INTEGER MAXTYP
388 parameter( maxtyp = 21 )
389* ..
390* .. Local Scalars ..
391 LOGICAL BADNN
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 REAL 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 REAL SLAMCH, SLARND
408 EXTERNAL LSAME, SLAMCH, SLARND
409* ..
410* .. External Subroutines ..
411 EXTERNAL slabad, slacpy, slafts, slaset, slasum, slatmr,
415* ..
416* .. Intrinsic Functions ..
417 INTRINSIC abs, real, 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*
433 badnn = .false.
434 nmax = 0
435 DO 10 j = 1, nsizes
436 nmax = max( nmax, nn( j ) )
437 IF( nn( j ).LT.0 )
438 $ badnn = .true.
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( 'SDRVSG2STG', -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 = slamch( 'Safe minimum' )
472 ovfl = slamch( 'Overflow' )
473 CALL slabad( unfl, ovfl )
474 ulp = slamch( 'Epsilon' )*slamch( '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 / real( 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 slaset( '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 slaset( '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 slatms( 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 slatms( 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 slatmr( 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 slatmr( 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 slatms( 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 )*slarnd( 1, iseed2 ) )
659 iu = 1 + int( ( n-1 )*slarnd( 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 SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD, SSBGVD,
668* SSYGVX, SSPGVX, and SSBGVX, 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 slatms( n, n, 'U', iseed, 'P', work, 5, ten, one,
689 $ kb, kb, uplo, b, ldb, work( n+1 ),
690 $ iinfo )
691*
692* Test SSYGV
693*
694 ntest = ntest + 1
695*
696 CALL slacpy( ' ', n, n, a, lda, z, ldz )
697 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
698*
699 CALL ssygv( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
700 $ work, nwork, iinfo )
701 IF( iinfo.NE.0 ) THEN
702 WRITE( nounit, fmt = 9999 )'SSYGV(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 ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
716 $ ldz, d, work, result( ntest ) )
717*
718* Test SSYGV_2STAGE
719*
720 ntest = ntest + 1
721*
722 CALL slacpy( ' ', n, n, a, lda, z, ldz )
723 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
724*
725 CALL ssygv_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 $ 'SSYGV_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 SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
743C $ LDZ, D, WORK, RESULT( NTEST ) )
744*
745*
746* Do Tests | D1 - D2 | / ( |D1| ulp )
747* D1 computed using the standard 1-stage reduction as reference
748* D2 computed using the 2-stage reduction
749*
750 temp1 = zero
751 temp2 = zero
752 DO 151 j = 1, n
753 temp1 = max( temp1, abs( d( j ) ),
754 $ abs( d2( j ) ) )
755 temp2 = max( temp2, abs( d( j )-d2( j ) ) )
756 151 CONTINUE
757*
758 result( ntest ) = temp2 /
759 $ max( unfl, ulp*max( temp1, temp2 ) )
760*
761* Test SSYGVD
762*
763 ntest = ntest + 1
764*
765 CALL slacpy( ' ', n, n, a, lda, z, ldz )
766 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
767*
768 CALL ssygvd( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
769 $ work, nwork, iwork, liwork, iinfo )
770 IF( iinfo.NE.0 ) THEN
771 WRITE( nounit, fmt = 9999 )'SSYGVD(V,' // uplo //
772 $ ')', iinfo, n, jtype, ioldsd
773 info = abs( iinfo )
774 IF( iinfo.LT.0 ) THEN
775 RETURN
776 ELSE
777 result( ntest ) = ulpinv
778 GO TO 100
779 END IF
780 END IF
781*
782* Do Test
783*
784 CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
785 $ ldz, d, work, result( ntest ) )
786*
787* Test SSYGVX
788*
789 ntest = ntest + 1
790*
791 CALL slacpy( ' ', n, n, a, lda, ab, lda )
792 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
793*
794 CALL ssygvx( ibtype, 'V', 'A', uplo, n, ab, lda, bb,
795 $ ldb, vl, vu, il, iu, abstol, m, d, z,
796 $ ldz, work, nwork, iwork( n+1 ), iwork,
797 $ iinfo )
798 IF( iinfo.NE.0 ) THEN
799 WRITE( nounit, fmt = 9999 )'SSYGVX(V,A' // uplo //
800 $ ')', iinfo, n, jtype, ioldsd
801 info = abs( iinfo )
802 IF( iinfo.LT.0 ) THEN
803 RETURN
804 ELSE
805 result( ntest ) = ulpinv
806 GO TO 100
807 END IF
808 END IF
809*
810* Do Test
811*
812 CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
813 $ ldz, d, work, result( ntest ) )
814*
815 ntest = ntest + 1
816*
817 CALL slacpy( ' ', n, n, a, lda, ab, lda )
818 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
819*
820* since we do not know the exact eigenvalues of this
821* eigenpair, we just set VL and VU as constants.
822* It is quite possible that there are no eigenvalues
823* in this interval.
824*
825 vl = zero
826 vu = anorm
827 CALL ssygvx( ibtype, 'V', 'V', uplo, n, ab, lda, bb,
828 $ ldb, vl, vu, il, iu, abstol, m, d, z,
829 $ ldz, work, nwork, iwork( n+1 ), iwork,
830 $ iinfo )
831 IF( iinfo.NE.0 ) THEN
832 WRITE( nounit, fmt = 9999 )'SSYGVX(V,V,' //
833 $ uplo // ')', iinfo, n, jtype, ioldsd
834 info = abs( iinfo )
835 IF( iinfo.LT.0 ) THEN
836 RETURN
837 ELSE
838 result( ntest ) = ulpinv
839 GO TO 100
840 END IF
841 END IF
842*
843* Do Test
844*
845 CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
846 $ ldz, d, work, result( ntest ) )
847*
848 ntest = ntest + 1
849*
850 CALL slacpy( ' ', n, n, a, lda, ab, lda )
851 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
852*
853 CALL ssygvx( ibtype, 'V', 'I', uplo, n, ab, lda, bb,
854 $ ldb, vl, vu, il, iu, abstol, m, d, z,
855 $ ldz, work, nwork, iwork( n+1 ), iwork,
856 $ iinfo )
857 IF( iinfo.NE.0 ) THEN
858 WRITE( nounit, fmt = 9999 )'SSYGVX(V,I,' //
859 $ uplo // ')', iinfo, n, jtype, ioldsd
860 info = abs( iinfo )
861 IF( iinfo.LT.0 ) THEN
862 RETURN
863 ELSE
864 result( ntest ) = ulpinv
865 GO TO 100
866 END IF
867 END IF
868*
869* Do Test
870*
871 CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
872 $ ldz, d, work, result( ntest ) )
873*
874 100 CONTINUE
875*
876* Test SSPGV
877*
878 ntest = ntest + 1
879*
880* Copy the matrices into packed storage.
881*
882 IF( lsame( uplo, 'U' ) ) THEN
883 ij = 1
884 DO 120 j = 1, n
885 DO 110 i = 1, j
886 ap( ij ) = a( i, j )
887 bp( ij ) = b( i, j )
888 ij = ij + 1
889 110 CONTINUE
890 120 CONTINUE
891 ELSE
892 ij = 1
893 DO 140 j = 1, n
894 DO 130 i = j, n
895 ap( ij ) = a( i, j )
896 bp( ij ) = b( i, j )
897 ij = ij + 1
898 130 CONTINUE
899 140 CONTINUE
900 END IF
901*
902 CALL sspgv( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
903 $ work, iinfo )
904 IF( iinfo.NE.0 ) THEN
905 WRITE( nounit, fmt = 9999 )'SSPGV(V,' // uplo //
906 $ ')', iinfo, n, jtype, ioldsd
907 info = abs( iinfo )
908 IF( iinfo.LT.0 ) THEN
909 RETURN
910 ELSE
911 result( ntest ) = ulpinv
912 GO TO 310
913 END IF
914 END IF
915*
916* Do Test
917*
918 CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
919 $ ldz, d, work, result( ntest ) )
920*
921* Test SSPGVD
922*
923 ntest = ntest + 1
924*
925* Copy the matrices into packed storage.
926*
927 IF( lsame( uplo, 'U' ) ) THEN
928 ij = 1
929 DO 160 j = 1, n
930 DO 150 i = 1, j
931 ap( ij ) = a( i, j )
932 bp( ij ) = b( i, j )
933 ij = ij + 1
934 150 CONTINUE
935 160 CONTINUE
936 ELSE
937 ij = 1
938 DO 180 j = 1, n
939 DO 170 i = j, n
940 ap( ij ) = a( i, j )
941 bp( ij ) = b( i, j )
942 ij = ij + 1
943 170 CONTINUE
944 180 CONTINUE
945 END IF
946*
947 CALL sspgvd( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
948 $ work, nwork, iwork, liwork, iinfo )
949 IF( iinfo.NE.0 ) THEN
950 WRITE( nounit, fmt = 9999 )'SSPGVD(V,' // uplo //
951 $ ')', iinfo, n, jtype, ioldsd
952 info = abs( iinfo )
953 IF( iinfo.LT.0 ) THEN
954 RETURN
955 ELSE
956 result( ntest ) = ulpinv
957 GO TO 310
958 END IF
959 END IF
960*
961* Do Test
962*
963 CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
964 $ ldz, d, work, result( ntest ) )
965*
966* Test SSPGVX
967*
968 ntest = ntest + 1
969*
970* Copy the matrices into packed storage.
971*
972 IF( lsame( uplo, 'U' ) ) THEN
973 ij = 1
974 DO 200 j = 1, n
975 DO 190 i = 1, j
976 ap( ij ) = a( i, j )
977 bp( ij ) = b( i, j )
978 ij = ij + 1
979 190 CONTINUE
980 200 CONTINUE
981 ELSE
982 ij = 1
983 DO 220 j = 1, n
984 DO 210 i = j, n
985 ap( ij ) = a( i, j )
986 bp( ij ) = b( i, j )
987 ij = ij + 1
988 210 CONTINUE
989 220 CONTINUE
990 END IF
991*
992 CALL sspgvx( ibtype, 'V', 'A', uplo, n, ap, bp, vl,
993 $ vu, il, iu, abstol, m, d, z, ldz, work,
994 $ iwork( n+1 ), iwork, info )
995 IF( iinfo.NE.0 ) THEN
996 WRITE( nounit, fmt = 9999 )'SSPGVX(V,A' // uplo //
997 $ ')', iinfo, n, jtype, ioldsd
998 info = abs( iinfo )
999 IF( iinfo.LT.0 ) THEN
1000 RETURN
1001 ELSE
1002 result( ntest ) = ulpinv
1003 GO TO 310
1004 END IF
1005 END IF
1006*
1007* Do Test
1008*
1009 CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1010 $ ldz, d, work, result( ntest ) )
1011*
1012 ntest = ntest + 1
1013*
1014* Copy the matrices into packed storage.
1015*
1016 IF( lsame( uplo, 'U' ) ) THEN
1017 ij = 1
1018 DO 240 j = 1, n
1019 DO 230 i = 1, j
1020 ap( ij ) = a( i, j )
1021 bp( ij ) = b( i, j )
1022 ij = ij + 1
1023 230 CONTINUE
1024 240 CONTINUE
1025 ELSE
1026 ij = 1
1027 DO 260 j = 1, n
1028 DO 250 i = j, n
1029 ap( ij ) = a( i, j )
1030 bp( ij ) = b( i, j )
1031 ij = ij + 1
1032 250 CONTINUE
1033 260 CONTINUE
1034 END IF
1035*
1036 vl = zero
1037 vu = anorm
1038 CALL sspgvx( ibtype, 'V', 'V', uplo, n, ap, bp, vl,
1039 $ vu, il, iu, abstol, m, d, z, ldz, work,
1040 $ iwork( n+1 ), iwork, info )
1041 IF( iinfo.NE.0 ) THEN
1042 WRITE( nounit, fmt = 9999 )'SSPGVX(V,V' // uplo //
1043 $ ')', iinfo, n, jtype, ioldsd
1044 info = abs( iinfo )
1045 IF( iinfo.LT.0 ) THEN
1046 RETURN
1047 ELSE
1048 result( ntest ) = ulpinv
1049 GO TO 310
1050 END IF
1051 END IF
1052*
1053* Do Test
1054*
1055 CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1056 $ ldz, d, work, result( ntest ) )
1057*
1058 ntest = ntest + 1
1059*
1060* Copy the matrices into packed storage.
1061*
1062 IF( lsame( uplo, 'U' ) ) THEN
1063 ij = 1
1064 DO 280 j = 1, n
1065 DO 270 i = 1, j
1066 ap( ij ) = a( i, j )
1067 bp( ij ) = b( i, j )
1068 ij = ij + 1
1069 270 CONTINUE
1070 280 CONTINUE
1071 ELSE
1072 ij = 1
1073 DO 300 j = 1, n
1074 DO 290 i = j, n
1075 ap( ij ) = a( i, j )
1076 bp( ij ) = b( i, j )
1077 ij = ij + 1
1078 290 CONTINUE
1079 300 CONTINUE
1080 END IF
1081*
1082 CALL sspgvx( ibtype, 'V', 'I', uplo, n, ap, bp, vl,
1083 $ vu, il, iu, abstol, m, d, z, ldz, work,
1084 $ iwork( n+1 ), iwork, info )
1085 IF( iinfo.NE.0 ) THEN
1086 WRITE( nounit, fmt = 9999 )'SSPGVX(V,I' // uplo //
1087 $ ')', iinfo, n, jtype, ioldsd
1088 info = abs( iinfo )
1089 IF( iinfo.LT.0 ) THEN
1090 RETURN
1091 ELSE
1092 result( ntest ) = ulpinv
1093 GO TO 310
1094 END IF
1095 END IF
1096*
1097* Do Test
1098*
1099 CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1100 $ ldz, d, work, result( ntest ) )
1101*
1102 310 CONTINUE
1103*
1104 IF( ibtype.EQ.1 ) THEN
1105*
1106* TEST SSBGV
1107*
1108 ntest = ntest + 1
1109*
1110* Copy the matrices into band storage.
1111*
1112 IF( lsame( uplo, 'U' ) ) THEN
1113 DO 340 j = 1, n
1114 DO 320 i = max( 1, j-ka ), j
1115 ab( ka+1+i-j, j ) = a( i, j )
1116 320 CONTINUE
1117 DO 330 i = max( 1, j-kb ), j
1118 bb( kb+1+i-j, j ) = b( i, j )
1119 330 CONTINUE
1120 340 CONTINUE
1121 ELSE
1122 DO 370 j = 1, n
1123 DO 350 i = j, min( n, j+ka )
1124 ab( 1+i-j, j ) = a( i, j )
1125 350 CONTINUE
1126 DO 360 i = j, min( n, j+kb )
1127 bb( 1+i-j, j ) = b( i, j )
1128 360 CONTINUE
1129 370 CONTINUE
1130 END IF
1131*
1132 CALL ssbgv( 'V', uplo, n, ka, kb, ab, lda, bb, ldb,
1133 $ d, z, ldz, work, iinfo )
1134 IF( iinfo.NE.0 ) THEN
1135 WRITE( nounit, fmt = 9999 )'SSBGV(V,' //
1136 $ uplo // ')', iinfo, n, jtype, ioldsd
1137 info = abs( iinfo )
1138 IF( iinfo.LT.0 ) THEN
1139 RETURN
1140 ELSE
1141 result( ntest ) = ulpinv
1142 GO TO 620
1143 END IF
1144 END IF
1145*
1146* Do Test
1147*
1148 CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1149 $ ldz, d, work, result( ntest ) )
1150*
1151* TEST SSBGVD
1152*
1153 ntest = ntest + 1
1154*
1155* Copy the matrices into band storage.
1156*
1157 IF( lsame( uplo, 'U' ) ) THEN
1158 DO 400 j = 1, n
1159 DO 380 i = max( 1, j-ka ), j
1160 ab( ka+1+i-j, j ) = a( i, j )
1161 380 CONTINUE
1162 DO 390 i = max( 1, j-kb ), j
1163 bb( kb+1+i-j, j ) = b( i, j )
1164 390 CONTINUE
1165 400 CONTINUE
1166 ELSE
1167 DO 430 j = 1, n
1168 DO 410 i = j, min( n, j+ka )
1169 ab( 1+i-j, j ) = a( i, j )
1170 410 CONTINUE
1171 DO 420 i = j, min( n, j+kb )
1172 bb( 1+i-j, j ) = b( i, j )
1173 420 CONTINUE
1174 430 CONTINUE
1175 END IF
1176*
1177 CALL ssbgvd( 'V', uplo, n, ka, kb, ab, lda, bb,
1178 $ ldb, d, z, ldz, work, nwork, iwork,
1179 $ liwork, iinfo )
1180 IF( iinfo.NE.0 ) THEN
1181 WRITE( nounit, fmt = 9999 )'SSBGVD(V,' //
1182 $ uplo // ')', iinfo, n, jtype, ioldsd
1183 info = abs( iinfo )
1184 IF( iinfo.LT.0 ) THEN
1185 RETURN
1186 ELSE
1187 result( ntest ) = ulpinv
1188 GO TO 620
1189 END IF
1190 END IF
1191*
1192* Do Test
1193*
1194 CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1195 $ ldz, d, work, result( ntest ) )
1196*
1197* Test SSBGVX
1198*
1199 ntest = ntest + 1
1200*
1201* Copy the matrices into band storage.
1202*
1203 IF( lsame( uplo, 'U' ) ) THEN
1204 DO 460 j = 1, n
1205 DO 440 i = max( 1, j-ka ), j
1206 ab( ka+1+i-j, j ) = a( i, j )
1207 440 CONTINUE
1208 DO 450 i = max( 1, j-kb ), j
1209 bb( kb+1+i-j, j ) = b( i, j )
1210 450 CONTINUE
1211 460 CONTINUE
1212 ELSE
1213 DO 490 j = 1, n
1214 DO 470 i = j, min( n, j+ka )
1215 ab( 1+i-j, j ) = a( i, j )
1216 470 CONTINUE
1217 DO 480 i = j, min( n, j+kb )
1218 bb( 1+i-j, j ) = b( i, j )
1219 480 CONTINUE
1220 490 CONTINUE
1221 END IF
1222*
1223 CALL ssbgvx( 'V', 'A', uplo, n, ka, kb, ab, lda,
1224 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1225 $ iu, abstol, m, d, z, ldz, work,
1226 $ iwork( n+1 ), iwork, iinfo )
1227 IF( iinfo.NE.0 ) THEN
1228 WRITE( nounit, fmt = 9999 )'SSBGVX(V,A' //
1229 $ uplo // ')', iinfo, n, jtype, ioldsd
1230 info = abs( iinfo )
1231 IF( iinfo.LT.0 ) THEN
1232 RETURN
1233 ELSE
1234 result( ntest ) = ulpinv
1235 GO TO 620
1236 END IF
1237 END IF
1238*
1239* Do Test
1240*
1241 CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1242 $ ldz, d, work, result( ntest ) )
1243*
1244*
1245 ntest = ntest + 1
1246*
1247* Copy the matrices into band storage.
1248*
1249 IF( lsame( uplo, 'U' ) ) THEN
1250 DO 520 j = 1, n
1251 DO 500 i = max( 1, j-ka ), j
1252 ab( ka+1+i-j, j ) = a( i, j )
1253 500 CONTINUE
1254 DO 510 i = max( 1, j-kb ), j
1255 bb( kb+1+i-j, j ) = b( i, j )
1256 510 CONTINUE
1257 520 CONTINUE
1258 ELSE
1259 DO 550 j = 1, n
1260 DO 530 i = j, min( n, j+ka )
1261 ab( 1+i-j, j ) = a( i, j )
1262 530 CONTINUE
1263 DO 540 i = j, min( n, j+kb )
1264 bb( 1+i-j, j ) = b( i, j )
1265 540 CONTINUE
1266 550 CONTINUE
1267 END IF
1268*
1269 vl = zero
1270 vu = anorm
1271 CALL ssbgvx( 'V', 'V', uplo, n, ka, kb, ab, lda,
1272 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1273 $ iu, abstol, m, d, z, ldz, work,
1274 $ iwork( n+1 ), iwork, iinfo )
1275 IF( iinfo.NE.0 ) THEN
1276 WRITE( nounit, fmt = 9999 )'SSBGVX(V,V' //
1277 $ uplo // ')', iinfo, n, jtype, ioldsd
1278 info = abs( iinfo )
1279 IF( iinfo.LT.0 ) THEN
1280 RETURN
1281 ELSE
1282 result( ntest ) = ulpinv
1283 GO TO 620
1284 END IF
1285 END IF
1286*
1287* Do Test
1288*
1289 CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1290 $ ldz, d, work, result( ntest ) )
1291*
1292 ntest = ntest + 1
1293*
1294* Copy the matrices into band storage.
1295*
1296 IF( lsame( uplo, 'U' ) ) THEN
1297 DO 580 j = 1, n
1298 DO 560 i = max( 1, j-ka ), j
1299 ab( ka+1+i-j, j ) = a( i, j )
1300 560 CONTINUE
1301 DO 570 i = max( 1, j-kb ), j
1302 bb( kb+1+i-j, j ) = b( i, j )
1303 570 CONTINUE
1304 580 CONTINUE
1305 ELSE
1306 DO 610 j = 1, n
1307 DO 590 i = j, min( n, j+ka )
1308 ab( 1+i-j, j ) = a( i, j )
1309 590 CONTINUE
1310 DO 600 i = j, min( n, j+kb )
1311 bb( 1+i-j, j ) = b( i, j )
1312 600 CONTINUE
1313 610 CONTINUE
1314 END IF
1315*
1316 CALL ssbgvx( 'V', 'I', uplo, n, ka, kb, ab, lda,
1317 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1318 $ iu, abstol, m, d, z, ldz, work,
1319 $ iwork( n+1 ), iwork, iinfo )
1320 IF( iinfo.NE.0 ) THEN
1321 WRITE( nounit, fmt = 9999 )'SSBGVX(V,I' //
1322 $ uplo // ')', iinfo, n, jtype, ioldsd
1323 info = abs( iinfo )
1324 IF( iinfo.LT.0 ) THEN
1325 RETURN
1326 ELSE
1327 result( ntest ) = ulpinv
1328 GO TO 620
1329 END IF
1330 END IF
1331*
1332* Do Test
1333*
1334 CALL ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1335 $ ldz, d, work, result( ntest ) )
1336*
1337 END IF
1338*
1339 620 CONTINUE
1340 630 CONTINUE
1341*
1342* End of Loop -- Check for RESULT(j) > THRESH
1343*
1344 ntestt = ntestt + ntest
1345 CALL slafts( 'SSG', n, n, jtype, ntest, result, ioldsd,
1346 $ thresh, nounit, nerrs )
1347 640 CONTINUE
1348 650 CONTINUE
1349*
1350* Summary
1351*
1352 CALL slasum( 'SSG', nounit, nerrs, ntestt )
1353*
1354 RETURN
1355*
1356* End of SDRVSG2STG
1357*
1358 9999 FORMAT( ' SDRVSG2STG: ', a, ' returned INFO=', i6, '.', / 9x,
1359 $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1360 END
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: slaset.f:110
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:103
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:321
subroutine slatmr(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)
SLATMR
Definition: slatmr.f:471
subroutine ssbgvd(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSBGVD
Definition: ssbgvd.f:227
subroutine ssbgv(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, INFO)
SSBGV
Definition: ssbgv.f:177
subroutine ssbgvx(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)
SSBGVX
Definition: ssbgvx.f:294
subroutine sspgvx(ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSPGVX
Definition: sspgvx.f:272
subroutine sspgvd(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSPGVD
Definition: sspgvd.f:210
subroutine sspgv(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, INFO)
SSPGV
Definition: sspgv.f:160
subroutine ssygv(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, INFO)
SSYGV
Definition: ssygv.f:175
subroutine ssygvx(ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
SSYGVX
Definition: ssygvx.f:297
subroutine ssygv_2stage(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, INFO)
SSYGV_2STAGE
Definition: ssygv_2stage.f:226
subroutine ssygvd(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, IWORK, LIWORK, INFO)
SSYGVD
Definition: ssygvd.f:227
subroutine ssgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RESULT)
SSGT01
Definition: ssgt01.f:146
subroutine slafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
SLAFTS
Definition: slafts.f:99
subroutine sdrvsg2stg(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)
SDRVSG2STG
Definition: sdrvsg2stg.f:362
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:41