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.

sget23.f 28 kB

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