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: d6d7a6685d
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from 'd6d7a6685d'
${ noResults }
OpenBLAS/lapack-netlib/TESTING/EIG/cdrvev.f

954 lines
33 kB
Raw Blame History 

  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 December 2016

  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.7.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. *     December 2016

  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