LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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: