LAPACK 3.11.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, slabad,
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 CALL slabad( unfl, ovfl )
571 ulp = slamch( 'Precision' )
572 ulpinv = one / ulp
573 rtulp = sqrt( ulp )
574 rtulpi = one / rtulp
575*
576* Loop over sizes, types
577*
578 nerrs = 0
579*
580 DO 140 jsize = 1, nsizes
581 n = nn( jsize )
582 IF( nsizes.NE.1 ) THEN
583 mtypes = min( maxtyp, ntypes )
584 ELSE
585 mtypes = min( maxtyp+1, ntypes )
586 END IF
587*
588 DO 130 jtype = 1, mtypes
589 IF( .NOT.dotype( jtype ) )
590 $ GO TO 130
591*
592* Save ISEED in case of an error.
593*
594 DO 20 j = 1, 4
595 ioldsd( j ) = iseed( j )
596 20 CONTINUE
597*
598* Compute "A"
599*
600* Control parameters:
601*
602* KMAGN KCONDS KMODE KTYPE
603* =1 O(1) 1 clustered 1 zero
604* =2 large large clustered 2 identity
605* =3 small exponential Jordan
606* =4 arithmetic diagonal, (w/ eigenvalues)
607* =5 random log symmetric, w/ eigenvalues
608* =6 random general, w/ eigenvalues
609* =7 random diagonal
610* =8 random symmetric
611* =9 random general
612* =10 random triangular
613*
614 IF( mtypes.GT.maxtyp )
615 $ GO TO 90
616*
617 itype = ktype( jtype )
618 imode = kmode( jtype )
619*
620* Compute norm
621*
622 GO TO ( 30, 40, 50 )kmagn( jtype )
623*
624 30 CONTINUE
625 anorm = one
626 GO TO 60
627*
628 40 CONTINUE
629 anorm = ovfl*ulp
630 GO TO 60
631*
632 50 CONTINUE
633 anorm = unfl*ulpinv
634 GO TO 60
635*
636 60 CONTINUE
637*
638 CALL claset( 'Full', lda, n, czero, czero, a, lda )
639 iinfo = 0
640 cond = ulpinv
641*
642* Special Matrices -- Identity & Jordan block
643*
644 IF( itype.EQ.1 ) THEN
645*
646* Zero
647*
648 iinfo = 0
649*
650 ELSE IF( itype.EQ.2 ) THEN
651*
652* Identity
653*
654 DO 70 jcol = 1, n
655 a( jcol, jcol ) = anorm
656 70 CONTINUE
657*
658 ELSE IF( itype.EQ.3 ) THEN
659*
660* Jordan Block
661*
662 DO 80 jcol = 1, n
663 a( jcol, jcol ) = anorm
664 IF( jcol.GT.1 )
665 $ a( jcol, jcol-1 ) = cone
666 80 CONTINUE
667*
668 ELSE IF( itype.EQ.4 ) THEN
669*
670* Diagonal Matrix, [Eigen]values Specified
671*
672 CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
673 $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
674 $ iinfo )
675*
676 ELSE IF( itype.EQ.5 ) THEN
677*
678* Symmetric, eigenvalues specified
679*
680 CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
681 $ anorm, n, n, 'N', a, lda, work( n+1 ),
682 $ iinfo )
683*
684 ELSE IF( itype.EQ.6 ) THEN
685*
686* General, eigenvalues specified
687*
688 IF( kconds( jtype ).EQ.1 ) THEN
689 conds = one
690 ELSE IF( kconds( jtype ).EQ.2 ) THEN
691 conds = rtulpi
692 ELSE
693 conds = zero
694 END IF
695*
696 CALL clatme( n, 'D', iseed, work, imode, cond, cone,
697 $ 'T', 'T', 'T', rwork, 4, conds, n, n, anorm,
698 $ a, lda, work( 2*n+1 ), iinfo )
699*
700 ELSE IF( itype.EQ.7 ) THEN
701*
702* Diagonal, random eigenvalues
703*
704 CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
705 $ 'T', 'N', work( n+1 ), 1, one,
706 $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
707 $ zero, anorm, 'NO', a, lda, idumma, iinfo )
708*
709 ELSE IF( itype.EQ.8 ) THEN
710*
711* Symmetric, random eigenvalues
712*
713 CALL clatmr( n, n, 'D', iseed, 'H', work, 6, one, cone,
714 $ 'T', 'N', work( n+1 ), 1, one,
715 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
716 $ zero, anorm, 'NO', a, lda, idumma, iinfo )
717*
718 ELSE IF( itype.EQ.9 ) THEN
719*
720* General, random eigenvalues
721*
722 CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
723 $ 'T', 'N', work( n+1 ), 1, one,
724 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
725 $ zero, anorm, 'NO', a, lda, idumma, iinfo )
726 IF( n.GE.4 ) THEN
727 CALL claset( 'Full', 2, n, czero, czero, a, lda )
728 CALL claset( 'Full', n-3, 1, czero, czero, a( 3, 1 ),
729 $ lda )
730 CALL claset( 'Full', n-3, 2, czero, czero,
731 $ a( 3, n-1 ), lda )
732 CALL claset( 'Full', 1, n, czero, czero, a( n, 1 ),
733 $ lda )
734 END IF
735*
736 ELSE IF( itype.EQ.10 ) THEN
737*
738* Triangular, random eigenvalues
739*
740 CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
741 $ 'T', 'N', work( n+1 ), 1, one,
742 $ work( 2*n+1 ), 1, one, 'N', idumma, n, 0,
743 $ zero, anorm, 'NO', a, lda, idumma, iinfo )
744*
745 ELSE
746*
747 iinfo = 1
748 END IF
749*
750 IF( iinfo.NE.0 ) THEN
751 WRITE( nounit, fmt = 9991 )'Generator', iinfo, n, jtype,
752 $ ioldsd
753 info = abs( iinfo )
754 RETURN
755 END IF
756*
757 90 CONTINUE
758*
759* Test for minimal and generous workspace
760*
761 DO 120 iwk = 1, 2
762 IF( iwk.EQ.1 ) THEN
763 nnwork = 2*n
764 ELSE
765 nnwork = max( 2*n, n*( n+1 ) / 2 )
766 END IF
767 nnwork = max( nnwork, 1 )
768*
769 CALL cget24( .false., jtype, thresh, ioldsd, nounit, n,
770 $ a, lda, h, ht, w, wt, wtmp, vs, ldvs, vs1,
771 $ rcdein, rcdvin, nslct, islct, 0, result,
772 $ work, nnwork, rwork, bwork, info )
773*
774* Check for RESULT(j) > THRESH
775*
776 ntest = 0
777 nfail = 0
778 DO 100 j = 1, 15
779 IF( result( j ).GE.zero )
780 $ ntest = ntest + 1
781 IF( result( j ).GE.thresh )
782 $ nfail = nfail + 1
783 100 CONTINUE
784*
785 IF( nfail.GT.0 )
786 $ ntestf = ntestf + 1
787 IF( ntestf.EQ.1 ) THEN
788 WRITE( nounit, fmt = 9999 )path
789 WRITE( nounit, fmt = 9998 )
790 WRITE( nounit, fmt = 9997 )
791 WRITE( nounit, fmt = 9996 )
792 WRITE( nounit, fmt = 9995 )thresh
793 WRITE( nounit, fmt = 9994 )
794 ntestf = 2
795 END IF
796*
797 DO 110 j = 1, 15
798 IF( result( j ).GE.thresh ) THEN
799 WRITE( nounit, fmt = 9993 )n, iwk, ioldsd, jtype,
800 $ j, result( j )
801 END IF
802 110 CONTINUE
803*
804 nerrs = nerrs + nfail
805 ntestt = ntestt + ntest
806*
807 120 CONTINUE
808 130 CONTINUE
809 140 CONTINUE
810*
811 150 CONTINUE
812*
813* Read in data from file to check accuracy of condition estimation
814* Read input data until N=0
815*
816 jtype = 0
817 160 CONTINUE
818 READ( niunit, fmt = *, END = 200 )N, NSLCT, isrt
819 IF( n.EQ.0 )
820 $ GO TO 200
821 jtype = jtype + 1
822 iseed( 1 ) = jtype
823 READ( niunit, fmt = * )( islct( i ), i = 1, nslct )
824 DO 170 i = 1, n
825 READ( niunit, fmt = * )( a( i, j ), j = 1, n )
826 170 CONTINUE
827 READ( niunit, fmt = * )rcdein, rcdvin
828*
829 CALL cget24( .true., 22, thresh, iseed, nounit, n, a, lda, h, ht,
830 $ w, wt, wtmp, vs, ldvs, vs1, rcdein, rcdvin, nslct,
831 $ islct, isrt, result, work, lwork, rwork, bwork,
832 $ info )
833*
834* Check for RESULT(j) > THRESH
835*
836 ntest = 0
837 nfail = 0
838 DO 180 j = 1, 17
839 IF( result( j ).GE.zero )
840 $ ntest = ntest + 1
841 IF( result( j ).GE.thresh )
842 $ nfail = nfail + 1
843 180 CONTINUE
844*
845 IF( nfail.GT.0 )
846 $ ntestf = ntestf + 1
847 IF( ntestf.EQ.1 ) THEN
848 WRITE( nounit, fmt = 9999 )path
849 WRITE( nounit, fmt = 9998 )
850 WRITE( nounit, fmt = 9997 )
851 WRITE( nounit, fmt = 9996 )
852 WRITE( nounit, fmt = 9995 )thresh
853 WRITE( nounit, fmt = 9994 )
854 ntestf = 2
855 END IF
856 DO 190 j = 1, 17
857 IF( result( j ).GE.thresh ) THEN
858 WRITE( nounit, fmt = 9992 )n, jtype, j, result( j )
859 END IF
860 190 CONTINUE
861*
862 nerrs = nerrs + nfail
863 ntestt = ntestt + ntest
864 GO TO 160
865 200 CONTINUE
866*
867* Summary
868*
869 CALL slasum( path, nounit, nerrs, ntestt )
870*
871 9999 FORMAT( / 1x, a3, ' -- Complex Schur Form Decomposition Expert ',
872 $ 'Driver', / ' Matrix types (see CDRVSX for details): ' )
873*
874 9998 FORMAT( / ' Special Matrices:', / ' 1=Zero matrix. ',
875 $ ' ', ' 5=Diagonal: geometr. spaced entries.',
876 $ / ' 2=Identity matrix. ', ' 6=Diagona',
877 $ 'l: clustered entries.', / ' 3=Transposed Jordan block. ',
878 $ ' ', ' 7=Diagonal: large, evenly spaced.', / ' ',
879 $ '4=Diagonal: evenly spaced entries. ', ' 8=Diagonal: s',
880 $ 'mall, evenly spaced.' )
881 9997 FORMAT( ' Dense, Non-Symmetric Matrices:', / ' 9=Well-cond., ev',
882 $ 'enly spaced eigenvals.', ' 14=Ill-cond., geomet. spaced e',
883 $ 'igenals.', / ' 10=Well-cond., geom. spaced eigenvals. ',
884 $ ' 15=Ill-conditioned, clustered e.vals.', / ' 11=Well-cond',
885 $ 'itioned, clustered e.vals. ', ' 16=Ill-cond., random comp',
886 $ 'lex ', / ' 12=Well-cond., random complex ', ' ',
887 $ ' 17=Ill-cond., large rand. complx ', / ' 13=Ill-condi',
888 $ 'tioned, evenly spaced. ', ' 18=Ill-cond., small rand.',
889 $ ' complx ' )
890 9996 FORMAT( ' 19=Matrix with random O(1) entries. ', ' 21=Matrix ',
891 $ 'with small random entries.', / ' 20=Matrix with large ran',
892 $ 'dom entries. ', / )
893 9995 FORMAT( ' Tests performed with test threshold =', f8.2,
894 $ / ' ( A denotes A on input and T denotes A on output)',
895 $ / / ' 1 = 0 if T in Schur form (no sort), ',
896 $ ' 1/ulp otherwise', /
897 $ ' 2 = | A - VS T transpose(VS) | / ( n |A| ulp ) (no sort)',
898 $ / ' 3 = | I - VS transpose(VS) | / ( n ulp ) (no sort) ',
899 $ / ' 4 = 0 if W are eigenvalues of T (no sort),',
900 $ ' 1/ulp otherwise', /
901 $ ' 5 = 0 if T same no matter if VS computed (no sort),',
902 $ ' 1/ulp otherwise', /
903 $ ' 6 = 0 if W same no matter if VS computed (no sort)',
904 $ ', 1/ulp otherwise' )
905 9994 FORMAT( ' 7 = 0 if T in Schur form (sort), ', ' 1/ulp otherwise',
906 $ / ' 8 = | A - VS T transpose(VS) | / ( n |A| ulp ) (sort)',
907 $ / ' 9 = | I - VS transpose(VS) | / ( n ulp ) (sort) ',
908 $ / ' 10 = 0 if W are eigenvalues of T (sort),',
909 $ ' 1/ulp otherwise', /
910 $ ' 11 = 0 if T same no matter what else computed (sort),',
911 $ ' 1/ulp otherwise', /
912 $ ' 12 = 0 if W same no matter what else computed ',
913 $ '(sort), 1/ulp otherwise', /
914 $ ' 13 = 0 if sorting successful, 1/ulp otherwise',
915 $ / ' 14 = 0 if RCONDE same no matter what else computed,',
916 $ ' 1/ulp otherwise', /
917 $ ' 15 = 0 if RCONDv same no matter what else computed,',
918 $ ' 1/ulp otherwise', /
919 $ ' 16 = | RCONDE - RCONDE(precomputed) | / cond(RCONDE),',
920 $ / ' 17 = | RCONDV - RCONDV(precomputed) | / cond(RCONDV),' )
921 9993 FORMAT( ' N=', i5, ', IWK=', i2, ', seed=', 4( i4, ',' ),
922 $ ' type ', i2, ', test(', i2, ')=', g10.3 )
923 9992 FORMAT( ' N=', i5, ', input example =', i3, ', test(', i2, ')=',
924 $ g10.3 )
925 9991 FORMAT( ' CDRVSX: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
926 $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
927*
928 RETURN
929*
930* End of CDRVSX
931*
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
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 clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:332
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 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
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
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: