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

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762
  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 tranpose 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. *> \date June 2016
  292. *
  293. *> \ingroup complex_eig
  294. *
  295. * =====================================================================
  296. SUBROUTINE CDRGVX( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
  297. $ ALPHA, BETA, VL, VR, ILO, IHI, LSCALE, RSCALE,
  298. $ S, STRU, DIF, DIFTRU, WORK, LWORK, RWORK,
  299. $ IWORK, LIWORK, RESULT, BWORK, INFO )
  300. *
  301. * -- LAPACK test routine (version 3.7.0) --
  302. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  303. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  304. * June 2016
  305. *
  306. * .. Scalar Arguments ..
  307. INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
  308. $ NSIZE
  309. REAL THRESH
  310. * ..
  311. * .. Array Arguments ..
  312. LOGICAL BWORK( * )
  313. INTEGER IWORK( * )
  314. REAL DIF( * ), DIFTRU( * ), LSCALE( * ),
  315. $ RESULT( 4 ), RSCALE( * ), RWORK( * ), S( * ),
  316. $ STRU( * )
  317. COMPLEX A( LDA, * ), AI( LDA, * ), ALPHA( * ),
  318. $ B( LDA, * ), BETA( * ), BI( LDA, * ),
  319. $ VL( LDA, * ), VR( LDA, * ), WORK( * )
  320. * ..
  321. *
  322. * =====================================================================
  323. *
  324. * .. Parameters ..
  325. REAL ZERO, ONE, TEN, TNTH, HALF
  326. PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TEN = 1.0E+1,
  327. $ TNTH = 1.0E-1, HALF = 0.5E+0 )
  328. * ..
  329. * .. Local Scalars ..
  330. INTEGER I, IPTYPE, IWA, IWB, IWX, IWY, J, LINFO,
  331. $ MAXWRK, MINWRK, N, NERRS, NMAX, NPTKNT, NTESTT
  332. REAL ABNORM, ANORM, BNORM, RATIO1, RATIO2, THRSH2,
  333. $ ULP, ULPINV
  334. * ..
  335. * .. Local Arrays ..
  336. COMPLEX WEIGHT( 5 )
  337. * ..
  338. * .. External Functions ..
  339. INTEGER ILAENV
  340. REAL CLANGE, SLAMCH
  341. EXTERNAL ILAENV, CLANGE, SLAMCH
  342. * ..
  343. * .. External Subroutines ..
  344. EXTERNAL ALASVM, CGET52, CGGEVX, CLACPY, CLATM6, XERBLA
  345. * ..
  346. * .. Intrinsic Functions ..
  347. INTRINSIC ABS, CMPLX, MAX, SQRT
  348. * ..
  349. * .. Executable Statements ..
  350. *
  351. * Check for errors
  352. *
  353. INFO = 0
  354. *
  355. NMAX = 5
  356. *
  357. IF( NSIZE.LT.0 ) THEN
  358. INFO = -1
  359. ELSE IF( THRESH.LT.ZERO ) THEN
  360. INFO = -2
  361. ELSE IF( NIN.LE.0 ) THEN
  362. INFO = -3
  363. ELSE IF( NOUT.LE.0 ) THEN
  364. INFO = -4
  365. ELSE IF( LDA.LT.1 .OR. LDA.LT.NMAX ) THEN
  366. INFO = -6
  367. ELSE IF( LIWORK.LT.NMAX+2 ) THEN
  368. INFO = -26
  369. END IF
  370. *
  371. * Compute workspace
  372. * (Note: Comments in the code beginning "Workspace:" describe the
  373. * minimal amount of workspace needed at that point in the code,
  374. * as well as the preferred amount for good performance.
  375. * NB refers to the optimal block size for the immediately
  376. * following subroutine, as returned by ILAENV.)
  377. *
  378. MINWRK = 1
  379. IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
  380. MINWRK = 2*NMAX*( NMAX+1 )
  381. MAXWRK = NMAX*( 1+ILAENV( 1, 'CGEQRF', ' ', NMAX, 1, NMAX,
  382. $ 0 ) )
  383. MAXWRK = MAX( MAXWRK, 2*NMAX*( NMAX+1 ) )
  384. WORK( 1 ) = MAXWRK
  385. END IF
  386. *
  387. IF( LWORK.LT.MINWRK )
  388. $ INFO = -23
  389. *
  390. IF( INFO.NE.0 ) THEN
  391. CALL XERBLA( 'CDRGVX', -INFO )
  392. RETURN
  393. END IF
  394. *
  395. N = 5
  396. ULP = SLAMCH( 'P' )
  397. ULPINV = ONE / ULP
  398. THRSH2 = TEN*THRESH
  399. NERRS = 0
  400. NPTKNT = 0
  401. NTESTT = 0
  402. *
  403. IF( NSIZE.EQ.0 )
  404. $ GO TO 90
  405. *
  406. * Parameters used for generating test matrices.
  407. *
  408. WEIGHT( 1 ) = CMPLX( TNTH, ZERO )
  409. WEIGHT( 2 ) = CMPLX( HALF, ZERO )
  410. WEIGHT( 3 ) = ONE
  411. WEIGHT( 4 ) = ONE / WEIGHT( 2 )
  412. WEIGHT( 5 ) = ONE / WEIGHT( 1 )
  413. *
  414. DO 80 IPTYPE = 1, 2
  415. DO 70 IWA = 1, 5
  416. DO 60 IWB = 1, 5
  417. DO 50 IWX = 1, 5
  418. DO 40 IWY = 1, 5
  419. *
  420. * generated a pair of test matrix
  421. *
  422. CALL CLATM6( IPTYPE, 5, A, LDA, B, VR, LDA, VL,
  423. $ LDA, WEIGHT( IWA ), WEIGHT( IWB ),
  424. $ WEIGHT( IWX ), WEIGHT( IWY ), STRU,
  425. $ DIFTRU )
  426. *
  427. * Compute eigenvalues/eigenvectors of (A, B).
  428. * Compute eigenvalue/eigenvector condition numbers
  429. * using computed eigenvectors.
  430. *
  431. CALL CLACPY( 'F', N, N, A, LDA, AI, LDA )
  432. CALL CLACPY( 'F', N, N, B, LDA, BI, LDA )
  433. *
  434. CALL CGGEVX( 'N', 'V', 'V', 'B', N, AI, LDA, BI,
  435. $ LDA, ALPHA, BETA, VL, LDA, VR, LDA,
  436. $ ILO, IHI, LSCALE, RSCALE, ANORM,
  437. $ BNORM, S, DIF, WORK, LWORK, RWORK,
  438. $ IWORK, BWORK, LINFO )
  439. IF( LINFO.NE.0 ) THEN
  440. WRITE( NOUT, FMT = 9999 )'CGGEVX', LINFO, N,
  441. $ IPTYPE, IWA, IWB, IWX, IWY
  442. GO TO 30
  443. END IF
  444. *
  445. * Compute the norm(A, B)
  446. *
  447. CALL CLACPY( 'Full', N, N, AI, LDA, WORK, N )
  448. CALL CLACPY( 'Full', N, N, BI, LDA, WORK( N*N+1 ),
  449. $ N )
  450. ABNORM = CLANGE( 'Fro', N, 2*N, WORK, N, RWORK )
  451. *
  452. * Tests (1) and (2)
  453. *
  454. RESULT( 1 ) = ZERO
  455. CALL CGET52( .TRUE., N, A, LDA, B, LDA, VL, LDA,
  456. $ ALPHA, BETA, WORK, RWORK,
  457. $ RESULT( 1 ) )
  458. IF( RESULT( 2 ).GT.THRESH ) THEN
  459. WRITE( NOUT, FMT = 9998 )'Left', 'CGGEVX',
  460. $ RESULT( 2 ), N, IPTYPE, IWA, IWB, IWX, IWY
  461. END IF
  462. *
  463. RESULT( 2 ) = ZERO
  464. CALL CGET52( .FALSE., N, A, LDA, B, LDA, VR, LDA,
  465. $ ALPHA, BETA, WORK, RWORK,
  466. $ RESULT( 2 ) )
  467. IF( RESULT( 3 ).GT.THRESH ) THEN
  468. WRITE( NOUT, FMT = 9998 )'Right', 'CGGEVX',
  469. $ RESULT( 3 ), N, IPTYPE, IWA, IWB, IWX, IWY
  470. END IF
  471. *
  472. * Test (3)
  473. *
  474. RESULT( 3 ) = ZERO
  475. DO 10 I = 1, N
  476. IF( S( I ).EQ.ZERO ) THEN
  477. IF( STRU( I ).GT.ABNORM*ULP )
  478. $ RESULT( 3 ) = ULPINV
  479. ELSE IF( STRU( I ).EQ.ZERO ) THEN
  480. IF( S( I ).GT.ABNORM*ULP )
  481. $ RESULT( 3 ) = ULPINV
  482. ELSE
  483. RWORK( I ) = MAX( ABS( STRU( I ) / S( I ) ),
  484. $ ABS( S( I ) / STRU( I ) ) )
  485. RESULT( 3 ) = MAX( RESULT( 3 ), RWORK( I ) )
  486. END IF
  487. 10 CONTINUE
  488. *
  489. * Test (4)
  490. *
  491. RESULT( 4 ) = ZERO
  492. IF( DIF( 1 ).EQ.ZERO ) THEN
  493. IF( DIFTRU( 1 ).GT.ABNORM*ULP )
  494. $ RESULT( 4 ) = ULPINV
  495. ELSE IF( DIFTRU( 1 ).EQ.ZERO ) THEN
  496. IF( DIF( 1 ).GT.ABNORM*ULP )
  497. $ RESULT( 4 ) = ULPINV
  498. ELSE IF( DIF( 5 ).EQ.ZERO ) THEN
  499. IF( DIFTRU( 5 ).GT.ABNORM*ULP )
  500. $ RESULT( 4 ) = ULPINV
  501. ELSE IF( DIFTRU( 5 ).EQ.ZERO ) THEN
  502. IF( DIF( 5 ).GT.ABNORM*ULP )
  503. $ RESULT( 4 ) = ULPINV
  504. ELSE
  505. RATIO1 = MAX( ABS( DIFTRU( 1 ) / DIF( 1 ) ),
  506. $ ABS( DIF( 1 ) / DIFTRU( 1 ) ) )
  507. RATIO2 = MAX( ABS( DIFTRU( 5 ) / DIF( 5 ) ),
  508. $ ABS( DIF( 5 ) / DIFTRU( 5 ) ) )
  509. RESULT( 4 ) = MAX( RATIO1, RATIO2 )
  510. END IF
  511. *
  512. NTESTT = NTESTT + 4
  513. *
  514. * Print out tests which fail.
  515. *
  516. DO 20 J = 1, 4
  517. IF( ( RESULT( J ).GE.THRSH2 .AND. J.GE.4 ) .OR.
  518. $ ( RESULT( J ).GE.THRESH .AND. J.LE.3 ) )
  519. $ THEN
  520. *
  521. * If this is the first test to fail,
  522. * print a header to the data file.
  523. *
  524. IF( NERRS.EQ.0 ) THEN
  525. WRITE( NOUT, FMT = 9997 )'CXV'
  526. *
  527. * Print out messages for built-in examples
  528. *
  529. * Matrix types
  530. *
  531. WRITE( NOUT, FMT = 9995 )
  532. WRITE( NOUT, FMT = 9994 )
  533. WRITE( NOUT, FMT = 9993 )
  534. *
  535. * Tests performed
  536. *
  537. WRITE( NOUT, FMT = 9992 )'''',
  538. $ 'transpose', ''''
  539. *
  540. END IF
  541. NERRS = NERRS + 1
  542. IF( RESULT( J ).LT.10000.0 ) THEN
  543. WRITE( NOUT, FMT = 9991 )IPTYPE, IWA,
  544. $ IWB, IWX, IWY, J, RESULT( J )
  545. ELSE
  546. WRITE( NOUT, FMT = 9990 )IPTYPE, IWA,
  547. $ IWB, IWX, IWY, J, RESULT( J )
  548. END IF
  549. END IF
  550. 20 CONTINUE
  551. *
  552. 30 CONTINUE
  553. *
  554. 40 CONTINUE
  555. 50 CONTINUE
  556. 60 CONTINUE
  557. 70 CONTINUE
  558. 80 CONTINUE
  559. *
  560. GO TO 150
  561. *
  562. 90 CONTINUE
  563. *
  564. * Read in data from file to check accuracy of condition estimation
  565. * Read input data until N=0
  566. *
  567. READ( NIN, FMT = *, END = 150 )N
  568. IF( N.EQ.0 )
  569. $ GO TO 150
  570. DO 100 I = 1, N
  571. READ( NIN, FMT = * )( A( I, J ), J = 1, N )
  572. 100 CONTINUE
  573. DO 110 I = 1, N
  574. READ( NIN, FMT = * )( B( I, J ), J = 1, N )
  575. 110 CONTINUE
  576. READ( NIN, FMT = * )( STRU( I ), I = 1, N )
  577. READ( NIN, FMT = * )( DIFTRU( I ), I = 1, N )
  578. *
  579. NPTKNT = NPTKNT + 1
  580. *
  581. * Compute eigenvalues/eigenvectors of (A, B).
  582. * Compute eigenvalue/eigenvector condition numbers
  583. * using computed eigenvectors.
  584. *
  585. CALL CLACPY( 'F', N, N, A, LDA, AI, LDA )
  586. CALL CLACPY( 'F', N, N, B, LDA, BI, LDA )
  587. *
  588. CALL CGGEVX( 'N', 'V', 'V', 'B', N, AI, LDA, BI, LDA, ALPHA, BETA,
  589. $ VL, LDA, VR, LDA, ILO, IHI, LSCALE, RSCALE, ANORM,
  590. $ BNORM, S, DIF, WORK, LWORK, RWORK, IWORK, BWORK,
  591. $ LINFO )
  592. *
  593. IF( LINFO.NE.0 ) THEN
  594. WRITE( NOUT, FMT = 9987 )'CGGEVX', LINFO, N, NPTKNT
  595. GO TO 140
  596. END IF
  597. *
  598. * Compute the norm(A, B)
  599. *
  600. CALL CLACPY( 'Full', N, N, AI, LDA, WORK, N )
  601. CALL CLACPY( 'Full', N, N, BI, LDA, WORK( N*N+1 ), N )
  602. ABNORM = CLANGE( 'Fro', N, 2*N, WORK, N, RWORK )
  603. *
  604. * Tests (1) and (2)
  605. *
  606. RESULT( 1 ) = ZERO
  607. CALL CGET52( .TRUE., N, A, LDA, B, LDA, VL, LDA, ALPHA, BETA,
  608. $ WORK, RWORK, RESULT( 1 ) )
  609. IF( RESULT( 2 ).GT.THRESH ) THEN
  610. WRITE( NOUT, FMT = 9986 )'Left', 'CGGEVX', RESULT( 2 ), N,
  611. $ NPTKNT
  612. END IF
  613. *
  614. RESULT( 2 ) = ZERO
  615. CALL CGET52( .FALSE., N, A, LDA, B, LDA, VR, LDA, ALPHA, BETA,
  616. $ WORK, RWORK, RESULT( 2 ) )
  617. IF( RESULT( 3 ).GT.THRESH ) THEN
  618. WRITE( NOUT, FMT = 9986 )'Right', 'CGGEVX', RESULT( 3 ), N,
  619. $ NPTKNT
  620. END IF
  621. *
  622. * Test (3)
  623. *
  624. RESULT( 3 ) = ZERO
  625. DO 120 I = 1, N
  626. IF( S( I ).EQ.ZERO ) THEN
  627. IF( STRU( I ).GT.ABNORM*ULP )
  628. $ RESULT( 3 ) = ULPINV
  629. ELSE IF( STRU( I ).EQ.ZERO ) THEN
  630. IF( S( I ).GT.ABNORM*ULP )
  631. $ RESULT( 3 ) = ULPINV
  632. ELSE
  633. RWORK( I ) = MAX( ABS( STRU( I ) / S( I ) ),
  634. $ ABS( S( I ) / STRU( I ) ) )
  635. RESULT( 3 ) = MAX( RESULT( 3 ), RWORK( I ) )
  636. END IF
  637. 120 CONTINUE
  638. *
  639. * Test (4)
  640. *
  641. RESULT( 4 ) = ZERO
  642. IF( DIF( 1 ).EQ.ZERO ) THEN
  643. IF( DIFTRU( 1 ).GT.ABNORM*ULP )
  644. $ RESULT( 4 ) = ULPINV
  645. ELSE IF( DIFTRU( 1 ).EQ.ZERO ) THEN
  646. IF( DIF( 1 ).GT.ABNORM*ULP )
  647. $ RESULT( 4 ) = ULPINV
  648. ELSE IF( DIF( 5 ).EQ.ZERO ) THEN
  649. IF( DIFTRU( 5 ).GT.ABNORM*ULP )
  650. $ RESULT( 4 ) = ULPINV
  651. ELSE IF( DIFTRU( 5 ).EQ.ZERO ) THEN
  652. IF( DIF( 5 ).GT.ABNORM*ULP )
  653. $ RESULT( 4 ) = ULPINV
  654. ELSE
  655. RATIO1 = MAX( ABS( DIFTRU( 1 ) / DIF( 1 ) ),
  656. $ ABS( DIF( 1 ) / DIFTRU( 1 ) ) )
  657. RATIO2 = MAX( ABS( DIFTRU( 5 ) / DIF( 5 ) ),
  658. $ ABS( DIF( 5 ) / DIFTRU( 5 ) ) )
  659. RESULT( 4 ) = MAX( RATIO1, RATIO2 )
  660. END IF
  661. *
  662. NTESTT = NTESTT + 4
  663. *
  664. * Print out tests which fail.
  665. *
  666. DO 130 J = 1, 4
  667. IF( RESULT( J ).GE.THRSH2 ) THEN
  668. *
  669. * If this is the first test to fail,
  670. * print a header to the data file.
  671. *
  672. IF( NERRS.EQ.0 ) THEN
  673. WRITE( NOUT, FMT = 9997 )'CXV'
  674. *
  675. * Print out messages for built-in examples
  676. *
  677. * Matrix types
  678. *
  679. WRITE( NOUT, FMT = 9996 )
  680. *
  681. * Tests performed
  682. *
  683. WRITE( NOUT, FMT = 9992 )'''', 'transpose', ''''
  684. *
  685. END IF
  686. NERRS = NERRS + 1
  687. IF( RESULT( J ).LT.10000.0 ) THEN
  688. WRITE( NOUT, FMT = 9989 )NPTKNT, N, J, RESULT( J )
  689. ELSE
  690. WRITE( NOUT, FMT = 9988 )NPTKNT, N, J, RESULT( J )
  691. END IF
  692. END IF
  693. 130 CONTINUE
  694. *
  695. 140 CONTINUE
  696. *
  697. GO TO 90
  698. 150 CONTINUE
  699. *
  700. * Summary
  701. *
  702. CALL ALASVM( 'CXV', NOUT, NERRS, NTESTT, 0 )
  703. *
  704. WORK( 1 ) = MAXWRK
  705. *
  706. RETURN
  707. *
  708. 9999 FORMAT( ' CDRGVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
  709. $ I6, ', JTYPE=', I6, ')' )
  710. *
  711. 9998 FORMAT( ' CDRGVX: ', A, ' Eigenvectors from ', A, ' incorrectly ',
  712. $ 'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
  713. $ 'N=', I6, ', JTYPE=', I6, ', IWA=', I5, ', IWB=', I5,
  714. $ ', IWX=', I5, ', IWY=', I5 )
  715. *
  716. 9997 FORMAT( / 1X, A3, ' -- Complex Expert Eigenvalue/vector',
  717. $ ' problem driver' )
  718. *
  719. 9996 FORMAT( 'Input Example' )
  720. *
  721. 9995 FORMAT( ' Matrix types: ', / )
  722. *
  723. 9994 FORMAT( ' TYPE 1: Da is diagonal, Db is identity, ',
  724. $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
  725. $ / ' YH and X are left and right eigenvectors. ', / )
  726. *
  727. 9993 FORMAT( ' TYPE 2: Da is quasi-diagonal, Db is identity, ',
  728. $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
  729. $ / ' YH and X are left and right eigenvectors. ', / )
  730. *
  731. 9992 FORMAT( / ' Tests performed: ', / 4X,
  732. $ ' a is alpha, b is beta, l is a left eigenvector, ', / 4X,
  733. $ ' r is a right eigenvector and ', A, ' means ', A, '.',
  734. $ / ' 1 = max | ( b A - a B )', A, ' l | / const.',
  735. $ / ' 2 = max | ( b A - a B ) r | / const.',
  736. $ / ' 3 = max ( Sest/Stru, Stru/Sest ) ',
  737. $ ' over all eigenvalues', /
  738. $ ' 4 = max( DIFest/DIFtru, DIFtru/DIFest ) ',
  739. $ ' over the 1st and 5th eigenvectors', / )
  740. *
  741. 9991 FORMAT( ' Type=', I2, ',', ' IWA=', I2, ', IWB=', I2, ', IWX=',
  742. $ I2, ', IWY=', I2, ', result ', I2, ' is', 0P, F8.2 )
  743. *
  744. 9990 FORMAT( ' Type=', I2, ',', ' IWA=', I2, ', IWB=', I2, ', IWX=',
  745. $ I2, ', IWY=', I2, ', result ', I2, ' is', 1P, E10.3 )
  746. *
  747. 9989 FORMAT( ' Input example #', I2, ', matrix order=', I4, ',',
  748. $ ' result ', I2, ' is', 0P, F8.2 )
  749. *
  750. 9988 FORMAT( ' Input example #', I2, ', matrix order=', I4, ',',
  751. $ ' result ', I2, ' is', 1P, E10.3 )
  752. *
  753. 9987 FORMAT( ' CDRGVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
  754. $ I6, ', Input example #', I2, ')' )
  755. *
  756. 9986 FORMAT( ' CDRGVX: ', A, ' Eigenvectors from ', A, ' incorrectly ',
  757. $ 'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
  758. $ 'N=', I6, ', Input Example #', I2, ')' )
  759. *
  760. * End of CDRGVX
  761. *
  762. END