LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cdrves()

subroutine cdrves ( integer  NSIZES,
integer, dimension( * )  NN,
integer  NTYPES,
logical, dimension( * )  DOTYPE,
integer, dimension( 4 )  ISEED,
real  THRESH,
integer  NOUNIT,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( lda, * )  H,
complex, dimension( lda, * )  HT,
complex, dimension( * )  W,
complex, dimension( * )  WT,
complex, dimension( ldvs, * )  VS,
integer  LDVS,
real, dimension( 13 )  RESULT,
complex, dimension( * )  WORK,
integer  NWORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
logical, dimension( * )  BWORK,
integer  INFO 
)

CDRVES

Purpose:
    CDRVES checks the nonsymmetric eigenvalue (Schur form) problem
    driver CGEES.

    When CDRVES 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, 13
    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
            (with sorting of eigenvalues)

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

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

    (13)    if sorting worked and SDIM is the number of
            eigenvalues which were SELECTed

    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
Parameters
[in]NSIZES
          NSIZES is INTEGER
          The number of sizes of matrices to use.  If it is zero,
          CDRVES does nothing.  It must be at least zero.
[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.   If it is zero, CDRVES
          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. .
[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 CDRVES 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]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 CGEES.
[out]HT
          HT is COMPLEX array, dimension (LDA, max(NN))
          Yet another copy of the test matrix A, modified by CGEES.
[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 CGEES only computes a partial
          eigendecomposition, i.e. not Schur vectors
[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]RESULT
          RESULT is REAL array, dimension (13)
          The values computed by the 13 tests described above.
          The values are currently limited to 1/ulp, to avoid overflow.
[out]WORK
          WORK is COMPLEX array, dimension (NWORK)
[in]NWORK
          NWORK is INTEGER
          The number of entries in WORK.  This must be at least
          5*NN(j)+2*NN(j)**2 for all j.
[out]RWORK
          RWORK is REAL array, dimension (max(NN))
[out]IWORK
          IWORK is INTEGER array, dimension (max(NN))
[out]BWORK
          BWORK is LOGICAL array, dimension (max(NN))
[out]INFO
          INFO is INTEGER
          If 0, then everything ran OK.
           -1: NSIZES < 0
           -2: Some NN(j) < 0
           -3: NTYPES < 0
           -6: THRESH < 0
           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
          -15: LDVS < 1 or LDVS < NMAX, where NMAX is max( NN(j) ).
          -18: NWORK too small.
          If  CLATMR, CLATMS, CLATME or CGEES returns an error code,
              the absolute value of it is returned.

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

     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)       Select 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 375 of file cdrves.f.

378 *
379 * -- LAPACK test routine --
380 * -- LAPACK is a software package provided by Univ. of Tennessee, --
381 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
382 *
383 * .. Scalar Arguments ..
384  INTEGER INFO, LDA, LDVS, NOUNIT, NSIZES, NTYPES, NWORK
385  REAL THRESH
386 * ..
387 * .. Array Arguments ..
388  LOGICAL BWORK( * ), DOTYPE( * )
389  INTEGER ISEED( 4 ), IWORK( * ), NN( * )
390  REAL RESULT( 13 ), RWORK( * )
391  COMPLEX A( LDA, * ), H( LDA, * ), HT( LDA, * ),
392  $ VS( LDVS, * ), W( * ), WORK( * ), WT( * )
393 * ..
394 *
395 * =====================================================================
396 *
397 * .. Parameters ..
398  COMPLEX CZERO
399  parameter( czero = ( 0.0e+0, 0.0e+0 ) )
400  COMPLEX CONE
401  parameter( cone = ( 1.0e+0, 0.0e+0 ) )
402  REAL ZERO, ONE
403  parameter( zero = 0.0e+0, one = 1.0e+0 )
404  INTEGER MAXTYP
405  parameter( maxtyp = 21 )
406 * ..
407 * .. Local Scalars ..
408  LOGICAL BADNN
409  CHARACTER SORT
410  CHARACTER*3 PATH
411  INTEGER I, IINFO, IMODE, ISORT, ITYPE, IWK, J, JCOL,
412  $ JSIZE, JTYPE, KNTEIG, LWORK, MTYPES, N,
413  $ NERRS, NFAIL, NMAX, NNWORK, NTEST, NTESTF,
414  $ NTESTT, RSUB, SDIM
415  REAL ANORM, COND, CONDS, OVFL, RTULP, RTULPI, ULP,
416  $ ULPINV, UNFL
417 * ..
418 * .. Local Arrays ..
419  INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ),
420  $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
421  $ KTYPE( MAXTYP )
422  REAL RES( 2 )
423 * ..
424 * .. Arrays in Common ..
425  LOGICAL SELVAL( 20 )
426  REAL SELWI( 20 ), SELWR( 20 )
427 * ..
428 * .. Scalars in Common ..
429  INTEGER SELDIM, SELOPT
430 * ..
431 * .. Common blocks ..
432  COMMON / sslct / selopt, seldim, selval, selwr, selwi
433 * ..
434 * .. External Functions ..
435  LOGICAL CSLECT
436  REAL SLAMCH
437  EXTERNAL cslect, slamch
438 * ..
439 * .. External Subroutines ..
440  EXTERNAL cgees, chst01, clacpy, clatme, clatmr, clatms,
442 * ..
443 * .. Intrinsic Functions ..
444  INTRINSIC abs, cmplx, max, min, sqrt
445 * ..
446 * .. Data statements ..
447  DATA ktype / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
448  DATA kmagn / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
449  $ 3, 1, 2, 3 /
450  DATA kmode / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
451  $ 1, 5, 5, 5, 4, 3, 1 /
452  DATA kconds / 3*0, 5*0, 4*1, 6*2, 3*0 /
453 * ..
454 * .. Executable Statements ..
455 *
456  path( 1: 1 ) = 'Complex precision'
457  path( 2: 3 ) = 'ES'
458 *
459 * Check for errors
460 *
461  ntestt = 0
462  ntestf = 0
463  info = 0
464  selopt = 0
465 *
466 * Important constants
467 *
468  badnn = .false.
469  nmax = 0
470  DO 10 j = 1, nsizes
471  nmax = max( nmax, nn( j ) )
472  IF( nn( j ).LT.0 )
473  $ badnn = .true.
474  10 CONTINUE
475 *
476 * Check for errors
477 *
478  IF( nsizes.LT.0 ) THEN
479  info = -1
480  ELSE IF( badnn ) THEN
481  info = -2
482  ELSE IF( ntypes.LT.0 ) THEN
483  info = -3
484  ELSE IF( thresh.LT.zero ) THEN
485  info = -6
486  ELSE IF( nounit.LE.0 ) THEN
487  info = -7
488  ELSE IF( lda.LT.1 .OR. lda.LT.nmax ) THEN
489  info = -9
490  ELSE IF( ldvs.LT.1 .OR. ldvs.LT.nmax ) THEN
491  info = -15
492  ELSE IF( 5*nmax+2*nmax**2.GT.nwork ) THEN
493  info = -18
494  END IF
495 *
496  IF( info.NE.0 ) THEN
497  CALL xerbla( 'CDRVES', -info )
498  RETURN
499  END IF
500 *
501 * Quick return if nothing to do
502 *
503  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
504  $ RETURN
505 *
506 * More Important constants
507 *
508  unfl = slamch( 'Safe minimum' )
509  ovfl = one / unfl
510  CALL slabad( unfl, ovfl )
511  ulp = slamch( 'Precision' )
512  ulpinv = one / ulp
513  rtulp = sqrt( ulp )
514  rtulpi = one / rtulp
515 *
516 * Loop over sizes, types
517 *
518  nerrs = 0
519 *
520  DO 240 jsize = 1, nsizes
521  n = nn( jsize )
522  IF( nsizes.NE.1 ) THEN
523  mtypes = min( maxtyp, ntypes )
524  ELSE
525  mtypes = min( maxtyp+1, ntypes )
526  END IF
527 *
528  DO 230 jtype = 1, mtypes
529  IF( .NOT.dotype( jtype ) )
530  $ GO TO 230
531 *
532 * Save ISEED in case of an error.
533 *
534  DO 20 j = 1, 4
535  ioldsd( j ) = iseed( j )
536  20 CONTINUE
537 *
538 * Compute "A"
539 *
540 * Control parameters:
541 *
542 * KMAGN KCONDS KMODE KTYPE
543 * =1 O(1) 1 clustered 1 zero
544 * =2 large large clustered 2 identity
545 * =3 small exponential Jordan
546 * =4 arithmetic diagonal, (w/ eigenvalues)
547 * =5 random log symmetric, w/ eigenvalues
548 * =6 random general, w/ eigenvalues
549 * =7 random diagonal
550 * =8 random symmetric
551 * =9 random general
552 * =10 random triangular
553 *
554  IF( mtypes.GT.maxtyp )
555  $ GO TO 90
556 *
557  itype = ktype( jtype )
558  imode = kmode( jtype )
559 *
560 * Compute norm
561 *
562  GO TO ( 30, 40, 50 )kmagn( jtype )
563 *
564  30 CONTINUE
565  anorm = one
566  GO TO 60
567 *
568  40 CONTINUE
569  anorm = ovfl*ulp
570  GO TO 60
571 *
572  50 CONTINUE
573  anorm = unfl*ulpinv
574  GO TO 60
575 *
576  60 CONTINUE
577 *
578  CALL claset( 'Full', lda, n, czero, czero, a, lda )
579  iinfo = 0
580  cond = ulpinv
581 *
582 * Special Matrices -- Identity & Jordan block
583 *
584  IF( itype.EQ.1 ) THEN
585 *
586 * Zero
587 *
588  iinfo = 0
589 *
590  ELSE IF( itype.EQ.2 ) THEN
591 *
592 * Identity
593 *
594  DO 70 jcol = 1, n
595  a( jcol, jcol ) = cmplx( anorm )
596  70 CONTINUE
597 *
598  ELSE IF( itype.EQ.3 ) THEN
599 *
600 * Jordan Block
601 *
602  DO 80 jcol = 1, n
603  a( jcol, jcol ) = cmplx( anorm )
604  IF( jcol.GT.1 )
605  $ a( jcol, jcol-1 ) = cone
606  80 CONTINUE
607 *
608  ELSE IF( itype.EQ.4 ) THEN
609 *
610 * Diagonal Matrix, [Eigen]values Specified
611 *
612  CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
613  $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
614  $ iinfo )
615 *
616  ELSE IF( itype.EQ.5 ) THEN
617 *
618 * Symmetric, eigenvalues specified
619 *
620  CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
621  $ anorm, n, n, 'N', a, lda, work( n+1 ),
622  $ iinfo )
623 *
624  ELSE IF( itype.EQ.6 ) THEN
625 *
626 * General, eigenvalues specified
627 *
628  IF( kconds( jtype ).EQ.1 ) THEN
629  conds = one
630  ELSE IF( kconds( jtype ).EQ.2 ) THEN
631  conds = rtulpi
632  ELSE
633  conds = zero
634  END IF
635 *
636  CALL clatme( n, 'D', iseed, work, imode, cond, cone,
637  $ 'T', 'T', 'T', rwork, 4, conds, n, n, anorm,
638  $ a, lda, work( 2*n+1 ), iinfo )
639 *
640  ELSE IF( itype.EQ.7 ) THEN
641 *
642 * Diagonal, random eigenvalues
643 *
644  CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
645  $ 'T', 'N', work( n+1 ), 1, one,
646  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
647  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
648 *
649  ELSE IF( itype.EQ.8 ) THEN
650 *
651 * Symmetric, random eigenvalues
652 *
653  CALL clatmr( n, n, 'D', iseed, 'H', work, 6, one, cone,
654  $ 'T', 'N', work( n+1 ), 1, one,
655  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
656  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
657 *
658  ELSE IF( itype.EQ.9 ) THEN
659 *
660 * General, random eigenvalues
661 *
662  CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
663  $ 'T', 'N', work( n+1 ), 1, one,
664  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
665  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
666  IF( n.GE.4 ) THEN
667  CALL claset( 'Full', 2, n, czero, czero, a, lda )
668  CALL claset( 'Full', n-3, 1, czero, czero, a( 3, 1 ),
669  $ lda )
670  CALL claset( 'Full', n-3, 2, czero, czero,
671  $ a( 3, n-1 ), lda )
672  CALL claset( 'Full', 1, n, czero, czero, a( n, 1 ),
673  $ lda )
674  END IF
675 *
676  ELSE IF( itype.EQ.10 ) THEN
677 *
678 * Triangular, random eigenvalues
679 *
680  CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
681  $ 'T', 'N', work( n+1 ), 1, one,
682  $ work( 2*n+1 ), 1, one, 'N', idumma, n, 0,
683  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
684 *
685  ELSE
686 *
687  iinfo = 1
688  END IF
689 *
690  IF( iinfo.NE.0 ) THEN
691  WRITE( nounit, fmt = 9992 )'Generator', iinfo, n, jtype,
692  $ ioldsd
693  info = abs( iinfo )
694  RETURN
695  END IF
696 *
697  90 CONTINUE
698 *
699 * Test for minimal and generous workspace
700 *
701  DO 220 iwk = 1, 2
702  IF( iwk.EQ.1 ) THEN
703  nnwork = 3*n
704  ELSE
705  nnwork = 5*n + 2*n**2
706  END IF
707  nnwork = max( nnwork, 1 )
708 *
709 * Initialize RESULT
710 *
711  DO 100 j = 1, 13
712  result( j ) = -one
713  100 CONTINUE
714 *
715 * Test with and without sorting of eigenvalues
716 *
717  DO 180 isort = 0, 1
718  IF( isort.EQ.0 ) THEN
719  sort = 'N'
720  rsub = 0
721  ELSE
722  sort = 'S'
723  rsub = 6
724  END IF
725 *
726 * Compute Schur form and Schur vectors, and test them
727 *
728  CALL clacpy( 'F', n, n, a, lda, h, lda )
729  CALL cgees( 'V', sort, cslect, n, h, lda, sdim, w, vs,
730  $ ldvs, work, nnwork, rwork, bwork, iinfo )
731  IF( iinfo.NE.0 ) THEN
732  result( 1+rsub ) = ulpinv
733  WRITE( nounit, fmt = 9992 )'CGEES1', iinfo, n,
734  $ jtype, ioldsd
735  info = abs( iinfo )
736  GO TO 190
737  END IF
738 *
739 * Do Test (1) or Test (7)
740 *
741  result( 1+rsub ) = zero
742  DO 120 j = 1, n - 1
743  DO 110 i = j + 1, n
744  IF( h( i, j ).NE.zero )
745  $ result( 1+rsub ) = ulpinv
746  110 CONTINUE
747  120 CONTINUE
748 *
749 * Do Tests (2) and (3) or Tests (8) and (9)
750 *
751  lwork = max( 1, 2*n*n )
752  CALL chst01( n, 1, n, a, lda, h, lda, vs, ldvs, work,
753  $ lwork, rwork, res )
754  result( 2+rsub ) = res( 1 )
755  result( 3+rsub ) = res( 2 )
756 *
757 * Do Test (4) or Test (10)
758 *
759  result( 4+rsub ) = zero
760  DO 130 i = 1, n
761  IF( h( i, i ).NE.w( i ) )
762  $ result( 4+rsub ) = ulpinv
763  130 CONTINUE
764 *
765 * Do Test (5) or Test (11)
766 *
767  CALL clacpy( 'F', n, n, a, lda, ht, lda )
768  CALL cgees( 'N', sort, cslect, n, ht, lda, sdim, wt,
769  $ vs, ldvs, work, nnwork, rwork, bwork,
770  $ iinfo )
771  IF( iinfo.NE.0 ) THEN
772  result( 5+rsub ) = ulpinv
773  WRITE( nounit, fmt = 9992 )'CGEES2', iinfo, n,
774  $ jtype, ioldsd
775  info = abs( iinfo )
776  GO TO 190
777  END IF
778 *
779  result( 5+rsub ) = zero
780  DO 150 j = 1, n
781  DO 140 i = 1, n
782  IF( h( i, j ).NE.ht( i, j ) )
783  $ result( 5+rsub ) = ulpinv
784  140 CONTINUE
785  150 CONTINUE
786 *
787 * Do Test (6) or Test (12)
788 *
789  result( 6+rsub ) = zero
790  DO 160 i = 1, n
791  IF( w( i ).NE.wt( i ) )
792  $ result( 6+rsub ) = ulpinv
793  160 CONTINUE
794 *
795 * Do Test (13)
796 *
797  IF( isort.EQ.1 ) THEN
798  result( 13 ) = zero
799  knteig = 0
800  DO 170 i = 1, n
801  IF( cslect( w( i ) ) )
802  $ knteig = knteig + 1
803  IF( i.LT.n ) THEN
804  IF( cslect( w( i+1 ) ) .AND.
805  $ ( .NOT.cslect( w( i ) ) ) )result( 13 )
806  $ = ulpinv
807  END IF
808  170 CONTINUE
809  IF( sdim.NE.knteig )
810  $ result( 13 ) = ulpinv
811  END IF
812 *
813  180 CONTINUE
814 *
815 * End of Loop -- Check for RESULT(j) > THRESH
816 *
817  190 CONTINUE
818 *
819  ntest = 0
820  nfail = 0
821  DO 200 j = 1, 13
822  IF( result( j ).GE.zero )
823  $ ntest = ntest + 1
824  IF( result( j ).GE.thresh )
825  $ nfail = nfail + 1
826  200 CONTINUE
827 *
828  IF( nfail.GT.0 )
829  $ ntestf = ntestf + 1
830  IF( ntestf.EQ.1 ) THEN
831  WRITE( nounit, fmt = 9999 )path
832  WRITE( nounit, fmt = 9998 )
833  WRITE( nounit, fmt = 9997 )
834  WRITE( nounit, fmt = 9996 )
835  WRITE( nounit, fmt = 9995 )thresh
836  WRITE( nounit, fmt = 9994 )
837  ntestf = 2
838  END IF
839 *
840  DO 210 j = 1, 13
841  IF( result( j ).GE.thresh ) THEN
842  WRITE( nounit, fmt = 9993 )n, iwk, ioldsd, jtype,
843  $ j, result( j )
844  END IF
845  210 CONTINUE
846 *
847  nerrs = nerrs + nfail
848  ntestt = ntestt + ntest
849 *
850  220 CONTINUE
851  230 CONTINUE
852  240 CONTINUE
853 *
854 * Summary
855 *
856  CALL slasum( path, nounit, nerrs, ntestt )
857 *
858  9999 FORMAT( / 1x, a3, ' -- Complex Schur Form Decomposition Driver',
859  $ / ' Matrix types (see CDRVES for details): ' )
860 *
861  9998 FORMAT( / ' Special Matrices:', / ' 1=Zero matrix. ',
862  $ ' ', ' 5=Diagonal: geometr. spaced entries.',
863  $ / ' 2=Identity matrix. ', ' 6=Diagona',
864  $ 'l: clustered entries.', / ' 3=Transposed Jordan block. ',
865  $ ' ', ' 7=Diagonal: large, evenly spaced.', / ' ',
866  $ '4=Diagonal: evenly spaced entries. ', ' 8=Diagonal: s',
867  $ 'mall, evenly spaced.' )
868  9997 FORMAT( ' Dense, Non-Symmetric Matrices:', / ' 9=Well-cond., ev',
869  $ 'enly spaced eigenvals.', ' 14=Ill-cond., geomet. spaced e',
870  $ 'igenals.', / ' 10=Well-cond., geom. spaced eigenvals. ',
871  $ ' 15=Ill-conditioned, clustered e.vals.', / ' 11=Well-cond',
872  $ 'itioned, clustered e.vals. ', ' 16=Ill-cond., random comp',
873  $ 'lex ', a6, / ' 12=Well-cond., random complex ', a6, ' ',
874  $ ' 17=Ill-cond., large rand. complx ', a4, / ' 13=Ill-condi',
875  $ 'tioned, evenly spaced. ', ' 18=Ill-cond., small rand.',
876  $ ' complx ', a4 )
877  9996 FORMAT( ' 19=Matrix with random O(1) entries. ', ' 21=Matrix ',
878  $ 'with small random entries.', / ' 20=Matrix with large ran',
879  $ 'dom entries. ', / )
880  9995 FORMAT( ' Tests performed with test threshold =', f8.2,
881  $ / ' ( A denotes A on input and T denotes A on output)',
882  $ / / ' 1 = 0 if T in Schur form (no sort), ',
883  $ ' 1/ulp otherwise', /
884  $ ' 2 = | A - VS T transpose(VS) | / ( n |A| ulp ) (no sort)',
885  $ / ' 3 = | I - VS transpose(VS) | / ( n ulp ) (no sort) ',
886  $ / ' 4 = 0 if W are eigenvalues of T (no sort),',
887  $ ' 1/ulp otherwise', /
888  $ ' 5 = 0 if T same no matter if VS computed (no sort),',
889  $ ' 1/ulp otherwise', /
890  $ ' 6 = 0 if W same no matter if VS computed (no sort)',
891  $ ', 1/ulp otherwise' )
892  9994 FORMAT( ' 7 = 0 if T in Schur form (sort), ', ' 1/ulp otherwise',
893  $ / ' 8 = | A - VS T transpose(VS) | / ( n |A| ulp ) (sort)',
894  $ / ' 9 = | I - VS transpose(VS) | / ( n ulp ) (sort) ',
895  $ / ' 10 = 0 if W are eigenvalues of T (sort),',
896  $ ' 1/ulp otherwise', /
897  $ ' 11 = 0 if T same no matter if VS computed (sort),',
898  $ ' 1/ulp otherwise', /
899  $ ' 12 = 0 if W same no matter if VS computed (sort),',
900  $ ' 1/ulp otherwise', /
901  $ ' 13 = 0 if sorting successful, 1/ulp otherwise', / )
902  9993 FORMAT( ' N=', i5, ', IWK=', i2, ', seed=', 4( i4, ',' ),
903  $ ' type ', i2, ', test(', i2, ')=', g10.3 )
904  9992 FORMAT( ' CDRVES: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
905  $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
906 *
907  RETURN
908 *
909 * End of CDRVES
910 *
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function cslect(Z)
CSLECT
Definition: cslect.f:56
subroutine chst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
CHST01
Definition: chst01.f:140
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 cgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, LDVS, WORK, LWORK, RWORK, BWORK, INFO)
CGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE m...
Definition: cgees.f:197
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 clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:103
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: