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

◆ cdrvsx()

subroutine cdrvsx ( integer  nsizes,
integer, dimension( * )  nn,
integer  ntypes,
logical, dimension( * )  dotype,
integer, dimension( 4 )  iseed,
real  thresh,
integer  niunit,
integer  nounit,
complex, dimension( lda, * )  a,
integer  lda,
complex, dimension( lda, * )  h,
complex, dimension( lda, * )  ht,
complex, dimension( * )  w,
complex, dimension( * )  wt,
complex, dimension( * )  wtmp,
complex, dimension( ldvs, * )  vs,
integer  ldvs,
complex, dimension( ldvs, * )  vs1,
real, dimension( 17 )  result,
complex, dimension( * )  work,
integer  lwork,
real, dimension( * )  rwork,
logical, dimension( * )  bwork,
integer  info 
)

CDRVSX

Purpose:
    CDRVSX checks the nonsymmetric eigenvalue (Schur form) problem
    expert driver CGEESX.

    CDRVSX uses both test matrices generated randomly depending on
    data supplied in the calling sequence, as well as on data
    read from an input file and including precomputed condition
    numbers to which it compares the ones it computes.

    When CDRVSX is called, a number of matrix "sizes" ("n's") and a
    number of matrix "types" are specified.  For each size ("n")
    and each type of matrix, one matrix will be generated and used
    to test the nonsymmetric eigenroutines.  For each matrix, 15
    tests will be performed:

    (1)     0 if T is in Schur form, 1/ulp otherwise
           (no sorting of eigenvalues)

    (2)     | A - VS T VS' | / ( n |A| ulp )

      Here VS is the matrix of Schur eigenvectors, and T is in Schur
      form  (no sorting of eigenvalues).

    (3)     | I - VS VS' | / ( n ulp ) (no sorting of eigenvalues).

    (4)     0     if W are eigenvalues of T
            1/ulp otherwise
            (no sorting of eigenvalues)

    (5)     0     if T(with VS) = T(without VS),
            1/ulp otherwise
            (no sorting of eigenvalues)

    (6)     0     if eigenvalues(with VS) = eigenvalues(without VS),
            1/ulp otherwise
            (no sorting of eigenvalues)

    (7)     0 if T is in Schur form, 1/ulp otherwise
            (with sorting of eigenvalues)

    (8)     | A - VS T VS' | / ( n |A| ulp )

      Here VS is the matrix of Schur eigenvectors, and T is in Schur
      form  (with sorting of eigenvalues).

    (9)     | I - VS VS' | / ( n ulp ) (with sorting of eigenvalues).

    (10)    0     if W are eigenvalues of T
            1/ulp otherwise
            If workspace sufficient, also compare W with and
            without reciprocal condition numbers
            (with sorting of eigenvalues)

    (11)    0     if T(with VS) = T(without VS),
            1/ulp otherwise
            If workspace sufficient, also compare T with and without
            reciprocal condition numbers
            (with sorting of eigenvalues)

    (12)    0     if eigenvalues(with VS) = eigenvalues(without VS),
            1/ulp otherwise
            If workspace sufficient, also compare VS with and without
            reciprocal condition numbers
            (with sorting of eigenvalues)

    (13)    if sorting worked and SDIM is the number of
            eigenvalues which were SELECTed
            If workspace sufficient, also compare SDIM with and
            without reciprocal condition numbers

    (14)    if RCONDE the same no matter if VS and/or RCONDV computed

    (15)    if RCONDV the same no matter if VS and/or RCONDE computed

    The "sizes" are specified by an array NN(1:NSIZES); the value of
    each element NN(j) specifies one size.
    The "types" are specified by a logical array DOTYPE( 1:NTYPES );
    if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
    Currently, the list of possible types is:

    (1)  The zero matrix.
    (2)  The identity matrix.
    (3)  A (transposed) Jordan block, with 1's on the diagonal.

    (4)  A diagonal matrix with evenly spaced entries
         1, ..., ULP  and random complex angles.
         (ULP = (first number larger than 1) - 1 )
    (5)  A diagonal matrix with geometrically spaced entries
         1, ..., ULP  and random complex angles.
    (6)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
         and random complex angles.

    (7)  Same as (4), but multiplied by a constant near
         the overflow threshold
    (8)  Same as (4), but multiplied by a constant near
         the underflow threshold

    (9)  A matrix of the form  U' T U, where U is unitary and
         T has evenly spaced entries 1, ..., ULP with random
         complex angles on the diagonal and random O(1) entries in
         the upper triangle.

    (10) A matrix of the form  U' T U, where U is unitary and
         T has geometrically spaced entries 1, ..., ULP with random
         complex angles on the diagonal and random O(1) entries in
         the upper triangle.

    (11) A matrix of the form  U' T U, where U is orthogonal and
         T has "clustered" entries 1, ULP,..., ULP with random
         complex angles on the diagonal and random O(1) entries in
         the upper triangle.

    (12) A matrix of the form  U' T U, where U is unitary and
         T has complex eigenvalues randomly chosen from
         ULP < |z| < 1   and random O(1) entries in the upper
         triangle.

    (13) A matrix of the form  X' T X, where X has condition
         SQRT( ULP ) and T has evenly spaced entries 1, ..., ULP
         with random complex angles on the diagonal and random O(1)
         entries in the upper triangle.

    (14) A matrix of the form  X' T X, where X has condition
         SQRT( ULP ) and T has geometrically spaced entries
         1, ..., ULP with random complex angles on the diagonal
         and random O(1) entries in the upper triangle.

    (15) A matrix of the form  X' T X, where X has condition
         SQRT( ULP ) and T has "clustered" entries 1, ULP,..., ULP
         with random complex angles on the diagonal and random O(1)
         entries in the upper triangle.

    (16) A matrix of the form  X' T X, where X has condition
         SQRT( ULP ) and T has complex eigenvalues randomly chosen
         from ULP < |z| < 1 and random O(1) entries in the upper
         triangle.

    (17) Same as (16), but multiplied by a constant
         near the overflow threshold
    (18) Same as (16), but multiplied by a constant
         near the underflow threshold

    (19) Nonsymmetric matrix with random entries chosen from (-1,1).
         If N is at least 4, all entries in first two rows and last
         row, and first column and last two columns are zero.
    (20) Same as (19), but multiplied by a constant
         near the overflow threshold
    (21) Same as (19), but multiplied by a constant
         near the underflow threshold

    In addition, an input file will be read from logical unit number
    NIUNIT. The file contains matrices along with precomputed
    eigenvalues and reciprocal condition numbers for the eigenvalue
    average and right invariant subspace. For these matrices, in
    addition to tests (1) to (15) we will compute the following two
    tests:

   (16)  |RCONDE - RCDEIN| / cond(RCONDE)

      RCONDE is the reciprocal average eigenvalue condition number
      computed by CGEESX and RCDEIN (the precomputed true value)
      is supplied as input.  cond(RCONDE) is the condition number
      of RCONDE, and takes errors in computing RCONDE into account,
      so that the resulting quantity should be O(ULP). cond(RCONDE)
      is essentially given by norm(A)/RCONDV.

   (17)  |RCONDV - RCDVIN| / cond(RCONDV)

      RCONDV is the reciprocal right invariant subspace condition
      number computed by CGEESX and RCDVIN (the precomputed true
      value) is supplied as input. cond(RCONDV) is the condition
      number of RCONDV, and takes errors in computing RCONDV into
      account, so that the resulting quantity should be O(ULP).
      cond(RCONDV) is essentially given by norm(A)/RCONDE.
