LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ ddrvsg2stg()

subroutine ddrvsg2stg ( integer nsizes,
integer, dimension( * ) nn,
integer ntypes,
logical, dimension( * ) dotype,
integer, dimension( 4 ) iseed,
double precision thresh,
integer nounit,
double precision, dimension( lda, * ) a,
integer lda,
double precision, dimension( ldb, * ) b,
integer ldb,
double precision, dimension( * ) d,
double precision, dimension( * ) d2,
double precision, dimension( ldz, * ) z,
integer ldz,
double precision, dimension( lda, * ) ab,
double precision, dimension( ldb, * ) bb,
double precision, dimension( * ) ap,
double precision, dimension( * ) bp,
double precision, dimension( * ) work,
integer nwork,
integer, dimension( * ) iwork,
integer liwork,
double precision, dimension( * ) result,
integer info )

DDRVSG2STG

Purpose:
!>
!>      DDRVSG2STG checks the real symmetric generalized eigenproblem
!>      drivers.
!>
!>              DSYGV computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric-definite generalized
!>              eigenproblem.
!>
!>              DSYGVD computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric-definite generalized
!>              eigenproblem using a divide and conquer algorithm.
!>
!>              DSYGVX computes selected eigenvalues and, optionally,
!>              eigenvectors of a real symmetric-definite generalized
!>              eigenproblem.
!>
!>              DSPGV computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric-definite generalized
!>              eigenproblem in packed storage.
!>
!>              DSPGVD computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric-definite generalized
!>              eigenproblem in packed storage using a divide and
!>              conquer algorithm.
!>
!>              DSPGVX computes selected eigenvalues and, optionally,
!>              eigenvectors of a real symmetric-definite generalized
!>              eigenproblem in packed storage.
!>
!>              DSBGV computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric-definite banded
!>              generalized eigenproblem.
!>
!>              DSBGVD computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric-definite banded
!>              generalized eigenproblem using a divide and conquer
!>              algorithm.
!>
!>              DSBGVX computes selected eigenvalues and, optionally,
!>              eigenvectors of a real symmetric-definite banded
!>              generalized eigenproblem.
!>
!>      When DDRVSG2STG is called, a number of matrix  () and a
!>      number of matrix  are specified.  For each size ()
!>      and each type of matrix, one matrix A of the given type will be
!>      generated; a random well-conditioned matrix B is also generated
!>      and the pair (A,B) is used to test the drivers.
!>
!>      For each pair (A,B), the following tests are performed:
!>
!>      (1) DSYGV with ITYPE = 1 and UPLO ='U':
!>
!>              | A Z - B Z D | / ( |A| |Z| n ulp )
!>              | D - D2 | / ( |D| ulp )   where D is computed by
!>                                         DSYGV and  D2 is computed by
!>                                         DSYGV_2STAGE. This test is
!>                                         only performed for DSYGV
!>
!>      (2) as (1) but calling DSPGV
!>      (3) as (1) but calling DSBGV
!>      (4) as (1) but with UPLO = 'L'
!>      (5) as (4) but calling DSPGV
!>      (6) as (4) but calling DSBGV
!>
!>      (7) DSYGV with ITYPE = 2 and UPLO ='U':
!>
!>              | A B Z - Z D | / ( |A| |Z| n ulp )
!>
!>      (8) as (7) but calling DSPGV
!>      (9) as (7) but with UPLO = 'L'
!>      (10) as (9) but calling DSPGV
!>
!>      (11) DSYGV with ITYPE = 3 and UPLO ='U':
!>
!>              | B A Z - Z D | / ( |A| |Z| n ulp )
!>
!>      (12) as (11) but calling DSPGV
!>      (13) as (11) but with UPLO = 'L'
!>      (14) as (13) but calling DSPGV
!>
!>      DSYGVD, DSPGVD and DSBGVD performed the same 14 tests.
!>
!>      DSYGVX, DSPGVX and DSBGVX performed the above 14 tests with
!>      the parameter RANGE = 'A', 'N' and 'I', respectively.
!>
!>      The  are specified by an array NN(1:NSIZES); the value
!>      of each element NN(j) specifies one size.
!>      The  are specified by a logical array DOTYPE( 1:NTYPES );
!>      if DOTYPE(j) is .TRUE., then matrix type  will be generated.
!>      This type is used for the matrix A which has half-bandwidth KA.
!>      B is generated as a well-conditioned positive definite matrix
!>      with half-bandwidth KB (<= KA).
!>      Currently, the list of possible types for A is:
!>
!>      (1)  The zero matrix.
!>      (2)  The identity matrix.
!>
!>      (3)  A diagonal matrix with evenly spaced entries
!>           1, ..., ULP  and random signs.
!>           (ULP = (first number larger than 1) - 1 )
!>      (4)  A diagonal matrix with geometrically spaced entries
!>           1, ..., ULP  and random signs.
!>      (5)  A diagonal matrix with  entries
!>           1, ULP, ..., ULP and random signs.
!>
!>      (6)  Same as (4), but multiplied by SQRT( overflow threshold )
!>      (7)  Same as (4), but multiplied by SQRT( underflow threshold )
!>
!>      (8)  A matrix of the form  U* D U, where U is orthogonal and
!>           D has evenly spaced entries 1, ..., ULP with random signs
!>           on the diagonal.
!>
!>      (9)  A matrix of the form  U* D U, where U is orthogonal and
!>           D has geometrically spaced entries 1, ..., ULP with random
!>           signs on the diagonal.
!>
!>      (10) A matrix of the form  U* D U, where U is orthogonal and
!>           D has  entries 1, ULP,..., ULP with random
!>           signs on the diagonal.
!>
!>      (11) Same as (8), but multiplied by SQRT( overflow threshold )
!>      (12) Same as (8), but multiplied by SQRT( underflow threshold )
!>
!>      (13) symmetric matrix with random entries chosen from (-1,1).
!>      (14) Same as (13), but multiplied by SQRT( overflow threshold )
!>      (15) Same as (13), but multiplied by SQRT( underflow threshold)
!>
!>      (16) Same as (8), but with KA = 1 and KB = 1
!>      (17) Same as (8), but with KA = 2 and KB = 1
!>      (18) Same as (8), but with KA = 2 and KB = 2
!>      (19) Same as (8), but with KA = 3 and KB = 1
!>      (20) Same as (8), but with KA = 3 and KB = 2
!>      (21) Same as (8), but with KA = 3 and KB = 3
!> 
!>  NSIZES  INTEGER
!>          The number of sizes of matrices to use.  If it is zero,
!>          DDRVSG2STG does nothing.  It must be at least zero.
!>          Not modified.
!>
!>  NN      INTEGER array, dimension (NSIZES)
!>          An array containing the sizes to be used for the matrices.
!>          Zero values will be skipped.  The values must be at least
!>          zero.
!>          Not modified.
!>
!>  NTYPES  INTEGER
!>          The number of elements in DOTYPE.   If it is zero, DDRVSG2STG
!>          does nothing.  It must be at least zero.  If it is MAXTYP+1
!>          and NSIZES is 1, then an additional type, MAXTYP+1 is
!>          defined, which is to use whatever matrix is in A.  This
!>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
!>          DOTYPE(MAXTYP+1) is .TRUE. .
!>          Not modified.
!>
!>  DOTYPE  LOGICAL array, dimension (NTYPES)
!>          If DOTYPE(j) is .TRUE., then for each size in NN a
!>          matrix of that size and of type j will be generated.
!>          If NTYPES is smaller than the maximum number of types
!>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
!>          MAXTYP will not be generated.  If NTYPES is larger
!>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
!>          will be ignored.
!>          Not modified.
!>
!>  ISEED   INTEGER array, dimension (4)
!>          On entry ISEED specifies the seed of the random number
!>          generator. The array elements should be between 0 and 4095;
!>          if not they will be reduced mod 4096.  Also, ISEED(4) must
!>          be odd.  The random number generator uses a linear
!>          congruential sequence limited to small integers, and so
!>          should produce machine independent random numbers. The
!>          values of ISEED are changed on exit, and can be used in the
!>          next call to DDRVSG2STG to continue the same random number
!>          sequence.
!>          Modified.
!>
!>  THRESH  DOUBLE PRECISION
!>          A test will count as  if the , computed as
!>          described above, exceeds THRESH.  Note that the error
!>          is scaled to be O(1), so THRESH should be a reasonably
!>          small multiple of 1, e.g., 10 or 100.  In particular,
!>          it should not depend on the precision (single vs. double)
!>          or the size of the matrix.  It must be at least zero.
!>          Not modified.
!>
!>  NOUNIT  INTEGER
!>          The FORTRAN unit number for printing out error messages
!>          (e.g., if a routine returns IINFO not equal to 0.)
!>          Not modified.
!>
!>  A       DOUBLE PRECISION array, dimension (LDA , max(NN))
!>          Used to hold the matrix whose eigenvalues are to be
!>          computed.  On exit, A contains the last matrix actually
!>          used.
!>          Modified.
!>
!>  LDA     INTEGER
!>          The leading dimension of A and AB.  It must be at
!>          least 1 and at least max( NN ).
!>          Not modified.
!>
!>  B       DOUBLE PRECISION array, dimension (LDB , max(NN))
!>          Used to hold the symmetric positive definite matrix for
!>          the generalized problem.
!>          On exit, B contains the last matrix actually
!>          used.
!>          Modified.
!>
!>  LDB     INTEGER
!>          The leading dimension of B and BB.  It must be at
!>          least 1 and at least max( NN ).
!>          Not modified.
!>
!>  D       DOUBLE PRECISION array, dimension (max(NN))
!>          The eigenvalues of A. On exit, the eigenvalues in D
!>          correspond with the matrix in A.
!>          Modified.
!>
!>  Z       DOUBLE PRECISION array, dimension (LDZ, max(NN))
!>          The matrix of eigenvectors.
!>          Modified.
!>
!>  LDZ     INTEGER
!>          The leading dimension of Z.  It must be at least 1 and
!>          at least max( NN ).
!>          Not modified.
!>
!>  AB      DOUBLE PRECISION array, dimension (LDA, max(NN))
!>          Workspace.
!>          Modified.
!>
!>  BB      DOUBLE PRECISION array, dimension (LDB, max(NN))
!>          Workspace.
!>          Modified.
!>
!>  AP      DOUBLE PRECISION array, dimension (max(NN)**2)
!>          Workspace.
!>          Modified.
!>
!>  BP      DOUBLE PRECISION array, dimension (max(NN)**2)
!>          Workspace.
!>          Modified.
!>
!>  WORK    DOUBLE PRECISION array, dimension (NWORK)
!>          Workspace.
!>          Modified.
!>
!>  NWORK   INTEGER
!>          The number of entries in WORK.  This must be at least
!>          1+5*N+2*N*lg(N)+3*N**2 where N = max( NN(j) ) and
!>          lg( N ) = smallest integer k such that 2**k >= N.
!>          Not modified.
!>
!>  IWORK   INTEGER array, dimension (LIWORK)
!>          Workspace.
!>          Modified.
!>
!>  LIWORK  INTEGER
!>          The number of entries in WORK.  This must be at least 6*N.
!>          Not modified.
!>
!>  RESULT  DOUBLE PRECISION array, dimension (70)
!>          The values computed by the 70 tests described above.
!>          Modified.
!>
!>  INFO    INTEGER
!>          If 0, then everything ran OK.
!>           -1: NSIZES < 0
!>           -2: Some NN(j) < 0
!>           -3: NTYPES < 0
!>           -5: THRESH < 0
!>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
!>          -16: LDZ < 1 or LDZ < NMAX.
!>          -21: NWORK too small.
!>          -23: LIWORK too small.
!>          If  DLATMR, SLATMS, DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD,
!>              DSBGVD, DSYGVX, DSPGVX or SSBGVX returns an error code,
!>              the absolute value of it is returned.
!>          Modified.
!>
!> ----------------------------------------------------------------------
!>
!>       Some Local Variables and Parameters:
!>       ---- ----- --------- --- ----------
!>       ZERO, ONE       Real 0 and 1.
!>       MAXTYP          The number of types defined.
!>       NTEST           The number of tests that have been run
!>                       on this matrix.
!>       NTESTT          The total number of tests for this call.
!>       NMAX            Largest value in NN.
!>       NMATS           The number of matrices generated so far.
!>       NERRS           The number of tests which have exceeded THRESH
!>                       so far (computed by DLAFTS).
!>       COND, IMODE     Values to be passed to the matrix generators.
!>       ANORM           Norm of A; passed to matrix generators.
!>
!>       OVFL, UNFL      Overflow and underflow thresholds.
!>       ULP, ULPINV     Finest relative precision and its inverse.
!>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
!>               The following four arrays decode JTYPE:
!>       KTYPE(j)        The general type (1-10) for type .
!>       KMODE(j)        The MODE value to be passed to the matrix
!>                       generator for type .
!>       KMAGN(j)        The order of magnitude ( O(1),
!>                       O(overflow^(1/2) ), O(underflow^(1/2) )
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 358 of file ddrvsg2stg.f.

362*
363 IMPLICIT NONE
364*
365* -- LAPACK test routine --
366* -- LAPACK is a software package provided by Univ. of Tennessee, --
367* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
368*
369* .. Scalar Arguments ..
370 INTEGER INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
371 $ NTYPES, NWORK
372 DOUBLE PRECISION THRESH
373* ..
374* .. Array Arguments ..
375 LOGICAL DOTYPE( * )
376 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
377 DOUBLE PRECISION A( LDA, * ), AB( LDA, * ), AP( * ),
378 $ B( LDB, * ), BB( LDB, * ), BP( * ), D( * ),
379 $ D2( * ), RESULT( * ), WORK( * ), Z( LDZ, * )
380* ..
381*
382* =====================================================================
383*
384* .. Parameters ..
385 DOUBLE PRECISION ZERO, ONE, TEN
386 parameter( zero = 0.0d0, one = 1.0d0, ten = 10.0d0 )
387 INTEGER MAXTYP
388 parameter( maxtyp = 21 )
389* ..
390* .. Local Scalars ..
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 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
398 $ RTUNFL, ULP, ULPINV, UNFL, VL, VU, TEMP1, TEMP2
399* ..
400* .. Local Arrays ..
401 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
402 $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
403 $ KTYPE( MAXTYP )
404* ..
405* .. External Functions ..
406 LOGICAL LSAME
407 DOUBLE PRECISION DLAMCH, DLARND
408 EXTERNAL lsame, dlamch, dlarnd
409* ..
410* .. External Subroutines ..
411 EXTERNAL dlacpy, dlafts, dlaset, dlasum, dlatmr,
412 $ dlatms, dsbgv, dsbgvd, dsbgvx, dsgt01, dspgv,
413 $ dspgvd, dspgvx, dsygv, dsygvd, dsygvx, xerbla,
414 $ dsygv_2stage
415* ..
416* .. Intrinsic Functions ..
417 INTRINSIC abs, dble, max, min, sqrt
418* ..
419* .. Data statements ..
420 DATA ktype / 1, 2, 5*4, 5*5, 3*8, 6*9 /
421 DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
422 $ 2, 3, 6*1 /
423 DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
424 $ 0, 0, 6*4 /
425* ..
426* .. Executable Statements ..
427*
428* 1) Check for errors
429*
430 ntestt = 0
431 info = 0
432*
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( 'DDRVSG2STG', -info )
461 RETURN
462 END IF
463*
464* Quick return if possible
465*
466 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
467 $ RETURN
468*
469* More Important constants
470*
471 unfl = dlamch( 'Safe minimum' )
472 ovfl = dlamch( 'Overflow' )
473 ulp = dlamch( 'Epsilon' )*dlamch( '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 / dble( 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 dlaset( '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 dlaset( '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 dlatms( 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 dlatms( 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 dlatmr( 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 dlatmr( 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 dlatms( 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 )*dlarnd( 1, iseed2 ) )
658 iu = 1 + int( ( n-1 )*dlarnd( 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 DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD, SSBGVD,
667* DSYGVX, DSPGVX, and DSBGVX, 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 dlatms( n, n, 'U', iseed, 'P', work, 5, ten, one,
688 $ kb, kb, uplo, b, ldb, work( n+1 ),
689 $ iinfo )
690*
691* Test DSYGV
692*
693 ntest = ntest + 1
694*
695 CALL dlacpy( ' ', n, n, a, lda, z, ldz )
696 CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
697*
698 CALL dsygv( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
699 $ work, nwork, iinfo )
700 IF( iinfo.NE.0 ) THEN
701 WRITE( nounit, fmt = 9999 )'DSYGV(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 dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
715 $ ldz, d, work, result( ntest ) )
716*
717* Test DSYGV_2STAGE
718*
719 ntest = ntest + 1
720*
721 CALL dlacpy( ' ', n, n, a, lda, z, ldz )
722 CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
723*
724 CALL dsygv_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 $ 'DSYGV_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 DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
742C $ LDZ, D, WORK, RESULT( NTEST ) )
743*
744* Do Tests | D1 - D2 | / ( |D1| ulp )
745* D1 computed using the standard 1-stage reduction as reference
746* D2 computed using the 2-stage reduction
747*
748 temp1 = zero
749 temp2 = zero
750 DO 151 j = 1, n
751 temp1 = max( temp1, abs( d( j ) ),
752 $ abs( d2( j ) ) )
753 temp2 = max( temp2, abs( d( j )-d2( j ) ) )
754 151 CONTINUE
755*
756 result( ntest ) = temp2 /
757 $ max( unfl, ulp*max( temp1, temp2 ) )
758*
759* Test DSYGVD
760*
761 ntest = ntest + 1
762*
763 CALL dlacpy( ' ', n, n, a, lda, z, ldz )
764 CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
765*
766 CALL dsygvd( ibtype, 'V', uplo, n, z, ldz, bb, ldb, d,
767 $ work, nwork, iwork, liwork, iinfo )
768 IF( iinfo.NE.0 ) THEN
769 WRITE( nounit, fmt = 9999 )'DSYGVD(V,' // uplo //
770 $ ')', iinfo, n, jtype, ioldsd
771 info = abs( iinfo )
772 IF( iinfo.LT.0 ) THEN
773 RETURN
774 ELSE
775 result( ntest ) = ulpinv
776 GO TO 100
777 END IF
778 END IF
779*
780* Do Test
781*
782 CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
783 $ ldz, d, work, result( ntest ) )
784*
785* Test DSYGVX
786*
787 ntest = ntest + 1
788*
789 CALL dlacpy( ' ', n, n, a, lda, ab, lda )
790 CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
791*
792 CALL dsygvx( ibtype, 'V', 'A', uplo, n, ab, lda, bb,
793 $ ldb, vl, vu, il, iu, abstol, m, d, z,
794 $ ldz, work, nwork, iwork( n+1 ), iwork,
795 $ iinfo )
796 IF( iinfo.NE.0 ) THEN
797 WRITE( nounit, fmt = 9999 )'DSYGVX(V,A' // uplo //
798 $ ')', iinfo, n, jtype, ioldsd
799 info = abs( iinfo )
800 IF( iinfo.LT.0 ) THEN
801 RETURN
802 ELSE
803 result( ntest ) = ulpinv
804 GO TO 100
805 END IF
806 END IF
807*
808* Do Test
809*
810 CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
811 $ ldz, d, work, result( ntest ) )
812*
813 ntest = ntest + 1
814*
815 CALL dlacpy( ' ', n, n, a, lda, ab, lda )
816 CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
817*
818* since we do not know the exact eigenvalues of this
819* eigenpair, we just set VL and VU as constants.
820* It is quite possible that there are no eigenvalues
821* in this interval.
822*
823 vl = zero
824 vu = anorm
825 CALL dsygvx( ibtype, 'V', 'V', uplo, n, ab, lda, bb,
826 $ ldb, vl, vu, il, iu, abstol, m, d, z,
827 $ ldz, work, nwork, iwork( n+1 ), iwork,
828 $ iinfo )
829 IF( iinfo.NE.0 ) THEN
830 WRITE( nounit, fmt = 9999 )'DSYGVX(V,V,' //
831 $ uplo // ')', iinfo, n, jtype, ioldsd
832 info = abs( iinfo )
833 IF( iinfo.LT.0 ) THEN
834 RETURN
835 ELSE
836 result( ntest ) = ulpinv
837 GO TO 100
838 END IF
839 END IF
840*
841* Do Test
842*
843 CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
844 $ ldz, d, work, result( ntest ) )
845*
846 ntest = ntest + 1
847*
848 CALL dlacpy( ' ', n, n, a, lda, ab, lda )
849 CALL dlacpy( uplo, n, n, b, ldb, bb, ldb )
850*
851 CALL dsygvx( ibtype, 'V', 'I', uplo, n, ab, lda, bb,
852 $ ldb, vl, vu, il, iu, abstol, m, d, z,
853 $ ldz, work, nwork, iwork( n+1 ), iwork,
854 $ iinfo )
855 IF( iinfo.NE.0 ) THEN
856 WRITE( nounit, fmt = 9999 )'DSYGVX(V,I,' //
857 $ uplo // ')', iinfo, n, jtype, ioldsd
858 info = abs( iinfo )
859 IF( iinfo.LT.0 ) THEN
860 RETURN
861 ELSE
862 result( ntest ) = ulpinv
863 GO TO 100
864 END IF
865 END IF
866*
867* Do Test
868*
869 CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
870 $ ldz, d, work, result( ntest ) )
871*
872 100 CONTINUE
873*
874* Test DSPGV
875*
876 ntest = ntest + 1
877*
878* Copy the matrices into packed storage.
879*
880 IF( lsame( uplo, 'U' ) ) THEN
881 ij = 1
882 DO 120 j = 1, n
883 DO 110 i = 1, j
884 ap( ij ) = a( i, j )
885 bp( ij ) = b( i, j )
886 ij = ij + 1
887 110 CONTINUE
888 120 CONTINUE
889 ELSE
890 ij = 1
891 DO 140 j = 1, n
892 DO 130 i = j, n
893 ap( ij ) = a( i, j )
894 bp( ij ) = b( i, j )
895 ij = ij + 1
896 130 CONTINUE
897 140 CONTINUE
898 END IF
899*
900 CALL dspgv( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
901 $ work, iinfo )
902 IF( iinfo.NE.0 ) THEN
903 WRITE( nounit, fmt = 9999 )'DSPGV(V,' // uplo //
904 $ ')', iinfo, n, jtype, ioldsd
905 info = abs( iinfo )
906 IF( iinfo.LT.0 ) THEN
907 RETURN
908 ELSE
909 result( ntest ) = ulpinv
910 GO TO 310
911 END IF
912 END IF
913*
914* Do Test
915*
916 CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
917 $ ldz, d, work, result( ntest ) )
918*
919* Test DSPGVD
920*
921 ntest = ntest + 1
922*
923* Copy the matrices into packed storage.
924*
925 IF( lsame( uplo, 'U' ) ) THEN
926 ij = 1
927 DO 160 j = 1, n
928 DO 150 i = 1, j
929 ap( ij ) = a( i, j )
930 bp( ij ) = b( i, j )
931 ij = ij + 1
932 150 CONTINUE
933 160 CONTINUE
934 ELSE
935 ij = 1
936 DO 180 j = 1, n
937 DO 170 i = j, n
938 ap( ij ) = a( i, j )
939 bp( ij ) = b( i, j )
940 ij = ij + 1
941 170 CONTINUE
942 180 CONTINUE
943 END IF
944*
945 CALL dspgvd( ibtype, 'V', uplo, n, ap, bp, d, z, ldz,
946 $ work, nwork, iwork, liwork, iinfo )
947 IF( iinfo.NE.0 ) THEN
948 WRITE( nounit, fmt = 9999 )'DSPGVD(V,' // uplo //
949 $ ')', iinfo, n, jtype, ioldsd
950 info = abs( iinfo )
951 IF( iinfo.LT.0 ) THEN
952 RETURN
953 ELSE
954 result( ntest ) = ulpinv
955 GO TO 310
956 END IF
957 END IF
958*
959* Do Test
960*
961 CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
962 $ ldz, d, work, result( ntest ) )
963*
964* Test DSPGVX
965*
966 ntest = ntest + 1
967*
968* Copy the matrices into packed storage.
969*
970 IF( lsame( uplo, 'U' ) ) THEN
971 ij = 1
972 DO 200 j = 1, n
973 DO 190 i = 1, j
974 ap( ij ) = a( i, j )
975 bp( ij ) = b( i, j )
976 ij = ij + 1
977 190 CONTINUE
978 200 CONTINUE
979 ELSE
980 ij = 1
981 DO 220 j = 1, n
982 DO 210 i = j, n
983 ap( ij ) = a( i, j )
984 bp( ij ) = b( i, j )
985 ij = ij + 1
986 210 CONTINUE
987 220 CONTINUE
988 END IF
989*
990 CALL dspgvx( ibtype, 'V', 'A', uplo, n, ap, bp, vl,
991 $ vu, il, iu, abstol, m, d, z, ldz, work,
992 $ iwork( n+1 ), iwork, info )
993 IF( iinfo.NE.0 ) THEN
994 WRITE( nounit, fmt = 9999 )'DSPGVX(V,A' // uplo //
995 $ ')', iinfo, n, jtype, ioldsd
996 info = abs( iinfo )
997 IF( iinfo.LT.0 ) THEN
998 RETURN
999 ELSE
1000 result( ntest ) = ulpinv
1001 GO TO 310
1002 END IF
1003 END IF
1004*
1005* Do Test
1006*
1007 CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1008 $ ldz, d, work, result( ntest ) )
1009*
1010 ntest = ntest + 1
1011*
1012* Copy the matrices into packed storage.
1013*
1014 IF( lsame( uplo, 'U' ) ) THEN
1015 ij = 1
1016 DO 240 j = 1, n
1017 DO 230 i = 1, j
1018 ap( ij ) = a( i, j )
1019 bp( ij ) = b( i, j )
1020 ij = ij + 1
1021 230 CONTINUE
1022 240 CONTINUE
1023 ELSE
1024 ij = 1
1025 DO 260 j = 1, n
1026 DO 250 i = j, n
1027 ap( ij ) = a( i, j )
1028 bp( ij ) = b( i, j )
1029 ij = ij + 1
1030 250 CONTINUE
1031 260 CONTINUE
1032 END IF
1033*
1034 vl = zero
1035 vu = anorm
1036 CALL dspgvx( ibtype, 'V', 'V', uplo, n, ap, bp, vl,
1037 $ vu, il, iu, abstol, m, d, z, ldz, work,
1038 $ iwork( n+1 ), iwork, info )
1039 IF( iinfo.NE.0 ) THEN
1040 WRITE( nounit, fmt = 9999 )'DSPGVX(V,V' // uplo //
1041 $ ')', iinfo, n, jtype, ioldsd
1042 info = abs( iinfo )
1043 IF( iinfo.LT.0 ) THEN
1044 RETURN
1045 ELSE
1046 result( ntest ) = ulpinv
1047 GO TO 310
1048 END IF
1049 END IF
1050*
1051* Do Test
1052*
1053 CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1054 $ ldz, d, work, result( ntest ) )
1055*
1056 ntest = ntest + 1
1057*
1058* Copy the matrices into packed storage.
1059*
1060 IF( lsame( uplo, 'U' ) ) THEN
1061 ij = 1
1062 DO 280 j = 1, n
1063 DO 270 i = 1, j
1064 ap( ij ) = a( i, j )
1065 bp( ij ) = b( i, j )
1066 ij = ij + 1
1067 270 CONTINUE
1068 280 CONTINUE
1069 ELSE
1070 ij = 1
1071 DO 300 j = 1, n
1072 DO 290 i = j, n
1073 ap( ij ) = a( i, j )
1074 bp( ij ) = b( i, j )
1075 ij = ij + 1
1076 290 CONTINUE
1077 300 CONTINUE
1078 END IF
1079*
1080 CALL dspgvx( ibtype, 'V', 'I', uplo, n, ap, bp, vl,
1081 $ vu, il, iu, abstol, m, d, z, ldz, work,
1082 $ iwork( n+1 ), iwork, info )
1083 IF( iinfo.NE.0 ) THEN
1084 WRITE( nounit, fmt = 9999 )'DSPGVX(V,I' // uplo //
1085 $ ')', iinfo, n, jtype, ioldsd
1086 info = abs( iinfo )
1087 IF( iinfo.LT.0 ) THEN
1088 RETURN
1089 ELSE
1090 result( ntest ) = ulpinv
1091 GO TO 310
1092 END IF
1093 END IF
1094*
1095* Do Test
1096*
1097 CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1098 $ ldz, d, work, result( ntest ) )
1099*
1100 310 CONTINUE
1101*
1102 IF( ibtype.EQ.1 ) THEN
1103*
1104* TEST DSBGV
1105*
1106 ntest = ntest + 1
1107*
1108* Copy the matrices into band storage.
1109*
1110 IF( lsame( uplo, 'U' ) ) THEN
1111 DO 340 j = 1, n
1112 DO 320 i = max( 1, j-ka ), j
1113 ab( ka+1+i-j, j ) = a( i, j )
1114 320 CONTINUE
1115 DO 330 i = max( 1, j-kb ), j
1116 bb( kb+1+i-j, j ) = b( i, j )
1117 330 CONTINUE
1118 340 CONTINUE
1119 ELSE
1120 DO 370 j = 1, n
1121 DO 350 i = j, min( n, j+ka )
1122 ab( 1+i-j, j ) = a( i, j )
1123 350 CONTINUE
1124 DO 360 i = j, min( n, j+kb )
1125 bb( 1+i-j, j ) = b( i, j )
1126 360 CONTINUE
1127 370 CONTINUE
1128 END IF
1129*
1130 CALL dsbgv( 'V', uplo, n, ka, kb, ab, lda, bb, ldb,
1131 $ d, z, ldz, work, iinfo )
1132 IF( iinfo.NE.0 ) THEN
1133 WRITE( nounit, fmt = 9999 )'DSBGV(V,' //
1134 $ uplo // ')', iinfo, n, jtype, ioldsd
1135 info = abs( iinfo )
1136 IF( iinfo.LT.0 ) THEN
1137 RETURN
1138 ELSE
1139 result( ntest ) = ulpinv
1140 GO TO 620
1141 END IF
1142 END IF
1143*
1144* Do Test
1145*
1146 CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1147 $ ldz, d, work, result( ntest ) )
1148*
1149* TEST DSBGVD
1150*
1151 ntest = ntest + 1
1152*
1153* Copy the matrices into band storage.
1154*
1155 IF( lsame( uplo, 'U' ) ) THEN
1156 DO 400 j = 1, n
1157 DO 380 i = max( 1, j-ka ), j
1158 ab( ka+1+i-j, j ) = a( i, j )
1159 380 CONTINUE
1160 DO 390 i = max( 1, j-kb ), j
1161 bb( kb+1+i-j, j ) = b( i, j )
1162 390 CONTINUE
1163 400 CONTINUE
1164 ELSE
1165 DO 430 j = 1, n
1166 DO 410 i = j, min( n, j+ka )
1167 ab( 1+i-j, j ) = a( i, j )
1168 410 CONTINUE
1169 DO 420 i = j, min( n, j+kb )
1170 bb( 1+i-j, j ) = b( i, j )
1171 420 CONTINUE
1172 430 CONTINUE
1173 END IF
1174*
1175 CALL dsbgvd( 'V', uplo, n, ka, kb, ab, lda, bb,
1176 $ ldb, d, z, ldz, work, nwork, iwork,
1177 $ liwork, iinfo )
1178 IF( iinfo.NE.0 ) THEN
1179 WRITE( nounit, fmt = 9999 )'DSBGVD(V,' //
1180 $ uplo // ')', iinfo, n, jtype, ioldsd
1181 info = abs( iinfo )
1182 IF( iinfo.LT.0 ) THEN
1183 RETURN
1184 ELSE
1185 result( ntest ) = ulpinv
1186 GO TO 620
1187 END IF
1188 END IF
1189*
1190* Do Test
1191*
1192 CALL dsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1193 $ ldz, d, work, result( ntest ) )
1194*
1195* Test DSBGVX
1196*
1197 ntest = ntest + 1
1198*
1199* Copy the matrices into band storage.
1200*
1201 IF( lsame( uplo, 'U' ) ) THEN
1202 DO 460 j = 1, n
1203 DO 440 i = max( 1, j-ka ), j
1204 ab( ka+1+i-j, j ) = a( i, j )
1205 440 CONTINUE
1206 DO 450 i = max( 1, j-kb ), j
1207 bb( kb+1+i-j, j ) = b( i, j )
1208 450 CONTINUE
1209 460 CONTINUE
1210 ELSE
1211 DO 490 j = 1, n
1212 DO 470 i = j, min( n, j+ka )
1213 ab( 1+i-j, j ) = a( i, j )
1214 470 CONTINUE
1215 DO 480 i = j, min( n, j+kb )
1216 bb( 1+i-j, j ) = b( i, j )
1217 480 CONTINUE
1218 490 CONTINUE
1219 END IF
1220*
1221 CALL dsbgvx( 'V', 'A', uplo, n, ka, kb, ab, lda,
1222 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1223 $ iu, abstol, m, d, z, ldz, work,
1224 $ iwork( n+1 ), iwork, iinfo )
1225 IF( iinfo.NE.0 ) THEN
1226 WRITE( nounit, fmt = 9999 )'DSBGVX(V,A' //
1227 $ uplo // ')', iinfo, n, jtype, ioldsd
1228 info = abs( iinfo )
1229 IF( iinfo.LT.0 ) THEN
1230 RETURN
1231 ELSE
1232 result( ntest ) = ulpinv
1233 GO TO 620
1234 END IF
1235 END IF
1236*
1237* Do Test
1238*
1239 CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1240 $ ldz, d, work, result( ntest ) )
1241*
1242*
1243 ntest = ntest + 1
1244*
1245* Copy the matrices into band storage.
1246*
1247 IF( lsame( uplo, 'U' ) ) THEN
1248 DO 520 j = 1, n
1249 DO 500 i = max( 1, j-ka ), j
1250 ab( ka+1+i-j, j ) = a( i, j )
1251 500 CONTINUE
1252 DO 510 i = max( 1, j-kb ), j
1253 bb( kb+1+i-j, j ) = b( i, j )
1254 510 CONTINUE
1255 520 CONTINUE
1256 ELSE
1257 DO 550 j = 1, n
1258 DO 530 i = j, min( n, j+ka )
1259 ab( 1+i-j, j ) = a( i, j )
1260 530 CONTINUE
1261 DO 540 i = j, min( n, j+kb )
1262 bb( 1+i-j, j ) = b( i, j )
1263 540 CONTINUE
1264 550 CONTINUE
1265 END IF
1266*
1267 vl = zero
1268 vu = anorm
1269 CALL dsbgvx( 'V', 'V', uplo, n, ka, kb, ab, lda,
1270 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1271 $ iu, abstol, m, d, z, ldz, work,
1272 $ iwork( n+1 ), iwork, iinfo )
1273 IF( iinfo.NE.0 ) THEN
1274 WRITE( nounit, fmt = 9999 )'DSBGVX(V,V' //
1275 $ uplo // ')', iinfo, n, jtype, ioldsd
1276 info = abs( iinfo )
1277 IF( iinfo.LT.0 ) THEN
1278 RETURN
1279 ELSE
1280 result( ntest ) = ulpinv
1281 GO TO 620
1282 END IF
1283 END IF
1284*
1285* Do Test
1286*
1287 CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1288 $ ldz, d, work, result( ntest ) )
1289*
1290 ntest = ntest + 1
1291*
1292* Copy the matrices into band storage.
1293*
1294 IF( lsame( uplo, 'U' ) ) THEN
1295 DO 580 j = 1, n
1296 DO 560 i = max( 1, j-ka ), j
1297 ab( ka+1+i-j, j ) = a( i, j )
1298 560 CONTINUE
1299 DO 570 i = max( 1, j-kb ), j
1300 bb( kb+1+i-j, j ) = b( i, j )
1301 570 CONTINUE
1302 580 CONTINUE
1303 ELSE
1304 DO 610 j = 1, n
1305 DO 590 i = j, min( n, j+ka )
1306 ab( 1+i-j, j ) = a( i, j )
1307 590 CONTINUE
1308 DO 600 i = j, min( n, j+kb )
1309 bb( 1+i-j, j ) = b( i, j )
1310 600 CONTINUE
1311 610 CONTINUE
1312 END IF
1313*
1314 CALL dsbgvx( 'V', 'I', uplo, n, ka, kb, ab, lda,
1315 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1316 $ iu, abstol, m, d, z, ldz, work,
1317 $ iwork( n+1 ), iwork, iinfo )
1318 IF( iinfo.NE.0 ) THEN
1319 WRITE( nounit, fmt = 9999 )'DSBGVX(V,I' //
1320 $ uplo // ')', iinfo, n, jtype, ioldsd
1321 info = abs( iinfo )
1322 IF( iinfo.LT.0 ) THEN
1323 RETURN
1324 ELSE
1325 result( ntest ) = ulpinv
1326 GO TO 620
1327 END IF
1328 END IF
1329*
1330* Do Test
1331*
1332 CALL dsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1333 $ ldz, d, work, result( ntest ) )
1334*
1335 END IF
1336*
1337 620 CONTINUE
1338 630 CONTINUE
1339*
1340* End of Loop -- Check for RESULT(j) > THRESH
1341*
1342 ntestt = ntestt + ntest
1343 CALL dlafts( 'DSG', n, n, jtype, ntest, result, ioldsd,
1344 $ thresh, nounit, nerrs )
1345 640 CONTINUE
1346 650 CONTINUE
1347*
1348* Summary
1349*
1350 CALL dlasum( 'DSG', nounit, nerrs, ntestt )
1351*
1352 RETURN
1353*
1354* End of DDRVSG2STG
1355*
1356 9999 FORMAT( ' DDRVSG2STG: ', a, ' returned INFO=', i6, '.', / 9x,
1357 $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
dlafts
subroutine dlafts(type, m, n, imat, ntests, result, iseed, thresh, iounit, ie)
DLAFTS
Definition dlafts.f:99
dlarnd
double precision function dlarnd(idist, iseed)
DLARND
Definition dlarnd.f:73
dlasum
subroutine dlasum(type, iounit, ie, nrun)
DLASUM
Definition dlasum.f:43
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
dsgt01
subroutine dsgt01(itype, uplo, n, m, a, lda, b, ldb, z, ldz, d, work, result)
DSGT01
Definition dsgt01.f:146
dsbgv
subroutine dsbgv(jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, info)
DSBGV
Definition dsbgv.f:176
dsbgvd
subroutine dsbgvd(jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, lwork, iwork, liwork, info)
DSBGVD
Definition dsbgvd.f:220
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:292
dsygv_2stage
subroutine dsygv_2stage(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, info)
DSYGV_2STAGE
Definition dsygv_2stage.f:225
dsygv
subroutine dsygv(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, info)
DSYGV
Definition dsygv.f:174
dsygvd
subroutine dsygvd(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, iwork, liwork, info)
DSYGVD
Definition dsygvd.f:220
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:295
dspgv
subroutine dspgv(itype, jobz, uplo, n, ap, bp, w, z, ldz, work, info)
DSPGV
Definition dspgv.f:159
dspgvd
subroutine dspgvd(itype, jobz, uplo, n, ap, bp, w, z, ldz, work, lwork, iwork, liwork, info)
DSPGVD
Definition dspgvd.f:203
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:270
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:101
dlamch
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
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:108
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: