OSchip
/
OpenBLAS
Not watched
1
0
Fork 0
Code
Releases 66 Wiki evaluate Activity
Issues 0 Pull Requests 0 Datasets Model Cloudbrain HPC
You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.
Tree: 3814bf60d3
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from '3814bf60d3'
${ noResults }
OpenBLAS/lapack-netlib/TESTING/EIG/zdrvvx.f

999 lines
35 kB
Raw Blame History 

  1. *> \brief \b ZDRVVX

  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 ZDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,

  12. *                          NIUNIT, NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR,

  13. *                          LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,

  14. *                          RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,

  15. *                          WORK, NWORK, RWORK, INFO )

  16. * 

  17. *       .. Scalar Arguments ..

  18. *       INTEGER            INFO, LDA, LDLRE, LDVL, LDVR, NIUNIT, NOUNIT,

  19. *      $                   NSIZES, NTYPES, NWORK

  20. *       DOUBLE PRECISION   THRESH

  21. *       ..

  22. *       .. Array Arguments ..

  23. *       LOGICAL            DOTYPE( * )

  24. *       INTEGER            ISEED( 4 ), NN( * )

  25. *       DOUBLE PRECISION   RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),

  26. *      $                   RCNDV1( * ), RCONDE( * ), RCONDV( * ),

  27. *      $                   RESULT( 11 ), RWORK( * ), SCALE( * ),

  28. *      $                   SCALE1( * )

  29. *       COMPLEX*16         A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),

  30. *      $                   VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),

  31. *      $                   WORK( * )

  32. *       ..

  33. *  

  34. *

  35. *> \par Purpose:

  36. *  =============

  37. *>

  38. *> \verbatim

  39. *>

  40. *>    ZDRVVX  checks the nonsymmetric eigenvalue problem expert driver

  41. *>    ZGEEVX.

  42. *>

  43. *>    ZDRVVX uses both test matrices generated randomly depending on

  44. *>    data supplied in the calling sequence, as well as on data

  45. *>    read from an input file and including precomputed condition

  46. *>    numbers to which it compares the ones it computes.

  47. *>

  48. *>    When ZDRVVX is called, a number of matrix "sizes" ("n's") and a

  49. *>    number of matrix "types" are specified in the calling sequence.

  50. *>    For each size ("n") and each type of matrix, one matrix will be

  51. *>    generated and used to test the nonsymmetric eigenroutines.  For

  52. *>    each matrix, 9 tests will be performed:

  53. *>

  54. *>    (1)     | A * VR - VR * W | / ( n |A| ulp )

  55. *>

  56. *>      Here VR is the matrix of unit right eigenvectors.

  57. *>      W is a diagonal matrix with diagonal entries W(j).

  58. *>

  59. *>    (2)     | A**H  * VL - VL * W**H | / ( n |A| ulp )

  60. *>

  61. *>      Here VL is the matrix of unit left eigenvectors, A**H is the

  62. *>      conjugate transpose of A, and W is as above.

  63. *>

  64. *>    (3)     | |VR(i)| - 1 | / ulp and largest component real

  65. *>

  66. *>      VR(i) denotes the i-th column of VR.

  67. *>

  68. *>    (4)     | |VL(i)| - 1 | / ulp and largest component real

  69. *>

  70. *>      VL(i) denotes the i-th column of VL.

  71. *>

  72. *>    (5)     W(full) = W(partial)

  73. *>

  74. *>      W(full) denotes the eigenvalues computed when VR, VL, RCONDV

  75. *>      and RCONDE are also computed, and W(partial) denotes the

  76. *>      eigenvalues computed when only some of VR, VL, RCONDV, and

  77. *>      RCONDE are computed.

  78. *>

  79. *>    (6)     VR(full) = VR(partial)

  80. *>

  81. *>      VR(full) denotes the right eigenvectors computed when VL, RCONDV

  82. *>      and RCONDE are computed, and VR(partial) denotes the result

  83. *>      when only some of VL and RCONDV are computed.

  84. *>

  85. *>    (7)     VL(full) = VL(partial)

  86. *>

  87. *>      VL(full) denotes the left eigenvectors computed when VR, RCONDV

  88. *>      and RCONDE are computed, and VL(partial) denotes the result

  89. *>      when only some of VR and RCONDV are computed.

  90. *>

  91. *>    (8)     0 if SCALE, ILO, IHI, ABNRM (full) =

  92. *>                 SCALE, ILO, IHI, ABNRM (partial)

  93. *>            1/ulp otherwise

  94. *>

  95. *>      SCALE, ILO, IHI and ABNRM describe how the matrix is balanced.

  96. *>      (full) is when VR, VL, RCONDE and RCONDV are also computed, and

  97. *>      (partial) is when some are not computed.

  98. *>

  99. *>    (9)     RCONDV(full) = RCONDV(partial)

  100. *>

  101. *>      RCONDV(full) denotes the reciprocal condition numbers of the

  102. *>      right eigenvectors computed when VR, VL and RCONDE are also

  103. *>      computed. RCONDV(partial) denotes the reciprocal condition

  104. *>      numbers when only some of VR, VL and RCONDE are computed.

  105. *>

  106. *>    The "sizes" are specified by an array NN(1:NSIZES); the value of

  107. *>    each element NN(j) specifies one size.

  108. *>    The "types" are specified by a logical array DOTYPE( 1:NTYPES );

  109. *>    if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.

  110. *>    Currently, the list of possible types is:

  111. *>

  112. *>    (1)  The zero matrix.

  113. *>    (2)  The identity matrix.

  114. *>    (3)  A (transposed) Jordan block, with 1's on the diagonal.

  115. *>

  116. *>    (4)  A diagonal matrix with evenly spaced entries

  117. *>         1, ..., ULP  and random complex angles.

  118. *>         (ULP = (first number larger than 1) - 1 )

  119. *>    (5)  A diagonal matrix with geometrically spaced entries

  120. *>         1, ..., ULP  and random complex angles.

  121. *>    (6)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP

  122. *>         and random complex angles.

  123. *>

  124. *>    (7)  Same as (4), but multiplied by a constant near

  125. *>         the overflow threshold

  126. *>    (8)  Same as (4), but multiplied by a constant near

  127. *>         the underflow threshold

  128. *>

  129. *>    (9)  A matrix of the form  U' T U, where U is unitary and

  130. *>         T has evenly spaced entries 1, ..., ULP with random complex

  131. *>         angles on the diagonal and random O(1) entries in the upper

  132. *>         triangle.

  133. *>

  134. *>    (10) A matrix of the form  U' T U, where U is unitary and

  135. *>         T has geometrically spaced entries 1, ..., ULP with random

  136. *>         complex angles on the diagonal and random O(1) entries in

  137. *>         the upper triangle.

  138. *>

  139. *>    (11) A matrix of the form  U' T U, where U is unitary and

  140. *>         T has "clustered" entries 1, ULP,..., ULP with random

  141. *>         complex angles on the diagonal and random O(1) entries in

  142. *>         the upper triangle.

  143. *>

  144. *>    (12) A matrix of the form  U' T U, where U is unitary and

  145. *>         T has complex eigenvalues randomly chosen from

  146. *>         ULP < |z| < 1   and random O(1) entries in the upper

  147. *>         triangle.

  148. *>

  149. *>    (13) A matrix of the form  X' T X, where X has condition

  150. *>         SQRT( ULP ) and T has evenly spaced entries 1, ..., ULP

  151. *>         with random complex angles on the diagonal and random O(1)

  152. *>         entries in the upper triangle.

  153. *>

  154. *>    (14) A matrix of the form  X' T X, where X has condition

  155. *>         SQRT( ULP ) and T has geometrically spaced entries

  156. *>         1, ..., ULP with random complex angles on the diagonal

  157. *>         and random O(1) entries in the upper triangle.

  158. *>

  159. *>    (15) A matrix of the form  X' T X, where X has condition

  160. *>         SQRT( ULP ) and T has "clustered" entries 1, ULP,..., ULP

  161. *>         with random complex angles on the diagonal and random O(1)

  162. *>         entries in the upper triangle.

  163. *>

  164. *>    (16) A matrix of the form  X' T X, where X has condition

  165. *>         SQRT( ULP ) and T has complex eigenvalues randomly chosen

  166. *>         from ULP < |z| < 1 and random O(1) entries in the upper

  167. *>         triangle.

  168. *>

  169. *>    (17) Same as (16), but multiplied by a constant

  170. *>         near the overflow threshold

  171. *>    (18) Same as (16), but multiplied by a constant

  172. *>         near the underflow threshold

  173. *>

  174. *>    (19) Nonsymmetric matrix with random entries chosen from |z| < 1

  175. *>         If N is at least 4, all entries in first two rows and last

  176. *>         row, and first column and last two columns are zero.

  177. *>    (20) Same as (19), but multiplied by a constant

  178. *>         near the overflow threshold

  179. *>    (21) Same as (19), but multiplied by a constant

  180. *>         near the underflow threshold

  181. *>

  182. *>    In addition, an input file will be read from logical unit number

  183. *>    NIUNIT. The file contains matrices along with precomputed

  184. *>    eigenvalues and reciprocal condition numbers for the eigenvalues

  185. *>    and right eigenvectors. For these matrices, in addition to tests

  186. *>    (1) to (9) we will compute the following two tests:

  187. *>

  188. *>   (10)  |RCONDV - RCDVIN| / cond(RCONDV)

  189. *>

  190. *>      RCONDV is the reciprocal right eigenvector condition number

  191. *>      computed by ZGEEVX and RCDVIN (the precomputed true value)

  192. *>      is supplied as input. cond(RCONDV) is the condition number of

  193. *>      RCONDV, and takes errors in computing RCONDV into account, so

  194. *>      that the resulting quantity should be O(ULP). cond(RCONDV) is

  195. *>      essentially given by norm(A)/RCONDE.

  196. *>

  197. *>   (11)  |RCONDE - RCDEIN| / cond(RCONDE)

  198. *>

  199. *>      RCONDE is the reciprocal eigenvalue condition number

  200. *>      computed by ZGEEVX and RCDEIN (the precomputed true value)

  201. *>      is supplied as input.  cond(RCONDE) is the condition number

  202. *>      of RCONDE, and takes errors in computing RCONDE into account,

  203. *>      so that the resulting quantity should be O(ULP). cond(RCONDE)

  204. *>      is essentially given by norm(A)/RCONDV.

  205. *> \endverbatim

  206. *

  207. *  Arguments:

  208. *  ==========

  209. *

  210. *> \param[in] NSIZES

  211. *> \verbatim

  212. *>          NSIZES is INTEGER

  213. *>          The number of sizes of matrices to use.  NSIZES must be at

  214. *>          least zero. If it is zero, no randomly generated matrices

  215. *>          are tested, but any test matrices read from NIUNIT will be

  216. *>          tested.

  217. *> \endverbatim

  218. *>

  219. *> \param[in] NN

  220. *> \verbatim

  221. *>          NN is INTEGER array, dimension (NSIZES)

  222. *>          An array containing the sizes to be used for the matrices.

  223. *>          Zero values will be skipped.  The values must be at least

  224. *>          zero.

  225. *> \endverbatim

  226. *>

  227. *> \param[in] NTYPES

  228. *> \verbatim

  229. *>          NTYPES is INTEGER

  230. *>          The number of elements in DOTYPE. NTYPES must be at least

  231. *>          zero. If it is zero, no randomly generated test matrices

  232. *>          are tested, but and test matrices read from NIUNIT will be

  233. *>          tested. If it is MAXTYP+1 and NSIZES is 1, then an

  234. *>          additional type, MAXTYP+1 is defined, which is to use

  235. *>          whatever matrix is in A.  This is only useful if

  236. *>          DOTYPE(1:MAXTYP) is .FALSE. and DOTYPE(MAXTYP+1) is .TRUE. .

  237. *> \endverbatim

  238. *>

  239. *> \param[in] DOTYPE

  240. *> \verbatim

  241. *>          DOTYPE is LOGICAL array, dimension (NTYPES)

  242. *>          If DOTYPE(j) is .TRUE., then for each size in NN a

  243. *>          matrix of that size and of type j will be generated.

  244. *>          If NTYPES is smaller than the maximum number of types

  245. *>          defined (PARAMETER MAXTYP), then types NTYPES+1 through

  246. *>          MAXTYP will not be generated.  If NTYPES is larger

  247. *>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)

  248. *>          will be ignored.

  249. *> \endverbatim

  250. *>

  251. *> \param[in,out] ISEED

  252. *> \verbatim

  253. *>          ISEED is INTEGER array, dimension (4)

  254. *>          On entry ISEED specifies the seed of the random number

  255. *>          generator. The array elements should be between 0 and 4095;

  256. *>          if not they will be reduced mod 4096.  Also, ISEED(4) must

  257. *>          be odd.  The random number generator uses a linear

  258. *>          congruential sequence limited to small integers, and so

  259. *>          should produce machine independent random numbers. The

  260. *>          values of ISEED are changed on exit, and can be used in the

  261. *>          next call to ZDRVVX to continue the same random number

  262. *>          sequence.

  263. *> \endverbatim

  264. *>

  265. *> \param[in] THRESH

  266. *> \verbatim

  267. *>          THRESH is DOUBLE PRECISION

  268. *>          A test will count as "failed" if the "error", computed as

  269. *>          described above, exceeds THRESH.  Note that the error

  270. *>          is scaled to be O(1), so THRESH should be a reasonably

  271. *>          small multiple of 1, e.g., 10 or 100.  In particular,

  272. *>          it should not depend on the precision (single vs. double)

  273. *>          or the size of the matrix.  It must be at least zero.

  274. *> \endverbatim

  275. *>

  276. *> \param[in] NIUNIT

  277. *> \verbatim

  278. *>          NIUNIT is INTEGER

  279. *>          The FORTRAN unit number for reading in the data file of

  280. *>          problems to solve.

  281. *> \endverbatim

  282. *>

  283. *> \param[in] NOUNIT

  284. *> \verbatim

  285. *>          NOUNIT is INTEGER

  286. *>          The FORTRAN unit number for printing out error messages

  287. *>          (e.g., if a routine returns INFO not equal to 0.)

  288. *> \endverbatim

  289. *>

  290. *> \param[out] A

  291. *> \verbatim

  292. *>          A is COMPLEX*16 array, dimension (LDA, max(NN,12))

  293. *>          Used to hold the matrix whose eigenvalues are to be

  294. *>          computed.  On exit, A contains the last matrix actually used.

  295. *> \endverbatim

  296. *>

  297. *> \param[in] LDA

  298. *> \verbatim

  299. *>          LDA is INTEGER

  300. *>          The leading dimension of A, and H. LDA must be at

  301. *>          least 1 and at least max( NN, 12 ). (12 is the

  302. *>          dimension of the largest matrix on the precomputed

  303. *>          input file.)

  304. *> \endverbatim

  305. *>

  306. *> \param[out] H

  307. *> \verbatim

  308. *>          H is COMPLEX*16 array, dimension (LDA, max(NN,12))

  309. *>          Another copy of the test matrix A, modified by ZGEEVX.

  310. *> \endverbatim

  311. *>

  312. *> \param[out] W

  313. *> \verbatim

  314. *>          W is COMPLEX*16 array, dimension (max(NN,12))

  315. *>          Contains the eigenvalues of A.

  316. *> \endverbatim

  317. *>

  318. *> \param[out] W1

  319. *> \verbatim

  320. *>          W1 is COMPLEX*16 array, dimension (max(NN,12))

  321. *>          Like W, this array contains the eigenvalues of A,

  322. *>          but those computed when ZGEEVX only computes a partial

  323. *>          eigendecomposition, i.e. not the eigenvalues and left

  324. *>          and right eigenvectors.

  325. *> \endverbatim

  326. *>

  327. *> \param[out] VL

  328. *> \verbatim

  329. *>          VL is COMPLEX*16 array, dimension (LDVL, max(NN,12))

  330. *>          VL holds the computed left eigenvectors.

  331. *> \endverbatim

  332. *>

  333. *> \param[in] LDVL

  334. *> \verbatim

  335. *>          LDVL is INTEGER

  336. *>          Leading dimension of VL. Must be at least max(1,max(NN,12)).

  337. *> \endverbatim

  338. *>

  339. *> \param[out] VR

  340. *> \verbatim

  341. *>          VR is COMPLEX*16 array, dimension (LDVR, max(NN,12))

  342. *>          VR holds the computed right eigenvectors.

  343. *> \endverbatim

  344. *>

  345. *> \param[in] LDVR

  346. *> \verbatim

  347. *>          LDVR is INTEGER

  348. *>          Leading dimension of VR. Must be at least max(1,max(NN,12)).

  349. *> \endverbatim

  350. *>

  351. *> \param[out] LRE

  352. *> \verbatim

  353. *>          LRE is COMPLEX*16 array, dimension (LDLRE, max(NN,12))

  354. *>          LRE holds the computed right or left eigenvectors.

  355. *> \endverbatim

  356. *>

  357. *> \param[in] LDLRE

  358. *> \verbatim

  359. *>          LDLRE is INTEGER

  360. *>          Leading dimension of LRE. Must be at least max(1,max(NN,12))

  361. *> \endverbatim

  362. *>

  363. *> \param[out] RCONDV

  364. *> \verbatim

  365. *>          RCONDV is DOUBLE PRECISION array, dimension (N)

  366. *>          RCONDV holds the computed reciprocal condition numbers

  367. *>          for eigenvectors.

  368. *> \endverbatim

  369. *>

  370. *> \param[out] RCNDV1

  371. *> \verbatim

  372. *>          RCNDV1 is DOUBLE PRECISION array, dimension (N)

  373. *>          RCNDV1 holds more computed reciprocal condition numbers

  374. *>          for eigenvectors.

  375. *> \endverbatim

  376. *>

  377. *> \param[in] RCDVIN

  378. *> \verbatim

  379. *>          RCDVIN is DOUBLE PRECISION array, dimension (N)

  380. *>          When COMP = .TRUE. RCDVIN holds the precomputed reciprocal

  381. *>          condition numbers for eigenvectors to be compared with

  382. *>          RCONDV.

  383. *> \endverbatim

  384. *>

  385. *> \param[out] RCONDE

  386. *> \verbatim

  387. *>          RCONDE is DOUBLE PRECISION array, dimension (N)

  388. *>          RCONDE holds the computed reciprocal condition numbers

  389. *>          for eigenvalues.

  390. *> \endverbatim

  391. *>

  392. *> \param[out] RCNDE1

  393. *> \verbatim

  394. *>          RCNDE1 is DOUBLE PRECISION array, dimension (N)

  395. *>          RCNDE1 holds more computed reciprocal condition numbers

  396. *>          for eigenvalues.

  397. *> \endverbatim

  398. *>

  399. *> \param[in] RCDEIN

  400. *> \verbatim

  401. *>          RCDEIN is DOUBLE PRECISION array, dimension (N)

  402. *>          When COMP = .TRUE. RCDEIN holds the precomputed reciprocal

  403. *>          condition numbers for eigenvalues to be compared with

  404. *>          RCONDE.

  405. *> \endverbatim

  406. *>

  407. *> \param[out] SCALE

  408. *> \verbatim

  409. *>          SCALE is DOUBLE PRECISION array, dimension (N)

  410. *>          Holds information describing balancing of matrix.

  411. *> \endverbatim

  412. *>

  413. *> \param[out] SCALE1

  414. *> \verbatim

  415. *>          SCALE1 is DOUBLE PRECISION array, dimension (N)

  416. *>          Holds information describing balancing of matrix.

  417. *> \endverbatim

  418. *>

  419. *> \param[out] WORK

  420. *> \verbatim

  421. *>          WORK is COMPLEX*16 array, dimension (NWORK)

  422. *> \endverbatim

  423. *>

  424. *> \param[out] RESULT

  425. *> \verbatim

  426. *>          RESULT is DOUBLE PRECISION array, dimension (11)

  427. *>          The values computed by the seven tests described above.

  428. *>          The values are currently limited to 1/ulp, to avoid

  429. *>          overflow.

  430. *> \endverbatim

  431. *>

  432. *> \param[in] NWORK

  433. *> \verbatim

  434. *>          NWORK is INTEGER

  435. *>          The number of entries in WORK.  This must be at least

  436. *>          max(6*12+2*12**2,6*NN(j)+2*NN(j)**2) =

  437. *>          max(    360     ,6*NN(j)+2*NN(j)**2)    for all j.

  438. *> \endverbatim

  439. *>

  440. *> \param[out] RWORK

  441. *> \verbatim

  442. *>          RWORK is DOUBLE PRECISION array, dimension (2*max(NN,12))

  443. *> \endverbatim

  444. *>

  445. *> \param[out] INFO

  446. *> \verbatim

  447. *>          INFO is INTEGER

  448. *>          If 0,  then successful exit.

  449. *>          If <0, then input paramter -INFO is incorrect.

  450. *>          If >0, ZLATMR, CLATMS, CLATME or ZGET23 returned an error

  451. *>                 code, and INFO is its absolute value.

  452. *>

  453. *>-----------------------------------------------------------------------

  454. *>

  455. *>     Some Local Variables and Parameters:

  456. *>     ---- ----- --------- --- ----------

  457. *>

  458. *>     ZERO, ONE       Real 0 and 1.

  459. *>     MAXTYP          The number of types defined.

  460. *>     NMAX            Largest value in NN or 12.

  461. *>     NERRS           The number of tests which have exceeded THRESH

  462. *>     COND, CONDS,

  463. *>     IMODE           Values to be passed to the matrix generators.

  464. *>     ANORM           Norm of A; passed to matrix generators.

  465. *>

  466. *>     OVFL, UNFL      Overflow and underflow thresholds.

  467. *>     ULP, ULPINV     Finest relative precision and its inverse.

  468. *>     RTULP, RTULPI   Square roots of the previous 4 values.

  469. *>

  470. *>             The following four arrays decode JTYPE:

  471. *>     KTYPE(j)        The general type (1-10) for type "j".

  472. *>     KMODE(j)        The MODE value to be passed to the matrix

  473. *>                     generator for type "j".

  474. *>     KMAGN(j)        The order of magnitude ( O(1),

  475. *>                     O(overflow^(1/2) ), O(underflow^(1/2) )

  476. *>     KCONDS(j)       Selectw whether CONDS is to be 1 or

  477. *>                     1/sqrt(ulp).  (0 means irrelevant.)

  478. *> \endverbatim

  479. *

  480. *  Authors:

  481. *  ========

  482. *

  483. *> \author Univ. of Tennessee 

  484. *> \author Univ. of California Berkeley 

  485. *> \author Univ. of Colorado Denver 

  486. *> \author NAG Ltd. 

  487. *

  488. *> \date November 2011

  489. *

  490. *> \ingroup complex16_eig

  491. *

  492. *  =====================================================================

  493.       SUBROUTINE ZDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,

  494.      $                   NIUNIT, NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR,

  495.      $                   LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,

  496.      $                   RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,

  497.      $                   WORK, NWORK, RWORK, INFO )

  498. *

  499. *  -- LAPACK test routine (version 3.4.0) --

  500. *  -- LAPACK is a software package provided by Univ. of Tennessee,    --

  501. *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--

  502. *     November 2011

  503. *

  504. *     .. Scalar Arguments ..

  505.       INTEGER            INFO, LDA, LDLRE, LDVL, LDVR, NIUNIT, NOUNIT,

  506.      $                   NSIZES, NTYPES, NWORK

  507.       DOUBLE PRECISION   THRESH

  508. *     ..

  509. *     .. Array Arguments ..

  510.       LOGICAL            DOTYPE( * )

  511.       INTEGER            ISEED( 4 ), NN( * )

  512.       DOUBLE PRECISION   RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),

  513.      $                   RCNDV1( * ), RCONDE( * ), RCONDV( * ),

  514.      $                   RESULT( 11 ), RWORK( * ), SCALE( * ),

  515.      $                   SCALE1( * )

  516.       COMPLEX*16         A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),

  517.      $                   VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),

  518.      $                   WORK( * )

  519. *     ..

  520. *

  521. *  =====================================================================

  522. *

  523. *     .. Parameters ..

  524.       COMPLEX*16         CZERO

  525.       PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )

  526.       COMPLEX*16         CONE

  527.       PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )

  528.       DOUBLE PRECISION   ZERO, ONE

  529.       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )

  530.       INTEGER            MAXTYP

  531.       PARAMETER          ( MAXTYP = 21 )

  532. *     ..

  533. *     .. Local Scalars ..

  534.       LOGICAL            BADNN

  535.       CHARACTER          BALANC

  536.       CHARACTER*3        PATH

  537.       INTEGER            I, IBAL, IINFO, IMODE, ISRT, ITYPE, IWK, J,

  538.      $                   JCOL, JSIZE, JTYPE, MTYPES, N, NERRS, NFAIL,

  539.      $                   NMAX, NNWORK, NTEST, NTESTF, NTESTT

  540.       DOUBLE PRECISION   ANORM, COND, CONDS, OVFL, RTULP, RTULPI, ULP,

  541.      $                   ULPINV, UNFL, WI, WR

  542. *     ..

  543. *     .. Local Arrays ..

  544.       CHARACTER          BAL( 4 )

  545.       INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ),

  546.      $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),

  547.      $                   KTYPE( MAXTYP )

  548. *     ..

  549. *     .. External Functions ..

  550.       DOUBLE PRECISION   DLAMCH

  551.       EXTERNAL           DLAMCH

  552. *     ..

  553. *     .. External Subroutines ..

  554.       EXTERNAL           DLABAD, DLASUM, XERBLA, ZGET23, ZLASET, ZLATME,

  555.      $                   ZLATMR, ZLATMS

  556. *     ..

  557. *     .. Intrinsic Functions ..

  558.       INTRINSIC          ABS, DCMPLX, MAX, MIN, SQRT

  559. *     ..

  560. *     .. Data statements ..

  561.       DATA               KTYPE / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /

  562.       DATA               KMAGN / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,

  563.      $                   3, 1, 2, 3 /

  564.       DATA               KMODE / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,

  565.      $                   1, 5, 5, 5, 4, 3, 1 /

  566.       DATA               KCONDS / 3*0, 5*0, 4*1, 6*2, 3*0 /

  567.       DATA               BAL / 'N', 'P', 'S', 'B' /

  568. *     ..

  569. *     .. Executable Statements ..

  570. *

  571.       PATH( 1: 1 ) = 'Zomplex precision'

  572.       PATH( 2: 3 ) = 'VX'

  573. *

  574. *     Check for errors

  575. *

  576.       NTESTT = 0

  577.       NTESTF = 0

  578.       INFO = 0

  579. *

  580. *     Important constants

  581. *

  582.       BADNN = .FALSE.

  583. *

  584. *     7 is the largest dimension in the input file of precomputed

  585. *     problems

  586. *

  587.       NMAX = 7

  588.       DO 10 J = 1, NSIZES

  589.          NMAX = MAX( NMAX, NN( J ) )

  590.          IF( NN( J ).LT.0 )

  591.      $      BADNN = .TRUE.

  592.    10 CONTINUE

  593. *

  594. *     Check for errors

  595. *

  596.       IF( NSIZES.LT.0 ) THEN

  597.          INFO = -1

  598.       ELSE IF( BADNN ) THEN

  599.          INFO = -2

  600.       ELSE IF( NTYPES.LT.0 ) THEN

  601.          INFO = -3

  602.       ELSE IF( THRESH.LT.ZERO ) THEN

  603.          INFO = -6

  604.       ELSE IF( LDA.LT.1 .OR. LDA.LT.NMAX ) THEN

  605.          INFO = -10

  606.       ELSE IF( LDVL.LT.1 .OR. LDVL.LT.NMAX ) THEN

  607.          INFO = -15

  608.       ELSE IF( LDVR.LT.1 .OR. LDVR.LT.NMAX ) THEN

  609.          INFO = -17

  610.       ELSE IF( LDLRE.LT.1 .OR. LDLRE.LT.NMAX ) THEN

  611.          INFO = -19

  612.       ELSE IF( 6*NMAX+2*NMAX**2.GT.NWORK ) THEN

  613.          INFO = -30

  614.       END IF

  615. *

  616.       IF( INFO.NE.0 ) THEN

  617.          CALL XERBLA( 'ZDRVVX', -INFO )

  618.          RETURN

  619.       END IF

  620. *

  621. *     If nothing to do check on NIUNIT

  622. *

  623.       IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )

  624.      $   GO TO 160

  625. *

  626. *     More Important constants

  627. *

  628.       UNFL = DLAMCH( 'Safe minimum' )

  629.       OVFL = ONE / UNFL

  630.       CALL DLABAD( UNFL, OVFL )

  631.       ULP = DLAMCH( 'Precision' )

  632.       ULPINV = ONE / ULP

  633.       RTULP = SQRT( ULP )

  634.       RTULPI = ONE / RTULP

  635. *

  636. *     Loop over sizes, types

  637. *

  638.       NERRS = 0

  639. *

  640.       DO 150 JSIZE = 1, NSIZES

  641.          N = NN( JSIZE )

  642.          IF( NSIZES.NE.1 ) THEN

  643.             MTYPES = MIN( MAXTYP, NTYPES )

  644.          ELSE

  645.             MTYPES = MIN( MAXTYP+1, NTYPES )

  646.          END IF

  647. *

  648.          DO 140 JTYPE = 1, MTYPES

  649.             IF( .NOT.DOTYPE( JTYPE ) )

  650.      $         GO TO 140

  651. *

  652. *           Save ISEED in case of an error.

  653. *

  654.             DO 20 J = 1, 4

  655.                IOLDSD( J ) = ISEED( J )

  656.    20       CONTINUE

  657. *

  658. *           Compute "A"

  659. *

  660. *           Control parameters:

  661. *

  662. *           KMAGN  KCONDS  KMODE        KTYPE

  663. *       =1  O(1)   1       clustered 1  zero

  664. *       =2  large  large   clustered 2  identity

  665. *       =3  small          exponential  Jordan

  666. *       =4                 arithmetic   diagonal, (w/ eigenvalues)

  667. *       =5                 random log   symmetric, w/ eigenvalues

  668. *       =6                 random       general, w/ eigenvalues

  669. *       =7                              random diagonal

  670. *       =8                              random symmetric

  671. *       =9                              random general

  672. *       =10                             random triangular

  673. *

  674.             IF( MTYPES.GT.MAXTYP )

  675.      $         GO TO 90

  676. *

  677.             ITYPE = KTYPE( JTYPE )

  678.             IMODE = KMODE( JTYPE )

  679. *

  680. *           Compute norm

  681. *

  682.             GO TO ( 30, 40, 50 )KMAGN( JTYPE )

  683. *

  684.    30       CONTINUE

  685.             ANORM = ONE

  686.             GO TO 60

  687. *

  688.    40       CONTINUE

  689.             ANORM = OVFL*ULP

  690.             GO TO 60

  691. *

  692.    50       CONTINUE

  693.             ANORM = UNFL*ULPINV

  694.             GO TO 60

  695. *

  696.    60       CONTINUE

  697. *

  698.             CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )

  699.             IINFO = 0

  700.             COND = ULPINV

  701. *

  702. *           Special Matrices -- Identity & Jordan block

  703. *

  704. *              Zero

  705. *

  706.             IF( ITYPE.EQ.1 ) THEN

  707.                IINFO = 0

  708. *

  709.             ELSE IF( ITYPE.EQ.2 ) THEN

  710. *

  711. *              Identity

  712. *

  713.                DO 70 JCOL = 1, N

  714.                   A( JCOL, JCOL ) = ANORM

  715.    70          CONTINUE

  716. *

  717.             ELSE IF( ITYPE.EQ.3 ) THEN

  718. *

  719. *              Jordan Block

  720. *

  721.                DO 80 JCOL = 1, N

  722.                   A( JCOL, JCOL ) = ANORM

  723.                   IF( JCOL.GT.1 )

  724.      $               A( JCOL, JCOL-1 ) = ONE

  725.    80          CONTINUE

  726. *

  727.             ELSE IF( ITYPE.EQ.4 ) THEN

  728. *

  729. *              Diagonal Matrix, [Eigen]values Specified

  730. *

  731.                CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,

  732.      $                      ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),

  733.      $                      IINFO )

  734. *

  735.             ELSE IF( ITYPE.EQ.5 ) THEN

  736. *

  737. *              Symmetric, eigenvalues specified

  738. *

  739.                CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,

  740.      $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),

  741.      $                      IINFO )

  742. *

  743.             ELSE IF( ITYPE.EQ.6 ) THEN

  744. *

  745. *              General, eigenvalues specified

  746. *

  747.                IF( KCONDS( JTYPE ).EQ.1 ) THEN

  748.                   CONDS = ONE

  749.                ELSE IF( KCONDS( JTYPE ).EQ.2 ) THEN

  750.                   CONDS = RTULPI

  751.                ELSE

  752.                   CONDS = ZERO

  753.                END IF

  754. *

  755.                CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE,

  756.      $                      'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM,

  757.      $                      A, LDA, WORK( 2*N+1 ), IINFO )

  758. *

  759.             ELSE IF( ITYPE.EQ.7 ) THEN

  760. *

  761. *              Diagonal, random eigenvalues

  762. *

  763.                CALL ZLATMR( N, N, 'D', ISEED, 'S', WORK, 6, ONE, CONE,

  764.      $                      'T', 'N', WORK( N+1 ), 1, ONE,

  765.      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,

  766.      $                      ZERO, ANORM, 'NO', A, LDA, IDUMMA, IINFO )

  767. *

  768.             ELSE IF( ITYPE.EQ.8 ) THEN

  769. *

  770. *              Symmetric, random eigenvalues

  771. *

  772.                CALL ZLATMR( N, N, 'D', ISEED, 'H', WORK, 6, ONE, CONE,

  773.      $                      'T', 'N', WORK( N+1 ), 1, ONE,

  774.      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,

  775.      $                      ZERO, ANORM, 'NO', A, LDA, IDUMMA, IINFO )

  776. *

  777.             ELSE IF( ITYPE.EQ.9 ) THEN

  778. *

  779. *              General, random eigenvalues

  780. *

  781.                CALL ZLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE,

  782.      $                      'T', 'N', WORK( N+1 ), 1, ONE,

  783.      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,

  784.      $                      ZERO, ANORM, 'NO', A, LDA, IDUMMA, IINFO )

  785.                IF( N.GE.4 ) THEN

  786.                   CALL ZLASET( 'Full', 2, N, CZERO, CZERO, A, LDA )

  787.                   CALL ZLASET( 'Full', N-3, 1, CZERO, CZERO, A( 3, 1 ),

  788.      $                         LDA )

  789.                   CALL ZLASET( 'Full', N-3, 2, CZERO, CZERO,

  790.      $                         A( 3, N-1 ), LDA )

  791.                   CALL ZLASET( 'Full', 1, N, CZERO, CZERO, A( N, 1 ),

  792.      $                         LDA )

  793.                END IF

  794. *

  795.             ELSE IF( ITYPE.EQ.10 ) THEN

  796. *

  797. *              Triangular, random eigenvalues

  798. *

  799.                CALL ZLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE,

  800.      $                      'T', 'N', WORK( N+1 ), 1, ONE,

  801.      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, 0,

  802.      $                      ZERO, ANORM, 'NO', A, LDA, IDUMMA, IINFO )

  803. *

  804.             ELSE

  805. *

  806.                IINFO = 1

  807.             END IF

  808. *

  809.             IF( IINFO.NE.0 ) THEN

  810.                WRITE( NOUNIT, FMT = 9992 )'Generator', IINFO, N, JTYPE,

  811.      $            IOLDSD

  812.                INFO = ABS( IINFO )

  813.                RETURN

  814.             END IF

  815. *

  816.    90       CONTINUE

  817. *

  818. *           Test for minimal and generous workspace

  819. *

  820.             DO 130 IWK = 1, 3

  821.                IF( IWK.EQ.1 ) THEN

  822.                   NNWORK = 2*N

  823.                ELSE IF( IWK.EQ.2 ) THEN

  824.                   NNWORK = 2*N + N**2

  825.                ELSE

  826.                   NNWORK = 6*N + 2*N**2

  827.                END IF

  828.                NNWORK = MAX( NNWORK, 1 )

  829. *

  830. *              Test for all balancing options

  831. *

  832.                DO 120 IBAL = 1, 4

  833.                   BALANC = BAL( IBAL )

  834. *

  835. *                 Perform tests

  836. *

  837.                   CALL ZGET23( .FALSE., 0, BALANC, JTYPE, THRESH,

  838.      $                         IOLDSD, NOUNIT, N, A, LDA, H, W, W1, VL,

  839.      $                         LDVL, VR, LDVR, LRE, LDLRE, RCONDV,

  840.      $                         RCNDV1, RCDVIN, RCONDE, RCNDE1, RCDEIN,

  841.      $                         SCALE, SCALE1, RESULT, WORK, NNWORK,

  842.      $                         RWORK, INFO )

  843. *

  844. *                 Check for RESULT(j) > THRESH

  845. *

  846.                   NTEST = 0

  847.                   NFAIL = 0

  848.                   DO 100 J = 1, 9

  849.                      IF( RESULT( J ).GE.ZERO )

  850.      $                  NTEST = NTEST + 1

  851.                      IF( RESULT( J ).GE.THRESH )

  852.      $                  NFAIL = NFAIL + 1

  853.   100             CONTINUE

  854. *

  855.                   IF( NFAIL.GT.0 )

  856.      $               NTESTF = NTESTF + 1

  857.                   IF( NTESTF.EQ.1 ) THEN

  858.                      WRITE( NOUNIT, FMT = 9999 )PATH

  859.                      WRITE( NOUNIT, FMT = 9998 )

  860.                      WRITE( NOUNIT, FMT = 9997 )

  861.                      WRITE( NOUNIT, FMT = 9996 )

  862.                      WRITE( NOUNIT, FMT = 9995 )THRESH

  863.                      NTESTF = 2

  864.                   END IF

  865. *

  866.                   DO 110 J = 1, 9

  867.                      IF( RESULT( J ).GE.THRESH ) THEN

  868.                         WRITE( NOUNIT, FMT = 9994 )BALANC, N, IWK,

  869.      $                     IOLDSD, JTYPE, J, RESULT( J )

  870.                      END IF

  871.   110             CONTINUE

  872. *

  873.                   NERRS = NERRS + NFAIL

  874.                   NTESTT = NTESTT + NTEST

  875. *

  876.   120          CONTINUE

  877.   130       CONTINUE

  878.   140    CONTINUE

  879.   150 CONTINUE

  880. *

  881.   160 CONTINUE

  882. *

  883. *     Read in data from file to check accuracy of condition estimation.

  884. *     Assume input eigenvalues are sorted lexicographically (increasing

  885. *     by real part, then decreasing by imaginary part)

  886. *

  887.       JTYPE = 0

  888.   170 CONTINUE

  889.       READ( NIUNIT, FMT = *, END = 220 )N, ISRT

  890. *

  891. *     Read input data until N=0

  892. *

  893.       IF( N.EQ.0 )

  894.      $   GO TO 220

  895.       JTYPE = JTYPE + 1

  896.       ISEED( 1 ) = JTYPE

  897.       DO 180 I = 1, N

  898.          READ( NIUNIT, FMT = * )( A( I, J ), J = 1, N )

  899.   180 CONTINUE

  900.       DO 190 I = 1, N

  901.          READ( NIUNIT, FMT = * )WR, WI, RCDEIN( I ), RCDVIN( I )

  902.          W1( I ) = DCMPLX( WR, WI )

  903.   190 CONTINUE

  904.       CALL ZGET23( .TRUE., ISRT, 'N', 22, THRESH, ISEED, NOUNIT, N, A,

  905.      $             LDA, H, W, W1, VL, LDVL, VR, LDVR, LRE, LDLRE,

  906.      $             RCONDV, RCNDV1, RCDVIN, RCONDE, RCNDE1, RCDEIN,

  907.      $             SCALE, SCALE1, RESULT, WORK, 6*N+2*N**2, RWORK,

  908.      $             INFO )

  909. *

  910. *     Check for RESULT(j) > THRESH

  911. *

  912.       NTEST = 0

  913.       NFAIL = 0

  914.       DO 200 J = 1, 11

  915.          IF( RESULT( J ).GE.ZERO )

  916.      $      NTEST = NTEST + 1

  917.          IF( RESULT( J ).GE.THRESH )

  918.      $      NFAIL = NFAIL + 1

  919.   200 CONTINUE

  920. *

  921.       IF( NFAIL.GT.0 )

  922.      $   NTESTF = NTESTF + 1

  923.       IF( NTESTF.EQ.1 ) THEN

  924.          WRITE( NOUNIT, FMT = 9999 )PATH

  925.          WRITE( NOUNIT, FMT = 9998 )

  926.          WRITE( NOUNIT, FMT = 9997 )

  927.          WRITE( NOUNIT, FMT = 9996 )

  928.          WRITE( NOUNIT, FMT = 9995 )THRESH

  929.          NTESTF = 2

  930.       END IF

  931. *

  932.       DO 210 J = 1, 11

  933.          IF( RESULT( J ).GE.THRESH ) THEN

  934.             WRITE( NOUNIT, FMT = 9993 )N, JTYPE, J, RESULT( J )

  935.          END IF

  936.   210 CONTINUE

  937. *

  938.       NERRS = NERRS + NFAIL

  939.       NTESTT = NTESTT + NTEST

  940.       GO TO 170

  941.   220 CONTINUE

  942. *

  943. *     Summary

  944. *

  945.       CALL DLASUM( PATH, NOUNIT, NERRS, NTESTT )

  946. *

  947.  9999 FORMAT( / 1X, A3, ' -- Complex Eigenvalue-Eigenvector ',

  948.      $      'Decomposition Expert Driver',

  949.      $      / ' Matrix types (see ZDRVVX for details): ' )

  950. *

  951.  9998 FORMAT( / ' Special Matrices:', / '  1=Zero matrix.             ',

  952.      $      '           ', '  5=Diagonal: geometr. spaced entries.',

  953.      $      / '  2=Identity matrix.                    ', '  6=Diagona',

  954.      $      'l: clustered entries.', / '  3=Transposed Jordan block.  ',

  955.      $      '          ', '  7=Diagonal: large, evenly spaced.', / '  ',

  956.      $      '4=Diagonal: evenly spaced entries.    ', '  8=Diagonal: s',

  957.      $      'mall, evenly spaced.' )

  958.  9997 FORMAT( ' Dense, Non-Symmetric Matrices:', / '  9=Well-cond., ev',

  959.      $      'enly spaced eigenvals.', ' 14=Ill-cond., geomet. spaced e',

  960.      $      'igenals.', / ' 10=Well-cond., geom. spaced eigenvals. ',

  961.      $      ' 15=Ill-conditioned, clustered e.vals.', / ' 11=Well-cond',

  962.      $      'itioned, clustered e.vals. ', ' 16=Ill-cond., random comp',

  963.      $      'lex ', / ' 12=Well-cond., random complex ', '         ',

  964.      $      ' 17=Ill-cond., large rand. complx ', / ' 13=Ill-condi',

  965.      $      'tioned, evenly spaced.     ', ' 18=Ill-cond., small rand.',

  966.      $      ' complx ' )

  967.  9996 FORMAT( ' 19=Matrix with random O(1) entries.    ', ' 21=Matrix ',

  968.      $      'with small random entries.', / ' 20=Matrix with large ran',

  969.      $      'dom entries.   ', ' 22=Matrix read from input file', / )

  970.  9995 FORMAT( ' Tests performed with test threshold =', F8.2,

  971.      $      / / ' 1 = | A VR - VR W | / ( n |A| ulp ) ',

  972.      $      / ' 2 = | transpose(A) VL - VL W | / ( n |A| ulp ) ',

  973.      $      / ' 3 = | |VR(i)| - 1 | / ulp ',

  974.      $      / ' 4 = | |VL(i)| - 1 | / ulp ',

  975.      $      / ' 5 = 0 if W same no matter if VR or VL computed,',

  976.      $      ' 1/ulp otherwise', /

  977.      $      ' 6 = 0 if VR same no matter what else computed,',

  978.      $      '  1/ulp otherwise', /

  979.      $      ' 7 = 0 if VL same no matter what else computed,',

  980.      $      '  1/ulp otherwise', /

  981.      $      ' 8 = 0 if RCONDV same no matter what else computed,',

  982.      $      '  1/ulp otherwise', /

  983.      $      ' 9 = 0 if SCALE, ILO, IHI, ABNRM same no matter what else',

  984.      $      ' computed,  1/ulp otherwise',

  985.      $      / ' 10 = | RCONDV - RCONDV(precomputed) | / cond(RCONDV),',

  986.      $      / ' 11 = | RCONDE - RCONDE(precomputed) | / cond(RCONDE),' )

  987.  9994 FORMAT( ' BALANC=''', A1, ''',N=', I4, ',IWK=', I1, ', seed=',

  988.      $      4( I4, ',' ), ' type ', I2, ', test(', I2, ')=', G10.3 )

  989.  9993 FORMAT( ' N=', I5, ', input example =', I3, ',  test(', I2, ')=',

  990.      $      G10.3 )

  991.  9992 FORMAT( ' ZDRVVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',

  992.      $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )

  993. *

  994.       RETURN

  995. *

  996. *     End of ZDRVVX

  997. *

  998.       END