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

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