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.

cdrgvx.f 25 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759
  1. *> \brief \b CDRGVX
  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 CDRGVX( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
  12. * ALPHA, BETA, VL, VR, ILO, IHI, LSCALE, RSCALE,
  13. * S, STRU, DIF, DIFTRU, WORK, LWORK, RWORK,
  14. * IWORK, LIWORK, RESULT, BWORK, INFO )
  15. *
  16. * .. Scalar Arguments ..
  17. * INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
  18. * $ NSIZE
  19. * REAL THRESH
  20. * ..
  21. * .. Array Arguments ..
  22. * LOGICAL BWORK( * )
  23. * INTEGER IWORK( * )
  24. * REAL DIF( * ), DIFTRU( * ), LSCALE( * ),
  25. * $ RESULT( 4 ), RSCALE( * ), RWORK( * ), S( * ),
  26. * $ STRU( * )
  27. * COMPLEX A( LDA, * ), AI( LDA, * ), ALPHA( * ),
  28. * $ B( LDA, * ), BETA( * ), BI( LDA, * ),
  29. * $ VL( LDA, * ), VR( LDA, * ), WORK( * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> CDRGVX checks the nonsymmetric generalized eigenvalue problem
  39. *> expert driver CGGEVX.
  40. *>
  41. *> CGGEVX computes the generalized eigenvalues, (optionally) the left
  42. *> and/or right eigenvectors, (optionally) computes a balancing
  43. *> transformation to improve the conditioning, and (optionally)
  44. *> reciprocal condition numbers for the eigenvalues and eigenvectors.
  45. *>
  46. *> When CDRGVX is called with NSIZE > 0, two types of test matrix pairs
  47. *> are generated by the subroutine SLATM6 and test the driver CGGEVX.
  48. *> The test matrices have the known exact condition numbers for
  49. *> eigenvalues. For the condition numbers of the eigenvectors
  50. *> corresponding the first and last eigenvalues are also know
  51. *> ``exactly'' (see CLATM6).
  52. *> For each matrix pair, the following tests will be performed and
  53. *> compared with the threshold THRESH.
  54. *>
  55. *> (1) max over all left eigenvalue/-vector pairs (beta/alpha,l) of
  56. *>
  57. *> | l**H * (beta A - alpha B) | / ( ulp max( |beta A|, |alpha B| ) )
  58. *>
  59. *> where l**H is the conjugate transpose of l.
  60. *>
  61. *> (2) max over all right eigenvalue/-vector pairs (beta/alpha,r) of
  62. *>
  63. *> | (beta A - alpha B) r | / ( ulp max( |beta A|, |alpha B| ) )
  64. *>
  65. *> (3) The condition number S(i) of eigenvalues computed by CGGEVX
  66. *> differs less than a factor THRESH from the exact S(i) (see
  67. *> CLATM6).
  68. *>
  69. *> (4) DIF(i) computed by CTGSNA differs less than a factor 10*THRESH
  70. *> from the exact value (for the 1st and 5th vectors only).
  71. *>
  72. *> Test Matrices
  73. *> =============
  74. *>
  75. *> Two kinds of test matrix pairs
  76. *> (A, B) = inverse(YH) * (Da, Db) * inverse(X)
  77. *> are used in the tests:
  78. *>
  79. *> 1: Da = 1+a 0 0 0 0 Db = 1 0 0 0 0
  80. *> 0 2+a 0 0 0 0 1 0 0 0
  81. *> 0 0 3+a 0 0 0 0 1 0 0
  82. *> 0 0 0 4+a 0 0 0 0 1 0
  83. *> 0 0 0 0 5+a , 0 0 0 0 1 , and
  84. *>
  85. *> 2: Da = 1 -1 0 0 0 Db = 1 0 0 0 0
  86. *> 1 1 0 0 0 0 1 0 0 0
  87. *> 0 0 1 0 0 0 0 1 0 0
  88. *> 0 0 0 1+a 1+b 0 0 0 1 0
  89. *> 0 0 0 -1-b 1+a , 0 0 0 0 1 .
  90. *>
  91. *> In both cases the same inverse(YH) and inverse(X) are used to compute
  92. *> (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
  93. *>
  94. *> YH: = 1 0 -y y -y X = 1 0 -x -x x
  95. *> 0 1 -y y -y 0 1 x -x -x
  96. *> 0 0 1 0 0 0 0 1 0 0
  97. *> 0 0 0 1 0 0 0 0 1 0
  98. *> 0 0 0 0 1, 0 0 0 0 1 , where
  99. *>
  100. *> a, b, x and y will have all values independently of each other from
  101. *> { sqrt(sqrt(ULP)), 0.1, 1, 10, 1/sqrt(sqrt(ULP)) }.
  102. *> \endverbatim
  103. *
  104. * Arguments:
  105. * ==========
  106. *
  107. *> \param[in] NSIZE
  108. *> \verbatim
  109. *> NSIZE is INTEGER
  110. *> The number of sizes of matrices to use. NSIZE must be at
  111. *> least zero. If it is zero, no randomly generated matrices
  112. *> are tested, but any test matrices read from NIN will be
  113. *> tested. If it is not zero, then N = 5.
  114. *> \endverbatim
  115. *>
  116. *> \param[in] THRESH
  117. *> \verbatim
  118. *> THRESH is REAL
  119. *> A test will count as "failed" if the "error", computed as
  120. *> described above, exceeds THRESH. Note that the error
  121. *> is scaled to be O(1), so THRESH should be a reasonably
  122. *> small multiple of 1, e.g., 10 or 100. In particular,
  123. *> it should not depend on the precision (single vs. double)
  124. *> or the size of the matrix. It must be at least zero.
  125. *> \endverbatim
  126. *>
  127. *> \param[in] NIN
  128. *> \verbatim
  129. *> NIN is INTEGER
  130. *> The FORTRAN unit number for reading in the data file of
  131. *> problems to solve.
  132. *> \endverbatim
  133. *>
  134. *> \param[in] NOUT
  135. *> \verbatim
  136. *> NOUT is INTEGER
  137. *> The FORTRAN unit number for printing out error messages
  138. *> (e.g., if a routine returns IINFO not equal to 0.)
  139. *> \endverbatim
  140. *>
  141. *> \param[out] A
  142. *> \verbatim
  143. *> A is COMPLEX array, dimension (LDA, NSIZE)
  144. *> Used to hold the matrix whose eigenvalues are to be
  145. *> computed. On exit, A contains the last matrix actually used.
  146. *> \endverbatim
  147. *>
  148. *> \param[in] LDA
  149. *> \verbatim
  150. *> LDA is INTEGER
  151. *> The leading dimension of A, B, AI, BI, Ao, and Bo.
  152. *> It must be at least 1 and at least NSIZE.
  153. *> \endverbatim
  154. *>
  155. *> \param[out] B
  156. *> \verbatim
  157. *> B is COMPLEX array, dimension (LDA, NSIZE)
  158. *> Used to hold the matrix whose eigenvalues are to be
  159. *> computed. On exit, B contains the last matrix actually used.
  160. *> \endverbatim
  161. *>
  162. *> \param[out] AI
  163. *> \verbatim
  164. *> AI is COMPLEX array, dimension (LDA, NSIZE)
  165. *> Copy of A, modified by CGGEVX.
  166. *> \endverbatim
  167. *>
  168. *> \param[out] BI
  169. *> \verbatim
  170. *> BI is COMPLEX array, dimension (LDA, NSIZE)
  171. *> Copy of B, modified by CGGEVX.
  172. *> \endverbatim
  173. *>
  174. *> \param[out] ALPHA
  175. *> \verbatim
  176. *> ALPHA is COMPLEX array, dimension (NSIZE)
  177. *> \endverbatim
  178. *>
  179. *> \param[out] BETA
  180. *> \verbatim
  181. *> BETA is COMPLEX array, dimension (NSIZE)
  182. *>
  183. *> On exit, ALPHA/BETA are the eigenvalues.
  184. *> \endverbatim
  185. *>
  186. *> \param[out] VL
  187. *> \verbatim
  188. *> VL is COMPLEX array, dimension (LDA, NSIZE)
  189. *> VL holds the left eigenvectors computed by CGGEVX.
  190. *> \endverbatim
  191. *>
  192. *> \param[out] VR
  193. *> \verbatim
  194. *> VR is COMPLEX array, dimension (LDA, NSIZE)
  195. *> VR holds the right eigenvectors computed by CGGEVX.
  196. *> \endverbatim
  197. *>
  198. *> \param[out] ILO
  199. *> \verbatim
  200. *> ILO is INTEGER
  201. *> \endverbatim
  202. *>
  203. *> \param[out] IHI
  204. *> \verbatim
  205. *> IHI is INTEGER
  206. *> \endverbatim
  207. *>
  208. *> \param[out] LSCALE
  209. *> \verbatim
  210. *> LSCALE is REAL array, dimension (N)
  211. *> \endverbatim
  212. *>
  213. *> \param[out] RSCALE
  214. *> \verbatim
  215. *> RSCALE is REAL array, dimension (N)
  216. *> \endverbatim
  217. *>
  218. *> \param[out] S
  219. *> \verbatim
  220. *> S is REAL array, dimension (N)
  221. *> \endverbatim
  222. *>
  223. *> \param[out] STRU
  224. *> \verbatim
  225. *> STRU is REAL array, dimension (N)
  226. *> \endverbatim
  227. *>
  228. *> \param[out] DIF
  229. *> \verbatim
  230. *> DIF is REAL array, dimension (N)
  231. *> \endverbatim
  232. *>
  233. *> \param[out] DIFTRU
  234. *> \verbatim
  235. *> DIFTRU is REAL array, dimension (N)
  236. *> \endverbatim
  237. *>
  238. *> \param[out] WORK
  239. *> \verbatim
  240. *> WORK is COMPLEX array, dimension (LWORK)
  241. *> \endverbatim
  242. *>
  243. *> \param[in] LWORK
  244. *> \verbatim
  245. *> LWORK is INTEGER
  246. *> Leading dimension of WORK. LWORK >= 2*N*N + 2*N
  247. *> \endverbatim
  248. *>
  249. *> \param[out] RWORK
  250. *> \verbatim
  251. *> RWORK is REAL array, dimension (6*N)
  252. *> \endverbatim
  253. *>
  254. *> \param[out] IWORK
  255. *> \verbatim
  256. *> IWORK is INTEGER array, dimension (LIWORK)
  257. *> \endverbatim
  258. *>
  259. *> \param[in] LIWORK
  260. *> \verbatim
  261. *> LIWORK is INTEGER
  262. *> Leading dimension of IWORK. LIWORK >= N+2.
  263. *> \endverbatim
  264. *>
  265. *> \param[out] RESULT
  266. *> \verbatim
  267. *> RESULT is REAL array, dimension (4)
  268. *> \endverbatim
  269. *>
  270. *> \param[out] BWORK
  271. *> \verbatim
  272. *> BWORK is LOGICAL array, dimension (N)
  273. *> \endverbatim
  274. *>
  275. *> \param[out] INFO
  276. *> \verbatim
  277. *> INFO is INTEGER
  278. *> = 0: successful exit
  279. *> < 0: if INFO = -i, the i-th argument had an illegal value.
  280. *> > 0: A routine returned an error code.
  281. *> \endverbatim
  282. *
  283. * Authors:
  284. * ========
  285. *
  286. *> \author Univ. of Tennessee
  287. *> \author Univ. of California Berkeley
  288. *> \author Univ. of Colorado Denver
  289. *> \author NAG Ltd.
  290. *
  291. *> \ingroup complex_eig
  292. *
  293. * =====================================================================
  294. SUBROUTINE CDRGVX( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
  295. $ ALPHA, BETA, VL, VR, ILO, IHI, LSCALE, RSCALE,
  296. $ S, STRU, DIF, DIFTRU, WORK, LWORK, RWORK,
  297. $ IWORK, LIWORK, RESULT, BWORK, INFO )
  298. *
  299. * -- LAPACK test routine --
  300. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  301. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  302. *
  303. * .. Scalar Arguments ..
  304. INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
  305. $ NSIZE
  306. REAL THRESH
  307. * ..
  308. * .. Array Arguments ..
  309. LOGICAL BWORK( * )
  310. INTEGER IWORK( * )
  311. REAL DIF( * ), DIFTRU( * ), LSCALE( * ),
  312. $ RESULT( 4 ), RSCALE( * ), RWORK( * ), S( * ),
  313. $ STRU( * )
  314. COMPLEX A( LDA, * ), AI( LDA, * ), ALPHA( * ),
  315. $ B( LDA, * ), BETA( * ), BI( LDA, * ),
  316. $ VL( LDA, * ), VR( LDA, * ), WORK( * )
  317. * ..
  318. *
  319. * =====================================================================
  320. *
  321. * .. Parameters ..
  322. REAL ZERO, ONE, TEN, TNTH, HALF
  323. PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TEN = 1.0E+1,
  324. $ TNTH = 1.0E-1, HALF = 0.5E+0 )
  325. * ..
  326. * .. Local Scalars ..
  327. INTEGER I, IPTYPE, IWA, IWB, IWX, IWY, J, LINFO,
  328. $ MAXWRK, MINWRK, N, NERRS, NMAX, NPTKNT, NTESTT
  329. REAL ABNORM, ANORM, BNORM, RATIO1, RATIO2, THRSH2,
  330. $ ULP, ULPINV
  331. * ..
  332. * .. Local Arrays ..
  333. COMPLEX WEIGHT( 5 )
  334. * ..
  335. * .. External Functions ..
  336. INTEGER ILAENV
  337. REAL CLANGE, SLAMCH
  338. EXTERNAL ILAENV, CLANGE, SLAMCH
  339. * ..
  340. * .. External Subroutines ..
  341. EXTERNAL ALASVM, CGET52, CGGEVX, CLACPY, CLATM6, XERBLA
  342. * ..
  343. * .. Intrinsic Functions ..
  344. INTRINSIC ABS, CMPLX, MAX, SQRT
  345. * ..
  346. * .. Executable Statements ..
  347. *
  348. * Check for errors
  349. *
  350. INFO = 0
  351. *
  352. NMAX = 5
  353. *
  354. IF( NSIZE.LT.0 ) THEN
  355. INFO = -1
  356. ELSE IF( THRESH.LT.ZERO ) THEN
  357. INFO = -2
  358. ELSE IF( NIN.LE.0 ) THEN
  359. INFO = -3
  360. ELSE IF( NOUT.LE.0 ) THEN
  361. INFO = -4
  362. ELSE IF( LDA.LT.1 .OR. LDA.LT.NMAX ) THEN
  363. INFO = -6
  364. ELSE IF( LIWORK.LT.NMAX+2 ) THEN
  365. INFO = -26
  366. END IF
  367. *
  368. * Compute workspace
  369. * (Note: Comments in the code beginning "Workspace:" describe the
  370. * minimal amount of workspace needed at that point in the code,
  371. * as well as the preferred amount for good performance.
  372. * NB refers to the optimal block size for the immediately
  373. * following subroutine, as returned by ILAENV.)
  374. *
  375. MINWRK = 1
  376. IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
  377. MINWRK = 2*NMAX*( NMAX+1 )
  378. MAXWRK = NMAX*( 1+ILAENV( 1, 'CGEQRF', ' ', NMAX, 1, NMAX,
  379. $ 0 ) )
  380. MAXWRK = MAX( MAXWRK, 2*NMAX*( NMAX+1 ) )
  381. WORK( 1 ) = MAXWRK
  382. END IF
  383. *
  384. IF( LWORK.LT.MINWRK )
  385. $ INFO = -23
  386. *
  387. IF( INFO.NE.0 ) THEN
  388. CALL XERBLA( 'CDRGVX', -INFO )
  389. RETURN
  390. END IF
  391. *
  392. N = 5
  393. ULP = SLAMCH( 'P' )
  394. ULPINV = ONE / ULP
  395. THRSH2 = TEN*THRESH
  396. NERRS = 0
  397. NPTKNT = 0
  398. NTESTT = 0
  399. *
  400. IF( NSIZE.EQ.0 )
  401. $ GO TO 90
  402. *
  403. * Parameters used for generating test matrices.
  404. *
  405. WEIGHT( 1 ) = CMPLX( TNTH, ZERO )
  406. WEIGHT( 2 ) = CMPLX( HALF, ZERO )
  407. WEIGHT( 3 ) = ONE
  408. WEIGHT( 4 ) = ONE / WEIGHT( 2 )
  409. WEIGHT( 5 ) = ONE / WEIGHT( 1 )
  410. *
  411. DO 80 IPTYPE = 1, 2
  412. DO 70 IWA = 1, 5
  413. DO 60 IWB = 1, 5
  414. DO 50 IWX = 1, 5
  415. DO 40 IWY = 1, 5
  416. *
  417. * generated a pair of test matrix
  418. *
  419. CALL CLATM6( IPTYPE, 5, A, LDA, B, VR, LDA, VL,
  420. $ LDA, WEIGHT( IWA ), WEIGHT( IWB ),
  421. $ WEIGHT( IWX ), WEIGHT( IWY ), STRU,
  422. $ DIFTRU )
  423. *
  424. * Compute eigenvalues/eigenvectors of (A, B).
  425. * Compute eigenvalue/eigenvector condition numbers
  426. * using computed eigenvectors.
  427. *
  428. CALL CLACPY( 'F', N, N, A, LDA, AI, LDA )
  429. CALL CLACPY( 'F', N, N, B, LDA, BI, LDA )
  430. *
  431. CALL CGGEVX( 'N', 'V', 'V', 'B', N, AI, LDA, BI,
  432. $ LDA, ALPHA, BETA, VL, LDA, VR, LDA,
  433. $ ILO, IHI, LSCALE, RSCALE, ANORM,
  434. $ BNORM, S, DIF, WORK, LWORK, RWORK,
  435. $ IWORK, BWORK, LINFO )
  436. IF( LINFO.NE.0 ) THEN
  437. WRITE( NOUT, FMT = 9999 )'CGGEVX', LINFO, N,
  438. $ IPTYPE, IWA, IWB, IWX, IWY
  439. GO TO 30
  440. END IF
  441. *
  442. * Compute the norm(A, B)
  443. *
  444. CALL CLACPY( 'Full', N, N, AI, LDA, WORK, N )
  445. CALL CLACPY( 'Full', N, N, BI, LDA, WORK( N*N+1 ),
  446. $ N )
  447. ABNORM = CLANGE( 'Fro', N, 2*N, WORK, N, RWORK )
  448. *
  449. * Tests (1) and (2)
  450. *
  451. RESULT( 1 ) = ZERO
  452. CALL CGET52( .TRUE., N, A, LDA, B, LDA, VL, LDA,
  453. $ ALPHA, BETA, WORK, RWORK,
  454. $ RESULT( 1 ) )
  455. IF( RESULT( 2 ).GT.THRESH ) THEN
  456. WRITE( NOUT, FMT = 9998 )'Left', 'CGGEVX',
  457. $ RESULT( 2 ), N, IPTYPE, IWA, IWB, IWX, IWY
  458. END IF
  459. *
  460. RESULT( 2 ) = ZERO
  461. CALL CGET52( .FALSE., N, A, LDA, B, LDA, VR, LDA,
  462. $ ALPHA, BETA, WORK, RWORK,
  463. $ RESULT( 2 ) )
  464. IF( RESULT( 3 ).GT.THRESH ) THEN
  465. WRITE( NOUT, FMT = 9998 )'Right', 'CGGEVX',
  466. $ RESULT( 3 ), N, IPTYPE, IWA, IWB, IWX, IWY
  467. END IF
  468. *
  469. * Test (3)
  470. *
  471. RESULT( 3 ) = ZERO
  472. DO 10 I = 1, N
  473. IF( S( I ).EQ.ZERO ) THEN
  474. IF( STRU( I ).GT.ABNORM*ULP )
  475. $ RESULT( 3 ) = ULPINV
  476. ELSE IF( STRU( I ).EQ.ZERO ) THEN
  477. IF( S( I ).GT.ABNORM*ULP )
  478. $ RESULT( 3 ) = ULPINV
  479. ELSE
  480. RWORK( I ) = MAX( ABS( STRU( I ) / S( I ) ),
  481. $ ABS( S( I ) / STRU( I ) ) )
  482. RESULT( 3 ) = MAX( RESULT( 3 ), RWORK( I ) )
  483. END IF
  484. 10 CONTINUE
  485. *
  486. * Test (4)
  487. *
  488. RESULT( 4 ) = ZERO
  489. IF( DIF( 1 ).EQ.ZERO ) THEN
  490. IF( DIFTRU( 1 ).GT.ABNORM*ULP )
  491. $ RESULT( 4 ) = ULPINV
  492. ELSE IF( DIFTRU( 1 ).EQ.ZERO ) THEN
  493. IF( DIF( 1 ).GT.ABNORM*ULP )
  494. $ RESULT( 4 ) = ULPINV
  495. ELSE IF( DIF( 5 ).EQ.ZERO ) THEN
  496. IF( DIFTRU( 5 ).GT.ABNORM*ULP )
  497. $ RESULT( 4 ) = ULPINV
  498. ELSE IF( DIFTRU( 5 ).EQ.ZERO ) THEN
  499. IF( DIF( 5 ).GT.ABNORM*ULP )
  500. $ RESULT( 4 ) = ULPINV
  501. ELSE
  502. RATIO1 = MAX( ABS( DIFTRU( 1 ) / DIF( 1 ) ),
  503. $ ABS( DIF( 1 ) / DIFTRU( 1 ) ) )
  504. RATIO2 = MAX( ABS( DIFTRU( 5 ) / DIF( 5 ) ),
  505. $ ABS( DIF( 5 ) / DIFTRU( 5 ) ) )
  506. RESULT( 4 ) = MAX( RATIO1, RATIO2 )
  507. END IF
  508. *
  509. NTESTT = NTESTT + 4
  510. *
  511. * Print out tests which fail.
  512. *
  513. DO 20 J = 1, 4
  514. IF( ( RESULT( J ).GE.THRSH2 .AND. J.GE.4 ) .OR.
  515. $ ( RESULT( J ).GE.THRESH .AND. J.LE.3 ) )
  516. $ THEN
  517. *
  518. * If this is the first test to fail,
  519. * print a header to the data file.
  520. *
  521. IF( NERRS.EQ.0 ) THEN
  522. WRITE( NOUT, FMT = 9997 )'CXV'
  523. *
  524. * Print out messages for built-in examples
  525. *
  526. * Matrix types
  527. *
  528. WRITE( NOUT, FMT = 9995 )
  529. WRITE( NOUT, FMT = 9994 )
  530. WRITE( NOUT, FMT = 9993 )
  531. *
  532. * Tests performed
  533. *
  534. WRITE( NOUT, FMT = 9992 )'''',
  535. $ 'transpose', ''''
  536. *
  537. END IF
  538. NERRS = NERRS + 1
  539. IF( RESULT( J ).LT.10000.0 ) THEN
  540. WRITE( NOUT, FMT = 9991 )IPTYPE, IWA,
  541. $ IWB, IWX, IWY, J, RESULT( J )
  542. ELSE
  543. WRITE( NOUT, FMT = 9990 )IPTYPE, IWA,
  544. $ IWB, IWX, IWY, J, RESULT( J )
  545. END IF
  546. END IF
  547. 20 CONTINUE
  548. *
  549. 30 CONTINUE
  550. *
  551. 40 CONTINUE
  552. 50 CONTINUE
  553. 60 CONTINUE
  554. 70 CONTINUE
  555. 80 CONTINUE
  556. *
  557. GO TO 150
  558. *
  559. 90 CONTINUE
  560. *
  561. * Read in data from file to check accuracy of condition estimation
  562. * Read input data until N=0
  563. *
  564. READ( NIN, FMT = *, END = 150 )N
  565. IF( N.EQ.0 )
  566. $ GO TO 150
  567. DO 100 I = 1, N
  568. READ( NIN, FMT = * )( A( I, J ), J = 1, N )
  569. 100 CONTINUE
  570. DO 110 I = 1, N
  571. READ( NIN, FMT = * )( B( I, J ), J = 1, N )
  572. 110 CONTINUE
  573. READ( NIN, FMT = * )( STRU( I ), I = 1, N )
  574. READ( NIN, FMT = * )( DIFTRU( I ), I = 1, N )
  575. *
  576. NPTKNT = NPTKNT + 1
  577. *
  578. * Compute eigenvalues/eigenvectors of (A, B).
  579. * Compute eigenvalue/eigenvector condition numbers
  580. * using computed eigenvectors.
  581. *
  582. CALL CLACPY( 'F', N, N, A, LDA, AI, LDA )
  583. CALL CLACPY( 'F', N, N, B, LDA, BI, LDA )
  584. *
  585. CALL CGGEVX( 'N', 'V', 'V', 'B', N, AI, LDA, BI, LDA, ALPHA, BETA,
  586. $ VL, LDA, VR, LDA, ILO, IHI, LSCALE, RSCALE, ANORM,
  587. $ BNORM, S, DIF, WORK, LWORK, RWORK, IWORK, BWORK,
  588. $ LINFO )
  589. *
  590. IF( LINFO.NE.0 ) THEN
  591. WRITE( NOUT, FMT = 9987 )'CGGEVX', LINFO, N, NPTKNT
  592. GO TO 140
  593. END IF
  594. *
  595. * Compute the norm(A, B)
  596. *
  597. CALL CLACPY( 'Full', N, N, AI, LDA, WORK, N )
  598. CALL CLACPY( 'Full', N, N, BI, LDA, WORK( N*N+1 ), N )
  599. ABNORM = CLANGE( 'Fro', N, 2*N, WORK, N, RWORK )
  600. *
  601. * Tests (1) and (2)
  602. *
  603. RESULT( 1 ) = ZERO
  604. CALL CGET52( .TRUE., N, A, LDA, B, LDA, VL, LDA, ALPHA, BETA,
  605. $ WORK, RWORK, RESULT( 1 ) )
  606. IF( RESULT( 2 ).GT.THRESH ) THEN
  607. WRITE( NOUT, FMT = 9986 )'Left', 'CGGEVX', RESULT( 2 ), N,
  608. $ NPTKNT
  609. END IF
  610. *
  611. RESULT( 2 ) = ZERO
  612. CALL CGET52( .FALSE., N, A, LDA, B, LDA, VR, LDA, ALPHA, BETA,
  613. $ WORK, RWORK, RESULT( 2 ) )
  614. IF( RESULT( 3 ).GT.THRESH ) THEN
  615. WRITE( NOUT, FMT = 9986 )'Right', 'CGGEVX', RESULT( 3 ), N,
  616. $ NPTKNT
  617. END IF
  618. *
  619. * Test (3)
  620. *
  621. RESULT( 3 ) = ZERO
  622. DO 120 I = 1, N
  623. IF( S( I ).EQ.ZERO ) THEN
  624. IF( STRU( I ).GT.ABNORM*ULP )
  625. $ RESULT( 3 ) = ULPINV
  626. ELSE IF( STRU( I ).EQ.ZERO ) THEN
  627. IF( S( I ).GT.ABNORM*ULP )
  628. $ RESULT( 3 ) = ULPINV
  629. ELSE
  630. RWORK( I ) = MAX( ABS( STRU( I ) / S( I ) ),
  631. $ ABS( S( I ) / STRU( I ) ) )
  632. RESULT( 3 ) = MAX( RESULT( 3 ), RWORK( I ) )
  633. END IF
  634. 120 CONTINUE
  635. *
  636. * Test (4)
  637. *
  638. RESULT( 4 ) = ZERO
  639. IF( DIF( 1 ).EQ.ZERO ) THEN
  640. IF( DIFTRU( 1 ).GT.ABNORM*ULP )
  641. $ RESULT( 4 ) = ULPINV
  642. ELSE IF( DIFTRU( 1 ).EQ.ZERO ) THEN
  643. IF( DIF( 1 ).GT.ABNORM*ULP )
  644. $ RESULT( 4 ) = ULPINV
  645. ELSE IF( DIF( 5 ).EQ.ZERO ) THEN
  646. IF( DIFTRU( 5 ).GT.ABNORM*ULP )
  647. $ RESULT( 4 ) = ULPINV
  648. ELSE IF( DIFTRU( 5 ).EQ.ZERO ) THEN
  649. IF( DIF( 5 ).GT.ABNORM*ULP )
  650. $ RESULT( 4 ) = ULPINV
  651. ELSE
  652. RATIO1 = MAX( ABS( DIFTRU( 1 ) / DIF( 1 ) ),
  653. $ ABS( DIF( 1 ) / DIFTRU( 1 ) ) )
  654. RATIO2 = MAX( ABS( DIFTRU( 5 ) / DIF( 5 ) ),
  655. $ ABS( DIF( 5 ) / DIFTRU( 5 ) ) )
  656. RESULT( 4 ) = MAX( RATIO1, RATIO2 )
  657. END IF
  658. *
  659. NTESTT = NTESTT + 4
  660. *
  661. * Print out tests which fail.
  662. *
  663. DO 130 J = 1, 4
  664. IF( RESULT( J ).GE.THRSH2 ) THEN
  665. *
  666. * If this is the first test to fail,
  667. * print a header to the data file.
  668. *
  669. IF( NERRS.EQ.0 ) THEN
  670. WRITE( NOUT, FMT = 9997 )'CXV'
  671. *
  672. * Print out messages for built-in examples
  673. *
  674. * Matrix types
  675. *
  676. WRITE( NOUT, FMT = 9996 )
  677. *
  678. * Tests performed
  679. *
  680. WRITE( NOUT, FMT = 9992 )'''', 'transpose', ''''
  681. *
  682. END IF
  683. NERRS = NERRS + 1
  684. IF( RESULT( J ).LT.10000.0 ) THEN
  685. WRITE( NOUT, FMT = 9989 )NPTKNT, N, J, RESULT( J )
  686. ELSE
  687. WRITE( NOUT, FMT = 9988 )NPTKNT, N, J, RESULT( J )
  688. END IF
  689. END IF
  690. 130 CONTINUE
  691. *
  692. 140 CONTINUE
  693. *
  694. GO TO 90
  695. 150 CONTINUE
  696. *
  697. * Summary
  698. *
  699. CALL ALASVM( 'CXV', NOUT, NERRS, NTESTT, 0 )
  700. *
  701. WORK( 1 ) = MAXWRK
  702. *
  703. RETURN
  704. *
  705. 9999 FORMAT( ' CDRGVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
  706. $ I6, ', JTYPE=', I6, ')' )
  707. *
  708. 9998 FORMAT( ' CDRGVX: ', A, ' Eigenvectors from ', A, ' incorrectly ',
  709. $ 'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
  710. $ 'N=', I6, ', JTYPE=', I6, ', IWA=', I5, ', IWB=', I5,
  711. $ ', IWX=', I5, ', IWY=', I5 )
  712. *
  713. 9997 FORMAT( / 1X, A3, ' -- Complex Expert Eigenvalue/vector',
  714. $ ' problem driver' )
  715. *
  716. 9996 FORMAT( 'Input Example' )
  717. *
  718. 9995 FORMAT( ' Matrix types: ', / )
  719. *
  720. 9994 FORMAT( ' TYPE 1: Da is diagonal, Db is identity, ',
  721. $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
  722. $ / ' YH and X are left and right eigenvectors. ', / )
  723. *
  724. 9993 FORMAT( ' TYPE 2: Da is quasi-diagonal, Db is identity, ',
  725. $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
  726. $ / ' YH and X are left and right eigenvectors. ', / )
  727. *
  728. 9992 FORMAT( / ' Tests performed: ', / 4X,
  729. $ ' a is alpha, b is beta, l is a left eigenvector, ', / 4X,
  730. $ ' r is a right eigenvector and ', A, ' means ', A, '.',
  731. $ / ' 1 = max | ( b A - a B )', A, ' l | / const.',
  732. $ / ' 2 = max | ( b A - a B ) r | / const.',
  733. $ / ' 3 = max ( Sest/Stru, Stru/Sest ) ',
  734. $ ' over all eigenvalues', /
  735. $ ' 4 = max( DIFest/DIFtru, DIFtru/DIFest ) ',
  736. $ ' over the 1st and 5th eigenvectors', / )
  737. *
  738. 9991 FORMAT( ' Type=', I2, ',', ' IWA=', I2, ', IWB=', I2, ', IWX=',
  739. $ I2, ', IWY=', I2, ', result ', I2, ' is', 0P, F8.2 )
  740. *
  741. 9990 FORMAT( ' Type=', I2, ',', ' IWA=', I2, ', IWB=', I2, ', IWX=',
  742. $ I2, ', IWY=', I2, ', result ', I2, ' is', 1P, E10.3 )
  743. *
  744. 9989 FORMAT( ' Input example #', I2, ', matrix order=', I4, ',',
  745. $ ' result ', I2, ' is', 0P, F8.2 )
  746. *
  747. 9988 FORMAT( ' Input example #', I2, ', matrix order=', I4, ',',
  748. $ ' result ', I2, ' is', 1P, E10.3 )
  749. *
  750. 9987 FORMAT( ' CDRGVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
  751. $ I6, ', Input example #', I2, ')' )
  752. *
  753. 9986 FORMAT( ' CDRGVX: ', A, ' Eigenvectors from ', A, ' incorrectly ',
  754. $ 'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
  755. $ 'N=', I6, ', Input Example #', I2, ')' )
  756. *
  757. * End of CDRGVX
  758. *
  759. END