dget23.f

Go to the documentation of this file.

*> \brief \b DGET23
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*  Definition:
*  ===========
*
*       SUBROUTINE DGET23( COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N,
*                          A, LDA, H, WR, WI, WR1, WI1, VL, LDVL, VR,
*                          LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,
*                          RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,
*                          WORK, LWORK, IWORK, INFO )
*
*       .. Scalar Arguments ..
*       LOGICAL            COMP
*       CHARACTER          BALANC
*       INTEGER            INFO, JTYPE, LDA, LDLRE, LDVL, LDVR, LWORK, N,
*      $                   NOUNIT
*       DOUBLE PRECISION   THRESH
*       ..
*       .. Array Arguments ..
*       INTEGER            ISEED( 4 ), IWORK( * )
*       DOUBLE PRECISION   A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
*      $                   RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),
*      $                   RCNDV1( * ), RCONDE( * ), RCONDV( * ),
*      $                   RESULT( 11 ), SCALE( * ), SCALE1( * ),
*      $                   VL( LDVL, * ), VR( LDVR, * ), WI( * ),
*      $                   WI1( * ), WORK( * ), WR( * ), WR1( * )
*       ..
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*>    DGET23  checks the nonsymmetric eigenvalue problem driver SGEEVX.
*>    If COMP = .FALSE., the first 8 of the following tests will be
*>    performed on the input matrix A, and also test 9 if LWORK is
*>    sufficiently large.
*>    if COMP is .TRUE. all 11 tests will be performed.
*>
*>    (1)     | A * VR - VR * W | / ( n |A| ulp )
*>
*>      Here VR is the matrix of unit right eigenvectors.
*>      W is a block diagonal matrix, with a 1x1 block for each
*>      real eigenvalue and a 2x2 block for each complex conjugate
*>      pair.  If eigenvalues j and j+1 are a complex conjugate pair,
*>      so WR(j) = WR(j+1) = wr and WI(j) = - WI(j+1) = wi, then the
*>      2 x 2 block corresponding to the pair will be:
*>
*>              (  wr  wi  )
*>              ( -wi  wr  )
*>
*>      Such a block multiplying an n x 2 matrix  ( ur ui ) on the
*>      right will be the same as multiplying  ur + i*ui  by  wr + i*wi.
*>
*>    (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 largest component real
*>
*>      VR(i) denotes the i-th column of VR.
*>
*>    (4)     | |VL(i)| - 1 | / ulp and largest component real
*>
*>      VL(i) denotes the i-th column of VL.
*>
*>    (5)     0 if W(full) = W(partial), 1/ulp otherwise
*>
*>      W(full) denotes the eigenvalues computed when VR, VL, RCONDV
*>      and RCONDE are also computed, and W(partial) denotes the
*>      eigenvalues computed when only some of VR, VL, RCONDV, and
*>      RCONDE are computed.
*>
*>    (6)     0 if VR(full) = VR(partial), 1/ulp otherwise
*>
*>      VR(full) denotes the right eigenvectors computed when VL, RCONDV
*>      and RCONDE are computed, and VR(partial) denotes the result
*>      when only some of VL and RCONDV are computed.
*>
*>    (7)     0 if VL(full) = VL(partial), 1/ulp otherwise
*>
*>      VL(full) denotes the left eigenvectors computed when VR, RCONDV
*>      and RCONDE are computed, and VL(partial) denotes the result
*>      when only some of VR and RCONDV are computed.
*>
*>    (8)     0 if SCALE, ILO, IHI, ABNRM (full) =
*>                 SCALE, ILO, IHI, ABNRM (partial)
*>            1/ulp otherwise
*>
*>      SCALE, ILO, IHI and ABNRM describe how the matrix is balanced.
*>      (full) is when VR, VL, RCONDE and RCONDV are also computed, and
*>      (partial) is when some are not computed.
*>
*>    (9)     0 if RCONDV(full) = RCONDV(partial), 1/ulp otherwise
*>
*>      RCONDV(full) denotes the reciprocal condition numbers of the
*>      right eigenvectors computed when VR, VL and RCONDE are also
*>      computed. RCONDV(partial) denotes the reciprocal condition
*>      numbers when only some of VR, VL and RCONDE are computed.
*>
*>   (10)     |RCONDV - RCDVIN| / cond(RCONDV)
*>
*>      RCONDV is the reciprocal right eigenvector condition number
*>      computed by DGEEVX 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.
*>
*>   (11)     |RCONDE - RCDEIN| / cond(RCONDE)
*>
*>      RCONDE is the reciprocal eigenvalue condition number
*>      computed by DGEEVX 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.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] COMP
*> \verbatim
*>          COMP is LOGICAL
*>          COMP describes which input tests to perform:
*>            = .FALSE. if the computed condition numbers are not to
*>                      be tested against RCDVIN and RCDEIN
*>            = .TRUE.  if they are to be compared
*> \endverbatim
*>
*> \param[in] BALANC
*> \verbatim
*>          BALANC is CHARACTER
*>          Describes the balancing option to be tested.
*>            = 'N' for no permuting or diagonal scaling
*>            = 'P' for permuting but no diagonal scaling
*>            = 'S' for no permuting but diagonal scaling
*>            = 'B' for permuting and diagonal scaling
*> \endverbatim
*>
*> \param[in] JTYPE
*> \verbatim
*>          JTYPE is INTEGER
*>          Type of input matrix. Used to label output if error occurs.
*> \endverbatim
*>
*> \param[in] THRESH
*> \verbatim
*>          THRESH is DOUBLE PRECISION
*>          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.
*> \endverbatim
*>
*> \param[in] ISEED
*> \verbatim
*>          ISEED is INTEGER array, dimension (4)
*>          If COMP = .FALSE., the random number generator seed
*>          used to produce matrix.
*>          If COMP = .TRUE., ISEED(1) = the number of the example.
*>          Used to label output if error occurs.
*> \endverbatim
*>
*> \param[in] NOUNIT
*> \verbatim
*>          NOUNIT is INTEGER
*>          The FORTRAN unit number for printing out error messages
*>          (e.g., if a routine returns INFO not equal to 0.)
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*>          N is INTEGER
*>          The dimension of A. N must be at least 0.
*> \endverbatim
*>
*> \param[in,out] A
*> \verbatim
*>          A is DOUBLE PRECISION array, dimension (LDA,N)
*>          Used to hold the matrix whose eigenvalues are to be
*>          computed.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*>          LDA is INTEGER
*>          The leading dimension of A, and H. LDA must be at
*>          least 1 and at least N.
*> \endverbatim
*>
*> \param[out] H
*> \verbatim
*>          H is DOUBLE PRECISION array, dimension (LDA,N)
*>          Another copy of the test matrix A, modified by DGEEVX.
*> \endverbatim
*>
*> \param[out] WR
*> \verbatim
*>          WR is DOUBLE PRECISION array, dimension (N)
*> \endverbatim
*>
*> \param[out] WI
*> \verbatim
*>          WI is DOUBLE PRECISION array, dimension (N)
*>
*>          The real and imaginary parts of the eigenvalues of A.
*>          On exit, WR + WI*i are the eigenvalues of the matrix in A.
*> \endverbatim
*>
*> \param[out] WR1
*> \verbatim
*>          WR1 is DOUBLE PRECISION array, dimension (N)
*> \endverbatim
*>
*> \param[out] WI1
*> \verbatim
*>          WI1 is DOUBLE PRECISION array, dimension (N)
*>
*>          Like WR, WI, these arrays contain the eigenvalues of A,
*>          but those computed when DGEEVX only computes a partial
*>          eigendecomposition, i.e. not the eigenvalues and left
*>          and right eigenvectors.
*> \endverbatim
*>
*> \param[out] VL
*> \verbatim
*>          VL is DOUBLE PRECISION array, dimension (LDVL,N)
*>          VL holds the computed left eigenvectors.
*> \endverbatim
*>
*> \param[in] LDVL
*> \verbatim
*>          LDVL is INTEGER
*>          Leading dimension of VL. Must be at least max(1,N).
*> \endverbatim
*>
*> \param[out] VR
*> \verbatim
*>          VR is DOUBLE PRECISION array, dimension (LDVR,N)
*>          VR holds the computed right eigenvectors.
*> \endverbatim
*>
*> \param[in] LDVR
*> \verbatim
*>          LDVR is INTEGER
*>          Leading dimension of VR. Must be at least max(1,N).
*> \endverbatim
*>
*> \param[out] LRE
*> \verbatim
*>          LRE is DOUBLE PRECISION array, dimension (LDLRE,N)
*>          LRE holds the computed right or left eigenvectors.
*> \endverbatim
*>
*> \param[in] LDLRE
*> \verbatim
*>          LDLRE is INTEGER
*>          Leading dimension of LRE. Must be at least max(1,N).
*> \endverbatim
*>
*> \param[out] RCONDV
*> \verbatim
*>          RCONDV is DOUBLE PRECISION array, dimension (N)
*>          RCONDV holds the computed reciprocal condition numbers
*>          for eigenvectors.
*> \endverbatim
*>
*> \param[out] RCNDV1
*> \verbatim
*>          RCNDV1 is DOUBLE PRECISION array, dimension (N)
*>          RCNDV1 holds more computed reciprocal condition numbers
*>          for eigenvectors.
*> \endverbatim
*>
*> \param[in] RCDVIN
*> \verbatim
*>          RCDVIN is DOUBLE PRECISION array, dimension (N)
*>          When COMP = .TRUE. RCDVIN holds the precomputed reciprocal
*>          condition numbers for eigenvectors to be compared with
*>          RCONDV.
*> \endverbatim
*>
*> \param[out] RCONDE
*> \verbatim
*>          RCONDE is DOUBLE PRECISION array, dimension (N)
*>          RCONDE holds the computed reciprocal condition numbers
*>          for eigenvalues.
*> \endverbatim
*>
*> \param[out] RCNDE1
*> \verbatim
*>          RCNDE1 is DOUBLE PRECISION array, dimension (N)
*>          RCNDE1 holds more computed reciprocal condition numbers
*>          for eigenvalues.
*> \endverbatim
*>
*> \param[in] RCDEIN
*> \verbatim
*>          RCDEIN is DOUBLE PRECISION array, dimension (N)
*>          When COMP = .TRUE. RCDEIN holds the precomputed reciprocal
*>          condition numbers for eigenvalues to be compared with
*>          RCONDE.
*> \endverbatim
*>
*> \param[out] SCALE
*> \verbatim
*>          SCALE is DOUBLE PRECISION array, dimension (N)
*>          Holds information describing balancing of matrix.
*> \endverbatim
*>
*> \param[out] SCALE1
*> \verbatim
*>          SCALE1 is DOUBLE PRECISION array, dimension (N)
*>          Holds information describing balancing of matrix.
*> \endverbatim
*>
*> \param[out] RESULT
*> \verbatim
*>          RESULT is DOUBLE PRECISION array, dimension (11)
*>          The values computed by the 11 tests described above.
*>          The values are currently limited to 1/ulp, to avoid
*>          overflow.
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*>          WORK is DOUBLE PRECISION array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*>          LWORK is INTEGER
*>          The number of entries in WORK.  This must be at least
*>          3*N, and 6*N+N**2 if tests 9, 10 or 11 are to be performed.
*> \endverbatim
*>
*> \param[out] IWORK
*> \verbatim
*>          IWORK is INTEGER array, dimension (2*N)
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*>          INFO is INTEGER
*>          If 0,  successful exit.
*>          If <0, input parameter -INFO had an incorrect value.
*>          If >0, DGEEVX returned an error code, the absolute
*>                 value of which is returned.
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date December 2016
*
*> \ingroup double_eig
*
*  =====================================================================
      SUBROUTINE dget23( COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N,
     $                   A, LDA, H, WR, WI, WR1, WI1, VL, LDVL, VR,
     $                   LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,
     $                   RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,
     $                   WORK, LWORK, IWORK, INFO )
*
*  -- LAPACK test routine (version 3.7.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     December 2016
*
*     .. Scalar Arguments ..
      LOGICAL            COMP
      CHARACTER          BALANC
      INTEGER            INFO, JTYPE, LDA, LDLRE, LDVL, LDVR, LWORK, N,
     $                   nounit
      DOUBLE PRECISION   THRESH
*     ..
*     .. Array Arguments ..
      INTEGER            ISEED( 4 ), IWORK( * )
      DOUBLE PRECISION   A( lda, * ), H( lda, * ), LRE( ldlre, * ),
     $                   rcdein( * ), rcdvin( * ), rcnde1( * ),
     $                   rcndv1( * ), rconde( * ), rcondv( * ),
     $                   result( 11 ), scale( * ), scale1( * ),
     $                   vl( ldvl, * ), vr( ldvr, * ), wi( * ),
     $                   wi1( * ), work( * ), wr( * ), wr1( * )
*     ..
*
*  =====================================================================
*
*
*     .. Parameters ..
      DOUBLE PRECISION   ZERO, ONE, TWO
      parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0 )
      DOUBLE PRECISION   EPSIN
      parameter( epsin = 5.9605d-8 )
*     ..
*     .. Local Scalars ..
      LOGICAL            BALOK, NOBAL
      CHARACTER          SENSE
      INTEGER            I, IHI, IHI1, IINFO, ILO, ILO1, ISENS, ISENSM,
     $                   j, jj, kmin
      DOUBLE PRECISION   ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN,
     $                   ulp, ulpinv, v, vimin, vmax, vmx, vrmin, vrmx,
     $                   vtst
*     ..
*     .. Local Arrays ..
      CHARACTER          SENS( 2 )
      DOUBLE PRECISION   DUM( 1 ), RES( 2 )
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      DOUBLE PRECISION   DLAMCH, DLAPY2, DNRM2
      EXTERNAL           lsame, dlamch, dlapy2, dnrm2
*     ..
*     .. External Subroutines ..
      EXTERNAL           dgeevx, dget22, dlacpy, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, dble, max, min
*     ..
*     .. Data statements ..
      DATA               sens / 'N', 'V' /
*     ..
*     .. Executable Statements ..
*
*     Check for errors
*
      nobal = lsame( balanc, 'N' )
      balok = nobal .OR. lsame( balanc, 'P' ) .OR.
     $        lsame( balanc, 'S' ) .OR. lsame( balanc, 'B' )
      info = 0
      IF( .NOT.balok ) THEN
         info = -2
      ELSE IF( thresh.LT.zero ) THEN
         info = -4
      ELSE IF( nounit.LE.0 ) THEN
         info = -6
      ELSE IF( n.LT.0 ) THEN
         info = -7
      ELSE IF( lda.LT.1 .OR. lda.LT.n ) THEN
         info = -9
      ELSE IF( ldvl.LT.1 .OR. ldvl.LT.n ) THEN
         info = -16
      ELSE IF( ldvr.LT.1 .OR. ldvr.LT.n ) THEN
         info = -18
      ELSE IF( ldlre.LT.1 .OR. ldlre.LT.n ) THEN
         info = -20
      ELSE IF( lwork.LT.3*n .OR. ( comp .AND. lwork.LT.6*n+n*n ) ) THEN
         info = -31
      END IF