Parameters
[in]NSIZES
          NSIZES is INTEGER
          The number of sizes of matrices to use.  NSIZES must be at
          least zero. If it is zero, no randomly generated matrices
          are tested, but any test matrices read from NIUNIT will be
          tested.
[in]NN
          NN is 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.
[in]NTYPES
          NTYPES is INTEGER
          The number of elements in DOTYPE. NTYPES must be at least
          zero. If it is zero, no randomly generated test matrices
          are tested, but and test matrices read from NIUNIT will be
          tested. 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. .
[in]DOTYPE
          DOTYPE is 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.
[in,out]ISEED
          ISEED is 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 CDRVSX to continue the same random number
          sequence.
[in]THRESH
          THRESH is REAL
          A test will count as "failed" if the "error", 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.
[in]NIUNIT
          NIUNIT is INTEGER
          The FORTRAN unit number for reading in the data file of
          problems to solve.
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns INFO not equal to 0.)
[out]A
          A is COMPLEX 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.
[in]LDA
          LDA is INTEGER
          The leading dimension of A, and H. LDA must be at
          least 1 and at least max( NN ).
[out]H
          H is COMPLEX array, dimension (LDA, max(NN))
          Another copy of the test matrix A, modified by CGEESX.
[out]HT
          HT is COMPLEX array, dimension (LDA, max(NN))
          Yet another copy of the test matrix A, modified by CGEESX.
[out]W
          W is COMPLEX array, dimension (max(NN))
          The computed eigenvalues of A.
[out]WT
          WT is COMPLEX array, dimension (max(NN))
          Like W, this array contains the eigenvalues of A,
          but those computed when CGEESX only computes a partial
          eigendecomposition, i.e. not Schur vectors
[out]WTMP
          WTMP is COMPLEX array, dimension (max(NN))
          More temporary storage for eigenvalues.
[out]VS
          VS is COMPLEX array, dimension (LDVS, max(NN))
          VS holds the computed Schur vectors.
[in]LDVS
          LDVS is INTEGER
          Leading dimension of VS. Must be at least max(1,max(NN)).
[out]VS1
          VS1 is COMPLEX array, dimension (LDVS, max(NN))
          VS1 holds another copy of the computed Schur vectors.
[out]RESULT
          RESULT is REAL array, dimension (17)
          The values computed by the 17 tests described above.
          The values are currently limited to 1/ulp, to avoid overflow.
[out]WORK
          WORK is COMPLEX array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The number of entries in WORK.  This must be at least
          max(1,2*NN(j)**2) for all j.
[out]RWORK
          RWORK is REAL array, dimension (max(NN))
[out]BWORK
          BWORK is LOGICAL array, dimension (max(NN))
[out]INFO
          INFO is INTEGER
          If 0,  successful exit.
            <0,  input parameter -INFO is incorrect
            >0,  CLATMR, CLATMS, CLATME or CGET24 returned an error
                 code and INFO is its absolute value

