![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CGET37 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE CGET37( RMAX, LMAX, NINFO, KNT, NIN ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER KNT, NIN 00015 * .. 00016 * .. Array Arguments .. 00017 * INTEGER LMAX( 3 ), NINFO( 3 ) 00018 * REAL RMAX( 3 ) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> CGET37 tests CTRSNA, a routine for estimating condition numbers of 00028 *> eigenvalues and/or right eigenvectors of a matrix. 00029 *> 00030 *> The test matrices are read from a file with logical unit number NIN. 00031 *> \endverbatim 00032 * 00033 * Arguments: 00034 * ========== 00035 * 00036 *> \param[out] RMAX 00037 *> \verbatim 00038 *> RMAX is REAL array, dimension (3) 00039 *> Value of the largest test ratio. 00040 *> RMAX(1) = largest ratio comparing different calls to CTRSNA 00041 *> RMAX(2) = largest error in reciprocal condition 00042 *> numbers taking their conditioning into account 00043 *> RMAX(3) = largest error in reciprocal condition 00044 *> numbers not taking their conditioning into 00045 *> account (may be larger than RMAX(2)) 00046 *> \endverbatim 00047 *> 00048 *> \param[out] LMAX 00049 *> \verbatim 00050 *> LMAX is INTEGER array, dimension (3) 00051 *> LMAX(i) is example number where largest test ratio 00052 *> RMAX(i) is achieved. Also: 00053 *> If CGEHRD returns INFO nonzero on example i, LMAX(1)=i 00054 *> If CHSEQR returns INFO nonzero on example i, LMAX(2)=i 00055 *> If CTRSNA returns INFO nonzero on example i, LMAX(3)=i 00056 *> \endverbatim 00057 *> 00058 *> \param[out] NINFO 00059 *> \verbatim 00060 *> NINFO is INTEGER array, dimension (3) 00061 *> NINFO(1) = No. of times CGEHRD returned INFO nonzero 00062 *> NINFO(2) = No. of times CHSEQR returned INFO nonzero 00063 *> NINFO(3) = No. of times CTRSNA returned INFO nonzero 00064 *> \endverbatim 00065 *> 00066 *> \param[out] KNT 00067 *> \verbatim 00068 *> KNT is INTEGER 00069 *> Total number of examples tested. 00070 *> \endverbatim 00071 *> 00072 *> \param[in] NIN 00073 *> \verbatim 00074 *> NIN is INTEGER 00075 *> Input logical unit number 00076 *> \endverbatim 00077 * 00078 * Authors: 00079 * ======== 00080 * 00081 *> \author Univ. of Tennessee 00082 *> \author Univ. of California Berkeley 00083 *> \author Univ. of Colorado Denver 00084 *> \author NAG Ltd. 00085 * 00086 *> \date November 2011 00087 * 00088 *> \ingroup complex_eig 00089 * 00090 * ===================================================================== 00091 SUBROUTINE CGET37( RMAX, LMAX, NINFO, KNT, NIN ) 00092 * 00093 * -- LAPACK test routine (version 3.4.0) -- 00094 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00095 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00096 * November 2011 00097 * 00098 * .. Scalar Arguments .. 00099 INTEGER KNT, NIN 00100 * .. 00101 * .. Array Arguments .. 00102 INTEGER LMAX( 3 ), NINFO( 3 ) 00103 REAL RMAX( 3 ) 00104 * .. 00105 * 00106 * ===================================================================== 00107 * 00108 * .. Parameters .. 00109 REAL ZERO, ONE, TWO 00110 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 ) 00111 REAL EPSIN 00112 PARAMETER ( EPSIN = 5.9605E-8 ) 00113 INTEGER LDT, LWORK 00114 PARAMETER ( LDT = 20, LWORK = 2*LDT*( 10+LDT ) ) 00115 * .. 00116 * .. Local Scalars .. 00117 INTEGER I, ICMP, INFO, ISCL, ISRT, J, KMIN, M, N 00118 REAL BIGNUM, EPS, SMLNUM, TNRM, TOL, TOLIN, V, 00119 $ VCMIN, VMAX, VMIN, VMUL 00120 * .. 00121 * .. Local Arrays .. 00122 LOGICAL SELECT( LDT ) 00123 INTEGER LCMP( 3 ) 00124 REAL DUM( 1 ), RWORK( 2*LDT ), S( LDT ), SEP( LDT ), 00125 $ SEPIN( LDT ), SEPTMP( LDT ), SIN( LDT ), 00126 $ STMP( LDT ), VAL( 3 ), WIIN( LDT ), 00127 $ WRIN( LDT ), WSRT( LDT ) 00128 COMPLEX CDUM( 1 ), LE( LDT, LDT ), RE( LDT, LDT ), 00129 $ T( LDT, LDT ), TMP( LDT, LDT ), W( LDT ), 00130 $ WORK( LWORK ), WTMP( LDT ) 00131 * .. 00132 * .. External Functions .. 00133 REAL CLANGE, SLAMCH 00134 EXTERNAL CLANGE, SLAMCH 00135 * .. 00136 * .. External Subroutines .. 00137 EXTERNAL CCOPY, CGEHRD, CHSEQR, CLACPY, CSSCAL, CTREVC, 00138 $ CTRSNA, SCOPY, SLABAD, SSCAL 00139 * .. 00140 * .. Intrinsic Functions .. 00141 INTRINSIC AIMAG, MAX, REAL, SQRT 00142 * .. 00143 * .. Executable Statements .. 00144 * 00145 EPS = SLAMCH( 'P' ) 00146 SMLNUM = SLAMCH( 'S' ) / EPS 00147 BIGNUM = ONE / SMLNUM 00148 CALL SLABAD( SMLNUM, BIGNUM ) 00149 * 00150 * EPSIN = 2**(-24) = precision to which input data computed 00151 * 00152 EPS = MAX( EPS, EPSIN ) 00153 RMAX( 1 ) = ZERO 00154 RMAX( 2 ) = ZERO 00155 RMAX( 3 ) = ZERO 00156 LMAX( 1 ) = 0 00157 LMAX( 2 ) = 0 00158 LMAX( 3 ) = 0 00159 KNT = 0 00160 NINFO( 1 ) = 0 00161 NINFO( 2 ) = 0 00162 NINFO( 3 ) = 0 00163 VAL( 1 ) = SQRT( SMLNUM ) 00164 VAL( 2 ) = ONE 00165 VAL( 3 ) = SQRT( BIGNUM ) 00166 * 00167 * Read input data until N=0. Assume input eigenvalues are sorted 00168 * lexicographically (increasing by real part if ISRT = 0, 00169 * increasing by imaginary part if ISRT = 1) 00170 * 00171 10 CONTINUE 00172 READ( NIN, FMT = * )N, ISRT 00173 IF( N.EQ.0 ) 00174 $ RETURN 00175 DO 20 I = 1, N 00176 READ( NIN, FMT = * )( TMP( I, J ), J = 1, N ) 00177 20 CONTINUE 00178 DO 30 I = 1, N 00179 READ( NIN, FMT = * )WRIN( I ), WIIN( I ), SIN( I ), SEPIN( I ) 00180 30 CONTINUE 00181 TNRM = CLANGE( 'M', N, N, TMP, LDT, RWORK ) 00182 DO 260 ISCL = 1, 3 00183 * 00184 * Scale input matrix 00185 * 00186 KNT = KNT + 1 00187 CALL CLACPY( 'F', N, N, TMP, LDT, T, LDT ) 00188 VMUL = VAL( ISCL ) 00189 DO 40 I = 1, N 00190 CALL CSSCAL( N, VMUL, T( 1, I ), 1 ) 00191 40 CONTINUE 00192 IF( TNRM.EQ.ZERO ) 00193 $ VMUL = ONE 00194 * 00195 * Compute eigenvalues and eigenvectors 00196 * 00197 CALL CGEHRD( N, 1, N, T, LDT, WORK( 1 ), WORK( N+1 ), LWORK-N, 00198 $ INFO ) 00199 IF( INFO.NE.0 ) THEN 00200 LMAX( 1 ) = KNT 00201 NINFO( 1 ) = NINFO( 1 ) + 1 00202 GO TO 260 00203 END IF 00204 DO 60 J = 1, N - 2 00205 DO 50 I = J + 2, N 00206 T( I, J ) = ZERO 00207 50 CONTINUE 00208 60 CONTINUE 00209 * 00210 * Compute Schur form 00211 * 00212 CALL CHSEQR( 'S', 'N', N, 1, N, T, LDT, W, CDUM, 1, WORK, 00213 $ LWORK, INFO ) 00214 IF( INFO.NE.0 ) THEN 00215 LMAX( 2 ) = KNT 00216 NINFO( 2 ) = NINFO( 2 ) + 1 00217 GO TO 260 00218 END IF 00219 * 00220 * Compute eigenvectors 00221 * 00222 DO 70 I = 1, N 00223 SELECT( I ) = .TRUE. 00224 70 CONTINUE 00225 CALL CTREVC( 'B', 'A', SELECT, N, T, LDT, LE, LDT, RE, LDT, N, 00226 $ M, WORK, RWORK, INFO ) 00227 * 00228 * Compute condition numbers 00229 * 00230 CALL CTRSNA( 'B', 'A', SELECT, N, T, LDT, LE, LDT, RE, LDT, S, 00231 $ SEP, N, M, WORK, N, RWORK, INFO ) 00232 IF( INFO.NE.0 ) THEN 00233 LMAX( 3 ) = KNT 00234 NINFO( 3 ) = NINFO( 3 ) + 1 00235 GO TO 260 00236 END IF 00237 * 00238 * Sort eigenvalues and condition numbers lexicographically 00239 * to compare with inputs 00240 * 00241 CALL CCOPY( N, W, 1, WTMP, 1 ) 00242 IF( ISRT.EQ.0 ) THEN 00243 * 00244 * Sort by increasing real part 00245 * 00246 DO 80 I = 1, N 00247 WSRT( I ) = REAL( W( I ) ) 00248 80 CONTINUE 00249 ELSE 00250 * 00251 * Sort by increasing imaginary part 00252 * 00253 DO 90 I = 1, N 00254 WSRT( I ) = AIMAG( W( I ) ) 00255 90 CONTINUE 00256 END IF 00257 CALL SCOPY( N, S, 1, STMP, 1 ) 00258 CALL SCOPY( N, SEP, 1, SEPTMP, 1 ) 00259 CALL SSCAL( N, ONE / VMUL, SEPTMP, 1 ) 00260 DO 110 I = 1, N - 1 00261 KMIN = I 00262 VMIN = WSRT( I ) 00263 DO 100 J = I + 1, N 00264 IF( WSRT( J ).LT.VMIN ) THEN 00265 KMIN = J 00266 VMIN = WSRT( J ) 00267 END IF 00268 100 CONTINUE 00269 WSRT( KMIN ) = WSRT( I ) 00270 WSRT( I ) = VMIN 00271 VCMIN = WTMP( I ) 00272 WTMP( I ) = W( KMIN ) 00273 WTMP( KMIN ) = VCMIN 00274 VMIN = STMP( KMIN ) 00275 STMP( KMIN ) = STMP( I ) 00276 STMP( I ) = VMIN 00277 VMIN = SEPTMP( KMIN ) 00278 SEPTMP( KMIN ) = SEPTMP( I ) 00279 SEPTMP( I ) = VMIN 00280 110 CONTINUE 00281 * 00282 * Compare condition numbers for eigenvalues 00283 * taking their condition numbers into account 00284 * 00285 V = MAX( TWO*REAL( N )*EPS*TNRM, SMLNUM ) 00286 IF( TNRM.EQ.ZERO ) 00287 $ V = ONE 00288 DO 120 I = 1, N 00289 IF( V.GT.SEPTMP( I ) ) THEN 00290 TOL = ONE 00291 ELSE 00292 TOL = V / SEPTMP( I ) 00293 END IF 00294 IF( V.GT.SEPIN( I ) ) THEN 00295 TOLIN = ONE 00296 ELSE 00297 TOLIN = V / SEPIN( I ) 00298 END IF 00299 TOL = MAX( TOL, SMLNUM / EPS ) 00300 TOLIN = MAX( TOLIN, SMLNUM / EPS ) 00301 IF( EPS*( SIN( I )-TOLIN ).GT.STMP( I )+TOL ) THEN 00302 VMAX = ONE / EPS 00303 ELSE IF( SIN( I )-TOLIN.GT.STMP( I )+TOL ) THEN 00304 VMAX = ( SIN( I )-TOLIN ) / ( STMP( I )+TOL ) 00305 ELSE IF( SIN( I )+TOLIN.LT.EPS*( STMP( I )-TOL ) ) THEN 00306 VMAX = ONE / EPS 00307 ELSE IF( SIN( I )+TOLIN.LT.STMP( I )-TOL ) THEN 00308 VMAX = ( STMP( I )-TOL ) / ( SIN( I )+TOLIN ) 00309 ELSE 00310 VMAX = ONE 00311 END IF 00312 IF( VMAX.GT.RMAX( 2 ) ) THEN 00313 RMAX( 2 ) = VMAX 00314 IF( NINFO( 2 ).EQ.0 ) 00315 $ LMAX( 2 ) = KNT 00316 END IF 00317 120 CONTINUE 00318 * 00319 * Compare condition numbers for eigenvectors 00320 * taking their condition numbers into account 00321 * 00322 DO 130 I = 1, N 00323 IF( V.GT.SEPTMP( I )*STMP( I ) ) THEN 00324 TOL = SEPTMP( I ) 00325 ELSE 00326 TOL = V / STMP( I ) 00327 END IF 00328 IF( V.GT.SEPIN( I )*SIN( I ) ) THEN 00329 TOLIN = SEPIN( I ) 00330 ELSE 00331 TOLIN = V / SIN( I ) 00332 END IF 00333 TOL = MAX( TOL, SMLNUM / EPS ) 00334 TOLIN = MAX( TOLIN, SMLNUM / EPS ) 00335 IF( EPS*( SEPIN( I )-TOLIN ).GT.SEPTMP( I )+TOL ) THEN 00336 VMAX = ONE / EPS 00337 ELSE IF( SEPIN( I )-TOLIN.GT.SEPTMP( I )+TOL ) THEN 00338 VMAX = ( SEPIN( I )-TOLIN ) / ( SEPTMP( I )+TOL ) 00339 ELSE IF( SEPIN( I )+TOLIN.LT.EPS*( SEPTMP( I )-TOL ) ) THEN 00340 VMAX = ONE / EPS 00341 ELSE IF( SEPIN( I )+TOLIN.LT.SEPTMP( I )-TOL ) THEN 00342 VMAX = ( SEPTMP( I )-TOL ) / ( SEPIN( I )+TOLIN ) 00343 ELSE 00344 VMAX = ONE 00345 END IF 00346 IF( VMAX.GT.RMAX( 2 ) ) THEN 00347 RMAX( 2 ) = VMAX 00348 IF( NINFO( 2 ).EQ.0 ) 00349 $ LMAX( 2 ) = KNT 00350 END IF 00351 130 CONTINUE 00352 * 00353 * Compare condition numbers for eigenvalues 00354 * without taking their condition numbers into account 00355 * 00356 DO 140 I = 1, N 00357 IF( SIN( I ).LE.REAL( 2*N )*EPS .AND. STMP( I ).LE. 00358 $ REAL( 2*N )*EPS ) THEN 00359 VMAX = ONE 00360 ELSE IF( EPS*SIN( I ).GT.STMP( I ) ) THEN 00361 VMAX = ONE / EPS 00362 ELSE IF( SIN( I ).GT.STMP( I ) ) THEN 00363 VMAX = SIN( I ) / STMP( I ) 00364 ELSE IF( SIN( I ).LT.EPS*STMP( I ) ) THEN 00365 VMAX = ONE / EPS 00366 ELSE IF( SIN( I ).LT.STMP( I ) ) THEN 00367 VMAX = STMP( I ) / SIN( I ) 00368 ELSE 00369 VMAX = ONE 00370 END IF 00371 IF( VMAX.GT.RMAX( 3 ) ) THEN 00372 RMAX( 3 ) = VMAX 00373 IF( NINFO( 3 ).EQ.0 ) 00374 $ LMAX( 3 ) = KNT 00375 END IF 00376 140 CONTINUE 00377 * 00378 * Compare condition numbers for eigenvectors 00379 * without taking their condition numbers into account 00380 * 00381 DO 150 I = 1, N 00382 IF( SEPIN( I ).LE.V .AND. SEPTMP( I ).LE.V ) THEN 00383 VMAX = ONE 00384 ELSE IF( EPS*SEPIN( I ).GT.SEPTMP( I ) ) THEN 00385 VMAX = ONE / EPS 00386 ELSE IF( SEPIN( I ).GT.SEPTMP( I ) ) THEN 00387 VMAX = SEPIN( I ) / SEPTMP( I ) 00388 ELSE IF( SEPIN( I ).LT.EPS*SEPTMP( I ) ) THEN 00389 VMAX = ONE / EPS 00390 ELSE IF( SEPIN( I ).LT.SEPTMP( I ) ) THEN 00391 VMAX = SEPTMP( I ) / SEPIN( I ) 00392 ELSE 00393 VMAX = ONE 00394 END IF 00395 IF( VMAX.GT.RMAX( 3 ) ) THEN 00396 RMAX( 3 ) = VMAX 00397 IF( NINFO( 3 ).EQ.0 ) 00398 $ LMAX( 3 ) = KNT 00399 END IF 00400 150 CONTINUE 00401 * 00402 * Compute eigenvalue condition numbers only and compare 00403 * 00404 VMAX = ZERO 00405 DUM( 1 ) = -ONE 00406 CALL SCOPY( N, DUM, 0, STMP, 1 ) 00407 CALL SCOPY( N, DUM, 0, SEPTMP, 1 ) 00408 CALL CTRSNA( 'E', 'A', SELECT, N, T, LDT, LE, LDT, RE, LDT, 00409 $ STMP, SEPTMP, N, M, WORK, N, RWORK, INFO ) 00410 IF( INFO.NE.0 ) THEN 00411 LMAX( 3 ) = KNT 00412 NINFO( 3 ) = NINFO( 3 ) + 1 00413 GO TO 260 00414 END IF 00415 DO 160 I = 1, N 00416 IF( STMP( I ).NE.S( I ) ) 00417 $ VMAX = ONE / EPS 00418 IF( SEPTMP( I ).NE.DUM( 1 ) ) 00419 $ VMAX = ONE / EPS 00420 160 CONTINUE 00421 * 00422 * Compute eigenvector condition numbers only and compare 00423 * 00424 CALL SCOPY( N, DUM, 0, STMP, 1 ) 00425 CALL SCOPY( N, DUM, 0, SEPTMP, 1 ) 00426 CALL CTRSNA( 'V', 'A', SELECT, N, T, LDT, LE, LDT, RE, LDT, 00427 $ STMP, SEPTMP, N, M, WORK, N, RWORK, INFO ) 00428 IF( INFO.NE.0 ) THEN 00429 LMAX( 3 ) = KNT 00430 NINFO( 3 ) = NINFO( 3 ) + 1 00431 GO TO 260 00432 END IF 00433 DO 170 I = 1, N 00434 IF( STMP( I ).NE.DUM( 1 ) ) 00435 $ VMAX = ONE / EPS 00436 IF( SEPTMP( I ).NE.SEP( I ) ) 00437 $ VMAX = ONE / EPS 00438 170 CONTINUE 00439 * 00440 * Compute all condition numbers using SELECT and compare 00441 * 00442 DO 180 I = 1, N 00443 SELECT( I ) = .TRUE. 00444 180 CONTINUE 00445 CALL SCOPY( N, DUM, 0, STMP, 1 ) 00446 CALL SCOPY( N, DUM, 0, SEPTMP, 1 ) 00447 CALL CTRSNA( 'B', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT, 00448 $ STMP, SEPTMP, N, M, WORK, N, RWORK, INFO ) 00449 IF( INFO.NE.0 ) THEN 00450 LMAX( 3 ) = KNT 00451 NINFO( 3 ) = NINFO( 3 ) + 1 00452 GO TO 260 00453 END IF 00454 DO 190 I = 1, N 00455 IF( SEPTMP( I ).NE.SEP( I ) ) 00456 $ VMAX = ONE / EPS 00457 IF( STMP( I ).NE.S( I ) ) 00458 $ VMAX = ONE / EPS 00459 190 CONTINUE 00460 * 00461 * Compute eigenvalue condition numbers using SELECT and compare 00462 * 00463 CALL SCOPY( N, DUM, 0, STMP, 1 ) 00464 CALL SCOPY( N, DUM, 0, SEPTMP, 1 ) 00465 CALL CTRSNA( 'E', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT, 00466 $ STMP, SEPTMP, N, M, WORK, N, RWORK, INFO ) 00467 IF( INFO.NE.0 ) THEN 00468 LMAX( 3 ) = KNT 00469 NINFO( 3 ) = NINFO( 3 ) + 1 00470 GO TO 260 00471 END IF 00472 DO 200 I = 1, N 00473 IF( STMP( I ).NE.S( I ) ) 00474 $ VMAX = ONE / EPS 00475 IF( SEPTMP( I ).NE.DUM( 1 ) ) 00476 $ VMAX = ONE / EPS 00477 200 CONTINUE 00478 * 00479 * Compute eigenvector condition numbers using SELECT and compare 00480 * 00481 CALL SCOPY( N, DUM, 0, STMP, 1 ) 00482 CALL SCOPY( N, DUM, 0, SEPTMP, 1 ) 00483 CALL CTRSNA( 'V', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT, 00484 $ STMP, SEPTMP, N, M, WORK, N, RWORK, INFO ) 00485 IF( INFO.NE.0 ) THEN 00486 LMAX( 3 ) = KNT 00487 NINFO( 3 ) = NINFO( 3 ) + 1 00488 GO TO 260 00489 END IF 00490 DO 210 I = 1, N 00491 IF( STMP( I ).NE.DUM( 1 ) ) 00492 $ VMAX = ONE / EPS 00493 IF( SEPTMP( I ).NE.SEP( I ) ) 00494 $ VMAX = ONE / EPS 00495 210 CONTINUE 00496 IF( VMAX.GT.RMAX( 1 ) ) THEN 00497 RMAX( 1 ) = VMAX 00498 IF( NINFO( 1 ).EQ.0 ) 00499 $ LMAX( 1 ) = KNT 00500 END IF 00501 * 00502 * Select second and next to last eigenvalues 00503 * 00504 DO 220 I = 1, N 00505 SELECT( I ) = .FALSE. 00506 220 CONTINUE 00507 ICMP = 0 00508 IF( N.GT.1 ) THEN 00509 ICMP = 1 00510 LCMP( 1 ) = 2 00511 SELECT( 2 ) = .TRUE. 00512 CALL CCOPY( N, RE( 1, 2 ), 1, RE( 1, 1 ), 1 ) 00513 CALL CCOPY( N, LE( 1, 2 ), 1, LE( 1, 1 ), 1 ) 00514 END IF 00515 IF( N.GT.3 ) THEN 00516 ICMP = 2 00517 LCMP( 2 ) = N - 1 00518 SELECT( N-1 ) = .TRUE. 00519 CALL CCOPY( N, RE( 1, N-1 ), 1, RE( 1, 2 ), 1 ) 00520 CALL CCOPY( N, LE( 1, N-1 ), 1, LE( 1, 2 ), 1 ) 00521 END IF 00522 * 00523 * Compute all selected condition numbers 00524 * 00525 CALL SCOPY( ICMP, DUM, 0, STMP, 1 ) 00526 CALL SCOPY( ICMP, DUM, 0, SEPTMP, 1 ) 00527 CALL CTRSNA( 'B', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT, 00528 $ STMP, SEPTMP, N, M, WORK, N, RWORK, INFO ) 00529 IF( INFO.NE.0 ) THEN 00530 LMAX( 3 ) = KNT 00531 NINFO( 3 ) = NINFO( 3 ) + 1 00532 GO TO 260 00533 END IF 00534 DO 230 I = 1, ICMP 00535 J = LCMP( I ) 00536 IF( SEPTMP( I ).NE.SEP( J ) ) 00537 $ VMAX = ONE / EPS 00538 IF( STMP( I ).NE.S( J ) ) 00539 $ VMAX = ONE / EPS 00540 230 CONTINUE 00541 * 00542 * Compute selected eigenvalue condition numbers 00543 * 00544 CALL SCOPY( ICMP, DUM, 0, STMP, 1 ) 00545 CALL SCOPY( ICMP, DUM, 0, SEPTMP, 1 ) 00546 CALL CTRSNA( 'E', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT, 00547 $ STMP, SEPTMP, N, M, WORK, N, RWORK, INFO ) 00548 IF( INFO.NE.0 ) THEN 00549 LMAX( 3 ) = KNT 00550 NINFO( 3 ) = NINFO( 3 ) + 1 00551 GO TO 260 00552 END IF 00553 DO 240 I = 1, ICMP 00554 J = LCMP( I ) 00555 IF( STMP( I ).NE.S( J ) ) 00556 $ VMAX = ONE / EPS 00557 IF( SEPTMP( I ).NE.DUM( 1 ) ) 00558 $ VMAX = ONE / EPS 00559 240 CONTINUE 00560 * 00561 * Compute selected eigenvector condition numbers 00562 * 00563 CALL SCOPY( ICMP, DUM, 0, STMP, 1 ) 00564 CALL SCOPY( ICMP, DUM, 0, SEPTMP, 1 ) 00565 CALL CTRSNA( 'V', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT, 00566 $ STMP, SEPTMP, N, M, WORK, N, RWORK, INFO ) 00567 IF( INFO.NE.0 ) THEN 00568 LMAX( 3 ) = KNT 00569 NINFO( 3 ) = NINFO( 3 ) + 1 00570 GO TO 260 00571 END IF 00572 DO 250 I = 1, ICMP 00573 J = LCMP( I ) 00574 IF( STMP( I ).NE.DUM( 1 ) ) 00575 $ VMAX = ONE / EPS 00576 IF( SEPTMP( I ).NE.SEP( J ) ) 00577 $ VMAX = ONE / EPS 00578 250 CONTINUE 00579 IF( VMAX.GT.RMAX( 1 ) ) THEN 00580 RMAX( 1 ) = VMAX 00581 IF( NINFO( 1 ).EQ.0 ) 00582 $ LMAX( 1 ) = KNT 00583 END IF 00584 260 CONTINUE 00585 GO TO 10 00586 * 00587 * End of CGET37 00588 * 00589 END