cget24.f

Go to the documentation of this file.

*> \brief \b CGET24
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at 
*            http://www.netlib.org/lapack/explore-html/ 
*
*  Definition:
*  ===========
*
*       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 )
* 
*       .. Scalar Arguments ..
*       LOGICAL            COMP
*       INTEGER            INFO, ISRT, JTYPE, LDA, LDVS, LWORK, N, NOUNIT,
*      $                   NSLCT
*       REAL               RCDEIN, RCDVIN, THRESH
*       ..
*       .. Array Arguments ..
*       LOGICAL            BWORK( * )
*       INTEGER            ISEED( 4 ), ISLCT( * )
*       REAL               RESULT( 17 ), RWORK( * )
*       COMPLEX            A( LDA, * ), H( LDA, * ), HT( LDA, * ),
*      $                   VS( LDVS, * ), VS1( LDVS, * ), W( * ),
*      $                   WORK( * ), WT( * ), WTMP( * )
*       ..
*  
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*>    CGET24 checks the nonsymmetric eigenvalue (Schur form) problem
*>    expert driver CGEESX.
*>
*>    If COMP = .FALSE., the first 13 of the following tests will be
*>    be performed on the input matrix A, and also tests 14 and 15
*>    if LWORK is sufficiently large.
*>    If COMP = .TRUE., all 17 test 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
*>
*>    (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.
*> \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] JTYPE
*> \verbatim
*>          JTYPE is INTEGER
*>          Type of input matrix. Used to label output if error occurs.
*> \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] THRESH
*> \verbatim
*>          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.
*> \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 COMPLEX 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 COMPLEX array, dimension (LDA, N)
*>          Another copy of the test matrix A, modified by CGEESX.
*> \endverbatim
*>
*> \param[out] HT
*> \verbatim
*>          HT is COMPLEX array, dimension (LDA, N)
*>          Yet another copy of the test matrix A, modified by CGEESX.
*> \endverbatim
*>
*> \param[out] W
*> \verbatim
*>          W is COMPLEX array, dimension (N)
*>          The computed eigenvalues of A.
*> \endverbatim
*>
*> \param[out] WT
*> \verbatim
*>          WT is COMPLEX array, dimension (N)
*>          Like W, this array contains the eigenvalues of A,
*>          but those computed when CGEESX only computes a partial
*>          eigendecomposition, i.e. not Schur vectors
*> \endverbatim
*>
*> \param[out] WTMP
*> \verbatim
*>          WTMP is COMPLEX array, dimension (N)
*>          Like W, this array contains the eigenvalues of A,
*>          but sorted by increasing real or imaginary part.
*> \endverbatim
*>
*> \param[out] VS
*> \verbatim
*>          VS is COMPLEX array, dimension (LDVS, N)
*>          VS holds the computed Schur vectors.
*> \endverbatim
*>
*> \param[in] LDVS
*> \verbatim
*>          LDVS is INTEGER
*>          Leading dimension of VS. Must be at least max(1, N).
*> \endverbatim
*>
*> \param[out] VS1
*> \verbatim
*>          VS1 is COMPLEX array, dimension (LDVS, N)
*>          VS1 holds another copy of the computed Schur vectors.
*> \endverbatim
*>
*> \param[in] RCDEIN
*> \verbatim
*>          RCDEIN is REAL
*>          When COMP = .TRUE. RCDEIN holds the precomputed reciprocal
*>          condition number for the average of selected eigenvalues.
*> \endverbatim
*>
*> \param[in] RCDVIN
*> \verbatim
*>          RCDVIN is REAL
*>          When COMP = .TRUE. RCDVIN holds the precomputed reciprocal
*>          condition number for the selected right invariant subspace.
*> \endverbatim
*>
*> \param[in] NSLCT
*> \verbatim
*>          NSLCT is INTEGER
*>          When COMP = .TRUE. the number of selected eigenvalues
*>          corresponding to the precomputed values RCDEIN and RCDVIN.
*> \endverbatim
*>
*> \param[in] ISLCT
*> \verbatim
*>          ISLCT is INTEGER array, dimension (NSLCT)
*>          When COMP = .TRUE. ISLCT selects the eigenvalues of the
*>          input matrix corresponding to the precomputed values RCDEIN
*>          and RCDVIN. For I=1, ... ,NSLCT, if ISLCT(I) = J, then the
*>          eigenvalue with the J-th largest real or imaginary part is
*>          selected. The real part is used if ISRT = 0, and the
*>          imaginary part if ISRT = 1.
*>          Not referenced if COMP = .FALSE.
*> \endverbatim
*>
*> \param[in] ISRT
*> \verbatim
*>          ISRT is INTEGER
*>          When COMP = .TRUE., ISRT describes how ISLCT is used to
*>          choose a subset of the spectrum.
*>          Not referenced if COMP = .FALSE.
*> \endverbatim
*>
*> \param[out] RESULT
*> \verbatim
*>          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.
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*>          WORK is COMPLEX array, dimension (2*N*N)
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*>          LWORK is INTEGER
*>          The number of entries in WORK to be passed to CGEESX. This
*>          must be at least 2*N, and N*(N+1)/2 if tests 14--16 are to
*>          be performed.
*> \endverbatim
*>
*> \param[out] RWORK
*> \verbatim
*>          RWORK is REAL array, dimension (N)
*> \endverbatim
*>
*> \param[out] BWORK
*> \verbatim
*>          BWORK is LOGICAL array, dimension (N)
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*>          INFO is INTEGER
*>          If 0,  successful exit.
*>          If <0, input parameter -INFO had an incorrect value.
*>          If >0, CGEESX 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 November 2011
*
*> \ingroup complex_eig
*
*  =====================================================================
      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 )