-----------------------------------------------------------------------

     Some Local Variables and Parameters:
     ---- ----- --------- --- ----------
     ZERO, ONE       Real 0 and 1.
     MAXTYP          The number of types defined.
     NMAX            Largest value in NN.
     NERRS           The number of tests which have exceeded THRESH
     COND, CONDS,
     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.
     RTULP, RTULPI   Square roots of the previous 4 values.
             The following four arrays decode JTYPE:
     KTYPE(j)        The general type (1-10) for type "j".
     KMODE(j)        The MODE value to be passed to the matrix
                     generator for type "j".
     KMAGN(j)        The order of magnitude ( O(1),
                     O(overflow^(1/2) ), O(underflow^(1/2) )
     KCONDS(j)       Selectw whether CONDS is to be 1 or
                     1/sqrt(ulp).  (0 means irrelevant.)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 431 of file cdrvsx.f.

435*
436* -- LAPACK test routine --
437* -- LAPACK is a software package provided by Univ. of Tennessee, --
438* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
439*
440* .. Scalar Arguments ..
441 INTEGER INFO, LDA, LDVS, LWORK, NIUNIT, NOUNIT, NSIZES,
442 $ NTYPES
443 REAL THRESH
444* ..
445* .. Array Arguments ..
446 LOGICAL BWORK( * ), DOTYPE( * )
447 INTEGER ISEED( 4 ), NN( * )
448 REAL RESULT( 17 ), RWORK( * )
449 COMPLEX A( LDA, * ), H( LDA, * ), HT( LDA, * ),
450 $ VS( LDVS, * ), VS1( LDVS, * ), W( * ),
451 $ WORK( * ), WT( * ), WTMP( * )
452* ..
453*
454* =====================================================================
455*
456* .. Parameters ..
457 COMPLEX CZERO
458 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
459 COMPLEX CONE
460 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
461 REAL ZERO, ONE
462 parameter( zero = 0.0e+0, one = 1.0e+0 )
463 INTEGER MAXTYP
464 parameter( maxtyp = 21 )
465* ..
466* .. Local Scalars ..
467 LOGICAL BADNN
468 CHARACTER*3 PATH
469 INTEGER I, IINFO, IMODE, ISRT, ITYPE, IWK, J, JCOL,
470 $ JSIZE, JTYPE, MTYPES, N, NERRS, NFAIL,
471 $ NMAX, NNWORK, NSLCT, NTEST, NTESTF, NTESTT
472 REAL ANORM, COND, CONDS, OVFL, RCDEIN, RCDVIN,
473 $ RTULP, RTULPI, ULP, ULPINV, UNFL
474* ..
475* .. Local Arrays ..
476 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISLCT( 20 ),
477 $ KCONDS( MAXTYP ), KMAGN( MAXTYP ),
478 $ KMODE( MAXTYP ), KTYPE( MAXTYP )
479* ..
480* .. Arrays in Common ..
481 LOGICAL SELVAL( 20 )
482 REAL SELWI( 20 ), SELWR( 20 )
483* ..
484* .. Scalars in Common ..
485 INTEGER SELDIM, SELOPT
486* ..
487* .. Common blocks ..
488 COMMON / sslct / selopt, seldim, selval, selwr, selwi
489* ..
490* .. External Functions ..
491 REAL SLAMCH
492 EXTERNAL slamch
493* ..
494* .. External Subroutines ..
495 EXTERNAL cget24, clatme, clatmr, clatms, claset,
496 $ slasum, xerbla
497* ..
498* .. Intrinsic Functions ..
499 INTRINSIC abs, max, min, sqrt
500* ..
501* .. Data statements ..
502 DATA ktype / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
503 DATA kmagn / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
504 $ 3, 1, 2, 3 /
505 DATA kmode / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
506 $ 1, 5, 5, 5, 4, 3, 1 /
507 DATA kconds / 3*0, 5*0, 4*1, 6*2, 3*0 /
508* ..
509* .. Executable Statements ..
510*
511 path( 1: 1 ) = 'Complex precision'
512 path( 2: 3 ) = 'SX'
513*
514* Check for errors
515*
516 ntestt = 0
517 ntestf = 0
518 info = 0
519*
520* Important constants
521*
522 badnn = .false.
523*
524* 8 is the largest dimension in the input file of precomputed
525* problems
526*
527 nmax = 8
528 DO 10 j = 1, nsizes
529 nmax = max( nmax, nn( j ) )
530 IF( nn( j ).LT.0 )
531 $ badnn = .true.
532 10 CONTINUE
533*
534* Check for errors
535*
536 IF( nsizes.LT.0 ) THEN
537 info = -1
538 ELSE IF( badnn ) THEN
539 info = -2
540 ELSE IF( ntypes.LT.0 ) THEN
541 info = -3
542 ELSE IF( thresh.LT.zero ) THEN
543 info = -6
544 ELSE IF( niunit.LE.0 ) THEN
545 info = -7
546 ELSE IF( nounit.LE.0 ) THEN
547 info = -8
548 ELSE IF( lda.LT.1 .OR. lda.LT.nmax ) THEN
549 info = -10
550 ELSE IF( ldvs.LT.1 .OR. ldvs.LT.nmax ) THEN
551 info = -20
552 ELSE IF( max( 3*nmax, 2*nmax**2 ).GT.lwork ) THEN
553 info = -24
554 END IF
555*
556 IF( info.NE.0 ) THEN
557 CALL xerbla( 'CDRVSX', -info )
558 RETURN
559 END IF
560*
561* If nothing to do check on NIUNIT
562*
563 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
564 $ GO TO 150
565*
566* More Important constants
567*
568 unfl = slamch( 'Safe minimum' )
569 ovfl = one / unfl
570 ulp = slamch( 'Precision' )
571 ulpinv = one / ulp
572 rtulp = sqrt( ulp )
573 rtulpi = one / rtulp
574*
575* Loop over sizes, types
576*
577 nerrs = 0
578*
579 DO 140 jsize = 1, nsizes
580 n = nn( jsize )
581 IF( nsizes.NE.1 ) THEN
582 mtypes = min( maxtyp, ntypes )
583 ELSE
584 mtypes = min( maxtyp+1, ntypes )
585 END IF
586*
587 DO 130 jtype = 1, mtypes
588 IF( .NOT.dotype( jtype ) )
589 $ GO TO 130
590*
591* Save ISEED in case of an error.
592*
593 DO 20 j = 1, 4
594 ioldsd( j ) = iseed( j )
595 20 CONTINUE
596*
597* Compute "A"
598*
599* Control parameters:
600*
601* KMAGN KCONDS KMODE KTYPE
602* =1 O(1) 1 clustered 1 zero
603* =2 large large clustered 2 identity
604* =3 small exponential Jordan
605* =4 arithmetic diagonal, (w/ eigenvalues)
606* =5 random log symmetric, w/ eigenvalues
607* =6 random general, w/ eigenvalues
608* =7 random diagonal
609* =8 random symmetric
610* =9 random general
611* =10 random triangular
612*
613 IF( mtypes.GT.maxtyp )
614 $ GO TO 90
615*
616 itype = ktype( jtype )
617 imode = kmode( jtype )
618*
619* Compute norm
620*
621 GO TO ( 30, 40, 50 )kmagn( jtype )
622*
623 30 CONTINUE
624 anorm = one
625 GO TO 60
626*
627 40 CONTINUE
628 anorm = ovfl*ulp
629 GO TO 60
630*
631 50 CONTINUE
632 anorm = unfl*ulpinv
633 GO TO 60
634*
635 60 CONTINUE
636*
637 CALL claset( 'Full', lda, n, czero, czero, a, lda )
638 iinfo = 0
639 cond = ulpinv
640*
641* Special Matrices -- Identity & Jordan block
642*
643 IF( itype.EQ.1 ) THEN
644*
645* Zero
646*
647 iinfo = 0
648*
649 ELSE IF( itype.EQ.2 ) THEN
650*
651* Identity
652*
653 DO 70 jcol = 1, n
654 a( jcol, jcol ) = anorm
655 70 CONTINUE
656*
657 ELSE IF( itype.EQ.3 ) THEN
658*
659* Jordan Block
660*
661 DO 80 jcol = 1, n
662 a( jcol, jcol ) = anorm
663 IF( jcol.GT.1 )
664 $ a( jcol, jcol-1 ) = cone
665 80 CONTINUE
666*
667 ELSE IF( itype.EQ.4 ) THEN
668*
669* Diagonal Matrix, [Eigen]values Specified
670*
671 CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
672 $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
673 $ iinfo )
674*
675 ELSE IF( itype.EQ.5 ) THEN
676*
677* Symmetric, eigenvalues specified
678*
679 CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
680 $ anorm, n, n, 'N', a, lda, work( n+1 ),
681 $ iinfo )
682*
683 ELSE IF( itype.EQ.6 ) THEN
684*
685* General, eigenvalues specified
686*
687 IF( kconds( jtype ).EQ.1 ) THEN
688 conds = one
689 ELSE IF( kconds( jtype ).EQ.2 ) THEN
690 conds = rtulpi
691 ELSE
692 conds = zero
693 END IF
694*
695 CALL clatme( n, 'D', iseed, work, imode, cond, cone,
696 $ 'T', 'T', 'T', rwork, 4, conds, n, n, anorm,
697 $ a, lda, work( 2*n+1 ), iinfo )
698*
699 ELSE IF( itype.EQ.7 ) THEN
700*
701* Diagonal, random eigenvalues
702*
703 CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
704 $ 'T', 'N', work( n+1 ), 1, one,
705 $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
706 $ zero, anorm, 'NO', a, lda, idumma, iinfo )
707*
708 ELSE IF( itype.EQ.8 ) THEN
709*
710* Symmetric, random eigenvalues
711*
712 CALL clatmr( n, n, 'D', iseed, 'H', work, 6, one, cone,
713 $ 'T', 'N', work( n+1 ), 1, one,
714 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
715 $ zero, anorm, 'NO', a, lda, idumma, iinfo )
716*
717 ELSE IF( itype.EQ.9 ) THEN
718*
719* General, random eigenvalues
720*
721 CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
722 $ 'T', 'N', work( n+1 ), 1, one,
723 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
724 $ zero, anorm, 'NO', a, lda, idumma, iinfo )
725 IF( n.GE.4 ) THEN
726 CALL claset( 'Full', 2, n, czero, czero, a, lda )
727 CALL claset( 'Full', n-3, 1, czero, czero, a( 3, 1 ),
728 $ lda )
729 CALL claset( 'Full', n-3, 2, czero, czero,
730 $ a( 3, n-1 ), lda )
731 CALL claset( 'Full', 1, n, czero, czero, a( n, 1 ),
732 $ lda )
733 END IF
734*
735 ELSE IF( itype.EQ.10 ) THEN
736*
737* Triangular, random eigenvalues
738*
739 CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
740 $ 'T', 'N', work( n+1 ), 1, one,
741 $ work( 2*n+1 ), 1, one, 'N', idumma, n, 0,
742 $ zero, anorm, 'NO', a, lda, idumma, iinfo )
743*
744 ELSE
745*
746 iinfo = 1
747 END IF
748*
749 IF( iinfo.NE.0 ) THEN
750 WRITE( nounit, fmt = 9991 )'Generator', iinfo, n, jtype,
751 $ ioldsd
752 info = abs( iinfo )
753 RETURN
754 END IF
755*
756 90 CONTINUE
757*
758* Test for minimal and generous workspace
759*
760 DO 120 iwk = 1, 2
761 IF( iwk.EQ.1 ) THEN
762 nnwork = 2*n
763 ELSE
764 nnwork = max( 2*n, n*( n+1 ) / 2 )
765 END IF
766 nnwork = max( nnwork, 1 )
767*
768 CALL cget24( .false., jtype, thresh, ioldsd, nounit, n,
769 $ a, lda, h, ht, w, wt, wtmp, vs, ldvs, vs1,
770 $ rcdein, rcdvin, nslct, islct, 0, result,
771 $ work, nnwork, rwork, bwork, info )
772*
773* Check for RESULT(j) > THRESH
774*
775 ntest = 0
776 nfail = 0
777 DO 100 j = 1, 15
778 IF( result( j ).GE.zero )
779 $ ntest = ntest + 1
780 IF( result( j ).GE.thresh )
781 $ nfail = nfail + 1
782 100 CONTINUE
783*
784 IF( nfail.GT.0 )
785 $ ntestf = ntestf + 1
786 IF( ntestf.EQ.1 ) THEN
787 WRITE( nounit, fmt = 9999 )path
788 WRITE( nounit, fmt = 9998 )
789 WRITE( nounit, fmt = 9997 )
790 WRITE( nounit, fmt = 9996 )
791 WRITE( nounit, fmt = 9995 )thresh
792 WRITE( nounit, fmt = 9994 )
793 ntestf = 2
794 END IF
795*
796 DO 110 j = 1, 15
797 IF( result( j ).GE.thresh ) THEN
798 WRITE( nounit, fmt = 9993 )n, iwk, ioldsd, jtype,
799 $ j, result( j )
800 END IF
801 110 CONTINUE
802*
803 nerrs = nerrs + nfail
804 ntestt = ntestt + ntest
805*
806 120 CONTINUE
807 130 CONTINUE
808 140 CONTINUE
809*
810 150 CONTINUE
811*
812* Read in data from file to check accuracy of condition estimation
813* Read input data until N=0
814*
815 jtype = 0
816 160 CONTINUE
817 READ( niunit, fmt = *, END = 200 )N, NSLCT, isrt
818 IF( n.EQ.0 )
819 $ GO TO 200
820 jtype = jtype + 1
821 iseed( 1 ) = jtype
822 READ( niunit, fmt = * )( islct( i ), i = 1, nslct )
823 DO 170 i = 1, n
824 READ( niunit, fmt = * )( a( i, j ), j = 1, n )
825 170 CONTINUE
826 READ( niunit, fmt = * )rcdein, rcdvin
827*
828 CALL cget24( .true., 22, thresh, iseed, nounit, n, a, lda, h, ht,
829 $ w, wt, wtmp, vs, ldvs, vs1, rcdein, rcdvin, nslct,
830 $ islct, isrt, result, work, lwork, rwork, bwork,
831 $ info )
832*
833* Check for RESULT(j) > THRESH
834*
835 ntest = 0
836 nfail = 0
837 DO 180 j = 1, 17
838 IF( result( j ).GE.zero )
839 $ ntest = ntest + 1
840 IF( result( j ).GE.thresh )
841 $ nfail = nfail + 1
842 180 CONTINUE
843*
844 IF( nfail.GT.0 )
845 $ ntestf = ntestf + 1
846 IF( ntestf.EQ.1 ) THEN
847 WRITE( nounit, fmt = 9999 )path
848 WRITE( nounit, fmt = 9998 )
849 WRITE( nounit, fmt = 9997 )
850 WRITE( nounit, fmt = 9996 )
851 WRITE( nounit, fmt = 9995 )thresh
852 WRITE( nounit, fmt = 9994 )
853 ntestf = 2
854 END IF
855 DO 190 j = 1, 17
856 IF( result( j ).GE.thresh ) THEN
857 WRITE( nounit, fmt = 9992 )n, jtype, j, result( j )
858 END IF
859 190 CONTINUE
860*
861 nerrs = nerrs + nfail
862 ntestt = ntestt + ntest
863 GO TO 160
864 200 CONTINUE
865*
866* Summary
867*
868 CALL slasum( path, nounit, nerrs, ntestt )
869*
870 9999 FORMAT( / 1x, a3, ' -- Complex Schur Form Decomposition Expert ',
871 $ 'Driver', / ' Matrix types (see CDRVSX for details): ' )
872*
873 9998 FORMAT( / ' Special Matrices:', / ' 1=Zero matrix. ',
874 $ ' ', ' 5=Diagonal: geometr. spaced entries.',
875 $ / ' 2=Identity matrix. ', ' 6=Diagona',
876 $ 'l: clustered entries.', / ' 3=Transposed Jordan block. ',
877 $ ' ', ' 7=Diagonal: large, evenly spaced.', / ' ',
878 $ '4=Diagonal: evenly spaced entries. ', ' 8=Diagonal: s',
879 $ 'mall, evenly spaced.' )
880 9997 FORMAT( ' Dense, Non-Symmetric Matrices:', / ' 9=Well-cond., ev',
881 $ 'enly spaced eigenvals.', ' 14=Ill-cond., geomet. spaced e',
882 $ 'igenals.', / ' 10=Well-cond., geom. spaced eigenvals. ',
883 $ ' 15=Ill-conditioned, clustered e.vals.', / ' 11=Well-cond',
884 $ 'itioned, clustered e.vals. ', ' 16=Ill-cond., random comp',
885 $ 'lex ', / ' 12=Well-cond., random complex ', ' ',
886 $ ' 17=Ill-cond., large rand. complx ', / ' 13=Ill-condi',
887 $ 'tioned, evenly spaced. ', ' 18=Ill-cond., small rand.',
888 $ ' complx ' )
889 9996 FORMAT( ' 19=Matrix with random O(1) entries. ', ' 21=Matrix ',
890 $ 'with small random entries.', / ' 20=Matrix with large ran',
891 $ 'dom entries. ', / )
892 9995 FORMAT( ' Tests performed with test threshold =', f8.2,
893 $ / ' ( A denotes A on input and T denotes A on output)',
894 $ / / ' 1 = 0 if T in Schur form (no sort), ',
895 $ ' 1/ulp otherwise', /
896 $ ' 2 = | A - VS T transpose(VS) | / ( n |A| ulp ) (no sort)',
897 $ / ' 3 = | I - VS transpose(VS) | / ( n ulp ) (no sort) ',
898 $ / ' 4 = 0 if W are eigenvalues of T (no sort),',
899 $ ' 1/ulp otherwise', /
900 $ ' 5 = 0 if T same no matter if VS computed (no sort),',
901 $ ' 1/ulp otherwise', /
902 $ ' 6 = 0 if W same no matter if VS computed (no sort)',
903 $ ', 1/ulp otherwise' )
904 9994 FORMAT( ' 7 = 0 if T in Schur form (sort), ', ' 1/ulp otherwise',
905 $ / ' 8 = | A - VS T transpose(VS) | / ( n |A| ulp ) (sort)',
906 $ / ' 9 = | I - VS transpose(VS) | / ( n ulp ) (sort) ',
907 $ / ' 10 = 0 if W are eigenvalues of T (sort),',
908 $ ' 1/ulp otherwise', /
909 $ ' 11 = 0 if T same no matter what else computed (sort),',
910 $ ' 1/ulp otherwise', /
911 $ ' 12 = 0 if W same no matter what else computed ',
912 $ '(sort), 1/ulp otherwise', /
913 $ ' 13 = 0 if sorting successful, 1/ulp otherwise',
914 $ / ' 14 = 0 if RCONDE same no matter what else computed,',
915 $ ' 1/ulp otherwise', /
916 $ ' 15 = 0 if RCONDv same no matter what else computed,',
917 $ ' 1/ulp otherwise', /
918 $ ' 16 = | RCONDE - RCONDE(precomputed) | / cond(RCONDE),',
919 $ / ' 17 = | RCONDV - RCONDV(precomputed) | / cond(RCONDV),' )
920 9993 FORMAT( ' N=', i5, ', IWK=', i2, ', seed=', 4( i4, ',' ),
921 $ ' type ', i2, ', test(', i2, ')=', g10.3 )
922 9992 FORMAT( ' N=', i5, ', input example =', i3, ', test(', i2, ')=',
923 $ g10.3 )
924 9991 FORMAT( ' CDRVSX: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
925 $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
926*
927 RETURN
928*
929* End of CDRVSX
930*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine cget24(comp, jtype, thresh, iseed, nounit, n, a, lda, h, ht, w, wt, wtmp, vs, ldvs, vs1, rcdein, rcdvin, nslct, islct, isrt, result, work, lwork, rwork, bwork, info)
CGET24
Definition cget24.f:335
subroutine clatme(n, dist, iseed, d, mode, cond, dmax, rsign, upper, sim, ds, modes, conds, kl, ku, anorm, a, lda, work, info)
CLATME
Definition clatme.f:301
subroutine clatmr(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)
CLATMR
Definition clatmr.f:490
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
Definition clatms.f:332
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
subroutine claset(uplo, m, n, alpha, beta, a, lda)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition claset.f:106
subroutine slasum(type, iounit, ie, nrun)
SLASUM
Definition slasum.f:41
Here is the call graph for this function:
Here is the caller graph for this function: