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 November 2011 87* 88*> \ingroup double_eig 89* 90* ===================================================================== 91 SUBROUTINE DGET37( RMAX, LMAX, NINFO, KNT, NIN ) 92* 93* -- LAPACK test routine (version 3.4.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* November 2011 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 603