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.

cget23.f 27 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861
  1. *> \brief \b CGET23
  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 CGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED,
  12. * NOUNIT, N, A, LDA, H, W, W1, VL, LDVL, VR,
  13. * LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,
  14. * RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,
  15. * WORK, LWORK, RWORK, INFO )
  16. *
  17. * .. Scalar Arguments ..
  18. * LOGICAL COMP
  19. * CHARACTER BALANC
  20. * INTEGER INFO, ISRT, JTYPE, LDA, LDLRE, LDVL, LDVR,
  21. * $ LWORK, N, NOUNIT
  22. * REAL THRESH
  23. * ..
  24. * .. Array Arguments ..
  25. * INTEGER ISEED( 4 )
  26. * REAL RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),
  27. * $ RCNDV1( * ), RCONDE( * ), RCONDV( * ),
  28. * $ RESULT( 11 ), RWORK( * ), SCALE( * ),
  29. * $ SCALE1( * )
  30. * COMPLEX A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
  31. * $ VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
  32. * $ WORK( * )
  33. * ..
  34. *
  35. *
  36. *> \par Purpose:
  37. * =============
  38. *>
  39. *> \verbatim
  40. *>
  41. *> CGET23 checks the nonsymmetric eigenvalue problem driver CGEEVX.
  42. *> If COMP = .FALSE., the first 8 of the following tests will be
  43. *> performed on the input matrix A, and also test 9 if LWORK is
  44. *> sufficiently large.
  45. *> if COMP is .TRUE. all 11 tests will be performed.
  46. *>
  47. *> (1) | A * VR - VR * W | / ( n |A| ulp )
  48. *>
  49. *> Here VR is the matrix of unit right eigenvectors.
  50. *> W is a diagonal matrix with diagonal entries W(j).
  51. *>
  52. *> (2) | A**H * VL - VL * W**H | / ( n |A| ulp )
  53. *>
  54. *> Here VL is the matrix of unit left eigenvectors, A**H is the
  55. *> conjugate transpose of A, and W is as above.
  56. *>
  57. *> (3) | |VR(i)| - 1 | / ulp and largest component real
  58. *>
  59. *> VR(i) denotes the i-th column of VR.
  60. *>
  61. *> (4) | |VL(i)| - 1 | / ulp and largest component real
  62. *>
  63. *> VL(i) denotes the i-th column of VL.
  64. *>
  65. *> (5) 0 if W(full) = W(partial), 1/ulp otherwise
  66. *>
  67. *> W(full) denotes the eigenvalues computed when VR, VL, RCONDV
  68. *> and RCONDE are also computed, and W(partial) denotes the
  69. *> eigenvalues computed when only some of VR, VL, RCONDV, and
  70. *> RCONDE are computed.
  71. *>
  72. *> (6) 0 if VR(full) = VR(partial), 1/ulp otherwise
  73. *>
  74. *> VR(full) denotes the right eigenvectors computed when VL, RCONDV
  75. *> and RCONDE are computed, and VR(partial) denotes the result
  76. *> when only some of VL and RCONDV are computed.
  77. *>
  78. *> (7) 0 if VL(full) = VL(partial), 1/ulp otherwise
  79. *>
  80. *> VL(full) denotes the left eigenvectors computed when VR, RCONDV
  81. *> and RCONDE are computed, and VL(partial) denotes the result
  82. *> when only some of VR and RCONDV are computed.
  83. *>
  84. *> (8) 0 if SCALE, ILO, IHI, ABNRM (full) =
  85. *> SCALE, ILO, IHI, ABNRM (partial)
  86. *> 1/ulp otherwise
  87. *>
  88. *> SCALE, ILO, IHI and ABNRM describe how the matrix is balanced.
  89. *> (full) is when VR, VL, RCONDE and RCONDV are also computed, and
  90. *> (partial) is when some are not computed.
  91. *>
  92. *> (9) 0 if RCONDV(full) = RCONDV(partial), 1/ulp otherwise
  93. *>
  94. *> RCONDV(full) denotes the reciprocal condition numbers of the
  95. *> right eigenvectors computed when VR, VL and RCONDE are also
  96. *> computed. RCONDV(partial) denotes the reciprocal condition
  97. *> numbers when only some of VR, VL and RCONDE are computed.
  98. *>
  99. *> (10) |RCONDV - RCDVIN| / cond(RCONDV)
  100. *>
  101. *> RCONDV is the reciprocal right eigenvector condition number
  102. *> computed by CGEEVX and RCDVIN (the precomputed true value)
  103. *> is supplied as input. cond(RCONDV) is the condition number of
  104. *> RCONDV, and takes errors in computing RCONDV into account, so
  105. *> that the resulting quantity should be O(ULP). cond(RCONDV) is
  106. *> essentially given by norm(A)/RCONDE.
  107. *>
  108. *> (11) |RCONDE - RCDEIN| / cond(RCONDE)
  109. *>
  110. *> RCONDE is the reciprocal eigenvalue condition number
  111. *> computed by CGEEVX and RCDEIN (the precomputed true value)
  112. *> is supplied as input. cond(RCONDE) is the condition number
  113. *> of RCONDE, and takes errors in computing RCONDE into account,
  114. *> so that the resulting quantity should be O(ULP). cond(RCONDE)
  115. *> is essentially given by norm(A)/RCONDV.
  116. *> \endverbatim
  117. *
  118. * Arguments:
  119. * ==========
  120. *
  121. *> \param[in] COMP
  122. *> \verbatim
  123. *> COMP is LOGICAL
  124. *> COMP describes which input tests to perform:
  125. *> = .FALSE. if the computed condition numbers are not to
  126. *> be tested against RCDVIN and RCDEIN
  127. *> = .TRUE. if they are to be compared
  128. *> \endverbatim
  129. *>
  130. *> \param[in] ISRT
  131. *> \verbatim
  132. *> ISRT is INTEGER
  133. *> If COMP = .TRUE., ISRT indicates in how the eigenvalues
  134. *> corresponding to values in RCDVIN and RCDEIN are ordered:
  135. *> = 0 means the eigenvalues are sorted by
  136. *> increasing real part
  137. *> = 1 means the eigenvalues are sorted by
  138. *> increasing imaginary part
  139. *> If COMP = .FALSE., ISRT is not referenced.
  140. *> \endverbatim
  141. *>
  142. *> \param[in] BALANC
  143. *> \verbatim
  144. *> BALANC is CHARACTER
  145. *> Describes the balancing option to be tested.
  146. *> = 'N' for no permuting or diagonal scaling
  147. *> = 'P' for permuting but no diagonal scaling
  148. *> = 'S' for no permuting but diagonal scaling
  149. *> = 'B' for permuting and diagonal scaling
  150. *> \endverbatim
  151. *>
  152. *> \param[in] JTYPE
  153. *> \verbatim
  154. *> JTYPE is INTEGER
  155. *> Type of input matrix. Used to label output if error occurs.
  156. *> \endverbatim
  157. *>
  158. *> \param[in] THRESH
  159. *> \verbatim
  160. *> THRESH is REAL
  161. *> A test will count as "failed" if the "error", computed as
  162. *> described above, exceeds THRESH. Note that the error
  163. *> is scaled to be O(1), so THRESH should be a reasonably
  164. *> small multiple of 1, e.g., 10 or 100. In particular,
  165. *> it should not depend on the precision (single vs. double)
  166. *> or the size of the matrix. It must be at least zero.
  167. *> \endverbatim
  168. *>
  169. *> \param[in] ISEED
  170. *> \verbatim
  171. *> ISEED is INTEGER array, dimension (4)
  172. *> If COMP = .FALSE., the random number generator seed
  173. *> used to produce matrix.
  174. *> If COMP = .TRUE., ISEED(1) = the number of the example.
  175. *> Used to label output if error occurs.
  176. *> \endverbatim
  177. *>
  178. *> \param[in] NOUNIT
  179. *> \verbatim
  180. *> NOUNIT is INTEGER
  181. *> The FORTRAN unit number for printing out error messages
  182. *> (e.g., if a routine returns INFO not equal to 0.)
  183. *> \endverbatim
  184. *>
  185. *> \param[in] N
  186. *> \verbatim
  187. *> N is INTEGER
  188. *> The dimension of A. N must be at least 0.
  189. *> \endverbatim
  190. *>
  191. *> \param[in,out] A
  192. *> \verbatim
  193. *> A is COMPLEX array, dimension (LDA,N)
  194. *> Used to hold the matrix whose eigenvalues are to be
  195. *> computed.
  196. *> \endverbatim
  197. *>
  198. *> \param[in] LDA
  199. *> \verbatim
  200. *> LDA is INTEGER
  201. *> The leading dimension of A, and H. LDA must be at
  202. *> least 1 and at least N.
  203. *> \endverbatim
  204. *>
  205. *> \param[out] H
  206. *> \verbatim
  207. *> H is COMPLEX array, dimension (LDA,N)
  208. *> Another copy of the test matrix A, modified by CGEEVX.
  209. *> \endverbatim
  210. *>
  211. *> \param[out] W
  212. *> \verbatim
  213. *> W is COMPLEX array, dimension (N)
  214. *> Contains the eigenvalues of A.
  215. *> \endverbatim
  216. *>
  217. *> \param[out] W1
  218. *> \verbatim
  219. *> W1 is COMPLEX array, dimension (N)
  220. *> Like W, this array contains the eigenvalues of A,
  221. *> but those computed when CGEEVX only computes a partial
  222. *> eigendecomposition, i.e. not the eigenvalues and left
  223. *> and right eigenvectors.
  224. *> \endverbatim
  225. *>
  226. *> \param[out] VL
  227. *> \verbatim
  228. *> VL is COMPLEX array, dimension (LDVL,N)
  229. *> VL holds the computed left eigenvectors.
  230. *> \endverbatim
  231. *>
  232. *> \param[in] LDVL
  233. *> \verbatim
  234. *> LDVL is INTEGER
  235. *> Leading dimension of VL. Must be at least max(1,N).
  236. *> \endverbatim
  237. *>
  238. *> \param[out] VR
  239. *> \verbatim
  240. *> VR is COMPLEX array, dimension (LDVR,N)
  241. *> VR holds the computed right eigenvectors.
  242. *> \endverbatim
  243. *>
  244. *> \param[in] LDVR
  245. *> \verbatim
  246. *> LDVR is INTEGER
  247. *> Leading dimension of VR. Must be at least max(1,N).
  248. *> \endverbatim
  249. *>
  250. *> \param[out] LRE
  251. *> \verbatim
  252. *> LRE is COMPLEX array, dimension (LDLRE,N)
  253. *> LRE holds the computed right or left eigenvectors.
  254. *> \endverbatim
  255. *>
  256. *> \param[in] LDLRE
  257. *> \verbatim
  258. *> LDLRE is INTEGER
  259. *> Leading dimension of LRE. Must be at least max(1,N).
  260. *> \endverbatim
  261. *>
  262. *> \param[out] RCONDV
  263. *> \verbatim
  264. *> RCONDV is REAL array, dimension (N)
  265. *> RCONDV holds the computed reciprocal condition numbers
  266. *> for eigenvectors.
  267. *> \endverbatim
  268. *>
  269. *> \param[out] RCNDV1
  270. *> \verbatim
  271. *> RCNDV1 is REAL array, dimension (N)
  272. *> RCNDV1 holds more computed reciprocal condition numbers
  273. *> for eigenvectors.
  274. *> \endverbatim
  275. *>
  276. *> \param[in] RCDVIN
  277. *> \verbatim
  278. *> RCDVIN is REAL array, dimension (N)
  279. *> When COMP = .TRUE. RCDVIN holds the precomputed reciprocal
  280. *> condition numbers for eigenvectors to be compared with
  281. *> RCONDV.
  282. *> \endverbatim
  283. *>
  284. *> \param[out] RCONDE
  285. *> \verbatim
  286. *> RCONDE is REAL array, dimension (N)
  287. *> RCONDE holds the computed reciprocal condition numbers
  288. *> for eigenvalues.
  289. *> \endverbatim
  290. *>
  291. *> \param[out] RCNDE1
  292. *> \verbatim
  293. *> RCNDE1 is REAL array, dimension (N)
  294. *> RCNDE1 holds more computed reciprocal condition numbers
  295. *> for eigenvalues.
  296. *> \endverbatim
  297. *>
  298. *> \param[in] RCDEIN
  299. *> \verbatim
  300. *> RCDEIN is REAL array, dimension (N)
  301. *> When COMP = .TRUE. RCDEIN holds the precomputed reciprocal
  302. *> condition numbers for eigenvalues to be compared with
  303. *> RCONDE.
  304. *> \endverbatim
  305. *>
  306. *> \param[out] SCALE
  307. *> \verbatim
  308. *> SCALE is REAL array, dimension (N)
  309. *> Holds information describing balancing of matrix.
  310. *> \endverbatim
  311. *>
  312. *> \param[out] SCALE1
  313. *> \verbatim
  314. *> SCALE1 is REAL array, dimension (N)
  315. *> Holds information describing balancing of matrix.
  316. *> \endverbatim
  317. *>
  318. *> \param[out] RESULT
  319. *> \verbatim
  320. *> RESULT is REAL array, dimension (11)
  321. *> The values computed by the 11 tests described above.
  322. *> The values are currently limited to 1/ulp, to avoid
  323. *> overflow.
  324. *> \endverbatim
  325. *>
  326. *> \param[out] WORK
  327. *> \verbatim
  328. *> WORK is COMPLEX array, dimension (LWORK)
  329. *> \endverbatim
  330. *>
  331. *> \param[in] LWORK
  332. *> \verbatim
  333. *> LWORK is INTEGER
  334. *> The number of entries in WORK. This must be at least
  335. *> 2*N, and 2*N+N**2 if tests 9, 10 or 11 are to be performed.
  336. *> \endverbatim
  337. *>
  338. *> \param[out] RWORK
  339. *> \verbatim
  340. *> RWORK is REAL array, dimension (2*N)
  341. *> \endverbatim
  342. *>
  343. *> \param[out] INFO
  344. *> \verbatim
  345. *> INFO is INTEGER
  346. *> If 0, successful exit.
  347. *> If <0, input parameter -INFO had an incorrect value.
  348. *> If >0, CGEEVX returned an error code, the absolute
  349. *> value of which is returned.
  350. *> \endverbatim
  351. *
  352. * Authors:
  353. * ========
  354. *
  355. *> \author Univ. of Tennessee
  356. *> \author Univ. of California Berkeley
  357. *> \author Univ. of Colorado Denver
  358. *> \author NAG Ltd.
  359. *
  360. *> \date December 2016
  361. *
  362. *> \ingroup complex_eig
  363. *
  364. * =====================================================================
  365. SUBROUTINE CGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED,
  366. $ NOUNIT, N, A, LDA, H, W, W1, VL, LDVL, VR,
  367. $ LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,
  368. $ RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,
  369. $ WORK, LWORK, RWORK, INFO )
  370. *
  371. * -- LAPACK test routine (version 3.7.0) --
  372. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  373. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  374. * December 2016
  375. *
  376. * .. Scalar Arguments ..
  377. LOGICAL COMP
  378. CHARACTER BALANC
  379. INTEGER INFO, ISRT, JTYPE, LDA, LDLRE, LDVL, LDVR,
  380. $ LWORK, N, NOUNIT
  381. REAL THRESH
  382. * ..
  383. * .. Array Arguments ..
  384. INTEGER ISEED( 4 )
  385. REAL RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),
  386. $ RCNDV1( * ), RCONDE( * ), RCONDV( * ),
  387. $ RESULT( 11 ), RWORK( * ), SCALE( * ),
  388. $ SCALE1( * )
  389. COMPLEX A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
  390. $ VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
  391. $ WORK( * )
  392. * ..
  393. *
  394. * =====================================================================
  395. *
  396. * .. Parameters ..
  397. REAL ZERO, ONE, TWO
  398. PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
  399. REAL EPSIN
  400. PARAMETER ( EPSIN = 5.9605E-8 )
  401. * ..
  402. * .. Local Scalars ..
  403. LOGICAL BALOK, NOBAL
  404. CHARACTER SENSE
  405. INTEGER I, IHI, IHI1, IINFO, ILO, ILO1, ISENS, ISENSM,
  406. $ J, JJ, KMIN
  407. REAL ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN,
  408. $ ULP, ULPINV, V, VMAX, VMX, VRICMP, VRIMIN,
  409. $ VRMX, VTST
  410. COMPLEX CTMP
  411. * ..
  412. * .. Local Arrays ..
  413. CHARACTER SENS( 2 )
  414. REAL RES( 2 )
  415. COMPLEX CDUM( 1 )
  416. * ..
  417. * .. External Functions ..
  418. LOGICAL LSAME
  419. REAL SCNRM2, SLAMCH
  420. EXTERNAL LSAME, SCNRM2, SLAMCH
  421. * ..
  422. * .. External Subroutines ..
  423. EXTERNAL CGEEVX, CGET22, CLACPY, XERBLA
  424. * ..
  425. * .. Intrinsic Functions ..
  426. INTRINSIC ABS, AIMAG, MAX, MIN, REAL
  427. * ..
  428. * .. Data statements ..
  429. DATA SENS / 'N', 'V' /
  430. * ..
  431. * .. Executable Statements ..
  432. *
  433. * Check for errors
  434. *
  435. NOBAL = LSAME( BALANC, 'N' )
  436. BALOK = NOBAL .OR. LSAME( BALANC, 'P' ) .OR.
  437. $ LSAME( BALANC, 'S' ) .OR. LSAME( BALANC, 'B' )
  438. INFO = 0
  439. IF( ISRT.NE.0 .AND. ISRT.NE.1 ) THEN
  440. INFO = -2
  441. ELSE IF( .NOT.BALOK ) THEN
  442. INFO = -3
  443. ELSE IF( THRESH.LT.ZERO ) THEN
  444. INFO = -5
  445. ELSE IF( NOUNIT.LE.0 ) THEN
  446. INFO = -7
  447. ELSE IF( N.LT.0 ) THEN
  448. INFO = -8
  449. ELSE IF( LDA.LT.1 .OR. LDA.LT.N ) THEN
  450. INFO = -10
  451. ELSE IF( LDVL.LT.1 .OR. LDVL.LT.N ) THEN
  452. INFO = -15
  453. ELSE IF( LDVR.LT.1 .OR. LDVR.LT.N ) THEN
  454. INFO = -17
  455. ELSE IF( LDLRE.LT.1 .OR. LDLRE.LT.N ) THEN
  456. INFO = -19
  457. ELSE IF( LWORK.LT.2*N .OR. ( COMP .AND. LWORK.LT.2*N+N*N ) ) THEN
  458. INFO = -30
  459. END IF
  460. *
  461. IF( INFO.NE.0 ) THEN
  462. CALL XERBLA( 'CGET23', -INFO )
  463. RETURN
  464. END IF
  465. *
  466. * Quick return if nothing to do
  467. *
  468. DO 10 I = 1, 11
  469. RESULT( I ) = -ONE
  470. 10 CONTINUE
  471. *
  472. IF( N.EQ.0 )
  473. $ RETURN
  474. *
  475. * More Important constants
  476. *
  477. ULP = SLAMCH( 'Precision' )
  478. SMLNUM = SLAMCH( 'S' )
  479. ULPINV = ONE / ULP
  480. *
  481. * Compute eigenvalues and eigenvectors, and test them
  482. *
  483. IF( LWORK.GE.2*N+N*N ) THEN
  484. SENSE = 'B'
  485. ISENSM = 2
  486. ELSE
  487. SENSE = 'E'
  488. ISENSM = 1
  489. END IF
  490. CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
  491. CALL CGEEVX( BALANC, 'V', 'V', SENSE, N, H, LDA, W, VL, LDVL, VR,
  492. $ LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK,
  493. $ LWORK, RWORK, IINFO )
  494. IF( IINFO.NE.0 ) THEN
  495. RESULT( 1 ) = ULPINV
  496. IF( JTYPE.NE.22 ) THEN
  497. WRITE( NOUNIT, FMT = 9998 )'CGEEVX1', IINFO, N, JTYPE,
  498. $ BALANC, ISEED
  499. ELSE
  500. WRITE( NOUNIT, FMT = 9999 )'CGEEVX1', IINFO, N, ISEED( 1 )
  501. END IF
  502. INFO = ABS( IINFO )
  503. RETURN
  504. END IF
  505. *
  506. * Do Test (1)
  507. *
  508. CALL CGET22( 'N', 'N', 'N', N, A, LDA, VR, LDVR, W, WORK, RWORK,
  509. $ RES )
  510. RESULT( 1 ) = RES( 1 )
  511. *
  512. * Do Test (2)
  513. *
  514. CALL CGET22( 'C', 'N', 'C', N, A, LDA, VL, LDVL, W, WORK, RWORK,
  515. $ RES )
  516. RESULT( 2 ) = RES( 1 )
  517. *
  518. * Do Test (3)
  519. *
  520. DO 30 J = 1, N
  521. TNRM = SCNRM2( N, VR( 1, J ), 1 )
  522. RESULT( 3 ) = MAX( RESULT( 3 ),
  523. $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
  524. VMX = ZERO
  525. VRMX = ZERO
  526. DO 20 JJ = 1, N
  527. VTST = ABS( VR( JJ, J ) )
  528. IF( VTST.GT.VMX )
  529. $ VMX = VTST
  530. IF( AIMAG( VR( JJ, J ) ).EQ.ZERO .AND.
  531. $ ABS( REAL( VR( JJ, J ) ) ).GT.VRMX )
  532. $ VRMX = ABS( REAL( VR( JJ, J ) ) )
  533. 20 CONTINUE
  534. IF( VRMX / VMX.LT.ONE-TWO*ULP )
  535. $ RESULT( 3 ) = ULPINV
  536. 30 CONTINUE
  537. *
  538. * Do Test (4)
  539. *
  540. DO 50 J = 1, N
  541. TNRM = SCNRM2( N, VL( 1, J ), 1 )
  542. RESULT( 4 ) = MAX( RESULT( 4 ),
  543. $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
  544. VMX = ZERO
  545. VRMX = ZERO
  546. DO 40 JJ = 1, N
  547. VTST = ABS( VL( JJ, J ) )
  548. IF( VTST.GT.VMX )
  549. $ VMX = VTST
  550. IF( AIMAG( VL( JJ, J ) ).EQ.ZERO .AND.
  551. $ ABS( REAL( VL( JJ, J ) ) ).GT.VRMX )
  552. $ VRMX = ABS( REAL( VL( JJ, J ) ) )
  553. 40 CONTINUE
  554. IF( VRMX / VMX.LT.ONE-TWO*ULP )
  555. $ RESULT( 4 ) = ULPINV
  556. 50 CONTINUE
  557. *
  558. * Test for all options of computing condition numbers
  559. *
  560. DO 200 ISENS = 1, ISENSM
  561. *
  562. SENSE = SENS( ISENS )
  563. *
  564. * Compute eigenvalues only, and test them
  565. *
  566. CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
  567. CALL CGEEVX( BALANC, 'N', 'N', SENSE, N, H, LDA, W1, CDUM, 1,
  568. $ CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1,
  569. $ RCNDV1, WORK, LWORK, RWORK, IINFO )
  570. IF( IINFO.NE.0 ) THEN
  571. RESULT( 1 ) = ULPINV
  572. IF( JTYPE.NE.22 ) THEN
  573. WRITE( NOUNIT, FMT = 9998 )'CGEEVX2', IINFO, N, JTYPE,
  574. $ BALANC, ISEED
  575. ELSE
  576. WRITE( NOUNIT, FMT = 9999 )'CGEEVX2', IINFO, N,
  577. $ ISEED( 1 )
  578. END IF
  579. INFO = ABS( IINFO )
  580. GO TO 190
  581. END IF
  582. *
  583. * Do Test (5)
  584. *
  585. DO 60 J = 1, N
  586. IF( W( J ).NE.W1( J ) )
  587. $ RESULT( 5 ) = ULPINV
  588. 60 CONTINUE
  589. *
  590. * Do Test (8)
  591. *
  592. IF( .NOT.NOBAL ) THEN
  593. DO 70 J = 1, N
  594. IF( SCALE( J ).NE.SCALE1( J ) )
  595. $ RESULT( 8 ) = ULPINV
  596. 70 CONTINUE
  597. IF( ILO.NE.ILO1 )
  598. $ RESULT( 8 ) = ULPINV
  599. IF( IHI.NE.IHI1 )
  600. $ RESULT( 8 ) = ULPINV
  601. IF( ABNRM.NE.ABNRM1 )
  602. $ RESULT( 8 ) = ULPINV
  603. END IF
  604. *
  605. * Do Test (9)
  606. *
  607. IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
  608. DO 80 J = 1, N
  609. IF( RCONDV( J ).NE.RCNDV1( J ) )
  610. $ RESULT( 9 ) = ULPINV
  611. 80 CONTINUE
  612. END IF
  613. *
  614. * Compute eigenvalues and right eigenvectors, and test them
  615. *
  616. CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
  617. CALL CGEEVX( BALANC, 'N', 'V', SENSE, N, H, LDA, W1, CDUM, 1,
  618. $ LRE, LDLRE, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1,
  619. $ RCNDV1, WORK, LWORK, RWORK, IINFO )
  620. IF( IINFO.NE.0 ) THEN
  621. RESULT( 1 ) = ULPINV
  622. IF( JTYPE.NE.22 ) THEN
  623. WRITE( NOUNIT, FMT = 9998 )'CGEEVX3', IINFO, N, JTYPE,
  624. $ BALANC, ISEED
  625. ELSE
  626. WRITE( NOUNIT, FMT = 9999 )'CGEEVX3', IINFO, N,
  627. $ ISEED( 1 )
  628. END IF
  629. INFO = ABS( IINFO )
  630. GO TO 190
  631. END IF
  632. *
  633. * Do Test (5) again
  634. *
  635. DO 90 J = 1, N
  636. IF( W( J ).NE.W1( J ) )
  637. $ RESULT( 5 ) = ULPINV
  638. 90 CONTINUE
  639. *
  640. * Do Test (6)
  641. *
  642. DO 110 J = 1, N
  643. DO 100 JJ = 1, N
  644. IF( VR( J, JJ ).NE.LRE( J, JJ ) )
  645. $ RESULT( 6 ) = ULPINV
  646. 100 CONTINUE
  647. 110 CONTINUE
  648. *
  649. * Do Test (8) again
  650. *
  651. IF( .NOT.NOBAL ) THEN
  652. DO 120 J = 1, N
  653. IF( SCALE( J ).NE.SCALE1( J ) )
  654. $ RESULT( 8 ) = ULPINV
  655. 120 CONTINUE
  656. IF( ILO.NE.ILO1 )
  657. $ RESULT( 8 ) = ULPINV
  658. IF( IHI.NE.IHI1 )
  659. $ RESULT( 8 ) = ULPINV
  660. IF( ABNRM.NE.ABNRM1 )
  661. $ RESULT( 8 ) = ULPINV
  662. END IF
  663. *
  664. * Do Test (9) again
  665. *
  666. IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
  667. DO 130 J = 1, N
  668. IF( RCONDV( J ).NE.RCNDV1( J ) )
  669. $ RESULT( 9 ) = ULPINV
  670. 130 CONTINUE
  671. END IF
  672. *
  673. * Compute eigenvalues and left eigenvectors, and test them
  674. *
  675. CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
  676. CALL CGEEVX( BALANC, 'V', 'N', SENSE, N, H, LDA, W1, LRE,
  677. $ LDLRE, CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1,
  678. $ RCNDE1, RCNDV1, WORK, LWORK, RWORK, IINFO )
  679. IF( IINFO.NE.0 ) THEN
  680. RESULT( 1 ) = ULPINV
  681. IF( JTYPE.NE.22 ) THEN
  682. WRITE( NOUNIT, FMT = 9998 )'CGEEVX4', IINFO, N, JTYPE,
  683. $ BALANC, ISEED
  684. ELSE
  685. WRITE( NOUNIT, FMT = 9999 )'CGEEVX4', IINFO, N,
  686. $ ISEED( 1 )
  687. END IF
  688. INFO = ABS( IINFO )
  689. GO TO 190
  690. END IF
  691. *
  692. * Do Test (5) again
  693. *
  694. DO 140 J = 1, N
  695. IF( W( J ).NE.W1( J ) )
  696. $ RESULT( 5 ) = ULPINV
  697. 140 CONTINUE
  698. *
  699. * Do Test (7)
  700. *
  701. DO 160 J = 1, N
  702. DO 150 JJ = 1, N
  703. IF( VL( J, JJ ).NE.LRE( J, JJ ) )
  704. $ RESULT( 7 ) = ULPINV
  705. 150 CONTINUE
  706. 160 CONTINUE
  707. *
  708. * Do Test (8) again
  709. *
  710. IF( .NOT.NOBAL ) THEN
  711. DO 170 J = 1, N
  712. IF( SCALE( J ).NE.SCALE1( J ) )
  713. $ RESULT( 8 ) = ULPINV
  714. 170 CONTINUE
  715. IF( ILO.NE.ILO1 )
  716. $ RESULT( 8 ) = ULPINV
  717. IF( IHI.NE.IHI1 )
  718. $ RESULT( 8 ) = ULPINV
  719. IF( ABNRM.NE.ABNRM1 )
  720. $ RESULT( 8 ) = ULPINV
  721. END IF
  722. *
  723. * Do Test (9) again
  724. *
  725. IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
  726. DO 180 J = 1, N
  727. IF( RCONDV( J ).NE.RCNDV1( J ) )
  728. $ RESULT( 9 ) = ULPINV
  729. 180 CONTINUE
  730. END IF
  731. *
  732. 190 CONTINUE
  733. *
  734. 200 CONTINUE
  735. *
  736. * If COMP, compare condition numbers to precomputed ones
  737. *
  738. IF( COMP ) THEN
  739. CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
  740. CALL CGEEVX( 'N', 'V', 'V', 'B', N, H, LDA, W, VL, LDVL, VR,
  741. $ LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV,
  742. $ WORK, LWORK, RWORK, IINFO )
  743. IF( IINFO.NE.0 ) THEN
  744. RESULT( 1 ) = ULPINV
  745. WRITE( NOUNIT, FMT = 9999 )'CGEEVX5', IINFO, N, ISEED( 1 )
  746. INFO = ABS( IINFO )
  747. GO TO 250
  748. END IF
  749. *
  750. * Sort eigenvalues and condition numbers lexicographically
  751. * to compare with inputs
  752. *
  753. DO 220 I = 1, N - 1
  754. KMIN = I
  755. IF( ISRT.EQ.0 ) THEN
  756. VRIMIN = REAL( W( I ) )
  757. ELSE
  758. VRIMIN = AIMAG( W( I ) )
  759. END IF
  760. DO 210 J = I + 1, N
  761. IF( ISRT.EQ.0 ) THEN
  762. VRICMP = REAL( W( J ) )
  763. ELSE
  764. VRICMP = AIMAG( W( J ) )
  765. END IF
  766. IF( VRICMP.LT.VRIMIN ) THEN
  767. KMIN = J
  768. VRIMIN = VRICMP
  769. END IF
  770. 210 CONTINUE
  771. CTMP = W( KMIN )
  772. W( KMIN ) = W( I )
  773. W( I ) = CTMP
  774. VRIMIN = RCONDE( KMIN )
  775. RCONDE( KMIN ) = RCONDE( I )
  776. RCONDE( I ) = VRIMIN
  777. VRIMIN = RCONDV( KMIN )
  778. RCONDV( KMIN ) = RCONDV( I )
  779. RCONDV( I ) = VRIMIN
  780. 220 CONTINUE
  781. *
  782. * Compare condition numbers for eigenvectors
  783. * taking their condition numbers into account
  784. *
  785. RESULT( 10 ) = ZERO
  786. EPS = MAX( EPSIN, ULP )
  787. V = MAX( REAL( N )*EPS*ABNRM, SMLNUM )
  788. IF( ABNRM.EQ.ZERO )
  789. $ V = ONE
  790. DO 230 I = 1, N
  791. IF( V.GT.RCONDV( I )*RCONDE( I ) ) THEN
  792. TOL = RCONDV( I )
  793. ELSE
  794. TOL = V / RCONDE( I )
  795. END IF
  796. IF( V.GT.RCDVIN( I )*RCDEIN( I ) ) THEN
  797. TOLIN = RCDVIN( I )
  798. ELSE
  799. TOLIN = V / RCDEIN( I )
  800. END IF
  801. TOL = MAX( TOL, SMLNUM / EPS )
  802. TOLIN = MAX( TOLIN, SMLNUM / EPS )
  803. IF( EPS*( RCDVIN( I )-TOLIN ).GT.RCONDV( I )+TOL ) THEN
  804. VMAX = ONE / EPS
  805. ELSE IF( RCDVIN( I )-TOLIN.GT.RCONDV( I )+TOL ) THEN
  806. VMAX = ( RCDVIN( I )-TOLIN ) / ( RCONDV( I )+TOL )
  807. ELSE IF( RCDVIN( I )+TOLIN.LT.EPS*( RCONDV( I )-TOL ) ) THEN
  808. VMAX = ONE / EPS
  809. ELSE IF( RCDVIN( I )+TOLIN.LT.RCONDV( I )-TOL ) THEN
  810. VMAX = ( RCONDV( I )-TOL ) / ( RCDVIN( I )+TOLIN )
  811. ELSE
  812. VMAX = ONE
  813. END IF
  814. RESULT( 10 ) = MAX( RESULT( 10 ), VMAX )
  815. 230 CONTINUE
  816. *
  817. * Compare condition numbers for eigenvalues
  818. * taking their condition numbers into account
  819. *
  820. RESULT( 11 ) = ZERO
  821. DO 240 I = 1, N
  822. IF( V.GT.RCONDV( I ) ) THEN
  823. TOL = ONE
  824. ELSE
  825. TOL = V / RCONDV( I )
  826. END IF
  827. IF( V.GT.RCDVIN( I ) ) THEN
  828. TOLIN = ONE
  829. ELSE
  830. TOLIN = V / RCDVIN( I )
  831. END IF
  832. TOL = MAX( TOL, SMLNUM / EPS )
  833. TOLIN = MAX( TOLIN, SMLNUM / EPS )
  834. IF( EPS*( RCDEIN( I )-TOLIN ).GT.RCONDE( I )+TOL ) THEN
  835. VMAX = ONE / EPS
  836. ELSE IF( RCDEIN( I )-TOLIN.GT.RCONDE( I )+TOL ) THEN
  837. VMAX = ( RCDEIN( I )-TOLIN ) / ( RCONDE( I )+TOL )
  838. ELSE IF( RCDEIN( I )+TOLIN.LT.EPS*( RCONDE( I )-TOL ) ) THEN
  839. VMAX = ONE / EPS
  840. ELSE IF( RCDEIN( I )+TOLIN.LT.RCONDE( I )-TOL ) THEN
  841. VMAX = ( RCONDE( I )-TOL ) / ( RCDEIN( I )+TOLIN )
  842. ELSE
  843. VMAX = ONE
  844. END IF
  845. RESULT( 11 ) = MAX( RESULT( 11 ), VMAX )
  846. 240 CONTINUE
  847. 250 CONTINUE
  848. *
  849. END IF
  850. *
  851. 9999 FORMAT( ' CGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
  852. $ I6, ', INPUT EXAMPLE NUMBER = ', I4 )
  853. 9998 FORMAT( ' CGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
  854. $ I6, ', JTYPE=', I6, ', BALANC = ', A, ', ISEED=(',
  855. $ 3( I5, ',' ), I5, ')' )
  856. *
  857. RETURN
  858. *
  859. * End of CGET23
  860. *
  861. END