TESTING/EIG/zdrves.f

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