LAPACK 3.12.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 generalized 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 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 ulp = slamch( 'Epsilon' )*slamch( 'Base' )
474 ulpinv = one / ulp
475 rtunfl = sqrt( unfl )
476 rtovfl = sqrt( ovfl )
477*
478 DO 20 i = 1, 4
479 iseed2( i ) = iseed( i )
480 20 CONTINUE
481*
482* Loop over sizes, types
483*
484 nerrs = 0
485 nmats = 0
486*
487 DO 650 jsize = 1, nsizes
488 n = nn( jsize )
489 aninv = one / real( max( 1, n ) )
490*
491 IF( nsizes.NE.1 ) THEN
492 mtypes = min( maxtyp, ntypes )
493 ELSE
494 mtypes = min( maxtyp+1, ntypes )
495 END IF
496*
497 ka9 = 0
498 kb9 = 0
499 DO 640 jtype = 1, mtypes
500 IF( .NOT.dotype( jtype ) )
501 $ GO TO 640
502 nmats = nmats + 1
503 ntest = 0
504*
505 DO 30 j = 1, 4
506 ioldsd( j ) = iseed( j )
507 30 CONTINUE
508*
509* 2) Compute "A"
510*
511* Control parameters:
512*
513* KMAGN KMODE KTYPE
514* =1 O(1) clustered 1 zero
515* =2 large clustered 2 identity
516* =3 small exponential (none)
517* =4 arithmetic diagonal, w/ eigenvalues
518* =5 random log hermitian, w/ eigenvalues
519* =6 random (none)
520* =7 random diagonal
521* =8 random hermitian
522* =9 banded, w/ eigenvalues
523*
524 IF( mtypes.GT.maxtyp )
525 $ GO TO 90
526*
527 itype = ktype( jtype )
528 imode = kmode( jtype )
529*
530* Compute norm
531*
532 GO TO ( 40, 50, 60 )kmagn( jtype )
533*
534 40 CONTINUE
535 anorm = one
536 GO TO 70
537*
538 50 CONTINUE
539 anorm = ( rtovfl*ulp )*aninv
540 GO TO 70
541*
542 60 CONTINUE
543 anorm = rtunfl*n*ulpinv
544 GO TO 70
545*
546 70 CONTINUE
547*
548 iinfo = 0
549 cond = ulpinv
550*
551* Special Matrices -- Identity & Jordan block
552*
553 IF( itype.EQ.1 ) THEN
554*
555* Zero
556*
557 ka = 0
558 kb = 0
559 CALL slaset( 'Full', lda, n, zero, zero, a, lda )
560*
561 ELSE IF( itype.EQ.2 ) THEN
562*
563* Identity
564*
565 ka = 0
566 kb = 0
567 CALL slaset( 'Full', lda, n, zero, zero, a, lda )
568 DO 80 jcol = 1, n
569 a( jcol, jcol ) = anorm
570 80 CONTINUE
571*
572 ELSE IF( itype.EQ.4 ) THEN
573*
574* Diagonal Matrix, [Eigen]values Specified
575*
576 ka = 0
577 kb = 0
578 CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
579 $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
580 $ iinfo )
581*
582 ELSE IF( itype.EQ.5 ) THEN
583*
584* symmetric, eigenvalues specified
585*
586 ka = max( 0, n-1 )
587 kb = ka
588 CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
589 $ anorm, n, n, 'N', a, lda, work( n+1 ),
590 $ iinfo )
591*
592 ELSE IF( itype.EQ.7 ) THEN
593*
594* Diagonal, random eigenvalues
595*
596 ka = 0
597 kb = 0
598 CALL slatmr( n, n, 'S', iseed, 'S', work, 6, one, one,
599 $ 'T', 'N', work( n+1 ), 1, one,
600 $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
601 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
602*
603 ELSE IF( itype.EQ.8 ) THEN
604*
605* symmetric, random eigenvalues
606*
607 ka = max( 0, n-1 )
608 kb = ka
609 CALL slatmr( n, n, 'S', iseed, 'H', work, 6, one, one,
610 $ 'T', 'N', work( n+1 ), 1, one,
611 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
612 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
613*
614 ELSE IF( itype.EQ.9 ) THEN
615*
616* symmetric banded, eigenvalues specified
617*
618* The following values are used for the half-bandwidths:
619*
620* ka = 1 kb = 1
621* ka = 2 kb = 1
622* ka = 2 kb = 2
623* ka = 3 kb = 1
624* ka = 3 kb = 2
625* ka = 3 kb = 3
626*
627 kb9 = kb9 + 1
628 IF( kb9.GT.ka9 ) THEN
629 ka9 = ka9 + 1
630 kb9 = 1
631 END IF
632 ka = max( 0, min( n-1, ka9 ) )
633 kb = max( 0, min( n-1, kb9 ) )
634 CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
635 $ anorm, ka, ka, 'N', a, lda, work( n+1 ),
636 $ iinfo )
637*
638 ELSE
639*
640 iinfo = 1
641 END IF
642*
643 IF( iinfo.NE.0 ) THEN
644 WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
645 $ ioldsd
646 info = abs( iinfo )
647 RETURN
648 END IF
649*
650 90 CONTINUE
651*
652 abstol = unfl + unfl
653 IF( n.LE.1 ) THEN
654 il = 1
655 iu = n
656 ELSE
657 il = 1 + int( ( n-1 )*slarnd( 1, iseed2 ) )
658 iu = 1 + int( ( n-1 )*slarnd( 1, iseed2 ) )
659 IF( il.GT.iu ) THEN
660 itemp = il
661 il = iu
662 iu = itemp
663 END IF
664 END IF
665*
666* 3) Call SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD, SSBGVD,
667* SSYGVX, SSPGVX, and SSBGVX, do tests.
668*
669* loop over the three generalized problems
670* IBTYPE = 1: A*x = (lambda)*B*x
671* IBTYPE = 2: A*B*x = (lambda)*x
672* IBTYPE = 3: B*A*x = (lambda)*x
673*
674 DO 630 ibtype = 1, 3
675*
676* loop over the setting UPLO
677*
678 DO 620 ibuplo = 1, 2
679 IF( ibuplo.EQ.1 )
680 $ uplo = 'U'
681 IF( ibuplo.EQ.2 )
682 $ uplo = 'L'
683*
684* Generate random well-conditioned positive definite
685* matrix B, of bandwidth not greater than that of A.
686*
687 CALL slatms( n, n, 'U', iseed, 'P', work, 5, ten, one,
688 $ kb, kb, uplo, b, ldb, work( n+1 ),
689 $ iinfo )
690*
691* Test SSYGV
692*
693 ntest = ntest + 1
694*
695 CALL slacpy( ' ', n, n, a, lda, z, ldz )
696 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
697*
698 CALL ssygv( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
699 $ work, nwork, iinfo )
700 IF( iinfo.NE.0 ) THEN
701 WRITE( nounit, fmt = 9999 )'SSYGV(V,' // uplo //
702 $ ')', iinfo, n, jtype, ioldsd
703 info = abs( iinfo )
704 IF( iinfo.LT.0 ) THEN
705 RETURN
706 ELSE
707 result( ntest ) = ulpinv
708 GO TO 100
709 END IF
710 END IF
711*
712* Do Test
713*
714 CALL ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
715 $ ldz, d, work, result( ntest ) )
716*
717* Test SSYGV_2STAGE
718*
719 ntest = ntest + 1
720*
721 CALL slacpy( ' ', n, n, a, lda, z, ldz )
722 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
723*
724 CALL ssygv_2stage( ibtype, 'N', uplo, n, z, ldz,
725 $ bb, ldb, d2, work, nwork, iinfo )
726 IF( iinfo.NE.0 ) THEN
727 WRITE( nounit, fmt = 9999 )
728 $ 'SSYGV_2STAGE(V,' // uplo //
729 $ ')', iinfo, n, jtype, ioldsd
730 info = abs( iinfo )
731 IF( iinfo.LT.0 ) THEN
732 RETURN
733 ELSE
734 result( ntest ) = ulpinv
735 GO TO 100
736 END IF
737 END IF
738*
739* Do Test
740*
741C CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
742C $ LDZ, D, WORK, RESULT( NTEST ) )
743*
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 SSYGVD
761*
762 ntest = ntest + 1
763*
764 CALL slacpy( ' ', n, n, a, lda, z, ldz )
765 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
766*
767 CALL ssygvd( 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 )'SSYGVD(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 ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
784 $ ldz, d, work, result( ntest ) )
785*
786* Test SSYGVX
787*
788 ntest = ntest + 1
789*
790 CALL slacpy( ' ', n, n, a, lda, ab, lda )
791 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
792*
793 CALL ssygvx( 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 )'SSYGVX(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 ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
812 $ ldz, d, work, result( ntest ) )
813*
814 ntest = ntest + 1
815*
816 CALL slacpy( ' ', n, n, a, lda, ab, lda )
817 CALL slacpy( 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 ssygvx( 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 )'SSYGVX(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 ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
845 $ ldz, d, work, result( ntest ) )
846*
847 ntest = ntest + 1
848*
849 CALL slacpy( ' ', n, n, a, lda, ab, lda )
850 CALL slacpy( uplo, n, n, b, ldb, bb, ldb )
851*
852 CALL ssygvx( 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 )'SSYGVX(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 ssgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
871 $ ldz, d, work, result( ntest ) )
872*
873 100 CONTINUE
874*
875* Test SSPGV
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 sspgv( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
902 $ work, iinfo )
903 IF( iinfo.NE.0 ) THEN
904 WRITE( nounit, fmt = 9999 )'SSPGV(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 ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
918 $ ldz, d, work, result( ntest ) )
919*
920* Test SSPGVD
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 sspgvd( 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 )'SSPGVD(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 ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
963 $ ldz, d, work, result( ntest ) )
964*
965* Test SSPGVX
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 sspgvx( 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 )'SSPGVX(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 ssgt01( 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 sspgvx( 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 )'SSPGVX(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 ssgt01( 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 sspgvx( 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 )'SSPGVX(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 ssgt01( 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 SSBGV
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 ssbgv( '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 )'SSBGV(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 ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1148 $ ldz, d, work, result( ntest ) )
1149*
1150* TEST SSBGVD
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 ssbgvd( '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 )'SSBGVD(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 ssgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1194 $ ldz, d, work, result( ntest ) )
1195*
1196* Test SSBGVX
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 ssbgvx( '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 )'SSBGVX(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 ssgt01( 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 ssbgvx( '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 )'SSBGVX(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 ssgt01( 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 ssbgvx( '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 )'SSBGVX(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 ssgt01( 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 slafts( 'SSG', n, n, jtype, ntest, result, ioldsd,
1345 $ thresh, nounit, nerrs )
1346 640 CONTINUE
1347 650 CONTINUE
1348*
1349* Summary
1350*
1351 CALL slasum( 'SSG', nounit, nerrs, ntestt )
1352*
1353 RETURN
1354*
1355* End of SDRVSG2STG
1356*
1357 9999 FORMAT( ' SDRVSG2STG: ', a, ' returned INFO=', i6, '.', / 9x,
1358 $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1359 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine ssbgv(jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, info)
SSBGV
Definition ssbgv.f:177
subroutine ssbgvd(jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, lwork, iwork, liwork, info)
SSBGVD
Definition ssbgvd.f:221
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 ssygv_2stage(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, info)
SSYGV_2STAGE
subroutine ssygv(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, info)
SSYGV
Definition ssygv.f:175
subroutine ssygvd(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, iwork, liwork, info)
SSYGVD
Definition ssygvd.f:221
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 sspgv(itype, jobz, uplo, n, ap, bp, w, z, ldz, work, info)
SSPGV
Definition sspgv.f:160
subroutine sspgvd(itype, jobz, uplo, n, ap, bp, w, z, ldz, work, lwork, iwork, liwork, info)
SSPGVD
Definition sspgvd.f:204
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 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 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 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 slafts(type, m, n, imat, ntests, result, iseed, thresh, iounit, ie)
SLAFTS
Definition slafts.f:99
subroutine slasum(type, iounit, ie, nrun)
SLASUM
Definition slasum.f:41
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 slatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
SLATMS
Definition slatms.f:321
subroutine ssgt01(itype, uplo, n, m, a, lda, b, ldb, z, ldz, d, work, result)
SSGT01
Definition ssgt01.f:146