LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cdrvev ( 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( * )  W,
complex, dimension( * )  W1,
complex, dimension( ldvl, * )  VL,
integer  LDVL,
complex, dimension( ldvr, * )  VR,
integer  LDVR,
complex, dimension( ldlre, * )  LRE,
integer  LDLRE,
real, dimension( 7 )  RESULT,
complex, dimension( * )  WORK,
integer  NWORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  INFO 
)

CDRVEV

Purpose:
    CDRVEV  checks the nonsymmetric eigenvalue problem driver CGEEV.

    When CDRVEV 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, 7
    tests will be performed:

    (1)     | A * VR - VR * W | / ( n |A| ulp )

      Here VR is the matrix of unit right eigenvectors.
      W is a diagonal matrix with diagonal entries W(j).

    (2)     | A**H * VL - VL * W**H | / ( n |A| ulp )

      Here VL is the matrix of unit left eigenvectors, A**H is the
      conjugate-transpose of A, and W is as above.

    (3)     | |VR(i)| - 1 | / ulp and whether largest component real

      VR(i) denotes the i-th column of VR.

    (4)     | |VL(i)| - 1 | / ulp and whether largest component real

      VL(i) denotes the i-th column of VL.

    (5)     W(full) = W(partial)

      W(full) denotes the eigenvalues computed when both VR and VL
      are also computed, and W(partial) denotes the eigenvalues
      computed when only W, only W and VR, or only W and VL are
      computed.

    (6)     VR(full) = VR(partial)

      VR(full) denotes the right eigenvectors computed when both VR
      and VL are computed, and VR(partial) denotes the result
      when only VR is computed.

     (7)     VL(full) = VL(partial)

      VL(full) denotes the left eigenvectors computed when both VR
      and VL are also computed, and VL(partial) denotes the result
      when only VL is 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 unitary 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 |z| < 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,
          CDRVEV 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, CDRVEV
          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 CDRVEV 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 CGEEV.
[out]W
          W is COMPLEX array, dimension (max(NN))
          The eigenvalues of A. On exit, W are the eigenvalues of
          the matrix in A.
[out]W1
          W1 is COMPLEX array, dimension (max(NN))
          Like W, this array contains the eigenvalues of A,
          but those computed when CGEEV only computes a partial
          eigendecomposition, i.e. not the eigenvalues and left
          and right eigenvectors.
[out]VL
          VL is COMPLEX array, dimension (LDVL, max(NN))
          VL holds the computed left eigenvectors.
[in]LDVL
          LDVL is INTEGER
          Leading dimension of VL. Must be at least max(1,max(NN)).
[out]VR
          VR is COMPLEX array, dimension (LDVR, max(NN))
          VR holds the computed right eigenvectors.
[in]LDVR
          LDVR is INTEGER
          Leading dimension of VR. Must be at least max(1,max(NN)).
[out]LRE
          LRE is COMPLEX array, dimension (LDLRE, max(NN))
          LRE holds the computed right or left eigenvectors.
[in]LDLRE
          LDLRE is INTEGER
          Leading dimension of LRE. Must be at least max(1,max(NN)).
[out]RESULT
          RESULT is REAL array, dimension (7)
          The values computed by the seven 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 (2*max(NN))
[out]IWORK
          IWORK is INTEGER 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) ).
          -14: LDVL < 1 or LDVL < NMAX, where NMAX is max( NN(j) ).
          -16: LDVR < 1 or LDVR < NMAX, where NMAX is max( NN(j) ).
          -18: LDLRE < 1 or LDLRE < NMAX, where NMAX is max( NN(j) ).
          -21: NWORK too small.
          If  CLATMR, CLATMS, CLATME or CGEEV 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)       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.
Date
November 2011

Definition at line 393 of file cdrvev.f.

