LAPACK 3.3.0

cget23.f

Go to the documentation of this file.
00001       SUBROUTINE CGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED,
00002      $                   NOUNIT, N, A, LDA, H, W, W1, VL, LDVL, VR,
00003      $                   LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,
00004      $                   RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,
00005      $                   WORK, LWORK, RWORK, INFO )
00006 *
00007 *  -- LAPACK test routine (version 3.1) --
00008 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00009 *     November 2006
00010 *
00011 *     .. Scalar Arguments ..
00012       LOGICAL            COMP
00013       CHARACTER          BALANC
00014       INTEGER            INFO, ISRT, JTYPE, LDA, LDLRE, LDVL, LDVR,
00015      $                   LWORK, N, NOUNIT
00016       REAL               THRESH
00017 *     ..
00018 *     .. Array Arguments ..
00019       INTEGER            ISEED( 4 )
00020       REAL               RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),
00021      $                   RCNDV1( * ), RCONDE( * ), RCONDV( * ),
00022      $                   RESULT( 11 ), RWORK( * ), SCALE( * ),
00023      $                   SCALE1( * )
00024       COMPLEX            A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
00025      $                   VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
00026      $                   WORK( * )
00027 *     ..
00028 *
00029 *  Purpose
00030 *  =======
00031 *
00032 *     CGET23  checks the nonsymmetric eigenvalue problem driver CGEEVX.
00033 *     If COMP = .FALSE., the first 8 of the following tests will be
00034 *     performed on the input matrix A, and also test 9 if LWORK is
00035 *     sufficiently large.
00036 *     if COMP is .TRUE. all 11 tests will be performed.
00037 *
00038 *     (1)     | A * VR - VR * W | / ( n |A| ulp )
00039 *
00040 *       Here VR is the matrix of unit right eigenvectors.
00041 *       W is a diagonal matrix with diagonal entries W(j).
00042 *
00043 *     (2)     | A**H * VL - VL * W**H | / ( n |A| ulp )
00044 *
00045 *       Here VL is the matrix of unit left eigenvectors, A**H is the
00046 *       conjugate transpose of A, and W is as above.
00047 *
00048 *     (3)     | |VR(i)| - 1 | / ulp and largest component real
00049 *
00050 *       VR(i) denotes the i-th column of VR.
00051 *
00052 *     (4)     | |VL(i)| - 1 | / ulp and largest component real
00053 *
00054 *       VL(i) denotes the i-th column of VL.
00055 *
00056 *     (5)     0 if W(full) = W(partial), 1/ulp otherwise
00057 *
00058 *       W(full) denotes the eigenvalues computed when VR, VL, RCONDV
00059 *       and RCONDE are also computed, and W(partial) denotes the
00060 *       eigenvalues computed when only some of VR, VL, RCONDV, and
00061 *       RCONDE are computed.
00062 *
00063 *     (6)     0 if VR(full) = VR(partial), 1/ulp otherwise
00064 *
00065 *       VR(full) denotes the right eigenvectors computed when VL, RCONDV
00066 *       and RCONDE are computed, and VR(partial) denotes the result
00067 *       when only some of VL and RCONDV are computed.
00068 *
00069 *     (7)     0 if VL(full) = VL(partial), 1/ulp otherwise
00070 *
00071 *       VL(full) denotes the left eigenvectors computed when VR, RCONDV
00072 *       and RCONDE are computed, and VL(partial) denotes the result
00073 *       when only some of VR and RCONDV are computed.
00074 *
00075 *     (8)     0 if SCALE, ILO, IHI, ABNRM (full) =
00076 *                  SCALE, ILO, IHI, ABNRM (partial)
00077 *             1/ulp otherwise
00078 *
00079 *       SCALE, ILO, IHI and ABNRM describe how the matrix is balanced.
00080 *       (full) is when VR, VL, RCONDE and RCONDV are also computed, and
00081 *       (partial) is when some are not computed.
00082 *
00083 *     (9)     0 if RCONDV(full) = RCONDV(partial), 1/ulp otherwise
00084 *
00085 *       RCONDV(full) denotes the reciprocal condition numbers of the
00086 *       right eigenvectors computed when VR, VL and RCONDE are also
00087 *       computed. RCONDV(partial) denotes the reciprocal condition
00088 *       numbers when only some of VR, VL and RCONDE are computed.
00089 *
00090 *    (10)     |RCONDV - RCDVIN| / cond(RCONDV)
00091 *
00092 *       RCONDV is the reciprocal right eigenvector condition number
00093 *       computed by CGEEVX and RCDVIN (the precomputed true value)
00094 *       is supplied as input. cond(RCONDV) is the condition number of
00095 *       RCONDV, and takes errors in computing RCONDV into account, so
00096 *       that the resulting quantity should be O(ULP). cond(RCONDV) is
00097 *       essentially given by norm(A)/RCONDE.
00098 *
00099 *    (11)     |RCONDE - RCDEIN| / cond(RCONDE)
00100 *
00101 *       RCONDE is the reciprocal eigenvalue condition number
00102 *       computed by CGEEVX and RCDEIN (the precomputed true value)
00103 *       is supplied as input.  cond(RCONDE) is the condition number
00104 *       of RCONDE, and takes errors in computing RCONDE into account,
00105 *       so that the resulting quantity should be O(ULP). cond(RCONDE)
00106 *       is essentially given by norm(A)/RCONDV.
00107 *
00108 *  Arguments
00109 *  =========
00110 *
00111 *  COMP    (input) LOGICAL
00112 *          COMP describes which input tests to perform:
00113 *            = .FALSE. if the computed condition numbers are not to
00114 *                      be tested against RCDVIN and RCDEIN
00115 *            = .TRUE.  if they are to be compared
00116 *
00117 *  ISRT    (input) INTEGER
00118 *          If COMP = .TRUE., ISRT indicates in how the eigenvalues
00119 *          corresponding to values in RCDVIN and RCDEIN are ordered:
00120 *            = 0 means the eigenvalues are sorted by
00121 *                increasing real part
00122 *            = 1 means the eigenvalues are sorted by
00123 *                increasing imaginary part
00124 *          If COMP = .FALSE., ISRT is not referenced.
00125 *
00126 *  BALANC  (input) CHARACTER
00127 *          Describes the balancing option to be tested.
00128 *            = 'N' for no permuting or diagonal scaling
00129 *            = 'P' for permuting but no diagonal scaling
00130 *            = 'S' for no permuting but diagonal scaling
00131 *            = 'B' for permuting and diagonal scaling
00132 *
00133 *  JTYPE   (input) INTEGER
00134 *          Type of input matrix. Used to label output if error occurs.
00135 *
00136 *  THRESH  (input) REAL
00137 *          A test will count as "failed" if the "error", computed as
00138 *          described above, exceeds THRESH.  Note that the error
00139 *          is scaled to be O(1), so THRESH should be a reasonably
00140 *          small multiple of 1, e.g., 10 or 100.  In particular,
00141 *          it should not depend on the precision (single vs. double)
00142 *          or the size of the matrix.  It must be at least zero.
00143 *
00144 *  ISEED   (input) INTEGER array, dimension (4)
00145 *          If COMP = .FALSE., the random number generator seed
00146 *          used to produce matrix.
00147 *          If COMP = .TRUE., ISEED(1) = the number of the example.
00148 *          Used to label output if error occurs.
00149 *
00150 *  NOUNIT  (input) INTEGER
00151 *          The FORTRAN unit number for printing out error messages
00152 *          (e.g., if a routine returns INFO not equal to 0.)
00153 *
00154 *  N       (input) INTEGER
00155 *          The dimension of A. N must be at least 0.
00156 *
00157 *  A       (input/output) COMPLEX array, dimension (LDA,N)
00158 *          Used to hold the matrix whose eigenvalues are to be
00159 *          computed.
00160 *
00161 *  LDA     (input) INTEGER
00162 *          The leading dimension of A, and H. LDA must be at
00163 *          least 1 and at least N.
00164 *
00165 *  H       (workspace) COMPLEX array, dimension (LDA,N)
00166 *          Another copy of the test matrix A, modified by CGEEVX.
00167 *
00168 *  W       (workspace) COMPLEX array, dimension (N)
00169 *          Contains the eigenvalues of A.
00170 *
00171 *  W1      (workspace) COMPLEX array, dimension (N)
00172 *          Like W, this array contains the eigenvalues of A,
00173 *          but those computed when CGEEVX only computes a partial
00174 *          eigendecomposition, i.e. not the eigenvalues and left
00175 *          and right eigenvectors.
00176 *
00177 *  VL      (workspace) COMPLEX array, dimension (LDVL,N)
00178 *          VL holds the computed left eigenvectors.
00179 *
00180 *  LDVL    (input) INTEGER
00181 *          Leading dimension of VL. Must be at least max(1,N).
00182 *
00183 *  VR      (workspace) COMPLEX array, dimension (LDVR,N)
00184 *          VR holds the computed right eigenvectors.
00185 *
00186 *  LDVR    (input) INTEGER
00187 *          Leading dimension of VR. Must be at least max(1,N).
00188 *
00189 *  LRE     (workspace) COMPLEX array, dimension (LDLRE,N)
00190 *          LRE holds the computed right or left eigenvectors.
00191 *
00192 *  LDLRE   (input) INTEGER
00193 *          Leading dimension of LRE. Must be at least max(1,N).
00194 *
00195 *  RCONDV  (workspace) REAL array, dimension (N)
00196 *          RCONDV holds the computed reciprocal condition numbers
00197 *          for eigenvectors.
00198 *
00199 *  RCNDV1  (workspace) REAL array, dimension (N)
00200 *          RCNDV1 holds more computed reciprocal condition numbers
00201 *          for eigenvectors.
00202 *
00203 *  RCDVIN  (input) REAL array, dimension (N)
00204 *          When COMP = .TRUE. RCDVIN holds the precomputed reciprocal
00205 *          condition numbers for eigenvectors to be compared with
00206 *          RCONDV.
00207 *
00208 *  RCONDE  (workspace) REAL array, dimension (N)
00209 *          RCONDE holds the computed reciprocal condition numbers
00210 *          for eigenvalues.
00211 *
00212 *  RCNDE1  (workspace) REAL array, dimension (N)
00213 *          RCNDE1 holds more computed reciprocal condition numbers
00214 *          for eigenvalues.
00215 *
00216 *  RCDEIN  (input) REAL array, dimension (N)
00217 *          When COMP = .TRUE. RCDEIN holds the precomputed reciprocal
00218 *          condition numbers for eigenvalues to be compared with
00219 *          RCONDE.
00220 *
00221 *  SCALE   (workspace) REAL array, dimension (N)
00222 *          Holds information describing balancing of matrix.
00223 *
00224 *  SCALE1  (workspace) REAL array, dimension (N)
00225 *          Holds information describing balancing of matrix.
00226 *
00227 *  RESULT  (output) REAL array, dimension (11)
00228 *          The values computed by the 11 tests described above.
00229 *          The values are currently limited to 1/ulp, to avoid
00230 *          overflow.
00231 *
00232 *  WORK    (workspace) COMPLEX array, dimension (LWORK)
00233 *
00234 *  LWORK   (input) INTEGER
00235 *          The number of entries in WORK.  This must be at least
00236 *          2*N, and 2*N+N**2 if tests 9, 10 or 11 are to be performed.
00237 *
00238 *  RWORK   (workspace) REAL array, dimension (2*N)
00239 *
00240 *  INFO    (output) INTEGER
00241 *          If 0,  successful exit.
00242 *          If <0, input parameter -INFO had an incorrect value.
00243 *          If >0, CGEEVX returned an error code, the absolute
00244 *                 value of which is returned.
00245 *
00246 *  =====================================================================
00247 *
00248 *     .. Parameters ..
00249       REAL               ZERO, ONE, TWO
00250       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
00251       REAL               EPSIN
00252       PARAMETER          ( EPSIN = 5.9605E-8 )
00253 *     ..
00254 *     .. Local Scalars ..
00255       LOGICAL            BALOK, NOBAL
00256       CHARACTER          SENSE
00257       INTEGER            I, IHI, IHI1, IINFO, ILO, ILO1, ISENS, ISENSM,
00258      $                   J, JJ, KMIN
00259       REAL               ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN,
00260      $                   ULP, ULPINV, V, VMAX, VMX, VRICMP, VRIMIN,
00261      $                   VRMX, VTST
00262       COMPLEX            CTMP
00263 *     ..
00264 *     .. Local Arrays ..
00265       CHARACTER          SENS( 2 )
00266       REAL               RES( 2 )
00267       COMPLEX            CDUM( 1 )
00268 *     ..
00269 *     .. External Functions ..
00270       LOGICAL            LSAME
00271       REAL               SCNRM2, SLAMCH
00272       EXTERNAL           LSAME, SCNRM2, SLAMCH
00273 *     ..
00274 *     .. External Subroutines ..
00275       EXTERNAL           CGEEVX, CGET22, CLACPY, XERBLA
00276 *     ..
00277 *     .. Intrinsic Functions ..
00278       INTRINSIC          ABS, AIMAG, MAX, MIN, REAL
00279 *     ..
00280 *     .. Data statements ..
00281       DATA               SENS / 'N', 'V' /
00282 *     ..
00283 *     .. Executable Statements ..
00284 *
00285 *     Check for errors
00286 *
00287       NOBAL = LSAME( BALANC, 'N' )
00288       BALOK = NOBAL .OR. LSAME( BALANC, 'P' ) .OR.
00289      $        LSAME( BALANC, 'S' ) .OR. LSAME( BALANC, 'B' )
00290       INFO = 0
00291       IF( ISRT.NE.0 .AND. ISRT.NE.1 ) THEN
00292          INFO = -2
00293       ELSE IF( .NOT.BALOK ) THEN
00294          INFO = -3
00295       ELSE IF( THRESH.LT.ZERO ) THEN
00296          INFO = -5
00297       ELSE IF( NOUNIT.LE.0 ) THEN
00298          INFO = -7
00299       ELSE IF( N.LT.0 ) THEN
00300          INFO = -8
00301       ELSE IF( LDA.LT.1 .OR. LDA.LT.N ) THEN
00302          INFO = -10
00303       ELSE IF( LDVL.LT.1 .OR. LDVL.LT.N ) THEN
00304          INFO = -15
00305       ELSE IF( LDVR.LT.1 .OR. LDVR.LT.N ) THEN
00306          INFO = -17
00307       ELSE IF( LDLRE.LT.1 .OR. LDLRE.LT.N ) THEN
00308          INFO = -19
00309       ELSE IF( LWORK.LT.2*N .OR. ( COMP .AND. LWORK.LT.2*N+N*N ) ) THEN
00310          INFO = -30
00311       END IF
00312 *
00313       IF( INFO.NE.0 ) THEN
00314          CALL XERBLA( 'CGET23', -INFO )
00315          RETURN
00316       END IF
00317 *
00318 *     Quick return if nothing to do
00319 *
00320       DO 10 I = 1, 11
00321          RESULT( I ) = -ONE
00322    10 CONTINUE
00323 *
00324       IF( N.EQ.0 )
00325      $   RETURN
00326 *
00327 *     More Important constants
00328 *
00329       ULP = SLAMCH( 'Precision' )
00330       SMLNUM = SLAMCH( 'S' )
00331       ULPINV = ONE / ULP
00332 *
00333 *     Compute eigenvalues and eigenvectors, and test them
00334 *
00335       IF( LWORK.GE.2*N+N*N ) THEN
00336          SENSE = 'B'
00337          ISENSM = 2
00338       ELSE
00339          SENSE = 'E'
00340          ISENSM = 1
00341       END IF
00342       CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
00343       CALL CGEEVX( BALANC, 'V', 'V', SENSE, N, H, LDA, W, VL, LDVL, VR,
00344      $             LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK,
00345      $             LWORK, RWORK, IINFO )
00346       IF( IINFO.NE.0 ) THEN
00347          RESULT( 1 ) = ULPINV
00348          IF( JTYPE.NE.22 ) THEN
00349             WRITE( NOUNIT, FMT = 9998 )'CGEEVX1', IINFO, N, JTYPE,
00350      $         BALANC, ISEED
00351          ELSE
00352             WRITE( NOUNIT, FMT = 9999 )'CGEEVX1', IINFO, N, ISEED( 1 )
00353          END IF
00354          INFO = ABS( IINFO )
00355          RETURN
00356       END IF
00357 *
00358 *     Do Test (1)
00359 *
00360       CALL CGET22( 'N', 'N', 'N', N, A, LDA, VR, LDVR, W, WORK, RWORK,
00361      $             RES )
00362       RESULT( 1 ) = RES( 1 )
00363 *
00364 *     Do Test (2)
00365 *
00366       CALL CGET22( 'C', 'N', 'C', N, A, LDA, VL, LDVL, W, WORK, RWORK,
00367      $             RES )
00368       RESULT( 2 ) = RES( 1 )
00369 *
00370 *     Do Test (3)
00371 *
00372       DO 30 J = 1, N
00373          TNRM = SCNRM2( N, VR( 1, J ), 1 )
00374          RESULT( 3 ) = MAX( RESULT( 3 ),
00375      $                 MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
00376          VMX = ZERO
00377          VRMX = ZERO
00378          DO 20 JJ = 1, N
00379             VTST = ABS( VR( JJ, J ) )
00380             IF( VTST.GT.VMX )
00381      $         VMX = VTST
00382             IF( AIMAG( VR( JJ, J ) ).EQ.ZERO .AND.
00383      $          ABS( REAL( VR( JJ, J ) ) ).GT.VRMX )
00384      $          VRMX = ABS( REAL( VR( JJ, J ) ) )
00385    20    CONTINUE
00386          IF( VRMX / VMX.LT.ONE-TWO*ULP )
00387      $      RESULT( 3 ) = ULPINV
00388    30 CONTINUE
00389 *
00390 *     Do Test (4)
00391 *
00392       DO 50 J = 1, N
00393          TNRM = SCNRM2( N, VL( 1, J ), 1 )
00394          RESULT( 4 ) = MAX( RESULT( 4 ),
00395      $                 MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
00396          VMX = ZERO
00397          VRMX = ZERO
00398          DO 40 JJ = 1, N
00399             VTST = ABS( VL( JJ, J ) )
00400             IF( VTST.GT.VMX )
00401      $         VMX = VTST
00402             IF( AIMAG( VL( JJ, J ) ).EQ.ZERO .AND.
00403      $          ABS( REAL( VL( JJ, J ) ) ).GT.VRMX )
00404      $          VRMX = ABS( REAL( VL( JJ, J ) ) )
00405    40    CONTINUE
00406          IF( VRMX / VMX.LT.ONE-TWO*ULP )
00407      $      RESULT( 4 ) = ULPINV
00408    50 CONTINUE
00409 *
00410 *     Test for all options of computing condition numbers
00411 *
00412       DO 200 ISENS = 1, ISENSM
00413 *
00414          SENSE = SENS( ISENS )
00415 *
00416 *        Compute eigenvalues only, and test them
00417 *
00418          CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
00419          CALL CGEEVX( BALANC, 'N', 'N', SENSE, N, H, LDA, W1, CDUM, 1,
00420      $                CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1,
00421      $                RCNDV1, WORK, LWORK, RWORK, IINFO )
00422          IF( IINFO.NE.0 ) THEN
00423             RESULT( 1 ) = ULPINV
00424             IF( JTYPE.NE.22 ) THEN
00425                WRITE( NOUNIT, FMT = 9998 )'CGEEVX2', IINFO, N, JTYPE,
00426      $            BALANC, ISEED
00427             ELSE
00428                WRITE( NOUNIT, FMT = 9999 )'CGEEVX2', IINFO, N,
00429      $            ISEED( 1 )
00430             END IF
00431             INFO = ABS( IINFO )
00432             GO TO 190
00433          END IF
00434 *
00435 *        Do Test (5)
00436 *
00437          DO 60 J = 1, N
00438             IF( W( J ).NE.W1( J ) )
00439      $         RESULT( 5 ) = ULPINV
00440    60    CONTINUE
00441 *
00442 *        Do Test (8)
00443 *
00444          IF( .NOT.NOBAL ) THEN
00445             DO 70 J = 1, N
00446                IF( SCALE( J ).NE.SCALE1( J ) )
00447      $            RESULT( 8 ) = ULPINV
00448    70       CONTINUE
00449             IF( ILO.NE.ILO1 )
00450      $         RESULT( 8 ) = ULPINV
00451             IF( IHI.NE.IHI1 )
00452      $         RESULT( 8 ) = ULPINV
00453             IF( ABNRM.NE.ABNRM1 )
00454      $         RESULT( 8 ) = ULPINV
00455          END IF
00456 *
00457 *        Do Test (9)
00458 *
00459          IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
00460             DO 80 J = 1, N
00461                IF( RCONDV( J ).NE.RCNDV1( J ) )
00462      $            RESULT( 9 ) = ULPINV
00463    80       CONTINUE
00464          END IF
00465 *
00466 *        Compute eigenvalues and right eigenvectors, and test them
00467 *
00468          CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
00469          CALL CGEEVX( BALANC, 'N', 'V', SENSE, N, H, LDA, W1, CDUM, 1,
00470      $                LRE, LDLRE, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1,
00471      $                RCNDV1, WORK, LWORK, RWORK, IINFO )
00472          IF( IINFO.NE.0 ) THEN
00473             RESULT( 1 ) = ULPINV
00474             IF( JTYPE.NE.22 ) THEN
00475                WRITE( NOUNIT, FMT = 9998 )'CGEEVX3', IINFO, N, JTYPE,
00476      $            BALANC, ISEED
00477             ELSE
00478                WRITE( NOUNIT, FMT = 9999 )'CGEEVX3', IINFO, N,
00479      $            ISEED( 1 )
00480             END IF
00481             INFO = ABS( IINFO )
00482             GO TO 190
00483          END IF
00484 *
00485 *        Do Test (5) again
00486 *
00487          DO 90 J = 1, N
00488             IF( W( J ).NE.W1( J ) )
00489      $         RESULT( 5 ) = ULPINV
00490    90    CONTINUE
00491 *
00492 *        Do Test (6)
00493 *
00494          DO 110 J = 1, N
00495             DO 100 JJ = 1, N
00496                IF( VR( J, JJ ).NE.LRE( J, JJ ) )
00497      $            RESULT( 6 ) = ULPINV
00498   100       CONTINUE
00499   110    CONTINUE
00500 *
00501 *        Do Test (8) again
00502 *
00503          IF( .NOT.NOBAL ) THEN
00504             DO 120 J = 1, N
00505                IF( SCALE( J ).NE.SCALE1( J ) )
00506      $            RESULT( 8 ) = ULPINV
00507   120       CONTINUE
00508             IF( ILO.NE.ILO1 )
00509      $         RESULT( 8 ) = ULPINV
00510             IF( IHI.NE.IHI1 )
00511      $         RESULT( 8 ) = ULPINV
00512             IF( ABNRM.NE.ABNRM1 )
00513      $         RESULT( 8 ) = ULPINV
00514          END IF
00515 *
00516 *        Do Test (9) again
00517 *
00518          IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
00519             DO 130 J = 1, N
00520                IF( RCONDV( J ).NE.RCNDV1( J ) )
00521      $            RESULT( 9 ) = ULPINV
00522   130       CONTINUE
00523          END IF
00524 *
00525 *        Compute eigenvalues and left eigenvectors, and test them
00526 *
00527          CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
00528          CALL CGEEVX( BALANC, 'V', 'N', SENSE, N, H, LDA, W1, LRE,
00529      $                LDLRE, CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1,
00530      $                RCNDE1, RCNDV1, WORK, LWORK, RWORK, IINFO )
00531          IF( IINFO.NE.0 ) THEN
00532             RESULT( 1 ) = ULPINV
00533             IF( JTYPE.NE.22 ) THEN
00534                WRITE( NOUNIT, FMT = 9998 )'CGEEVX4', IINFO, N, JTYPE,
00535      $            BALANC, ISEED
00536             ELSE
00537                WRITE( NOUNIT, FMT = 9999 )'CGEEVX4', IINFO, N,
00538      $            ISEED( 1 )
00539             END IF
00540             INFO = ABS( IINFO )
00541             GO TO 190
00542          END IF
00543 *
00544 *        Do Test (5) again
00545 *
00546          DO 140 J = 1, N
00547             IF( W( J ).NE.W1( J ) )
00548      $         RESULT( 5 ) = ULPINV
00549   140    CONTINUE
00550 *
00551 *        Do Test (7)
00552 *
00553          DO 160 J = 1, N
00554             DO 150 JJ = 1, N
00555                IF( VL( J, JJ ).NE.LRE( J, JJ ) )
00556      $            RESULT( 7 ) = ULPINV
00557   150       CONTINUE
00558   160    CONTINUE
00559 *
00560 *        Do Test (8) again
00561 *
00562          IF( .NOT.NOBAL ) THEN
00563             DO 170 J = 1, N
00564                IF( SCALE( J ).NE.SCALE1( J ) )
00565      $            RESULT( 8 ) = ULPINV
00566   170       CONTINUE
00567             IF( ILO.NE.ILO1 )
00568      $         RESULT( 8 ) = ULPINV
00569             IF( IHI.NE.IHI1 )
00570      $         RESULT( 8 ) = ULPINV
00571             IF( ABNRM.NE.ABNRM1 )
00572      $         RESULT( 8 ) = ULPINV
00573          END IF
00574 *
00575 *        Do Test (9) again
00576 *
00577          IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
00578             DO 180 J = 1, N
00579                IF( RCONDV( J ).NE.RCNDV1( J ) )
00580      $            RESULT( 9 ) = ULPINV
00581   180       CONTINUE
00582          END IF
00583 *
00584   190    CONTINUE
00585 *
00586   200 CONTINUE
00587 *
00588 *     If COMP, compare condition numbers to precomputed ones
00589 *
00590       IF( COMP ) THEN
00591          CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
00592          CALL CGEEVX( 'N', 'V', 'V', 'B', N, H, LDA, W, VL, LDVL, VR,
00593      $                LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV,
00594      $                WORK, LWORK, RWORK, IINFO )
00595          IF( IINFO.NE.0 ) THEN
00596             RESULT( 1 ) = ULPINV
00597             WRITE( NOUNIT, FMT = 9999 )'CGEEVX5', IINFO, N, ISEED( 1 )
00598             INFO = ABS( IINFO )
00599             GO TO 250
00600          END IF
00601 *
00602 *        Sort eigenvalues and condition numbers lexicographically
00603 *        to compare with inputs
00604 *
00605          DO 220 I = 1, N - 1
00606             KMIN = I
00607             IF( ISRT.EQ.0 ) THEN
00608                VRIMIN = REAL( W( I ) )
00609             ELSE
00610                VRIMIN = AIMAG( W( I ) )
00611             END IF
00612             DO 210 J = I + 1, N
00613                IF( ISRT.EQ.0 ) THEN
00614                   VRICMP = REAL( W( J ) )
00615                ELSE
00616                   VRICMP = AIMAG( W( J ) )
00617                END IF
00618                IF( VRICMP.LT.VRIMIN ) THEN
00619                   KMIN = J
00620                   VRIMIN = VRICMP
00621                END IF
00622   210       CONTINUE
00623             CTMP = W( KMIN )
00624             W( KMIN ) = W( I )
00625             W( I ) = CTMP
00626             VRIMIN = RCONDE( KMIN )
00627             RCONDE( KMIN ) = RCONDE( I )
00628             RCONDE( I ) = VRIMIN
00629             VRIMIN = RCONDV( KMIN )
00630             RCONDV( KMIN ) = RCONDV( I )
00631             RCONDV( I ) = VRIMIN
00632   220    CONTINUE
00633 *
00634 *        Compare condition numbers for eigenvectors
00635 *        taking their condition numbers into account
00636 *
00637          RESULT( 10 ) = ZERO
00638          EPS = MAX( EPSIN, ULP )
00639          V = MAX( REAL( N )*EPS*ABNRM, SMLNUM )
00640          IF( ABNRM.EQ.ZERO )
00641      $      V = ONE
00642          DO 230 I = 1, N
00643             IF( V.GT.RCONDV( I )*RCONDE( I ) ) THEN
00644                TOL = RCONDV( I )
00645             ELSE
00646                TOL = V / RCONDE( I )
00647             END IF
00648             IF( V.GT.RCDVIN( I )*RCDEIN( I ) ) THEN
00649                TOLIN = RCDVIN( I )
00650             ELSE
00651                TOLIN = V / RCDEIN( I )
00652             END IF
00653             TOL = MAX( TOL, SMLNUM / EPS )
00654             TOLIN = MAX( TOLIN, SMLNUM / EPS )
00655             IF( EPS*( RCDVIN( I )-TOLIN ).GT.RCONDV( I )+TOL ) THEN
00656                VMAX = ONE / EPS
00657             ELSE IF( RCDVIN( I )-TOLIN.GT.RCONDV( I )+TOL ) THEN
00658                VMAX = ( RCDVIN( I )-TOLIN ) / ( RCONDV( I )+TOL )
00659             ELSE IF( RCDVIN( I )+TOLIN.LT.EPS*( RCONDV( I )-TOL ) ) THEN
00660                VMAX = ONE / EPS
00661             ELSE IF( RCDVIN( I )+TOLIN.LT.RCONDV( I )-TOL ) THEN
00662                VMAX = ( RCONDV( I )-TOL ) / ( RCDVIN( I )+TOLIN )
00663             ELSE
00664                VMAX = ONE
00665             END IF
00666             RESULT( 10 ) = MAX( RESULT( 10 ), VMAX )
00667   230    CONTINUE
00668 *
00669 *        Compare condition numbers for eigenvalues
00670 *        taking their condition numbers into account
00671 *
00672          RESULT( 11 ) = ZERO
00673          DO 240 I = 1, N
00674             IF( V.GT.RCONDV( I ) ) THEN
00675                TOL = ONE
00676             ELSE
00677                TOL = V / RCONDV( I )
00678             END IF
00679             IF( V.GT.RCDVIN( I ) ) THEN
00680                TOLIN = ONE
00681             ELSE
00682                TOLIN = V / RCDVIN( I )
00683             END IF
00684             TOL = MAX( TOL, SMLNUM / EPS )
00685             TOLIN = MAX( TOLIN, SMLNUM / EPS )
00686             IF( EPS*( RCDEIN( I )-TOLIN ).GT.RCONDE( I )+TOL ) THEN
00687                VMAX = ONE / EPS
00688             ELSE IF( RCDEIN( I )-TOLIN.GT.RCONDE( I )+TOL ) THEN
00689                VMAX = ( RCDEIN( I )-TOLIN ) / ( RCONDE( I )+TOL )
00690             ELSE IF( RCDEIN( I )+TOLIN.LT.EPS*( RCONDE( I )-TOL ) ) THEN
00691                VMAX = ONE / EPS
00692             ELSE IF( RCDEIN( I )+TOLIN.LT.RCONDE( I )-TOL ) THEN
00693                VMAX = ( RCONDE( I )-TOL ) / ( RCDEIN( I )+TOLIN )
00694             ELSE
00695                VMAX = ONE
00696             END IF
00697             RESULT( 11 ) = MAX( RESULT( 11 ), VMAX )
00698   240    CONTINUE
00699   250    CONTINUE
00700 *
00701       END IF
00702 *
00703  9999 FORMAT( ' CGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
00704      $      I6, ', INPUT EXAMPLE NUMBER = ', I4 )
00705  9998 FORMAT( ' CGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
00706      $      I6, ', JTYPE=', I6, ', BALANC = ', A, ', ISEED=(',
00707      $      3( I5, ',' ), I5, ')' )
00708 *
00709       RETURN
00710 *
00711 *     End of CGET23
00712 *
00713       END
 All Files Functions