*
      IF( info.NE.0 ) THEN
         CALL xerbla( 'DGET23', -info )
         RETURN
      END IF
*
*     Quick return if nothing to do
*
      DO 10 i = 1, 11
         result( i ) = -one
   10 CONTINUE
*
      IF( n.EQ.0 )
     $   RETURN
*
*     More Important constants
*
      ulp = dlamch( 'Precision' )
      smlnum = dlamch( 'S' )
      ulpinv = one / ulp
*
*     Compute eigenvalues and eigenvectors, and test them
*
      IF( lwork.GE.6*n+n*n ) THEN
         sense = 'B'
         isensm = 2
      ELSE
         sense = 'E'
         isensm = 1
      END IF
      CALL dlacpy( 'F', n, n, a, lda, h, lda )
      CALL dgeevx( balanc, 'V', 'V', sense, n, h, lda, wr, wi, vl, ldvl,
     $             vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv,
     $             work, lwork, iwork, iinfo )
      IF( iinfo.NE.0 ) THEN
         result( 1 ) = ulpinv
         IF( jtype.NE.22 ) THEN
            WRITE( nounit, fmt = 9998 )'DGEEVX1', iinfo, n, jtype,
     $         balanc, iseed
         ELSE
            WRITE( nounit, fmt = 9999 )'DGEEVX1', iinfo, n, iseed( 1 )
         END IF
         info = abs( iinfo )
         RETURN
      END IF
*
*     Do Test (1)
*
      CALL dget22( 'N', 'N', 'N', n, a, lda, vr, ldvr, wr, wi, work,
     $             res )
      result( 1 ) = res( 1 )
*
*     Do Test (2)
*
      CALL dget22( 'T', 'N', 'T', n, a, lda, vl, ldvl, wr, wi, work,
     $             res )
      result( 2 ) = res( 1 )
*
*     Do Test (3)
*
      DO 30 j = 1, n
         tnrm = one
         IF( wi( j ).EQ.zero ) THEN
            tnrm = dnrm2( n, vr( 1, j ), 1 )
         ELSE IF( wi( j ).GT.zero ) THEN
            tnrm = dlapy2( dnrm2( n, vr( 1, j ), 1 ),
     $             dnrm2( n, vr( 1, j+1 ), 1 ) )
         END IF
         result( 3 ) = max( result( 3 ),
     $                 min( ulpinv, abs( tnrm-one ) / ulp ) )
         IF( wi( j ).GT.zero ) THEN
            vmx = zero
            vrmx = zero
            DO 20 jj = 1, n
               vtst = dlapy2( vr( jj, j ), vr( jj, j+1 ) )
               IF( vtst.GT.vmx )
     $            vmx = vtst
               IF( vr( jj, j+1 ).EQ.zero .AND. abs( vr( jj, j ) ).GT.
     $             vrmx )vrmx = abs( vr( jj, j ) )
   20       CONTINUE
            IF( vrmx / vmx.LT.one-two*ulp )
     $         result( 3 ) = ulpinv
         END IF
   30 CONTINUE
*
*     Do Test (4)
*
      DO 50 j = 1, n
         tnrm = one
         IF( wi( j ).EQ.zero ) THEN
            tnrm = dnrm2( n, vl( 1, j ), 1 )
         ELSE IF( wi( j ).GT.zero ) THEN
            tnrm = dlapy2( dnrm2( n, vl( 1, j ), 1 ),
     $             dnrm2( n, vl( 1, j+1 ), 1 ) )
         END IF
         result( 4 ) = max( result( 4 ),
     $                 min( ulpinv, abs( tnrm-one ) / ulp ) )
         IF( wi( j ).GT.zero ) THEN
            vmx = zero
            vrmx = zero
            DO 40 jj = 1, n
               vtst = dlapy2( vl( jj, j ), vl( jj, j+1 ) )
               IF( vtst.GT.vmx )
     $            vmx = vtst
               IF( vl( jj, j+1 ).EQ.zero .AND. abs( vl( jj, j ) ).GT.
     $             vrmx )vrmx = abs( vl( jj, j ) )
   40       CONTINUE
            IF( vrmx / vmx.LT.one-two*ulp )
     $         result( 4 ) = ulpinv
         END IF
   50 CONTINUE
*
*     Test for all options of computing condition numbers
*
      DO 200 isens = 1, isensm
*
         sense = sens( isens )