*
*  -- LAPACK test routine (version 3.4.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     November 2011
*
*     .. Scalar Arguments ..
      LOGICAL            comp
      INTEGER            info, isrt, jtype, lda, ldvs, lwork, n, nounit,
     $                   nslct
      REAL               rcdein, rcdvin, thresh
*     ..
*     .. Array Arguments ..
      LOGICAL            bwork( * )
      INTEGER            iseed( 4 ), islct( * )
      REAL               result( 17 ), rwork( * )
      COMPLEX            a( lda, * ), h( lda, * ), ht( lda, * ),
     $                   vs( ldvs, * ), vs1( ldvs, * ), w( * ),
     $                   work( * ), wt( * ), wtmp( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      COMPLEX            czero, cone
      parameter( czero = ( 0.0e+0, 0.0e+0 ),
     $                   cone = ( 1.0e+0, 0.0e+0 ) )
      REAL               zero, one
      parameter( zero = 0.0e+0, one = 1.0e+0 )
      REAL               epsin
      parameter( epsin = 5.9605e-8 )
*     ..
*     .. Local Scalars ..
      CHARACTER          sort
      INTEGER            i, iinfo, isort, itmp, j, kmin, knteig, rsub,
     $                   sdim, sdim1
      REAL               anorm, eps, rcnde1, rcndv1, rconde, rcondv,
     $                   smlnum, tol, tolin, ulp, ulpinv, v, vricmp,
     $                   vrimin, wnorm
      COMPLEX            ctmp
*     ..
*     .. Local Arrays ..
      INTEGER            ipnt( 20 )
*     ..
*     .. External Functions ..
      LOGICAL            cslect
      REAL               clange, slamch
      EXTERNAL           cslect, clange, slamch
*     ..
*     .. External Subroutines ..
      EXTERNAL           ccopy, cgeesx, cgemm, clacpy, cunt01, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, aimag, max, min, real
*     ..
*     .. Arrays in Common ..
      LOGICAL            selval( 20 )
      REAL               selwi( 20 ), selwr( 20 )
*     ..
*     .. Scalars in Common ..
      INTEGER            seldim, selopt
*     ..
*     .. Common blocks ..
      common             / sslct / selopt, seldim, selval, selwr, selwi
*     ..
*     .. Executable Statements ..
*
*     Check for errors
*
      info = 0
      IF( thresh.LT.zero ) THEN
         info = -3
      ELSE IF( nounit.LE.0 ) THEN
         info = -5
      ELSE IF( n.LT.0 ) THEN
         info = -6
      ELSE IF( lda.LT.1 .OR. lda.LT.n ) THEN
         info = -8
      ELSE IF( ldvs.LT.1 .OR. ldvs.LT.n ) THEN
         info = -15
      ELSE IF( lwork.LT.2*n ) THEN
         info = -24
      END IF
*
      IF( info.NE.0 ) THEN
         CALL xerbla( 'CGET24', -info )
         return
      END IF
*
*     Quick return if nothing to do
*
      DO 10 i = 1, 17
         result( i ) = -one
   10 continue
*
      IF( n.EQ.0 )
     $   return
*
*     Important constants
*
      smlnum = slamch( 'Safe minimum' )
      ulp = slamch( 'Precision' )
      ulpinv = one / ulp
*
*     Perform tests (1)-(13)
*
      selopt = 0
      DO 90 isort = 0, 1
         IF( isort.EQ.0 ) THEN
            sort = 'N'
            rsub = 0
         ELSE
            sort = 'S'
            rsub = 6
         END IF
*
*        Compute Schur form and Schur vectors, and test them
*
         CALL clacpy( 'F', n, n, a, lda, h, lda )
         CALL cgeesx( 'V', sort, cslect, 'N', n, h, lda, sdim, w, vs,
     $                ldvs, rconde, rcondv, work, lwork, rwork, bwork,
     $                iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 1+rsub ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'CGEESX1', iinfo, n, jtype,
     $            iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'CGEESX1', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            return
         END IF
         IF( isort.EQ.0 ) THEN
            CALL ccopy( n, w, 1, wtmp, 1 )
         END IF
*
*        Do Test (1) or Test (7)
*
         result( 1+rsub ) = zero
         DO 30 j = 1, n - 1
            DO 20 i = j + 1, n
               IF( h( i, j ).NE.czero )
     $            result( 1+rsub ) = ulpinv
   20       continue
   30    continue
*
*        Test (2) or (8): Compute norm(A - Q*H*Q') / (norm(A) * N * ULP)
*
*        Copy A to VS1, used as workspace
*
         CALL clacpy( ' ', n, n, a, lda, vs1, ldvs )
*
*        Compute Q*H and store in HT.
*
         CALL cgemm( 'No transpose', 'No transpose', n, n, n, cone, vs,
     $               ldvs, h, lda, czero, ht, lda )
*
*        Compute A - Q*H*Q'
*
         CALL cgemm( 'No transpose', 'Conjugate transpose', n, n, n,
     $               -cone, ht, lda, vs, ldvs, cone, vs1, ldvs )
*
         anorm = max( clange( '1', n, n, a, lda, rwork ), smlnum )
         wnorm = clange( '1', n, n, vs1, ldvs, rwork )
*
         IF( anorm.GT.wnorm ) THEN
            result( 2+rsub ) = ( wnorm / anorm ) / ( n*ulp )
         ELSE
            IF( anorm.LT.one ) THEN
               result( 2+rsub ) = ( min( wnorm, n*anorm ) / anorm ) /
     $                            ( n*ulp )
            ELSE
               result( 2+rsub ) = min( wnorm / anorm, REAL( N ) ) /
     $                            ( n*ulp )
            END IF
         END IF
*
*        Test (3) or (9):  Compute norm( I - Q'*Q ) / ( N * ULP )
*
         CALL cunt01( 'Columns', n, n, vs, ldvs, work, lwork, rwork,
     $                result( 3+rsub ) )
*
*        Do Test (4) or Test (10)
*
         result( 4+rsub ) = zero
         DO 40 i = 1, n
            IF( h( i, i ).NE.w( i ) )
     $         result( 4+rsub ) = ulpinv
   40    continue
*
*        Do Test (5) or Test (11)
*
         CALL clacpy( 'F', n, n, a, lda, ht, lda )
         CALL cgeesx( 'N', sort, cslect, 'N', n, ht, lda, sdim, wt, vs,
     $                ldvs, rconde, rcondv, work, lwork, rwork, bwork,
     $                iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 5+rsub ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'CGEESX2', iinfo, n, jtype,
     $            iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'CGEESX2', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            go to 220
         END IF
*
         result( 5+rsub ) = zero
         DO 60 j = 1, n
            DO 50 i = 1, n
               IF( h( i, j ).NE.ht( i, j ) )
     $            result( 5+rsub ) = ulpinv
   50       continue
   60    continue
*
*        Do Test (6) or Test (12)
*
         result( 6+rsub ) = zero
         DO 70 i = 1, n
            IF( w( i ).NE.wt( i ) )
     $         result( 6+rsub ) = ulpinv
   70    continue
*
*        Do Test (13)
*
         IF( isort.EQ.1 ) THEN
            result( 13 ) = zero
            knteig = 0
            DO 80 i = 1, n
               IF( cslect( w( i ) ) )
     $            knteig = knteig + 1
               IF( i.LT.n ) THEN
                  IF( cslect( w( i+1 ) ) .AND.
     $                ( .NOT.cslect( w( i ) ) ) )result( 13 ) = ulpinv
               END IF
   80       continue
            IF( sdim.NE.knteig )
     $         result( 13 ) = ulpinv
         END IF
*
   90 continue
*
*     If there is enough workspace, perform tests (14) and (15)
*     as well as (10) through (13)
*
      IF( lwork.GE.( n*( n+1 ) ) / 2 ) THEN
*
*        Compute both RCONDE and RCONDV with VS
*
         sort = 'S'
         result( 14 ) = zero
         result( 15 ) = zero
         CALL clacpy( 'F', n, n, a, lda, ht, lda )
         CALL cgeesx( 'V', sort, cslect, 'B', n, ht, lda, sdim1, wt,
     $                vs1, ldvs, rconde, rcondv, work, lwork, rwork,
     $                bwork, iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 14 ) = ulpinv
            result( 15 ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'CGEESX3', iinfo, n, jtype,
     $            iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'CGEESX3', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            go to 220
         END IF
*
*        Perform tests (10), (11), (12), and (13)
*
         DO 110 i = 1, n
            IF( w( i ).NE.wt( i ) )
     $         result( 10 ) = ulpinv
            DO 100 j = 1, n
               IF( h( i, j ).NE.ht( i, j ) )
     $            result( 11 ) = ulpinv
               IF( vs( i, j ).NE.vs1( i, j ) )
     $            result( 12 ) = ulpinv
  100       continue
  110    continue
         IF( sdim.NE.sdim1 )
     $      result( 13 ) = ulpinv
*
*        Compute both RCONDE and RCONDV without VS, and compare
*
         CALL clacpy( 'F', n, n, a, lda, ht, lda )
         CALL cgeesx( 'N', sort, cslect, 'B', n, ht, lda, sdim1, wt,
     $                vs1, ldvs, rcnde1, rcndv1, work, lwork, rwork,
     $                bwork, iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 14 ) = ulpinv
            result( 15 ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'CGEESX4', iinfo, n, jtype,
     $            iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'CGEESX4', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            go to 220
         END IF
*
*        Perform tests (14) and (15)
*
         IF( rcnde1.NE.rconde )
     $      result( 14 ) = ulpinv
         IF( rcndv1.NE.rcondv )
     $      result( 15 ) = ulpinv
*
*        Perform tests (10), (11), (12), and (13)
*
         DO 130 i = 1, n
            IF( w( i ).NE.wt( i ) )
     $         result( 10 ) = ulpinv
            DO 120 j = 1, n
               IF( h( i, j ).NE.ht( i, j ) )
     $            result( 11 ) = ulpinv
               IF( vs( i, j ).NE.vs1( i, j ) )
     $            result( 12 ) = ulpinv
  120       continue
  130    continue
         IF( sdim.NE.sdim1 )
     $      result( 13 ) = ulpinv
*
*        Compute RCONDE with VS, and compare
*
         CALL clacpy( 'F', n, n, a, lda, ht, lda )
         CALL cgeesx( 'V', sort, cslect, 'E', n, ht, lda, sdim1, wt,
     $                vs1, ldvs, rcnde1, rcndv1, work, lwork, rwork,
     $                bwork, iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 14 ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'CGEESX5', iinfo, n, jtype,
     $            iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'CGEESX5', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            go to 220
         END IF
*
*        Perform test (14)
*
         IF( rcnde1.NE.rconde )
     $      result( 14 ) = ulpinv
*
*        Perform tests (10), (11), (12), and (13)
*
         DO 150 i = 1, n
            IF( w( i ).NE.wt( i ) )
     $         result( 10 ) = ulpinv
            DO 140 j = 1, n
               IF( h( i, j ).NE.ht( i, j ) )
     $            result( 11 ) = ulpinv
               IF( vs( i, j ).NE.vs1( i, j ) )
     $            result( 12 ) = ulpinv
  140       continue
  150    continue
         IF( sdim.NE.sdim1 )
     $      result( 13 ) = ulpinv
*
*        Compute RCONDE without VS, and compare
*
         CALL clacpy( 'F', n, n, a, lda, ht, lda )
         CALL cgeesx( 'N', sort, cslect, 'E', n, ht, lda, sdim1, wt,
     $                vs1, ldvs, rcnde1, rcndv1, work, lwork, rwork,
     $                bwork, iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 14 ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'CGEESX6', iinfo, n, jtype,
     $            iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'CGEESX6', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            go to 220
         END IF
*
*        Perform test (14)
*
         IF( rcnde1.NE.rconde )
     $      result( 14 ) = ulpinv
*
*        Perform tests (10), (11), (12), and (13)
*
         DO 170 i = 1, n
            IF( w( i ).NE.wt( i ) )
     $         result( 10 ) = ulpinv
            DO 160 j = 1, n
               IF( h( i, j ).NE.ht( i, j ) )
     $            result( 11 ) = ulpinv
               IF( vs( i, j ).NE.vs1( i, j ) )
     $            result( 12 ) = ulpinv
  160       continue
  170    continue
         IF( sdim.NE.sdim1 )
     $      result( 13 ) = ulpinv
*
*        Compute RCONDV with VS, and compare
*
         CALL clacpy( 'F', n, n, a, lda, ht, lda )
         CALL cgeesx( 'V', sort, cslect, 'V', n, ht, lda, sdim1, wt,
     $                vs1, ldvs, rcnde1, rcndv1, work, lwork, rwork,
     $                bwork, iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 15 ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'CGEESX7', iinfo, n, jtype,
     $            iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'CGEESX7', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            go to 220
         END IF
*
*        Perform test (15)
*
         IF( rcndv1.NE.rcondv )
     $      result( 15 ) = ulpinv
*
*        Perform tests (10), (11), (12), and (13)
*
         DO 190 i = 1, n
            IF( w( i ).NE.wt( i ) )
     $         result( 10 ) = ulpinv
            DO 180 j = 1, n
               IF( h( i, j ).NE.ht( i, j ) )
     $            result( 11 ) = ulpinv
               IF( vs( i, j ).NE.vs1( i, j ) )
     $            result( 12 ) = ulpinv
  180       continue
  190    continue
         IF( sdim.NE.sdim1 )
     $      result( 13 ) = ulpinv
*
*        Compute RCONDV without VS, and compare
*
         CALL clacpy( 'F', n, n, a, lda, ht, lda )
         CALL cgeesx( 'N', sort, cslect, 'V', n, ht, lda, sdim1, wt,
     $                vs1, ldvs, rcnde1, rcndv1, work, lwork, rwork,
     $                bwork, iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 15 ) = ulpinv
            IF( jtype.NE.22 ) THEN
               WRITE( nounit, fmt = 9998 )'CGEESX8', iinfo, n, jtype,
     $            iseed
            ELSE
               WRITE( nounit, fmt = 9999 )'CGEESX8', iinfo, n,
     $            iseed( 1 )
            END IF
            info = abs( iinfo )
            go to 220
         END IF
*
*        Perform test (15)
*
         IF( rcndv1.NE.rcondv )
     $      result( 15 ) = ulpinv
*
*        Perform tests (10), (11), (12), and (13)
*
         DO 210 i = 1, n
            IF( w( i ).NE.wt( i ) )
     $         result( 10 ) = ulpinv
            DO 200 j = 1, n
               IF( h( i, j ).NE.ht( i, j ) )
     $            result( 11 ) = ulpinv
               IF( vs( i, j ).NE.vs1( i, j ) )
     $            result( 12 ) = ulpinv
  200       continue
  210    continue
         IF( sdim.NE.sdim1 )
     $      result( 13 ) = ulpinv
*
      END IF
*
  220 continue
*
*     If there are precomputed reciprocal condition numbers, compare
*     computed values with them.
*
      IF( comp ) THEN
*
*        First set up SELOPT, SELDIM, SELVAL, SELWR and SELWI so that
*        the logical function CSLECT selects the eigenvalues specified
*        by NSLCT, ISLCT and ISRT.
*
         seldim = n
         selopt = 1
         eps = max( ulp, epsin )
         DO 230 i = 1, n
            ipnt( i ) = i
            selval( i ) = .false.
            selwr( i ) = REAL( WTMP( I ) )
            selwi( i ) = aimag( wtmp( i ) )
  230    continue
         DO 250 i = 1, n - 1
            kmin = i
            IF( isrt.EQ.0 ) THEN
               vrimin = REAL( WTMP( I ) )
            ELSE
               vrimin = aimag( wtmp( i ) )
            END IF
            DO 240 j = i + 1, n
               IF( isrt.EQ.0 ) THEN
                  vricmp = REAL( WTMP( J ) )
               ELSE
                  vricmp = aimag( wtmp( j ) )
               END IF
               IF( vricmp.LT.vrimin ) THEN
                  kmin = j
                  vrimin = vricmp
               END IF
  240       continue
            ctmp = wtmp( kmin )
            wtmp( kmin ) = wtmp( i )
            wtmp( i ) = ctmp
            itmp = ipnt( i )
            ipnt( i ) = ipnt( kmin )
            ipnt( kmin ) = itmp
  250    continue
         DO 260 i = 1, nslct
            selval( ipnt( islct( i ) ) ) = .true.
  260    continue
*
*        Compute condition numbers
*
         CALL clacpy( 'F', n, n, a, lda, ht, lda )
         CALL cgeesx( 'N', 'S', cslect, 'B', n, ht, lda, sdim1, wt, vs1,
     $                ldvs, rconde, rcondv, work, lwork, rwork, bwork,
     $                iinfo )
         IF( iinfo.NE.0 ) THEN
            result( 16 ) = ulpinv
            result( 17 ) = ulpinv
            WRITE( nounit, fmt = 9999 )'CGEESX9', iinfo, n, iseed( 1 )
            info = abs( iinfo )
            go to 270
         END IF
*
*        Compare condition number for average of selected eigenvalues
*        taking its condition number into account
*
         anorm = clange( '1', n, n, a, lda, rwork )
         v = max( REAL( n )*eps*anorm, smlnum )
         IF( anorm.EQ.zero )
     $      v = one
         IF( v.GT.rcondv ) THEN
            tol = one
         ELSE
            tol = v / rcondv
         END IF
         IF( v.GT.rcdvin ) THEN
            tolin = one
         ELSE
            tolin = v / rcdvin
         END IF
         tol = max( tol, smlnum / eps )
         tolin = max( tolin, smlnum / eps )
         IF( eps*( rcdein-tolin ).GT.rconde+tol ) THEN
            result( 16 ) = ulpinv
         ELSE IF( rcdein-tolin.GT.rconde+tol ) THEN
            result( 16 ) = ( rcdein-tolin ) / ( rconde+tol )
         ELSE IF( rcdein+tolin.LT.eps*( rconde-tol ) ) THEN
            result( 16 ) = ulpinv
         ELSE IF( rcdein+tolin.LT.rconde-tol ) THEN
            result( 16 ) = ( rconde-tol ) / ( rcdein+tolin )
         ELSE
            result( 16 ) = one
         END IF
*
*        Compare condition numbers for right invariant subspace
*        taking its condition number into account
*
         IF( v.GT.rcondv*rconde ) THEN
            tol = rcondv
         ELSE
            tol = v / rconde
         END IF
         IF( v.GT.rcdvin*rcdein ) THEN
            tolin = rcdvin
         ELSE
            tolin = v / rcdein
         END IF
         tol = max( tol, smlnum / eps )
         tolin = max( tolin, smlnum / eps )
         IF( eps*( rcdvin-tolin ).GT.rcondv+tol ) THEN
            result( 17 ) = ulpinv
         ELSE IF( rcdvin-tolin.GT.rcondv+tol ) THEN
            result( 17 ) = ( rcdvin-tolin ) / ( rcondv+tol )
         ELSE IF( rcdvin+tolin.LT.eps*( rcondv-tol ) ) THEN
            result( 17 ) = ulpinv
         ELSE IF( rcdvin+tolin.LT.rcondv-tol ) THEN
            result( 17 ) = ( rcondv-tol ) / ( rcdvin+tolin )
         ELSE
            result( 17 ) = one
         END IF
*
  270    continue
*
      END IF
*
 9999 format( ' CGET24: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
     $      i6, ', INPUT EXAMPLE NUMBER = ', i4 )
 9998 format( ' CGET24: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
     $      i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
*
      return
*
*     End of CGET24
*
      END