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.

dget37.f 19 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602
  1. *> \brief \b DGET37
  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 DGET37( RMAX, LMAX, NINFO, KNT, NIN )
  12. *
  13. * .. Scalar Arguments ..
  14. * INTEGER KNT, NIN
  15. * ..
  16. * .. Array Arguments ..
  17. * INTEGER LMAX( 3 ), NINFO( 3 )
  18. * DOUBLE PRECISION RMAX( 3 )
  19. * ..
  20. *
  21. *
  22. *> \par Purpose:
  23. * =============
  24. *>
  25. *> \verbatim
  26. *>
  27. *> DGET37 tests DTRSNA, a routine for estimating condition numbers of
  28. *> eigenvalues and/or right eigenvectors of a matrix.
  29. *>
  30. *> The test matrices are read from a file with logical unit number NIN.
  31. *> \endverbatim
  32. *
  33. * Arguments:
  34. * ==========
  35. *
  36. *> \param[out] RMAX
  37. *> \verbatim
  38. *> RMAX is DOUBLE PRECISION array, dimension (3)
  39. *> Value of the largest test ratio.
  40. *> RMAX(1) = largest ratio comparing different calls to DTRSNA
  41. *> RMAX(2) = largest error in reciprocal condition
  42. *> numbers taking their conditioning into account
  43. *> RMAX(3) = largest error in reciprocal condition
  44. *> numbers not taking their conditioning into
  45. *> account (may be larger than RMAX(2))
  46. *> \endverbatim
  47. *>
  48. *> \param[out] LMAX
  49. *> \verbatim
  50. *> LMAX is INTEGER array, dimension (3)
  51. *> LMAX(i) is example number where largest test ratio
  52. *> RMAX(i) is achieved. Also:
  53. *> If DGEHRD returns INFO nonzero on example i, LMAX(1)=i
  54. *> If DHSEQR returns INFO nonzero on example i, LMAX(2)=i
  55. *> If DTRSNA returns INFO nonzero on example i, LMAX(3)=i
  56. *> \endverbatim
  57. *>
  58. *> \param[out] NINFO
  59. *> \verbatim
  60. *> NINFO is INTEGER array, dimension (3)
  61. *> NINFO(1) = No. of times DGEHRD returned INFO nonzero
  62. *> NINFO(2) = No. of times DHSEQR returned INFO nonzero
  63. *> NINFO(3) = No. of times DTRSNA returned INFO nonzero
  64. *> \endverbatim
  65. *>
  66. *> \param[out] KNT
  67. *> \verbatim
  68. *> KNT is INTEGER
  69. *> Total number of examples tested.
  70. *> \endverbatim
  71. *>
  72. *> \param[in] NIN
  73. *> \verbatim
  74. *> NIN is INTEGER
  75. *> Input logical unit number
  76. *> \endverbatim
  77. *
  78. * Authors:
  79. * ========
  80. *
  81. *> \author Univ. of Tennessee
  82. *> \author Univ. of California Berkeley
  83. *> \author Univ. of Colorado Denver
  84. *> \author NAG Ltd.
  85. *
  86. *> \date December 2016
  87. *
  88. *> \ingroup double_eig
  89. *
  90. * =====================================================================
  91. SUBROUTINE DGET37( RMAX, LMAX, NINFO, KNT, NIN )
  92. *
  93. * -- LAPACK test routine (version 3.7.0) --
  94. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  95. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  96. * December 2016
  97. *
  98. * .. Scalar Arguments ..
  99. INTEGER KNT, NIN
  100. * ..
  101. * .. Array Arguments ..
  102. INTEGER LMAX( 3 ), NINFO( 3 )
  103. DOUBLE PRECISION RMAX( 3 )
  104. * ..
  105. *
  106. * =====================================================================
  107. *
  108. * .. Parameters ..
  109. DOUBLE PRECISION ZERO, ONE, TWO
  110. PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 )
  111. DOUBLE PRECISION EPSIN
  112. PARAMETER ( EPSIN = 5.9605D-8 )
  113. INTEGER LDT, LWORK
  114. PARAMETER ( LDT = 20, LWORK = 2*LDT*( 10+LDT ) )
  115. * ..
  116. * .. Local Scalars ..
  117. INTEGER I, ICMP, IFND, INFO, ISCL, J, KMIN, M, N
  118. DOUBLE PRECISION BIGNUM, EPS, SMLNUM, TNRM, TOL, TOLIN, V,
  119. $ VIMIN, VMAX, VMUL, VRMIN
  120. * ..
  121. * .. Local Arrays ..
  122. LOGICAL SELECT( LDT )
  123. INTEGER IWORK( 2*LDT ), LCMP( 3 )
  124. DOUBLE PRECISION DUM( 1 ), LE( LDT, LDT ), RE( LDT, LDT ),
  125. $ S( LDT ), SEP( LDT ), SEPIN( LDT ),
  126. $ SEPTMP( LDT ), SIN( LDT ), STMP( LDT ),
  127. $ T( LDT, LDT ), TMP( LDT, LDT ), VAL( 3 ),
  128. $ WI( LDT ), WIIN( LDT ), WITMP( LDT ),
  129. $ WORK( LWORK ), WR( LDT ), WRIN( LDT ),
  130. $ WRTMP( LDT )
  131. * ..
  132. * .. External Functions ..
  133. DOUBLE PRECISION DLAMCH, DLANGE
  134. EXTERNAL DLAMCH, DLANGE
  135. * ..
  136. * .. External Subroutines ..
  137. EXTERNAL DCOPY, DGEHRD, DHSEQR, DLABAD, DLACPY, DSCAL,
  138. $ DTREVC, DTRSNA
  139. * ..
  140. * .. Intrinsic Functions ..
  141. INTRINSIC DBLE, MAX, SQRT
  142. * ..
  143. * .. Executable Statements ..
  144. *
  145. EPS = DLAMCH( 'P' )
  146. SMLNUM = DLAMCH( 'S' ) / EPS
  147. BIGNUM = ONE / SMLNUM
  148. CALL DLABAD( SMLNUM, BIGNUM )
  149. *
  150. * EPSIN = 2**(-24) = precision to which input data computed
  151. *
  152. EPS = MAX( EPS, EPSIN )
  153. RMAX( 1 ) = ZERO
  154. RMAX( 2 ) = ZERO
  155. RMAX( 3 ) = ZERO
  156. LMAX( 1 ) = 0
  157. LMAX( 2 ) = 0
  158. LMAX( 3 ) = 0
  159. KNT = 0
  160. NINFO( 1 ) = 0
  161. NINFO( 2 ) = 0
  162. NINFO( 3 ) = 0
  163. *
  164. VAL( 1 ) = SQRT( SMLNUM )
  165. VAL( 2 ) = ONE
  166. VAL( 3 ) = SQRT( BIGNUM )
  167. *
  168. * Read input data until N=0. Assume input eigenvalues are sorted
  169. * lexicographically (increasing by real part, then decreasing by
  170. * imaginary part)
  171. *
  172. 10 CONTINUE
  173. READ( NIN, FMT = * )N
  174. IF( N.EQ.0 )
  175. $ RETURN
  176. DO 20 I = 1, N
  177. READ( NIN, FMT = * )( TMP( I, J ), J = 1, N )
  178. 20 CONTINUE
  179. DO 30 I = 1, N
  180. READ( NIN, FMT = * )WRIN( I ), WIIN( I ), SIN( I ), SEPIN( I )
  181. 30 CONTINUE
  182. TNRM = DLANGE( 'M', N, N, TMP, LDT, WORK )
  183. *
  184. * Begin test
  185. *
  186. DO 240 ISCL = 1, 3
  187. *
  188. * Scale input matrix
  189. *
  190. KNT = KNT + 1
  191. CALL DLACPY( 'F', N, N, TMP, LDT, T, LDT )
  192. VMUL = VAL( ISCL )
  193. DO 40 I = 1, N
  194. CALL DSCAL( N, VMUL, T( 1, I ), 1 )
  195. 40 CONTINUE
  196. IF( TNRM.EQ.ZERO )
  197. $ VMUL = ONE
  198. *
  199. * Compute eigenvalues and eigenvectors
  200. *
  201. CALL DGEHRD( N, 1, N, T, LDT, WORK( 1 ), WORK( N+1 ), LWORK-N,
  202. $ INFO )
  203. IF( INFO.NE.0 ) THEN
  204. LMAX( 1 ) = KNT
  205. NINFO( 1 ) = NINFO( 1 ) + 1
  206. GO TO 240
  207. END IF
  208. DO 60 J = 1, N - 2
  209. DO 50 I = J + 2, N
  210. T( I, J ) = ZERO
  211. 50 CONTINUE
  212. 60 CONTINUE
  213. *
  214. * Compute Schur form
  215. *
  216. CALL DHSEQR( 'S', 'N', N, 1, N, T, LDT, WR, WI, DUM, 1, WORK,
  217. $ LWORK, INFO )
  218. IF( INFO.NE.0 ) THEN
  219. LMAX( 2 ) = KNT
  220. NINFO( 2 ) = NINFO( 2 ) + 1
  221. GO TO 240
  222. END IF
  223. *
  224. * Compute eigenvectors
  225. *
  226. CALL DTREVC( 'Both', 'All', SELECT, N, T, LDT, LE, LDT, RE,
  227. $ LDT, N, M, WORK, INFO )
  228. *
  229. * Compute condition numbers
  230. *
  231. CALL DTRSNA( 'Both', 'All', SELECT, N, T, LDT, LE, LDT, RE,
  232. $ LDT, S, SEP, N, M, WORK, N, IWORK, INFO )
  233. IF( INFO.NE.0 ) THEN
  234. LMAX( 3 ) = KNT
  235. NINFO( 3 ) = NINFO( 3 ) + 1
  236. GO TO 240
  237. END IF
  238. *
  239. * Sort eigenvalues and condition numbers lexicographically
  240. * to compare with inputs
  241. *
  242. CALL DCOPY( N, WR, 1, WRTMP, 1 )
  243. CALL DCOPY( N, WI, 1, WITMP, 1 )
  244. CALL DCOPY( N, S, 1, STMP, 1 )
  245. CALL DCOPY( N, SEP, 1, SEPTMP, 1 )
  246. CALL DSCAL( N, ONE / VMUL, SEPTMP, 1 )
  247. DO 80 I = 1, N - 1
  248. KMIN = I
  249. VRMIN = WRTMP( I )
  250. VIMIN = WITMP( I )
  251. DO 70 J = I + 1, N
  252. IF( WRTMP( J ).LT.VRMIN ) THEN
  253. KMIN = J
  254. VRMIN = WRTMP( J )
  255. VIMIN = WITMP( J )
  256. END IF
  257. 70 CONTINUE
  258. WRTMP( KMIN ) = WRTMP( I )
  259. WITMP( KMIN ) = WITMP( I )
  260. WRTMP( I ) = VRMIN
  261. WITMP( I ) = VIMIN
  262. VRMIN = STMP( KMIN )
  263. STMP( KMIN ) = STMP( I )
  264. STMP( I ) = VRMIN
  265. VRMIN = SEPTMP( KMIN )
  266. SEPTMP( KMIN ) = SEPTMP( I )
  267. SEPTMP( I ) = VRMIN
  268. 80 CONTINUE
  269. *
  270. * Compare condition numbers for eigenvalues
  271. * taking their condition numbers into account
  272. *
  273. V = MAX( TWO*DBLE( N )*EPS*TNRM, SMLNUM )
  274. IF( TNRM.EQ.ZERO )
  275. $ V = ONE
  276. DO 90 I = 1, N
  277. IF( V.GT.SEPTMP( I ) ) THEN
  278. TOL = ONE
  279. ELSE
  280. TOL = V / SEPTMP( I )
  281. END IF
  282. IF( V.GT.SEPIN( I ) ) THEN
  283. TOLIN = ONE
  284. ELSE
  285. TOLIN = V / SEPIN( I )
  286. END IF
  287. TOL = MAX( TOL, SMLNUM / EPS )
  288. TOLIN = MAX( TOLIN, SMLNUM / EPS )
  289. IF( EPS*( SIN( I )-TOLIN ).GT.STMP( I )+TOL ) THEN
  290. VMAX = ONE / EPS
  291. ELSE IF( SIN( I )-TOLIN.GT.STMP( I )+TOL ) THEN
  292. VMAX = ( SIN( I )-TOLIN ) / ( STMP( I )+TOL )
  293. ELSE IF( SIN( I )+TOLIN.LT.EPS*( STMP( I )-TOL ) ) THEN
  294. VMAX = ONE / EPS
  295. ELSE IF( SIN( I )+TOLIN.LT.STMP( I )-TOL ) THEN
  296. VMAX = ( STMP( I )-TOL ) / ( SIN( I )+TOLIN )
  297. ELSE
  298. VMAX = ONE
  299. END IF
  300. IF( VMAX.GT.RMAX( 2 ) ) THEN
  301. RMAX( 2 ) = VMAX
  302. IF( NINFO( 2 ).EQ.0 )
  303. $ LMAX( 2 ) = KNT
  304. END IF
  305. 90 CONTINUE
  306. *
  307. * Compare condition numbers for eigenvectors
  308. * taking their condition numbers into account
  309. *
  310. DO 100 I = 1, N
  311. IF( V.GT.SEPTMP( I )*STMP( I ) ) THEN
  312. TOL = SEPTMP( I )
  313. ELSE
  314. TOL = V / STMP( I )
  315. END IF
  316. IF( V.GT.SEPIN( I )*SIN( I ) ) THEN
  317. TOLIN = SEPIN( I )
  318. ELSE
  319. TOLIN = V / SIN( I )
  320. END IF
  321. TOL = MAX( TOL, SMLNUM / EPS )
  322. TOLIN = MAX( TOLIN, SMLNUM / EPS )
  323. IF( EPS*( SEPIN( I )-TOLIN ).GT.SEPTMP( I )+TOL ) THEN
  324. VMAX = ONE / EPS
  325. ELSE IF( SEPIN( I )-TOLIN.GT.SEPTMP( I )+TOL ) THEN
  326. VMAX = ( SEPIN( I )-TOLIN ) / ( SEPTMP( I )+TOL )
  327. ELSE IF( SEPIN( I )+TOLIN.LT.EPS*( SEPTMP( I )-TOL ) ) THEN
  328. VMAX = ONE / EPS
  329. ELSE IF( SEPIN( I )+TOLIN.LT.SEPTMP( I )-TOL ) THEN
  330. VMAX = ( SEPTMP( I )-TOL ) / ( SEPIN( I )+TOLIN )
  331. ELSE
  332. VMAX = ONE
  333. END IF
  334. IF( VMAX.GT.RMAX( 2 ) ) THEN
  335. RMAX( 2 ) = VMAX
  336. IF( NINFO( 2 ).EQ.0 )
  337. $ LMAX( 2 ) = KNT
  338. END IF
  339. 100 CONTINUE
  340. *
  341. * Compare condition numbers for eigenvalues
  342. * without taking their condition numbers into account
  343. *
  344. DO 110 I = 1, N
  345. IF( SIN( I ).LE.DBLE( 2*N )*EPS .AND. STMP( I ).LE.
  346. $ DBLE( 2*N )*EPS ) THEN
  347. VMAX = ONE
  348. ELSE IF( EPS*SIN( I ).GT.STMP( I ) ) THEN
  349. VMAX = ONE / EPS
  350. ELSE IF( SIN( I ).GT.STMP( I ) ) THEN
  351. VMAX = SIN( I ) / STMP( I )
  352. ELSE IF( SIN( I ).LT.EPS*STMP( I ) ) THEN
  353. VMAX = ONE / EPS
  354. ELSE IF( SIN( I ).LT.STMP( I ) ) THEN
  355. VMAX = STMP( I ) / SIN( I )
  356. ELSE
  357. VMAX = ONE
  358. END IF
  359. IF( VMAX.GT.RMAX( 3 ) ) THEN
  360. RMAX( 3 ) = VMAX
  361. IF( NINFO( 3 ).EQ.0 )
  362. $ LMAX( 3 ) = KNT
  363. END IF
  364. 110 CONTINUE
  365. *
  366. * Compare condition numbers for eigenvectors
  367. * without taking their condition numbers into account
  368. *
  369. DO 120 I = 1, N
  370. IF( SEPIN( I ).LE.V .AND. SEPTMP( I ).LE.V ) THEN
  371. VMAX = ONE
  372. ELSE IF( EPS*SEPIN( I ).GT.SEPTMP( I ) ) THEN
  373. VMAX = ONE / EPS
  374. ELSE IF( SEPIN( I ).GT.SEPTMP( I ) ) THEN
  375. VMAX = SEPIN( I ) / SEPTMP( I )
  376. ELSE IF( SEPIN( I ).LT.EPS*SEPTMP( I ) ) THEN
  377. VMAX = ONE / EPS
  378. ELSE IF( SEPIN( I ).LT.SEPTMP( I ) ) THEN
  379. VMAX = SEPTMP( I ) / SEPIN( I )
  380. ELSE
  381. VMAX = ONE
  382. END IF
  383. IF( VMAX.GT.RMAX( 3 ) ) THEN
  384. RMAX( 3 ) = VMAX
  385. IF( NINFO( 3 ).EQ.0 )
  386. $ LMAX( 3 ) = KNT
  387. END IF
  388. 120 CONTINUE
  389. *
  390. * Compute eigenvalue condition numbers only and compare
  391. *
  392. VMAX = ZERO
  393. DUM( 1 ) = -ONE
  394. CALL DCOPY( N, DUM, 0, STMP, 1 )
  395. CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
  396. CALL DTRSNA( 'Eigcond', 'All', SELECT, N, T, LDT, LE, LDT, RE,
  397. $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
  398. IF( INFO.NE.0 ) THEN
  399. LMAX( 3 ) = KNT
  400. NINFO( 3 ) = NINFO( 3 ) + 1
  401. GO TO 240
  402. END IF
  403. DO 130 I = 1, N
  404. IF( STMP( I ).NE.S( I ) )
  405. $ VMAX = ONE / EPS
  406. IF( SEPTMP( I ).NE.DUM( 1 ) )
  407. $ VMAX = ONE / EPS
  408. 130 CONTINUE
  409. *
  410. * Compute eigenvector condition numbers only and compare
  411. *
  412. CALL DCOPY( N, DUM, 0, STMP, 1 )
  413. CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
  414. CALL DTRSNA( 'Veccond', 'All', SELECT, N, T, LDT, LE, LDT, RE,
  415. $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
  416. IF( INFO.NE.0 ) THEN
  417. LMAX( 3 ) = KNT
  418. NINFO( 3 ) = NINFO( 3 ) + 1
  419. GO TO 240
  420. END IF
  421. DO 140 I = 1, N
  422. IF( STMP( I ).NE.DUM( 1 ) )
  423. $ VMAX = ONE / EPS
  424. IF( SEPTMP( I ).NE.SEP( I ) )
  425. $ VMAX = ONE / EPS
  426. 140 CONTINUE
  427. *
  428. * Compute all condition numbers using SELECT and compare
  429. *
  430. DO 150 I = 1, N
  431. SELECT( I ) = .TRUE.
  432. 150 CONTINUE
  433. CALL DCOPY( N, DUM, 0, STMP, 1 )
  434. CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
  435. CALL DTRSNA( 'Bothcond', 'Some', SELECT, N, T, LDT, LE, LDT,
  436. $ RE, LDT, STMP, SEPTMP, N, M, WORK, N, IWORK,
  437. $ INFO )
  438. IF( INFO.NE.0 ) THEN
  439. LMAX( 3 ) = KNT
  440. NINFO( 3 ) = NINFO( 3 ) + 1
  441. GO TO 240
  442. END IF
  443. DO 160 I = 1, N
  444. IF( SEPTMP( I ).NE.SEP( I ) )
  445. $ VMAX = ONE / EPS
  446. IF( STMP( I ).NE.S( I ) )
  447. $ VMAX = ONE / EPS
  448. 160 CONTINUE
  449. *
  450. * Compute eigenvalue condition numbers using SELECT and compare
  451. *
  452. CALL DCOPY( N, DUM, 0, STMP, 1 )
  453. CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
  454. CALL DTRSNA( 'Eigcond', 'Some', SELECT, N, T, LDT, LE, LDT, RE,
  455. $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
  456. IF( INFO.NE.0 ) THEN
  457. LMAX( 3 ) = KNT
  458. NINFO( 3 ) = NINFO( 3 ) + 1
  459. GO TO 240
  460. END IF
  461. DO 170 I = 1, N
  462. IF( STMP( I ).NE.S( I ) )
  463. $ VMAX = ONE / EPS
  464. IF( SEPTMP( I ).NE.DUM( 1 ) )
  465. $ VMAX = ONE / EPS
  466. 170 CONTINUE
  467. *
  468. * Compute eigenvector condition numbers using SELECT and compare
  469. *
  470. CALL DCOPY( N, DUM, 0, STMP, 1 )
  471. CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
  472. CALL DTRSNA( 'Veccond', 'Some', SELECT, N, T, LDT, LE, LDT, RE,
  473. $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
  474. IF( INFO.NE.0 ) THEN
  475. LMAX( 3 ) = KNT
  476. NINFO( 3 ) = NINFO( 3 ) + 1
  477. GO TO 240
  478. END IF
  479. DO 180 I = 1, N
  480. IF( STMP( I ).NE.DUM( 1 ) )
  481. $ VMAX = ONE / EPS
  482. IF( SEPTMP( I ).NE.SEP( I ) )
  483. $ VMAX = ONE / EPS
  484. 180 CONTINUE
  485. IF( VMAX.GT.RMAX( 1 ) ) THEN
  486. RMAX( 1 ) = VMAX
  487. IF( NINFO( 1 ).EQ.0 )
  488. $ LMAX( 1 ) = KNT
  489. END IF
  490. *
  491. * Select first real and first complex eigenvalue
  492. *
  493. IF( WI( 1 ).EQ.ZERO ) THEN
  494. LCMP( 1 ) = 1
  495. IFND = 0
  496. DO 190 I = 2, N
  497. IF( IFND.EQ.1 .OR. WI( I ).EQ.ZERO ) THEN
  498. SELECT( I ) = .FALSE.
  499. ELSE
  500. IFND = 1
  501. LCMP( 2 ) = I
  502. LCMP( 3 ) = I + 1
  503. CALL DCOPY( N, RE( 1, I ), 1, RE( 1, 2 ), 1 )
  504. CALL DCOPY( N, RE( 1, I+1 ), 1, RE( 1, 3 ), 1 )
  505. CALL DCOPY( N, LE( 1, I ), 1, LE( 1, 2 ), 1 )
  506. CALL DCOPY( N, LE( 1, I+1 ), 1, LE( 1, 3 ), 1 )
  507. END IF
  508. 190 CONTINUE
  509. IF( IFND.EQ.0 ) THEN
  510. ICMP = 1
  511. ELSE
  512. ICMP = 3
  513. END IF
  514. ELSE
  515. LCMP( 1 ) = 1
  516. LCMP( 2 ) = 2
  517. IFND = 0
  518. DO 200 I = 3, N
  519. IF( IFND.EQ.1 .OR. WI( I ).NE.ZERO ) THEN
  520. SELECT( I ) = .FALSE.
  521. ELSE
  522. LCMP( 3 ) = I
  523. IFND = 1
  524. CALL DCOPY( N, RE( 1, I ), 1, RE( 1, 3 ), 1 )
  525. CALL DCOPY( N, LE( 1, I ), 1, LE( 1, 3 ), 1 )
  526. END IF
  527. 200 CONTINUE
  528. IF( IFND.EQ.0 ) THEN
  529. ICMP = 2
  530. ELSE
  531. ICMP = 3
  532. END IF
  533. END IF
  534. *
  535. * Compute all selected condition numbers
  536. *
  537. CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
  538. CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
  539. CALL DTRSNA( 'Bothcond', 'Some', SELECT, N, T, LDT, LE, LDT,
  540. $ RE, LDT, STMP, SEPTMP, N, M, WORK, N, IWORK,
  541. $ INFO )
  542. IF( INFO.NE.0 ) THEN
  543. LMAX( 3 ) = KNT
  544. NINFO( 3 ) = NINFO( 3 ) + 1
  545. GO TO 240
  546. END IF
  547. DO 210 I = 1, ICMP
  548. J = LCMP( I )
  549. IF( SEPTMP( I ).NE.SEP( J ) )
  550. $ VMAX = ONE / EPS
  551. IF( STMP( I ).NE.S( J ) )
  552. $ VMAX = ONE / EPS
  553. 210 CONTINUE
  554. *
  555. * Compute selected eigenvalue condition numbers
  556. *
  557. CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
  558. CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
  559. CALL DTRSNA( 'Eigcond', 'Some', SELECT, N, T, LDT, LE, LDT, RE,
  560. $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
  561. IF( INFO.NE.0 ) THEN
  562. LMAX( 3 ) = KNT
  563. NINFO( 3 ) = NINFO( 3 ) + 1
  564. GO TO 240
  565. END IF
  566. DO 220 I = 1, ICMP
  567. J = LCMP( I )
  568. IF( STMP( I ).NE.S( J ) )
  569. $ VMAX = ONE / EPS
  570. IF( SEPTMP( I ).NE.DUM( 1 ) )
  571. $ VMAX = ONE / EPS
  572. 220 CONTINUE
  573. *
  574. * Compute selected eigenvector condition numbers
  575. *
  576. CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
  577. CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
  578. CALL DTRSNA( 'Veccond', 'Some', SELECT, N, T, LDT, LE, LDT, RE,
  579. $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
  580. IF( INFO.NE.0 ) THEN
  581. LMAX( 3 ) = KNT
  582. NINFO( 3 ) = NINFO( 3 ) + 1
  583. GO TO 240
  584. END IF
  585. DO 230 I = 1, ICMP
  586. J = LCMP( I )
  587. IF( STMP( I ).NE.DUM( 1 ) )
  588. $ VMAX = ONE / EPS
  589. IF( SEPTMP( I ).NE.SEP( J ) )
  590. $ VMAX = ONE / EPS
  591. 230 CONTINUE
  592. IF( VMAX.GT.RMAX( 1 ) ) THEN
  593. RMAX( 1 ) = VMAX
  594. IF( NINFO( 1 ).EQ.0 )
  595. $ LMAX( 1 ) = KNT
  596. END IF
  597. 240 CONTINUE
  598. GO TO 10
  599. *
  600. * End of DGET37
  601. *
  602. END