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