*
*        Compute eigenvalues only, and test them
*
         CALL dlacpy( 'F', n, n, a, lda, h, lda )
         CALL dgeevx( balanc, 'N', 'N', sense, n, h, lda, wr1, wi1, dum,
     $                1, dum, 1, ilo1, ihi1, scale1, abnrm1, rcnde1,
     $                rcndv1, work, lwork, iwork, iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 1 ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'DGEEVX2', iinfo, n, jtype,
     $            balanc, iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'DGEEVX2', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            GO TO 190
         END IF
*
*        Do Test (5)
*
         DO 60 j = 1, n
            IF( wr( j ).NE.wr1( j ) .OR. wi( j ).NE.wi1( j ) )
     $         result( 5 ) = ulpinv
   60    CONTINUE
*
*        Do Test (8)
*
         IF( .NOT.nobal ) THEN
            DO 70 j = 1, n
               IF( scale( j ).NE.scale1( j ) )
     $            result( 8 ) = ulpinv
   70       CONTINUE
            IF( ilo.NE.ilo1 )
     $         result( 8 ) = ulpinv
            IF( ihi.NE.ihi1 )
     $         result( 8 ) = ulpinv
            IF( abnrm.NE.abnrm1 )
     $         result( 8 ) = ulpinv
         END IF
*
*        Do Test (9)
*
         IF( isens.EQ.2 .AND. n.GT.1 ) THEN
            DO 80 j = 1, n
               IF( rcondv( j ).NE.rcndv1( j ) )
     $            result( 9 ) = ulpinv
   80       CONTINUE
         END IF
*
*        Compute eigenvalues and right eigenvectors, and test them
*
         CALL dlacpy( 'F', n, n, a, lda, h, lda )
         CALL dgeevx( balanc, 'N', 'V', sense, n, h, lda, wr1, wi1, dum,
     $                1, lre, ldlre, ilo1, ihi1, scale1, abnrm1, rcnde1,
     $                rcndv1, work, lwork, iwork, iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 1 ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'DGEEVX3', iinfo, n, jtype,
     $            balanc, iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'DGEEVX3', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            GO TO 190
         END IF
*
*        Do Test (5) again
*
         DO 90 j = 1, n
            IF( wr( j ).NE.wr1( j ) .OR. wi( j ).NE.wi1( j ) )
     $         result( 5 ) = ulpinv
   90    CONTINUE
*
*        Do Test (6)
*
         DO 110 j = 1, n
            DO 100 jj = 1, n
               IF( vr( j, jj ).NE.lre( j, jj ) )
     $            result( 6 ) = ulpinv
  100       CONTINUE
  110    CONTINUE
*
*        Do Test (8) again
*
         IF( .NOT.nobal ) THEN
            DO 120 j = 1, n
               IF( scale( j ).NE.scale1( j ) )
     $            result( 8 ) = ulpinv
  120       CONTINUE
            IF( ilo.NE.ilo1 )
     $         result( 8 ) = ulpinv
            IF( ihi.NE.ihi1 )
     $         result( 8 ) = ulpinv
            IF( abnrm.NE.abnrm1 )
     $         result( 8 ) = ulpinv
         END IF
*
*        Do Test (9) again
*
         IF( isens.EQ.2 .AND. n.GT.1 ) THEN
            DO 130 j = 1, n
               IF( rcondv( j ).NE.rcndv1( j ) )
     $            result( 9 ) = ulpinv
  130       CONTINUE
         END IF
*
*        Compute eigenvalues and left eigenvectors, and test them
*
         CALL dlacpy( 'F', n, n, a, lda, h, lda )
         CALL dgeevx( balanc, 'V', 'N', sense, n, h, lda, wr1, wi1, lre,
     $                ldlre, dum, 1, ilo1, ihi1, scale1, abnrm1, rcnde1,
     $                rcndv1, work, lwork, iwork, iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 1 ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'DGEEVX4', iinfo, n, jtype,
     $            balanc, iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'DGEEVX4', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            GO TO 190
         END IF
*
*        Do Test (5) again
*
         DO 140 j = 1, n
            IF( wr( j ).NE.wr1( j ) .OR. wi( j ).NE.wi1( j ) )
     $         result( 5 ) = ulpinv
  140    CONTINUE
*
*        Do Test (7)
*
         DO 160 j = 1, n
            DO 150 jj = 1, n
               IF( vl( j, jj ).NE.lre( j, jj ) )
     $            result( 7 ) = ulpinv
  150       CONTINUE
  160    CONTINUE
*
*        Do Test (8) again
*
         IF( .NOT.nobal ) THEN
            DO 170 j = 1, n
               IF( scale( j ).NE.scale1( j ) )
     $            result( 8 ) = ulpinv
  170       CONTINUE
            IF( ilo.NE.ilo1 )
     $         result( 8 ) = ulpinv
            IF( ihi.NE.ihi1 )
     $         result( 8 ) = ulpinv
            IF( abnrm.NE.abnrm1 )
     $         result( 8 ) = ulpinv
         END IF
*
*        Do Test (9) again
*
         IF( isens.EQ.2 .AND. n.GT.1 ) THEN
            DO 180 j = 1, n
               IF( rcondv( j ).NE.rcndv1( j ) )
     $            result( 9 ) = ulpinv
  180       CONTINUE
         END IF
*
  190    CONTINUE
*
  200 CONTINUE
*
*     If COMP, compare condition numbers to precomputed ones
*
      IF( comp ) THEN
         CALL dlacpy( 'F', n, n, a, lda, h, lda )
         CALL dgeevx( 'N', 'V', 'V', 'B', n, h, lda, wr, wi, vl, ldvl,
     $                vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv,
     $                work, lwork, iwork, iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 1 ) = ulpinv
            WRITE( nounit, fmt = 9999 )'DGEEVX5', iinfo, n, iseed( 1 )
            info = abs( iinfo )
            GO TO 250
         END IF
*
*        Sort eigenvalues and condition numbers lexicographically
*        to compare with inputs
*
         DO 220 i = 1, n - 1
            kmin = i
            vrmin = wr( i )
            vimin = wi( i )
            DO 210 j = i + 1, n
               IF( wr( j ).LT.vrmin ) THEN
                  kmin = j
                  vrmin = wr( j )
                  vimin = wi( j )
               END IF
  210       CONTINUE
            wr( kmin ) = wr( i )
            wi( kmin ) = wi( i )
            wr( i ) = vrmin
            wi( i ) = vimin
            vrmin = rconde( kmin )
            rconde( kmin ) = rconde( i )
            rconde( i ) = vrmin
            vrmin = rcondv( kmin )
            rcondv( kmin ) = rcondv( i )
            rcondv( i ) = vrmin
  220    CONTINUE
*
*        Compare condition numbers for eigenvectors
*        taking their condition numbers into account
*
         result( 10 ) = zero
         eps = max( epsin, ulp )
         v = max( dble( n )*eps*abnrm, smlnum )
         IF( abnrm.EQ.zero )
     $      v = one
         DO 230 i = 1, n
            IF( v.GT.rcondv( i )*rconde( i ) ) THEN
               tol = rcondv( i )
            ELSE
               tol = v / rconde( i )
            END IF
            IF( v.GT.rcdvin( i )*rcdein( i ) ) THEN
               tolin = rcdvin( i )
            ELSE
               tolin = v / rcdein( i )
            END IF
            tol = max( tol, smlnum / eps )
            tolin = max( tolin, smlnum / eps )
            IF( eps*( rcdvin( i )-tolin ).GT.rcondv( i )+tol ) THEN
               vmax = one / eps
            ELSE IF( rcdvin( i )-tolin.GT.rcondv( i )+tol ) THEN
               vmax = ( rcdvin( i )-tolin ) / ( rcondv( i )+tol )
            ELSE IF( rcdvin( i )+tolin.LT.eps*( rcondv( i )-tol ) ) THEN
               vmax = one / eps
            ELSE IF( rcdvin( i )+tolin.LT.rcondv( i )-tol ) THEN
               vmax = ( rcondv( i )-tol ) / ( rcdvin( i )+tolin )
            ELSE
               vmax = one
            END IF
            result( 10 ) = max( result( 10 ), vmax )
  230    CONTINUE
*
*        Compare condition numbers for eigenvalues
*        taking their condition numbers into account
*
         result( 11 ) = zero
         DO 240 i = 1, n
            IF( v.GT.rcondv( i ) ) THEN
               tol = one
            ELSE
               tol = v / rcondv( i )
            END IF
            IF( v.GT.rcdvin( i ) ) THEN
               tolin = one
            ELSE
               tolin = v / rcdvin( i )
            END IF
            tol = max( tol, smlnum / eps )
            tolin = max( tolin, smlnum / eps )
            IF( eps*( rcdein( i )-tolin ).GT.rconde( i )+tol ) THEN
               vmax = one / eps
            ELSE IF( rcdein( i )-tolin.GT.rconde( i )+tol ) THEN
               vmax = ( rcdein( i )-tolin ) / ( rconde( i )+tol )
            ELSE IF( rcdein( i )+tolin.LT.eps*( rconde( i )-tol ) ) THEN
               vmax = one / eps
            ELSE IF( rcdein( i )+tolin.LT.rconde( i )-tol ) THEN
               vmax = ( rconde( i )-tol ) / ( rcdein( i )+tolin )
            ELSE
               vmax = one
            END IF
            result( 11 ) = max( result( 11 ), vmax )
  240    CONTINUE
  250    CONTINUE
*
      END IF
*
 9999 FORMAT( ' DGET23: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
     $      i6, ', INPUT EXAMPLE NUMBER = ', i4 )
 9998 FORMAT( ' DGET23: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
     $      i6, ', JTYPE=', i6, ', BALANC = ', a, ', ISEED=(',
     $      3( i5, ',' ), i5, ')' )
*
      RETURN
*
*     End of DGET23
*
      END