TESTING/EIG/cdrvev.f

   1 *> \brief \b CDRVEV
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
  12 *                          NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR, LDVR,
  13 *                          LRE, LDLRE, RESULT, WORK, NWORK, RWORK, IWORK,
  14 *                          INFO )
  15 *
  16 *       .. Scalar Arguments ..
  17 *       INTEGER            INFO, LDA, LDLRE, LDVL, LDVR, NOUNIT, NSIZES,
  18 *      $                   NTYPES, NWORK
  19 *       REAL               THRESH
  20 *       ..
  21 *       .. Array Arguments ..
  22 *       LOGICAL            DOTYPE( * )
  23 *       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
  24 *       REAL               RESULT( 7 ), RWORK( * )
  25 *       COMPLEX            A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
  26 *      $                   VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
  27 *      $                   WORK( * )
  28 *       ..
  29 *
  30 *
  31 *> \par Purpose:
  32 *  =============
  33 *>
  34 *> \verbatim
  35 *>
  36 *>    CDRVEV  checks the nonsymmetric eigenvalue problem driver CGEEV.
  37 *>
  38 *>    When CDRVEV is called, a number of matrix "sizes" ("n's") and a
  39 *>    number of matrix "types" are specified.  For each size ("n")
  40 *>    and each type of matrix, one matrix will be generated and used
  41 *>    to test the nonsymmetric eigenroutines.  For each matrix, 7
  42 *>    tests will be performed:
  43 *>
  44 *>    (1)     | A * VR - VR * W | / ( n |A| ulp )
  45 *>
  46 *>      Here VR is the matrix of unit right eigenvectors.
  47 *>      W is a diagonal matrix with diagonal entries W(j).
  48 *>
  49 *>    (2)     | A**H * VL - VL * W**H | / ( n |A| ulp )
  50 *>
  51 *>      Here VL is the matrix of unit left eigenvectors, A**H is the
  52 *>      conjugate-transpose of A, and W is as above.
  53 *>
  54 *>    (3)     | |VR(i)| - 1 | / ulp and whether largest component real
  55 *>
  56 *>      VR(i) denotes the i-th column of VR.
  57 *>
  58 *>    (4)     | |VL(i)| - 1 | / ulp and whether largest component real
  59 *>
  60 *>      VL(i) denotes the i-th column of VL.
  61 *>
  62 *>    (5)     W(full) = W(partial)
  63 *>
  64 *>      W(full) denotes the eigenvalues computed when both VR and VL
  65 *>      are also computed, and W(partial) denotes the eigenvalues
  66 *>      computed when only W, only W and VR, or only W and VL are
  67 *>      computed.
  68 *>
  69 *>    (6)     VR(full) = VR(partial)
  70 *>
  71 *>      VR(full) denotes the right eigenvectors computed when both VR
  72 *>      and VL are computed, and VR(partial) denotes the result
  73 *>      when only VR is computed.
  74 *>
  75 *>     (7)     VL(full) = VL(partial)
  76 *>
  77 *>      VL(full) denotes the left eigenvectors computed when both VR
  78 *>      and VL are also computed, and VL(partial) denotes the result
  79 *>      when only VL is computed.
  80 *>
  81 *>    The "sizes" are specified by an array NN(1:NSIZES); the value of
  82 *>    each element NN(j) specifies one size.
  83 *>    The "types" are specified by a logical array DOTYPE( 1:NTYPES );
  84 *>    if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
  85 *>    Currently, the list of possible types is:
  86 *>
  87 *>    (1)  The zero matrix.
  88 *>    (2)  The identity matrix.
  89 *>    (3)  A (transposed) Jordan block, with 1's on the diagonal.
  90 *>
  91 *>    (4)  A diagonal matrix with evenly spaced entries
  92 *>         1, ..., ULP  and random complex angles.
  93 *>         (ULP = (first number larger than 1) - 1 )
  94 *>    (5)  A diagonal matrix with geometrically spaced entries
  95 *>         1, ..., ULP  and random complex angles.
  96 *>    (6)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
  97 *>         and random complex angles.
  98 *>
  99 *>    (7)  Same as (4), but multiplied by a constant near
 100 *>         the overflow threshold
 101 *>    (8)  Same as (4), but multiplied by a constant near
 102 *>         the underflow threshold
 103 *>
 104 *>    (9)  A matrix of the form  U' T U, where U is unitary and
 105 *>         T has evenly spaced entries 1, ..., ULP with random complex
 106 *>         angles on the diagonal and random O(1) entries in the upper
 107 *>         triangle.
 108 *>
 109 *>    (10) A matrix of the form  U' T U, where U is unitary and
 110 *>         T has geometrically spaced entries 1, ..., ULP with random
 111 *>         complex angles on the diagonal and random O(1) entries in
 112 *>         the upper triangle.
 113 *>
 114 *>    (11) A matrix of the form  U' T U, where U is unitary and
 115 *>         T has "clustered" entries 1, ULP,..., ULP with random
 116 *>         complex angles on the diagonal and random O(1) entries in
 117 *>         the upper triangle.
 118 *>
 119 *>    (12) A matrix of the form  U' T U, where U is unitary and
 120 *>         T has complex eigenvalues randomly chosen from
 121 *>         ULP < |z| < 1   and random O(1) entries in the upper
 122 *>         triangle.
 123 *>
 124 *>    (13) A matrix of the form  X' T X, where X has condition
 125 *>         SQRT( ULP ) and T has evenly spaced entries 1, ..., ULP
 126 *>         with random complex angles on the diagonal and random O(1)
 127 *>         entries in the upper triangle.
 128 *>
 129 *>    (14) A matrix of the form  X' T X, where X has condition
 130 *>         SQRT( ULP ) and T has geometrically spaced entries
 131 *>         1, ..., ULP with random complex angles on the diagonal
 132 *>         and random O(1) entries in the upper triangle.
 133 *>
 134 *>    (15) A matrix of the form  X' T X, where X has condition
 135 *>         SQRT( ULP ) and T has "clustered" entries 1, ULP,..., ULP
 136 *>         with random complex angles on the diagonal and random O(1)
 137 *>         entries in the upper triangle.
 138 *>
 139 *>    (16) A matrix of the form  X' T X, where X has condition
 140 *>         SQRT( ULP ) and T has complex eigenvalues randomly chosen
 141 *>         from ULP < |z| < 1 and random O(1) entries in the upper
 142 *>         triangle.
 143 *>
 144 *>    (17) Same as (16), but multiplied by a constant
 145 *>         near the overflow threshold
 146 *>    (18) Same as (16), but multiplied by a constant
 147 *>         near the underflow threshold
 148 *>
 149 *>    (19) Nonsymmetric matrix with random entries chosen from |z| < 1
 150 *>         If N is at least 4, all entries in first two rows and last
 151 *>         row, and first column and last two columns are zero.
 152 *>    (20) Same as (19), but multiplied by a constant
 153 *>         near the overflow threshold
 154 *>    (21) Same as (19), but multiplied by a constant
 155 *>         near the underflow threshold
 156 *> \endverbatim
 157 *
 158 *  Arguments:
 159 *  ==========
 160 *
 161 *> \param[in] NSIZES
 162 *> \verbatim
 163 *>          NSIZES is INTEGER
 164 *>          The number of sizes of matrices to use.  If it is zero,
 165 *>          CDRVEV does nothing.  It must be at least zero.
 166 *> \endverbatim
 167 *>
 168 *> \param[in] NN
 169 *> \verbatim
 170 *>          NN is INTEGER array, dimension (NSIZES)
 171 *>          An array containing the sizes to be used for the matrices.
 172 *>          Zero values will be skipped.  The values must be at least
 173 *>          zero.
 174 *> \endverbatim
 175 *>
 176 *> \param[in] NTYPES
 177 *> \verbatim
 178 *>          NTYPES is INTEGER
 179 *>          The number of elements in DOTYPE.   If it is zero, CDRVEV
 180 *>          does nothing.  It must be at least zero.  If it is MAXTYP+1
 181 *>          and NSIZES is 1, then an additional type, MAXTYP+1 is
 182 *>          defined, which is to use whatever matrix is in A.  This
 183 *>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
 184 *>          DOTYPE(MAXTYP+1) is .TRUE. .
 185 *> \endverbatim
 186 *>
 187 *> \param[in] DOTYPE
 188 *> \verbatim
 189 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
 190 *>          If DOTYPE(j) is .TRUE., then for each size in NN a
 191 *>          matrix of that size and of type j will be generated.
 192 *>          If NTYPES is smaller than the maximum number of types
 193 *>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
 194 *>          MAXTYP will not be generated.  If NTYPES is larger
 195 *>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
 196 *>          will be ignored.
 197 *> \endverbatim
 198 *>
 199 *> \param[in,out] ISEED
 200 *> \verbatim
 201 *>          ISEED is INTEGER array, dimension (4)
 202 *>          On entry ISEED specifies the seed of the random number
 203 *>          generator. The array elements should be between 0 and 4095;
 204 *>          if not they will be reduced mod 4096.  Also, ISEED(4) must
 205 *>          be odd.  The random number generator uses a linear
 206 *>          congruential sequence limited to small integers, and so
 207 *>          should produce machine independent random numbers. The
 208 *>          values of ISEED are changed on exit, and can be used in the
 209 *>          next call to CDRVEV to continue the same random number
 210 *>          sequence.
 211 *> \endverbatim
 212 *>
 213 *> \param[in] THRESH
 214 *> \verbatim
 215 *>          THRESH is REAL
 216 *>          A test will count as "failed" if the "error", computed as
 217 *>          described above, exceeds THRESH.  Note that the error
 218 *>          is scaled to be O(1), so THRESH should be a reasonably
 219 *>          small multiple of 1, e.g., 10 or 100.  In particular,
 220 *>          it should not depend on the precision (single vs. double)
 221 *>          or the size of the matrix.  It must be at least zero.
 222 *> \endverbatim
 223 *>
 224 *> \param[in] NOUNIT
 225 *> \verbatim
 226 *>          NOUNIT is INTEGER
 227 *>          The FORTRAN unit number for printing out error messages
 228 *>          (e.g., if a routine returns INFO not equal to 0.)
 229 *> \endverbatim
 230 *>
 231 *> \param[out] A
 232 *> \verbatim
 233 *>          A is COMPLEX array, dimension (LDA, max(NN))
 234 *>          Used to hold the matrix whose eigenvalues are to be
 235 *>          computed.  On exit, A contains the last matrix actually used.
 236 *> \endverbatim
 237 *>
 238 *> \param[in] LDA
 239 *> \verbatim
 240 *>          LDA is INTEGER
 241 *>          The leading dimension of A, and H. LDA must be at
 242 *>          least 1 and at least max(NN).
 243 *> \endverbatim
 244 *>
 245 *> \param[out] H
 246 *> \verbatim
 247 *>          H is COMPLEX array, dimension (LDA, max(NN))
 248 *>          Another copy of the test matrix A, modified by CGEEV.
 249 *> \endverbatim
 250 *>
 251 *> \param[out] W
 252 *> \verbatim
 253 *>          W is COMPLEX array, dimension (max(NN))
 254 *>          The eigenvalues of A. On exit, W are the eigenvalues of
 255 *>          the matrix in A.
 256 *> \endverbatim
 257 *>
 258 *> \param[out] W1
 259 *> \verbatim
 260 *>          W1 is COMPLEX array, dimension (max(NN))
 261 *>          Like W, this array contains the eigenvalues of A,
 262 *>          but those computed when CGEEV only computes a partial
 263 *>          eigendecomposition, i.e. not the eigenvalues and left
 264 *>          and right eigenvectors.
 265 *> \endverbatim
 266 *>
 267 *> \param[out] VL
 268 *> \verbatim
 269 *>          VL is COMPLEX array, dimension (LDVL, max(NN))
 270 *>          VL holds the computed left eigenvectors.
 271 *> \endverbatim
 272 *>
 273 *> \param[in] LDVL
 274 *> \verbatim
 275 *>          LDVL is INTEGER
 276 *>          Leading dimension of VL. Must be at least max(1,max(NN)).
 277 *> \endverbatim
 278 *>
 279 *> \param[out] VR
 280 *> \verbatim
 281 *>          VR is COMPLEX array, dimension (LDVR, max(NN))
 282 *>          VR holds the computed right eigenvectors.
 283 *> \endverbatim
 284 *>
 285 *> \param[in] LDVR
 286 *> \verbatim
 287 *>          LDVR is INTEGER
 288 *>          Leading dimension of VR. Must be at least max(1,max(NN)).
 289 *> \endverbatim
 290 *>
 291 *> \param[out] LRE
 292 *> \verbatim
 293 *>          LRE is COMPLEX array, dimension (LDLRE, max(NN))
 294 *>          LRE holds the computed right or left eigenvectors.
 295 *> \endverbatim
 296 *>
 297 *> \param[in] LDLRE
 298 *> \verbatim
 299 *>          LDLRE is INTEGER
 300 *>          Leading dimension of LRE. Must be at least max(1,max(NN)).
 301 *> \endverbatim
 302 *>
 303 *> \param[out] RESULT
 304 *> \verbatim
 305 *>          RESULT is REAL array, dimension (7)
 306 *>          The values computed by the seven tests described above.
 307 *>          The values are currently limited to 1/ulp, to avoid
 308 *>          overflow.
 309 *> \endverbatim
 310 *>
 311 *> \param[out] WORK
 312 *> \verbatim
 313 *>          WORK is COMPLEX array, dimension (NWORK)
 314 *> \endverbatim
 315 *>
 316 *> \param[in] NWORK
 317 *> \verbatim
 318 *>          NWORK is INTEGER
 319 *>          The number of entries in WORK.  This must be at least
 320 *>          5*NN(j)+2*NN(j)**2 for all j.
 321 *> \endverbatim
 322 *>
 323 *> \param[out] RWORK
 324 *> \verbatim
 325 *>          RWORK is REAL array, dimension (2*max(NN))
 326 *> \endverbatim
 327 *>
 328 *> \param[out] IWORK
 329 *> \verbatim
 330 *>          IWORK is INTEGER array, dimension (max(NN))
 331 *> \endverbatim
 332 *>
 333 *> \param[out] INFO
 334 *> \verbatim
 335 *>          INFO is INTEGER
 336 *>          If 0, then everything ran OK.
 337 *>           -1: NSIZES < 0
 338 *>           -2: Some NN(j) < 0
 339 *>           -3: NTYPES < 0
 340 *>           -6: THRESH < 0
 341 *>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
 342 *>          -14: LDVL < 1 or LDVL < NMAX, where NMAX is max( NN(j) ).
 343 *>          -16: LDVR < 1 or LDVR < NMAX, where NMAX is max( NN(j) ).
 344 *>          -18: LDLRE < 1 or LDLRE < NMAX, where NMAX is max( NN(j) ).
 345 *>          -21: NWORK too small.
 346 *>          If  CLATMR, CLATMS, CLATME or CGEEV returns an error code,
 347 *>              the absolute value of it is returned.
 348 *>
 349 *>-----------------------------------------------------------------------
 350 *>
 351 *>     Some Local Variables and Parameters:
 352 *>     ---- ----- --------- --- ----------
 353 *>
 354 *>     ZERO, ONE       Real 0 and 1.
 355 *>     MAXTYP          The number of types defined.
 356 *>     NMAX            Largest value in NN.
 357 *>     NERRS           The number of tests which have exceeded THRESH
 358 *>     COND, CONDS,
 359 *>     IMODE           Values to be passed to the matrix generators.
 360 *>     ANORM           Norm of A; passed to matrix generators.
 361 *>
 362 *>     OVFL, UNFL      Overflow and underflow thresholds.
 363 *>     ULP, ULPINV     Finest relative precision and its inverse.
 364 *>     RTULP, RTULPI   Square roots of the previous 4 values.
 365 *>
 366 *>             The following four arrays decode JTYPE:
 367 *>     KTYPE(j)        The general type (1-10) for type "j".
 368 *>     KMODE(j)        The MODE value to be passed to the matrix
 369 *>                     generator for type "j".
 370 *>     KMAGN(j)        The order of magnitude ( O(1),
 371 *>                     O(overflow^(1/2) ), O(underflow^(1/2) )
 372 *>     KCONDS(j)       Selectw whether CONDS is to be 1 or
 373 *>                     1/sqrt(ulp).  (0 means irrelevant.)
 374 *> \endverbatim
 375 *
 376 *  Authors:
 377 *  ========
 378 *
 379 *> \author Univ. of Tennessee
 380 *> \author Univ. of California Berkeley
 381 *> \author Univ. of Colorado Denver
 382 *> \author NAG Ltd.
 383 *
 384 *> \date November 2011
 385 *
 386 *> \ingroup complex_eig
 387 *
 388 *  =====================================================================
 389       SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
 390      $                   NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR, LDVR,
 391      $                   LRE, LDLRE, RESULT, WORK, NWORK, RWORK, IWORK,
 392      $                   INFO )
 393 *
 394 *  -- LAPACK test routine (version 3.4.0) --
 395 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 396 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 397 *     November 2011
 398 *
 399 *     .. Scalar Arguments ..
 400       INTEGER            INFO, LDA, LDLRE, LDVL, LDVR, NOUNIT, NSIZES,
 401      $                   NTYPES, NWORK
 402       REAL               THRESH
 403 *     ..
 404 *     .. Array Arguments ..
 405       LOGICAL            DOTYPE( * )
 406       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
 407       REAL               RESULT( 7 ), RWORK( * )
 408       COMPLEX            A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
 409      $                   VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
 410      $                   WORK( * )
 411 *     ..
 412 *
 413 *  =====================================================================
 414 *
 415 *     .. Parameters ..
 416       COMPLEX            CZERO
 417       PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ) )
 418       COMPLEX            CONE
 419       PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ) )
 420       REAL               ZERO, ONE
 421       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
 422       REAL               TWO
 423       PARAMETER          ( TWO = 2.0E+0 )
 424       INTEGER            MAXTYP
 425       PARAMETER          ( MAXTYP = 21 )
 426 *     ..
 427 *     .. Local Scalars ..
 428       LOGICAL            BADNN
 429       CHARACTER*3        PATH
 430       INTEGER            IINFO, IMODE, ITYPE, IWK, J, JCOL, JJ, JSIZE,
 431      $                   JTYPE, MTYPES, N, NERRS, NFAIL, NMAX,
 432      $                   NNWORK, NTEST, NTESTF, NTESTT
 433       REAL               ANORM, COND, CONDS, OVFL, RTULP, RTULPI, TNRM,
 434      $                   ULP, ULPINV, UNFL, VMX, VRMX, VTST
 435 *     ..
 436 *     .. Local Arrays ..
 437       INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ),
 438      $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
 439      $                   KTYPE( MAXTYP )
 440       REAL               RES( 2 )
 441       COMPLEX            DUM( 1 )
 442 *     ..
 443 *     .. External Functions ..
 444       REAL               SCNRM2, SLAMCH
 445       EXTERNAL           SCNRM2, SLAMCH
 446 *     ..
 447 *     .. External Subroutines ..
 448       EXTERNAL           CGEEV, CGET22, CLACPY, CLATME, CLATMR, CLATMS,
 449      $                   CLASET, SLABAD, SLASUM, XERBLA
 450 *     ..
 451 *     .. Intrinsic Functions ..
 452       INTRINSIC          ABS, AIMAG, CMPLX, MAX, MIN, REAL, SQRT
 453 *     ..
 454 *     .. Data statements ..
 455       DATA               KTYPE / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
 456       DATA               KMAGN / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
 457      $                   3, 1, 2, 3 /
 458       DATA               KMODE / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
 459      $                   1, 5, 5, 5, 4, 3, 1 /
 460       DATA               KCONDS / 3*0, 5*0, 4*1, 6*2, 3*0 /
 461 *     ..
 462 *     .. Executable Statements ..
 463 *
 464       PATH( 1: 1 ) = 'Complex precision'
 465       PATH( 2: 3 ) = 'EV'
 466 *
 467 *     Check for errors
 468 *
 469       NTESTT = 0
 470       NTESTF = 0
 471       INFO = 0
 472 *
 473 *     Important constants
 474 *
 475       BADNN = .FALSE.
 476       NMAX = 0
 477       DO 10 J = 1, NSIZES
 478          NMAX = MAX( NMAX, NN( J ) )
 479          IF( NN( J ).LT.0 )
 480      $      BADNN = .TRUE.
 481    10 CONTINUE
 482 *
 483 *     Check for errors
 484 *
 485       IF( NSIZES.LT.0 ) THEN
 486          INFO = -1
 487       ELSE IF( BADNN ) THEN
 488          INFO = -2
 489       ELSE IF( NTYPES.LT.0 ) THEN
 490          INFO = -3
 491       ELSE IF( THRESH.LT.ZERO ) THEN
 492          INFO = -6
 493       ELSE IF( NOUNIT.LE.0 ) THEN
 494          INFO = -7
 495       ELSE IF( LDA.LT.1 .OR. LDA.LT.NMAX ) THEN
 496          INFO = -9
 497       ELSE IF( LDVL.LT.1 .OR. LDVL.LT.NMAX ) THEN
 498          INFO = -14
 499       ELSE IF( LDVR.LT.1 .OR. LDVR.LT.NMAX ) THEN
 500          INFO = -16
 501       ELSE IF( LDLRE.LT.1 .OR. LDLRE.LT.NMAX ) THEN
 502          INFO = -28
 503       ELSE IF( 5*NMAX+2*NMAX**2.GT.NWORK ) THEN
 504          INFO = -21
 505       END IF
 506 *
 507       IF( INFO.NE.0 ) THEN
 508          CALL XERBLA( 'CDRVEV', -INFO )
 509          RETURN
 510       END IF
 511 *
 512 *     Quick return if nothing to do
 513 *
 514       IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
 515      $   RETURN
 516 *
 517 *     More Important constants
 518 *
 519       UNFL = SLAMCH( 'Safe minimum' )
 520       OVFL = ONE / UNFL
 521       CALL SLABAD( UNFL, OVFL )
 522       ULP = SLAMCH( 'Precision' )
 523       ULPINV = ONE / ULP
 524       RTULP = SQRT( ULP )
 525       RTULPI = ONE / RTULP
 526 *
 527 *     Loop over sizes, types
 528 *
 529       NERRS = 0
 530 *
 531       DO 270 JSIZE = 1, NSIZES
 532          N = NN( JSIZE )
 533          IF( NSIZES.NE.1 ) THEN
 534             MTYPES = MIN( MAXTYP, NTYPES )
 535          ELSE
 536             MTYPES = MIN( MAXTYP+1, NTYPES )
 537          END IF
 538 *
 539          DO 260 JTYPE = 1, MTYPES
 540             IF( .NOT.DOTYPE( JTYPE ) )
 541      $         GO TO 260
 542 *
 543 *           Save ISEED in case of an error.
 544 *
 545             DO 20 J = 1, 4
 546                IOLDSD( J ) = ISEED( J )
 547    20       CONTINUE
 548 *
 549 *           Compute "A"
 550 *
 551 *           Control parameters:
 552 *
 553 *           KMAGN  KCONDS  KMODE        KTYPE
 554 *       =1  O(1)   1       clustered 1  zero
 555 *       =2  large  large   clustered 2  identity
 556 *       =3  small          exponential  Jordan
 557 *       =4                 arithmetic   diagonal, (w/ eigenvalues)
 558 *       =5                 random log   symmetric, w/ eigenvalues
 559 *       =6                 random       general, w/ eigenvalues
 560 *       =7                              random diagonal
 561 *       =8                              random symmetric
 562 *       =9                              random general
 563 *       =10                             random triangular
 564 *
 565             IF( MTYPES.GT.MAXTYP )
 566      $         GO TO 90
 567 *
 568             ITYPE = KTYPE( JTYPE )
 569             IMODE = KMODE( JTYPE )
 570 *
 571 *           Compute norm
 572 *
 573             GO TO ( 30, 40, 50 )KMAGN( JTYPE )
 574 *
 575    30       CONTINUE
 576             ANORM = ONE
 577             GO TO 60
 578 *
 579    40       CONTINUE
 580             ANORM = OVFL*ULP
 581             GO TO 60
 582 *
 583    50       CONTINUE
 584             ANORM = UNFL*ULPINV
 585             GO TO 60
 586 *
 587    60       CONTINUE
 588 *
 589             CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
 590             IINFO = 0
 591             COND = ULPINV
 592 *
 593 *           Special Matrices -- Identity & Jordan block
 594 *
 595 *              Zero
 596 *
 597             IF( ITYPE.EQ.1 ) THEN
 598                IINFO = 0
 599 *
 600             ELSE IF( ITYPE.EQ.2 ) THEN
 601 *
 602 *              Identity
 603 *
 604                DO 70 JCOL = 1, N
 605                   A( JCOL, JCOL ) = CMPLX( ANORM )
 606    70          CONTINUE
 607 *
 608             ELSE IF( ITYPE.EQ.3 ) THEN
 609 *
 610 *              Jordan Block
 611 *
 612                DO 80 JCOL = 1, N
 613                   A( JCOL, JCOL ) = CMPLX( ANORM )
 614                   IF( JCOL.GT.1 )
 615      $               A( JCOL, JCOL-1 ) = CONE
 616    80          CONTINUE
 617 *
 618             ELSE IF( ITYPE.EQ.4 ) THEN
 619 *
 620 *              Diagonal Matrix, [Eigen]values Specified
 621 *
 622                CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
 623      $                      ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
 624      $                      IINFO )
 625 *
 626             ELSE IF( ITYPE.EQ.5 ) THEN
 627 *
 628 *              Hermitian, eigenvalues specified
 629 *
 630                CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
 631      $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
 632      $                      IINFO )
 633 *
 634             ELSE IF( ITYPE.EQ.6 ) THEN
 635 *
 636 *              General, eigenvalues specified
 637 *
 638                IF( KCONDS( JTYPE ).EQ.1 ) THEN
 639                   CONDS = ONE
 640                ELSE IF( KCONDS( JTYPE ).EQ.2 ) THEN
 641                   CONDS = RTULPI
 642                ELSE
 643                   CONDS = ZERO
 644                END IF
 645 *
 646                CALL CLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE,
 647      $                      'T', 'T', 'T', RWORK, 4, CONDS, N, N,
 648      $                      ANORM, A, LDA, WORK( 2*N+1 ), IINFO )
 649 *
 650             ELSE IF( ITYPE.EQ.7 ) THEN
 651 *
 652 *              Diagonal, random eigenvalues
 653 *
 654                CALL CLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE,
 655      $                      'T', 'N', WORK( N+1 ), 1, ONE,
 656      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
 657      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
 658 *
 659             ELSE IF( ITYPE.EQ.8 ) THEN
 660 *
 661 *              Symmetric, random eigenvalues
 662 *
 663                CALL CLATMR( N, N, 'D', ISEED, 'H', WORK, 6, ONE, CONE,
 664      $                      'T', 'N', WORK( N+1 ), 1, ONE,
 665      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
 666      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
 667 *
 668             ELSE IF( ITYPE.EQ.9 ) THEN
 669 *
 670 *              General, random eigenvalues
 671 *
 672                CALL CLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE,
 673      $                      'T', 'N', WORK( N+1 ), 1, ONE,
 674      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
 675      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
 676                IF( N.GE.4 ) THEN
 677                   CALL CLASET( 'Full', 2, N, CZERO, CZERO, A, LDA )
 678                   CALL CLASET( 'Full', N-3, 1, CZERO, CZERO, A( 3, 1 ),
 679      $                         LDA )
 680                   CALL CLASET( 'Full', N-3, 2, CZERO, CZERO,
 681      $                         A( 3, N-1 ), LDA )
 682                   CALL CLASET( 'Full', 1, N, CZERO, CZERO, A( N, 1 ),
 683      $                         LDA )
 684                END IF
 685 *
 686             ELSE IF( ITYPE.EQ.10 ) THEN
 687 *
 688 *              Triangular, random eigenvalues
 689 *
 690                CALL CLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE,
 691      $                      'T', 'N', WORK( N+1 ), 1, ONE,
 692      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, 0,
 693      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
 694 *
 695             ELSE
 696 *
 697                IINFO = 1
 698             END IF
 699 *
 700             IF( IINFO.NE.0 ) THEN
 701                WRITE( NOUNIT, FMT = 9993 )'Generator', IINFO, N, JTYPE,
 702      $            IOLDSD
 703                INFO = ABS( IINFO )
 704                RETURN
 705             END IF
 706 *
 707    90       CONTINUE
 708 *
 709 *           Test for minimal and generous workspace
 710 *
 711             DO 250 IWK = 1, 2
 712                IF( IWK.EQ.1 ) THEN
 713                   NNWORK = 2*N
 714                ELSE
 715                   NNWORK = 5*N + 2*N**2
 716                END IF
 717                NNWORK = MAX( NNWORK, 1 )
 718 *
 719 *              Initialize RESULT
 720 *
 721                DO 100 J = 1, 7
 722                   RESULT( J ) = -ONE
 723   100          CONTINUE
 724 *
 725 *              Compute eigenvalues and eigenvectors, and test them
 726 *
 727                CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
 728                CALL CGEEV( 'V', 'V', N, H, LDA, W, VL, LDVL, VR, LDVR,
 729      $                     WORK, NNWORK, RWORK, IINFO )
 730                IF( IINFO.NE.0 ) THEN
 731                   RESULT( 1 ) = ULPINV
 732                   WRITE( NOUNIT, FMT = 9993 )'CGEEV1', IINFO, N, JTYPE,
 733      $               IOLDSD
 734                   INFO = ABS( IINFO )
 735                   GO TO 220
 736                END IF
 737 *
 738 *              Do Test (1)
 739 *
 740                CALL CGET22( 'N', 'N', 'N', N, A, LDA, VR, LDVR, W, WORK,
 741      $                      RWORK, RES )
 742                RESULT( 1 ) = RES( 1 )
 743 *
 744 *              Do Test (2)
 745 *
 746                CALL CGET22( 'C', 'N', 'C', N, A, LDA, VL, LDVL, W, WORK,
 747      $                      RWORK, RES )
 748                RESULT( 2 ) = RES( 1 )
 749 *
 750 *              Do Test (3)
 751 *
 752                DO 120 J = 1, N
 753                   TNRM = SCNRM2( N, VR( 1, J ), 1 )
 754                   RESULT( 3 ) = MAX( RESULT( 3 ),
 755      $                          MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
 756                   VMX = ZERO
 757                   VRMX = ZERO
 758                   DO 110 JJ = 1, N
 759                      VTST = ABS( VR( JJ, J ) )
 760                      IF( VTST.GT.VMX )
 761      $                  VMX = VTST
 762                      IF( AIMAG( VR( JJ, J ) ).EQ.ZERO .AND.
 763      $                   ABS( REAL( VR( JJ, J ) ) ).GT.VRMX )
 764      $                   VRMX = ABS( REAL( VR( JJ, J ) ) )
 765   110             CONTINUE
 766                   IF( VRMX / VMX.LT.ONE-TWO*ULP )
 767      $               RESULT( 3 ) = ULPINV
 768   120          CONTINUE
 769 *
 770 *              Do Test (4)
 771 *
 772                DO 140 J = 1, N
 773                   TNRM = SCNRM2( N, VL( 1, J ), 1 )
 774                   RESULT( 4 ) = MAX( RESULT( 4 ),
 775      $                          MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
 776                   VMX = ZERO
 777                   VRMX = ZERO
 778                   DO 130 JJ = 1, N
 779                      VTST = ABS( VL( JJ, J ) )
 780                      IF( VTST.GT.VMX )
 781      $                  VMX = VTST
 782                      IF( AIMAG( VL( JJ, J ) ).EQ.ZERO .AND.
 783      $                   ABS( REAL( VL( JJ, J ) ) ).GT.VRMX )
 784      $                   VRMX = ABS( REAL( VL( JJ, J ) ) )
 785   130             CONTINUE
 786                   IF( VRMX / VMX.LT.ONE-TWO*ULP )
 787      $               RESULT( 4 ) = ULPINV
 788   140          CONTINUE
 789 *
 790 *              Compute eigenvalues only, and test them
 791 *
 792                CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
 793                CALL CGEEV( 'N', 'N', N, H, LDA, W1, DUM, 1, DUM, 1,
 794      $                     WORK, NNWORK, RWORK, IINFO )
 795                IF( IINFO.NE.0 ) THEN
 796                   RESULT( 1 ) = ULPINV
 797                   WRITE( NOUNIT, FMT = 9993 )'CGEEV2', IINFO, N, JTYPE,
 798      $               IOLDSD
 799                   INFO = ABS( IINFO )
 800                   GO TO 220
 801                END IF
 802 *
 803 *              Do Test (5)
 804 *
 805                DO 150 J = 1, N
 806                   IF( W( J ).NE.W1( J ) )
 807      $               RESULT( 5 ) = ULPINV
 808   150          CONTINUE
 809 *
 810 *              Compute eigenvalues and right eigenvectors, and test them
 811 *
 812                CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
 813                CALL CGEEV( 'N', 'V', N, H, LDA, W1, DUM, 1, LRE, LDLRE,
 814      $                     WORK, NNWORK, RWORK, IINFO )
 815                IF( IINFO.NE.0 ) THEN
 816                   RESULT( 1 ) = ULPINV
 817                   WRITE( NOUNIT, FMT = 9993 )'CGEEV3', IINFO, N, JTYPE,
 818      $               IOLDSD
 819                   INFO = ABS( IINFO )
 820                   GO TO 220
 821                END IF
 822 *
 823 *              Do Test (5) again
 824 *
 825                DO 160 J = 1, N
 826                   IF( W( J ).NE.W1( J ) )
 827      $               RESULT( 5 ) = ULPINV
 828   160          CONTINUE
 829 *
 830 *              Do Test (6)
 831 *
 832                DO 180 J = 1, N
 833                   DO 170 JJ = 1, N
 834                      IF( VR( J, JJ ).NE.LRE( J, JJ ) )
 835      $                  RESULT( 6 ) = ULPINV
 836   170             CONTINUE
 837   180          CONTINUE
 838 *
 839 *              Compute eigenvalues and left eigenvectors, and test them
 840 *
 841                CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
 842                CALL CGEEV( 'V', 'N', N, H, LDA, W1, LRE, LDLRE, DUM, 1,
 843      $                     WORK, NNWORK, RWORK, IINFO )
 844                IF( IINFO.NE.0 ) THEN
 845                   RESULT( 1 ) = ULPINV
 846                   WRITE( NOUNIT, FMT = 9993 )'CGEEV4', IINFO, N, JTYPE,
 847      $               IOLDSD
 848                   INFO = ABS( IINFO )
 849                   GO TO 220
 850                END IF
 851 *
 852 *              Do Test (5) again
 853 *
 854                DO 190 J = 1, N
 855                   IF( W( J ).NE.W1( J ) )
 856      $               RESULT( 5 ) = ULPINV
 857   190          CONTINUE
 858 *
 859 *              Do Test (7)
 860 *
 861                DO 210 J = 1, N
 862                   DO 200 JJ = 1, N
 863                      IF( VL( J, JJ ).NE.LRE( J, JJ ) )
 864      $                  RESULT( 7 ) = ULPINV
 865   200             CONTINUE
 866   210          CONTINUE
 867 *
 868 *              End of Loop -- Check for RESULT(j) > THRESH
 869 *
 870   220          CONTINUE
 871 *
 872                NTEST = 0
 873                NFAIL = 0
 874                DO 230 J = 1, 7
 875                   IF( RESULT( J ).GE.ZERO )
 876      $               NTEST = NTEST + 1
 877                   IF( RESULT( J ).GE.THRESH )
 878      $               NFAIL = NFAIL + 1
 879   230          CONTINUE
 880 *
 881                IF( NFAIL.GT.0 )
 882      $            NTESTF = NTESTF + 1
 883                IF( NTESTF.EQ.1 ) THEN
 884                   WRITE( NOUNIT, FMT = 9999 )PATH
 885                   WRITE( NOUNIT, FMT = 9998 )
 886                   WRITE( NOUNIT, FMT = 9997 )
 887                   WRITE( NOUNIT, FMT = 9996 )
 888                   WRITE( NOUNIT, FMT = 9995 )THRESH
 889                   NTESTF = 2
 890                END IF
 891 *
 892                DO 240 J = 1, 7
 893                   IF( RESULT( J ).GE.THRESH ) THEN
 894                      WRITE( NOUNIT, FMT = 9994 )N, IWK, IOLDSD, JTYPE,
 895      $                  J, RESULT( J )
 896                   END IF
 897   240          CONTINUE
 898 *
 899                NERRS = NERRS + NFAIL
 900                NTESTT = NTESTT + NTEST
 901 *
 902   250       CONTINUE
 903   260    CONTINUE
 904   270 CONTINUE
 905 *
 906 *     Summary
 907 *
 908       CALL SLASUM( PATH, NOUNIT, NERRS, NTESTT )
 909 *
 910  9999 FORMAT( / 1X, A3, ' -- Complex Eigenvalue-Eigenvector ',
 911      $      'Decomposition Driver', /
 912      $      ' Matrix types (see CDRVEV for details): ' )
 913 *
 914  9998 FORMAT( / ' Special Matrices:', / '  1=Zero matrix.             ',
 915      $      '           ', '  5=Diagonal: geometr. spaced entries.',
 916      $      / '  2=Identity matrix.                    ', '  6=Diagona',
 917      $      'l: clustered entries.', / '  3=Transposed Jordan block.  ',
 918      $      '          ', '  7=Diagonal: large, evenly spaced.', / '  ',
 919      $      '4=Diagonal: evenly spaced entries.    ', '  8=Diagonal: s',
 920      $      'mall, evenly spaced.' )
 921  9997 FORMAT( ' Dense, Non-Symmetric Matrices:', / '  9=Well-cond., ev',
 922      $      'enly spaced eigenvals.', ' 14=Ill-cond., geomet. spaced e',
 923      $      'igenals.', / ' 10=Well-cond., geom. spaced eigenvals. ',
 924      $      ' 15=Ill-conditioned, clustered e.vals.', / ' 11=Well-cond',
 925      $      'itioned, clustered e.vals. ', ' 16=Ill-cond., random comp',
 926      $      'lex ', A6, / ' 12=Well-cond., random complex ', A6, '   ',
 927      $      ' 17=Ill-cond., large rand. complx ', A4, / ' 13=Ill-condi',
 928      $      'tioned, evenly spaced.     ', ' 18=Ill-cond., small rand.',
 929      $      ' complx ', A4 )
 930  9996 FORMAT( ' 19=Matrix with random O(1) entries.    ', ' 21=Matrix ',
 931      $      'with small random entries.', / ' 20=Matrix with large ran',
 932      $      'dom entries.   ', / )
 933  9995 FORMAT( ' Tests performed with test threshold =', F8.2,
 934      $      / / ' 1 = | A VR - VR W | / ( n |A| ulp ) ',
 935      $      / ' 2 = | conj-trans(A) VL - VL conj-trans(W) | /',
 936      $      ' ( n |A| ulp ) ', / ' 3 = | |VR(i)| - 1 | / ulp ',
 937      $      / ' 4 = | |VL(i)| - 1 | / ulp ',
 938      $      / ' 5 = 0 if W same no matter if VR or VL computed,',
 939      $      ' 1/ulp otherwise', /
 940      $      ' 6 = 0 if VR same no matter if VL computed,',
 941      $      '  1/ulp otherwise', /
 942      $      ' 7 = 0 if VL same no matter if VR computed,',
 943      $      '  1/ulp otherwise', / )
 944  9994 FORMAT( ' N=', I5, ', IWK=', I2, ', seed=', 4( I4, ',' ),
 945      $      ' type ', I2, ', test(', I2, ')=', G10.3 )
 946  9993 FORMAT( ' CDRVEV: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
 947      $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
 948 *
 949       RETURN
 950 *
 951 *     End of CDRVEV
 952 *
 953       END