393 *
394 * -- LAPACK test routine (version 3.4.0) --
395 * -- LAPACK is a software package provided by Univ. of Tennessee, --
396 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
397 * November 2011
398 *
399 * .. Scalar Arguments ..
400  INTEGER info, lda, ldlre, ldvl, ldvr, nounit, nsizes,
401  $ ntypes, nwork
402  REAL thresh
403 * ..
404 * .. Array Arguments ..
405  LOGICAL dotype( * )
406  INTEGER iseed( 4 ), iwork( * ), nn( * )
407  REAL result( 7 ), rwork( * )
408  COMPLEX a( lda, * ), h( lda, * ), lre( ldlre, * ),
409  $ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
410  $ work( * )
411 * ..
412 *
413 * =====================================================================
414 *
415 * .. Parameters ..
416  COMPLEX czero
417  parameter ( czero = ( 0.0e+0, 0.0e+0 ) )
418  COMPLEX cone
419  parameter ( cone = ( 1.0e+0, 0.0e+0 ) )
420  REAL zero, one
421  parameter ( zero = 0.0e+0, one = 1.0e+0 )
422  REAL two
423  parameter ( two = 2.0e+0 )
424  INTEGER maxtyp
425  parameter ( maxtyp = 21 )
426 * ..
427 * .. Local Scalars ..
428  LOGICAL badnn
429  CHARACTER*3 path
430  INTEGER iinfo, imode, itype, iwk, j, jcol, jj, jsize,
431  $ jtype, mtypes, n, nerrs, nfail, nmax,
432  $ nnwork, ntest, ntestf, ntestt
433  REAL anorm, cond, conds, ovfl, rtulp, rtulpi, tnrm,
434  $ ulp, ulpinv, unfl, vmx, vrmx, vtst
435 * ..
436 * .. Local Arrays ..
437  INTEGER idumma( 1 ), ioldsd( 4 ), kconds( maxtyp ),
438  $ kmagn( maxtyp ), kmode( maxtyp ),
439  $ ktype( maxtyp )
440  REAL res( 2 )
441  COMPLEX dum( 1 )
442 * ..
443 * .. External Functions ..
444  REAL scnrm2, slamch
445  EXTERNAL scnrm2, slamch
446 * ..
447 * .. External Subroutines ..
448  EXTERNAL cgeev, cget22, clacpy, clatme, clatmr, clatms,
450 * ..
451 * .. Intrinsic Functions ..
452  INTRINSIC abs, aimag, cmplx, max, min, REAL, sqrt
453 * ..
454 * .. Data statements ..
455  DATA ktype / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
456  DATA kmagn / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
457  $ 3, 1, 2, 3 /
458  DATA kmode / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
459  $ 1, 5, 5, 5, 4, 3, 1 /
460  DATA kconds / 3*0, 5*0, 4*1, 6*2, 3*0 /
461 * ..
462 * .. Executable Statements ..
463 *
464  path( 1: 1 ) = 'Complex precision'
465  path( 2: 3 ) = 'EV'
466 *
467 * Check for errors
468 *
469  ntestt = 0
470  ntestf = 0
471  info = 0
472 *
473 * Important constants
474 *
475  badnn = .false.
476  nmax = 0
477  DO 10 j = 1, nsizes
478  nmax = max( nmax, nn( j ) )
479  IF( nn( j ).LT.0 )
480  $ badnn = .true.
481  10 CONTINUE
482 *
483 * Check for errors
484 *
485  IF( nsizes.LT.0 ) THEN
486  info = -1
487  ELSE IF( badnn ) THEN
488  info = -2
489  ELSE IF( ntypes.LT.0 ) THEN
490  info = -3
491  ELSE IF( thresh.LT.zero ) THEN
492  info = -6
493  ELSE IF( nounit.LE.0 ) THEN
494  info = -7
495  ELSE IF( lda.LT.1 .OR. lda.LT.nmax ) THEN
496  info = -9
497  ELSE IF( ldvl.LT.1 .OR. ldvl.LT.nmax ) THEN
498  info = -14
499  ELSE IF( ldvr.LT.1 .OR. ldvr.LT.nmax ) THEN
500  info = -16
501  ELSE IF( ldlre.LT.1 .OR. ldlre.LT.nmax ) THEN
502  info = -28
503  ELSE IF( 5*nmax+2*nmax**2.GT.nwork ) THEN
504  info = -21
505  END IF
506 *
507  IF( info.NE.0 ) THEN
508  CALL xerbla( 'CDRVEV', -info )
509  RETURN
510  END IF
511 *
512 * Quick return if nothing to do
513 *
514  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
515  $ RETURN
516 *
517 * More Important constants
518 *
519  unfl = slamch( 'Safe minimum' )
520  ovfl = one / unfl
521  CALL slabad( unfl, ovfl )
522  ulp = slamch( 'Precision' )
523  ulpinv = one / ulp
524  rtulp = sqrt( ulp )
525  rtulpi = one / rtulp
526 *
527 * Loop over sizes, types
528 *
529  nerrs = 0
530 *
531  DO 270 jsize = 1, nsizes
532  n = nn( jsize )
533  IF( nsizes.NE.1 ) THEN
534  mtypes = min( maxtyp, ntypes )
535  ELSE
536  mtypes = min( maxtyp+1, ntypes )
537  END IF
538 *
539  DO 260 jtype = 1, mtypes
540  IF( .NOT.dotype( jtype ) )
541  $ GO TO 260
542 *
543 * Save ISEED in case of an error.
544 *
545  DO 20 j = 1, 4
546  ioldsd( j ) = iseed( j )
547  20 CONTINUE
548 *
549 * Compute "A"
550 *
551 * Control parameters:
552 *
553 * KMAGN KCONDS KMODE KTYPE
554 * =1 O(1) 1 clustered 1 zero
555 * =2 large large clustered 2 identity
556 * =3 small exponential Jordan
557 * =4 arithmetic diagonal, (w/ eigenvalues)
558 * =5 random log symmetric, w/ eigenvalues
559 * =6 random general, w/ eigenvalues
560 * =7 random diagonal
561 * =8 random symmetric
562 * =9 random general
563 * =10 random triangular
564 *
565  IF( mtypes.GT.maxtyp )
566  $ GO TO 90
567 *
568  itype = ktype( jtype )
569  imode = kmode( jtype )
570 *
571 * Compute norm
572 *
573  GO TO ( 30, 40, 50 )kmagn( jtype )
574 *
575  30 CONTINUE
576  anorm = one
577  GO TO 60
578 *
579  40 CONTINUE
580  anorm = ovfl*ulp
581  GO TO 60
582 *
583  50 CONTINUE
584  anorm = unfl*ulpinv
585  GO TO 60
586 *
587  60 CONTINUE
588 *
589  CALL claset( 'Full', lda, n, czero, czero, a, lda )
590  iinfo = 0
591  cond = ulpinv
592 *
593 * Special Matrices -- Identity & Jordan block
594 *
595 * Zero
596 *
597  IF( itype.EQ.1 ) THEN
598  iinfo = 0
599 *
600  ELSE IF( itype.EQ.2 ) THEN
601 *
602 * Identity
603 *
604  DO 70 jcol = 1, n
605  a( jcol, jcol ) = cmplx( anorm )
606  70 CONTINUE
607 *
608  ELSE IF( itype.EQ.3 ) THEN
609 *
610 * Jordan Block
611 *
612  DO 80 jcol = 1, n
613  a( jcol, jcol ) = cmplx( anorm )
614  IF( jcol.GT.1 )
615  $ a( jcol, jcol-1 ) = cone
616  80 CONTINUE
617 *
618  ELSE IF( itype.EQ.4 ) THEN
619 *
620 * Diagonal Matrix, [Eigen]values Specified
621 *
622  CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
623  $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
624  $ iinfo )
625 *
626  ELSE IF( itype.EQ.5 ) THEN
627 *
628 * Hermitian, eigenvalues specified
629 *
630  CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
631  $ anorm, n, n, 'N', a, lda, work( n+1 ),
632  $ iinfo )
633 *
634  ELSE IF( itype.EQ.6 ) THEN
635 *
636 * General, eigenvalues specified
637 *
638  IF( kconds( jtype ).EQ.1 ) THEN
639  conds = one
640  ELSE IF( kconds( jtype ).EQ.2 ) THEN
641  conds = rtulpi
642  ELSE
643  conds = zero
644  END IF
645 *
646  CALL clatme( n, 'D', iseed, work, imode, cond, cone,
647  $ 'T', 'T', 'T', rwork, 4, conds, n, n,
648  $ anorm, a, lda, work( 2*n+1 ), iinfo )
649 *
650  ELSE IF( itype.EQ.7 ) THEN
651 *
652 * Diagonal, random eigenvalues
653 *
654  CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
655  $ 'T', 'N', work( n+1 ), 1, one,
656  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
657  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
658 *
659  ELSE IF( itype.EQ.8 ) THEN
660 *
661 * Symmetric, random eigenvalues
662 *
663  CALL clatmr( n, n, 'D', iseed, 'H', work, 6, one, cone,
664  $ 'T', 'N', work( n+1 ), 1, one,
665  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
666  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
667 *
668  ELSE IF( itype.EQ.9 ) THEN
669 *
670 * General, random eigenvalues
671 *
672  CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
673  $ 'T', 'N', work( n+1 ), 1, one,
674  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
675  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
676  IF( n.GE.4 ) THEN
677  CALL claset( 'Full', 2, n, czero, czero, a, lda )
678  CALL claset( 'Full', n-3, 1, czero, czero, a( 3, 1 ),
679  $ lda )
680  CALL claset( 'Full', n-3, 2, czero, czero,
681  $ a( 3, n-1 ), lda )
682  CALL claset( 'Full', 1, n, czero, czero, a( n, 1 ),
683  $ lda )
684  END IF
685 *
686  ELSE IF( itype.EQ.10 ) THEN
687 *
688 * Triangular, random eigenvalues
689 *
690  CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
691  $ 'T', 'N', work( n+1 ), 1, one,
692  $ work( 2*n+1 ), 1, one, 'N', idumma, n, 0,
693  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
694 *
695  ELSE
696 *
697  iinfo = 1
698  END IF
699 *
700  IF( iinfo.NE.0 ) THEN
701  WRITE( nounit, fmt = 9993 )'Generator', iinfo, n, jtype,
702  $ ioldsd
703  info = abs( iinfo )
704  RETURN
705  END IF
706 *
707  90 CONTINUE
708 *
709 * Test for minimal and generous workspace
710 *
711  DO 250 iwk = 1, 2
712  IF( iwk.EQ.1 ) THEN
713  nnwork = 2*n
714  ELSE
715  nnwork = 5*n + 2*n**2
716  END IF
717  nnwork = max( nnwork, 1 )
718 *
719 * Initialize RESULT
720 *
721  DO 100 j = 1, 7
722  result( j ) = -one
723  100 CONTINUE
724 *
725 * Compute eigenvalues and eigenvectors, and test them
726 *
727  CALL clacpy( 'F', n, n, a, lda, h, lda )
728  CALL cgeev( 'V', 'V', n, h, lda, w, vl, ldvl, vr, ldvr,
729  $ work, nnwork, rwork, iinfo )
730  IF( iinfo.NE.0 ) THEN
731  result( 1 ) = ulpinv
732  WRITE( nounit, fmt = 9993 )'CGEEV1', iinfo, n, jtype,
733  $ ioldsd
734  info = abs( iinfo )
735  GO TO 220
736  END IF
737 *
738 * Do Test (1)
739 *
740  CALL cget22( 'N', 'N', 'N', n, a, lda, vr, ldvr, w, work,
741  $ rwork, res )
742  result( 1 ) = res( 1 )
743 *
744 * Do Test (2)
745 *
746  CALL cget22( 'C', 'N', 'C', n, a, lda, vl, ldvl, w, work,
747  $ rwork, res )
748  result( 2 ) = res( 1 )
749 *
750 * Do Test (3)
751 *
752  DO 120 j = 1, n
753  tnrm = scnrm2( n, vr( 1, j ), 1 )
754  result( 3 ) = max( result( 3 ),
755  $ min( ulpinv, abs( tnrm-one ) / ulp ) )
756  vmx = zero
757  vrmx = zero
758  DO 110 jj = 1, n
759  vtst = abs( vr( jj, j ) )
760  IF( vtst.GT.vmx )
761  $ vmx = vtst
762  IF( aimag( vr( jj, j ) ).EQ.zero .AND.
763  $ abs( REAL( VR( JJ, J ) ) ).GT.vrmx )
764  $ vrmx = abs( REAL( VR( JJ, J ) ) )
765  110 CONTINUE
766  IF( vrmx / vmx.LT.one-two*ulp )
767  $ result( 3 ) = ulpinv
768  120 CONTINUE
769 *
770 * Do Test (4)
771 *
772  DO 140 j = 1, n
773  tnrm = scnrm2( n, vl( 1, j ), 1 )
774  result( 4 ) = max( result( 4 ),
775  $ min( ulpinv, abs( tnrm-one ) / ulp ) )
776  vmx = zero
777  vrmx = zero
778  DO 130 jj = 1, n
779  vtst = abs( vl( jj, j ) )
780  IF( vtst.GT.vmx )
781  $ vmx = vtst
782  IF( aimag( vl( jj, j ) ).EQ.zero .AND.
783  $ abs( REAL( VL( JJ, J ) ) ).GT.vrmx )
784  $ vrmx = abs( REAL( VL( JJ, J ) ) )
785  130 CONTINUE
786  IF( vrmx / vmx.LT.one-two*ulp )
787  $ result( 4 ) = ulpinv
788  140 CONTINUE
789 *
790 * Compute eigenvalues only, and test them
791 *
792  CALL clacpy( 'F', n, n, a, lda, h, lda )
793  CALL cgeev( 'N', 'N', n, h, lda, w1, dum, 1, dum, 1,
794  $ work, nnwork, rwork, iinfo )
795  IF( iinfo.NE.0 ) THEN
796  result( 1 ) = ulpinv
797  WRITE( nounit, fmt = 9993 )'CGEEV2', iinfo, n, jtype,
798  $ ioldsd
799  info = abs( iinfo )
800  GO TO 220
801  END IF
802 *
803 * Do Test (5)
804 *
805  DO 150 j = 1, n
806  IF( w( j ).NE.w1( j ) )
807  $ result( 5 ) = ulpinv
808  150 CONTINUE
809 *
810 * Compute eigenvalues and right eigenvectors, and test them
811 *
812  CALL clacpy( 'F', n, n, a, lda, h, lda )
813  CALL cgeev( 'N', 'V', n, h, lda, w1, dum, 1, lre, ldlre,
814  $ work, nnwork, rwork, iinfo )
815  IF( iinfo.NE.0 ) THEN
816  result( 1 ) = ulpinv
817  WRITE( nounit, fmt = 9993 )'CGEEV3', iinfo, n, jtype,
818  $ ioldsd
819  info = abs( iinfo )
820  GO TO 220
821  END IF
822 *
823 * Do Test (5) again
824 *
825  DO 160 j = 1, n
826  IF( w( j ).NE.w1( j ) )
827  $ result( 5 ) = ulpinv
828  160 CONTINUE
829 *
830 * Do Test (6)
831 *
832  DO 180 j = 1, n
833  DO 170 jj = 1, n
834  IF( vr( j, jj ).NE.lre( j, jj ) )
835  $ result( 6 ) = ulpinv
836  170 CONTINUE
837  180 CONTINUE
838 *
839 * Compute eigenvalues and left eigenvectors, and test them
840 *
841  CALL clacpy( 'F', n, n, a, lda, h, lda )
842  CALL cgeev( 'V', 'N', n, h, lda, w1, lre, ldlre, dum, 1,
843  $ work, nnwork, rwork, iinfo )
844  IF( iinfo.NE.0 ) THEN
845  result( 1 ) = ulpinv
846  WRITE( nounit, fmt = 9993 )'CGEEV4', iinfo, n, jtype,
847  $ ioldsd
848  info = abs( iinfo )
849  GO TO 220
850  END IF
851 *
852 * Do Test (5) again
853 *
854  DO 190 j = 1, n
855  IF( w( j ).NE.w1( j ) )
856  $ result( 5 ) = ulpinv
857  190 CONTINUE
858 *
859 * Do Test (7)
860 *
861  DO 210 j = 1, n
862  DO 200 jj = 1, n
863  IF( vl( j, jj ).NE.lre( j, jj ) )
864  $ result( 7 ) = ulpinv
865  200 CONTINUE
866  210 CONTINUE
867 *
868 * End of Loop -- Check for RESULT(j) > THRESH
869 *
870  220 CONTINUE
871 *
872  ntest = 0
873  nfail = 0
874  DO 230 j = 1, 7
875  IF( result( j ).GE.zero )
876  $ ntest = ntest + 1
877  IF( result( j ).GE.thresh )
878  $ nfail = nfail + 1
879  230 CONTINUE
880 *
881  IF( nfail.GT.0 )
882  $ ntestf = ntestf + 1
883  IF( ntestf.EQ.1 ) THEN
884  WRITE( nounit, fmt = 9999 )path
885  WRITE( nounit, fmt = 9998 )
886  WRITE( nounit, fmt = 9997 )
887  WRITE( nounit, fmt = 9996 )
888  WRITE( nounit, fmt = 9995 )thresh
889  ntestf = 2
890  END IF
891 *
892  DO 240 j = 1, 7
893  IF( result( j ).GE.thresh ) THEN
894  WRITE( nounit, fmt = 9994 )n, iwk, ioldsd, jtype,
895  $ j, result( j )
896  END IF
897  240 CONTINUE
898 *
899  nerrs = nerrs + nfail
900  ntestt = ntestt + ntest
901 *
902  250 CONTINUE
903  260 CONTINUE
904  270 CONTINUE
905 *
906 * Summary
907 *
908  CALL slasum( path, nounit, nerrs, ntestt )
909 *
910  9999 FORMAT( / 1x, a3, ' -- Complex Eigenvalue-Eigenvector ',
911  $ 'Decomposition Driver', /
912  $ ' Matrix types (see CDRVEV for details): ' )
913 *
914  9998 FORMAT( / ' Special Matrices:', / ' 1=Zero matrix. ',
915  $ ' ', ' 5=Diagonal: geometr. spaced entries.',
916  $ / ' 2=Identity matrix. ', ' 6=Diagona',
917  $ 'l: clustered entries.', / ' 3=Transposed Jordan block. ',
918  $ ' ', ' 7=Diagonal: large, evenly spaced.', / ' ',
919  $ '4=Diagonal: evenly spaced entries. ', ' 8=Diagonal: s',
920  $ 'mall, evenly spaced.' )
921  9997 FORMAT( ' Dense, Non-Symmetric Matrices:', / ' 9=Well-cond., ev',
922  $ 'enly spaced eigenvals.', ' 14=Ill-cond., geomet. spaced e',
923  $ 'igenals.', / ' 10=Well-cond., geom. spaced eigenvals. ',
924  $ ' 15=Ill-conditioned, clustered e.vals.', / ' 11=Well-cond',
925  $ 'itioned, clustered e.vals. ', ' 16=Ill-cond., random comp',
926  $ 'lex ', a6, / ' 12=Well-cond., random complex ', a6, ' ',
927  $ ' 17=Ill-cond., large rand. complx ', a4, / ' 13=Ill-condi',
928  $ 'tioned, evenly spaced. ', ' 18=Ill-cond., small rand.',
929  $ ' complx ', a4 )
930  9996 FORMAT( ' 19=Matrix with random O(1) entries. ', ' 21=Matrix ',
931  $ 'with small random entries.', / ' 20=Matrix with large ran',
932  $ 'dom entries. ', / )
933  9995 FORMAT( ' Tests performed with test threshold =', f8.2,
934  $ / / ' 1 = | A VR - VR W | / ( n |A| ulp ) ',
935  $ / ' 2 = | conj-trans(A) VL - VL conj-trans(W) | /',
936  $ ' ( n |A| ulp ) ', / ' 3 = | |VR(i)| - 1 | / ulp ',
937  $ / ' 4 = | |VL(i)| - 1 | / ulp ',
938  $ / ' 5 = 0 if W same no matter if VR or VL computed,',
939  $ ' 1/ulp otherwise', /
940  $ ' 6 = 0 if VR same no matter if VL computed,',
941  $ ' 1/ulp otherwise', /
942  $ ' 7 = 0 if VL same no matter if VR computed,',
943  $ ' 1/ulp otherwise', / )
944  9994 FORMAT( ' N=', i5, ', IWK=', i2, ', seed=', 4( i4, ',' ),
945  $ ' type ', i2, ', test(', i2, ')=', g10.3 )
946  9993 FORMAT( ' CDRVEV: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
947  $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
948 *
949  RETURN
950 *
951 * End of CDRVEV
952 *
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:492
real function scnrm2(N, X, INCX)
SCNRM2
Definition: scnrm2.f:56
subroutine cgeev(JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
CGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: cgeev.f:181
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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:108
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine cget22(TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W, WORK, RWORK, RESULT)
CGET22
Definition: cget22.f:145
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:42
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:303

Here is the call graph for this function:

Here is the caller graph for this function: