![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SGET37 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 SGET37( 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 *> SGET37 tests STRSNA, 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 STRSNA 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 SGEHRD returns INFO nonzero on example i, LMAX(1)=i 00054 *> If SHSEQR returns INFO nonzero on example i, LMAX(2)=i 00055 *> If STRSNA 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 SGEHRD returned INFO nonzero 00062 *> NINFO(2) = No. of times SHSEQR returned INFO nonzero 00063 *> NINFO(3) = No. of times STRSNA 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 single_eig 00089 * 00090 * ===================================================================== 00091 SUBROUTINE SGET37( 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, IFND, INFO, ISCL, J, KMIN, M, N 00118 REAL BIGNUM, EPS, SMLNUM, TNRM, TOL, TOLIN, V, 00119 $ VIMIN, VMAX, VMUL, VRMIN 00120 * .. 00121 * .. Local Arrays .. 00122 LOGICAL SELECT( LDT ) 00123 INTEGER IWORK( 2*LDT ), LCMP( 3 ) 00124 REAL DUM( 1 ), LE( LDT, LDT ), RE( LDT, LDT ), 00125 $ S( LDT ), SEP( LDT ), SEPIN( LDT ), 00126 $ SEPTMP( LDT ), SIN( LDT ), STMP( LDT ), 00127 $ T( LDT, LDT ), TMP( LDT, LDT ), VAL( 3 ), 00128 $ WI( LDT ), WIIN( LDT ), WITMP( LDT ), 00129 $ WORK( LWORK ), WR( LDT ), WRIN( LDT ), 00130 $ WRTMP( LDT ) 00131 * .. 00132 * .. External Functions .. 00133 REAL SLAMCH, SLANGE 00134 EXTERNAL SLAMCH, SLANGE 00135 * .. 00136 * .. External Subroutines .. 00137 EXTERNAL SCOPY, SGEHRD, SHSEQR, SLABAD, SLACPY, SSCAL, 00138 $ STREVC, STRSNA 00139 * .. 00140 * .. Intrinsic Functions .. 00141 INTRINSIC 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 * 00164 VAL( 1 ) = SQRT( SMLNUM ) 00165 VAL( 2 ) = ONE 00166 VAL( 3 ) = SQRT( BIGNUM ) 00167 * 00168 * Read input data until N=0. Assume input eigenvalues are sorted 00169 * lexicographically (increasing by real part, then decreasing by 00170 * imaginary part) 00171 * 00172 10 CONTINUE 00173 READ( NIN, FMT = * )N 00174 IF( N.EQ.0 ) 00175 $ RETURN 00176 DO 20 I = 1, N 00177 READ( NIN, FMT = * )( TMP( I, J ), J = 1, N ) 00178 20 CONTINUE 00179 DO 30 I = 1, N 00180 READ( NIN, FMT = * )WRIN( I ), WIIN( I ), SIN( I ), SEPIN( I ) 00181 30 CONTINUE 00182 TNRM = SLANGE( 'M', N, N, TMP, LDT, WORK ) 00183 * 00184 * Begin test 00185 * 00186 DO 240 ISCL = 1, 3 00187 * 00188 * Scale input matrix 00189 * 00190 KNT = KNT + 1 00191 CALL SLACPY( 'F', N, N, TMP, LDT, T, LDT ) 00192 VMUL = VAL( ISCL ) 00193 DO 40 I = 1, N 00194 CALL SSCAL( N, VMUL, T( 1, I ), 1 ) 00195 40 CONTINUE 00196 IF( TNRM.EQ.ZERO ) 00197 $ VMUL = ONE 00198 * 00199 * Compute eigenvalues and eigenvectors 00200 * 00201 CALL SGEHRD( N, 1, N, T, LDT, WORK( 1 ), WORK( N+1 ), LWORK-N, 00202 $ INFO ) 00203 IF( INFO.NE.0 ) THEN 00204 LMAX( 1 ) = KNT 00205 NINFO( 1 ) = NINFO( 1 ) + 1 00206 GO TO 240 00207 END IF 00208 DO 60 J = 1, N - 2 00209 DO 50 I = J + 2, N 00210 T( I, J ) = ZERO 00211 50 CONTINUE 00212 60 CONTINUE 00213 * 00214 * Compute Schur form 00215 * 00216 CALL SHSEQR( 'S', 'N', N, 1, N, T, LDT, WR, WI, DUM, 1, WORK, 00217 $ LWORK, INFO ) 00218 IF( INFO.NE.0 ) THEN 00219 LMAX( 2 ) = KNT 00220 NINFO( 2 ) = NINFO( 2 ) + 1 00221 GO TO 240 00222 END IF 00223 * 00224 * Compute eigenvectors 00225 * 00226 CALL STREVC( 'Both', 'All', SELECT, N, T, LDT, LE, LDT, RE, 00227 $ LDT, N, M, WORK, INFO ) 00228 * 00229 * Compute condition numbers 00230 * 00231 CALL STRSNA( 'Both', 'All', SELECT, N, T, LDT, LE, LDT, RE, 00232 $ LDT, S, SEP, N, M, WORK, N, IWORK, INFO ) 00233 IF( INFO.NE.0 ) THEN 00234 LMAX( 3 ) = KNT 00235 NINFO( 3 ) = NINFO( 3 ) + 1 00236 GO TO 240 00237 END IF 00238 * 00239 * Sort eigenvalues and condition numbers lexicographically 00240 * to compare with inputs 00241 * 00242 CALL SCOPY( N, WR, 1, WRTMP, 1 ) 00243 CALL SCOPY( N, WI, 1, WITMP, 1 ) 00244 CALL SCOPY( N, S, 1, STMP, 1 ) 00245 CALL SCOPY( N, SEP, 1, SEPTMP, 1 ) 00246 CALL SSCAL( N, ONE / VMUL, SEPTMP, 1 ) 00247 DO 80 I = 1, N - 1 00248 KMIN = I 00249 VRMIN = WRTMP( I ) 00250 VIMIN = WITMP( I ) 00251 DO 70 J = I + 1, N 00252 IF( WRTMP( J ).LT.VRMIN ) THEN 00253 KMIN = J 00254 VRMIN = WRTMP( J ) 00255 VIMIN = WITMP( J ) 00256 END IF 00257 70 CONTINUE 00258 WRTMP( KMIN ) = WRTMP( I ) 00259 WITMP( KMIN ) = WITMP( I ) 00260 WRTMP( I ) = VRMIN 00261 WITMP( I ) = VIMIN 00262 VRMIN = STMP( KMIN ) 00263 STMP( KMIN ) = STMP( I ) 00264 STMP( I ) = VRMIN 00265 VRMIN = SEPTMP( KMIN ) 00266 SEPTMP( KMIN ) = SEPTMP( I ) 00267 SEPTMP( I ) = VRMIN 00268 80 CONTINUE 00269 * 00270 * Compare condition numbers for eigenvalues 00271 * taking their condition numbers into account 00272 * 00273 V = MAX( TWO*REAL( N )*EPS*TNRM, SMLNUM ) 00274 IF( TNRM.EQ.ZERO ) 00275 $ V = ONE 00276 DO 90 I = 1, N 00277 IF( V.GT.SEPTMP( I ) ) THEN 00278 TOL = ONE 00279 ELSE 00280 TOL = V / SEPTMP( I ) 00281 END IF 00282 IF( V.GT.SEPIN( I ) ) THEN 00283 TOLIN = ONE 00284 ELSE 00285 TOLIN = V / SEPIN( I ) 00286 END IF 00287 TOL = MAX( TOL, SMLNUM / EPS ) 00288 TOLIN = MAX( TOLIN, SMLNUM / EPS ) 00289 IF( EPS*( SIN( I )-TOLIN ).GT.STMP( I )+TOL ) THEN 00290 VMAX = ONE / EPS 00291 ELSE IF( SIN( I )-TOLIN.GT.STMP( I )+TOL ) THEN 00292 VMAX = ( SIN( I )-TOLIN ) / ( STMP( I )+TOL ) 00293 ELSE IF( SIN( I )+TOLIN.LT.EPS*( STMP( I )-TOL ) ) THEN 00294 VMAX = ONE / EPS 00295 ELSE IF( SIN( I )+TOLIN.LT.STMP( I )-TOL ) THEN 00296 VMAX = ( STMP( I )-TOL ) / ( SIN( I )+TOLIN ) 00297 ELSE 00298 VMAX = ONE 00299 END IF 00300 IF( VMAX.GT.RMAX( 2 ) ) THEN 00301 RMAX( 2 ) = VMAX 00302 IF( NINFO( 2 ).EQ.0 ) 00303 $ LMAX( 2 ) = KNT 00304 END IF 00305 90 CONTINUE 00306 * 00307 * Compare condition numbers for eigenvectors 00308 * taking their condition numbers into account 00309 * 00310 DO 100 I = 1, N 00311 IF( V.GT.SEPTMP( I )*STMP( I ) ) THEN 00312 TOL = SEPTMP( I ) 00313 ELSE 00314 TOL = V / STMP( I ) 00315 END IF 00316 IF( V.GT.SEPIN( I )*SIN( I ) ) THEN 00317 TOLIN = SEPIN( I ) 00318 ELSE 00319 TOLIN = V / SIN( I ) 00320 END IF 00321 TOL = MAX( TOL, SMLNUM / EPS ) 00322 TOLIN = MAX( TOLIN, SMLNUM / EPS ) 00323 IF( EPS*( SEPIN( I )-TOLIN ).GT.SEPTMP( I )+TOL ) THEN 00324 VMAX = ONE / EPS 00325 ELSE IF( SEPIN( I )-TOLIN.GT.SEPTMP( I )+TOL ) THEN 00326 VMAX = ( SEPIN( I )-TOLIN ) / ( SEPTMP( I )+TOL ) 00327 ELSE IF( SEPIN( I )+TOLIN.LT.EPS*( SEPTMP( I )-TOL ) ) THEN 00328 VMAX = ONE / EPS 00329 ELSE IF( SEPIN( I )+TOLIN.LT.SEPTMP( I )-TOL ) THEN 00330 VMAX = ( SEPTMP( I )-TOL ) / ( SEPIN( I )+TOLIN ) 00331 ELSE 00332 VMAX = ONE 00333 END IF 00334 IF( VMAX.GT.RMAX( 2 ) ) THEN 00335 RMAX( 2 ) = VMAX 00336 IF( NINFO( 2 ).EQ.0 ) 00337 $ LMAX( 2 ) = KNT 00338 END IF 00339 100 CONTINUE 00340 * 00341 * Compare condition numbers for eigenvalues 00342 * without taking their condition numbers into account 00343 * 00344 DO 110 I = 1, N 00345 IF( SIN( I ).LE.REAL( 2*N )*EPS .AND. STMP( I ).LE. 00346 $ REAL( 2*N )*EPS ) THEN 00347 VMAX = ONE 00348 ELSE IF( EPS*SIN( I ).GT.STMP( I ) ) THEN 00349 VMAX = ONE / EPS 00350 ELSE IF( SIN( I ).GT.STMP( I ) ) THEN 00351 VMAX = SIN( I ) / STMP( I ) 00352 ELSE IF( SIN( I ).LT.EPS*STMP( I ) ) THEN 00353 VMAX = ONE / EPS 00354 ELSE IF( SIN( I ).LT.STMP( I ) ) THEN 00355 VMAX = STMP( I ) / SIN( I ) 00356 ELSE 00357 VMAX = ONE 00358 END IF 00359 IF( VMAX.GT.RMAX( 3 ) ) THEN 00360 RMAX( 3 ) = VMAX 00361 IF( NINFO( 3 ).EQ.0 ) 00362 $ LMAX( 3 ) = KNT 00363 END IF 00364 110 CONTINUE 00365 * 00366 * Compare condition numbers for eigenvectors 00367 * without taking their condition numbers into account 00368 * 00369 DO 120 I = 1, N 00370 IF( SEPIN( I ).LE.V .AND. SEPTMP( I ).LE.V ) THEN 00371 VMAX = ONE 00372 ELSE IF( EPS*SEPIN( I ).GT.SEPTMP( I ) ) THEN 00373 VMAX = ONE / EPS 00374 ELSE IF( SEPIN( I ).GT.SEPTMP( I ) ) THEN 00375 VMAX = SEPIN( I ) / SEPTMP( I ) 00376 ELSE IF( SEPIN( I ).LT.EPS*SEPTMP( I ) ) THEN 00377 VMAX = ONE / EPS 00378 ELSE IF( SEPIN( I ).LT.SEPTMP( I ) ) THEN 00379 VMAX = SEPTMP( I ) / SEPIN( I ) 00380 ELSE 00381 VMAX = ONE 00382 END IF 00383 IF( VMAX.GT.RMAX( 3 ) ) THEN 00384 RMAX( 3 ) = VMAX 00385 IF( NINFO( 3 ).EQ.0 ) 00386 $ LMAX( 3 ) = KNT 00387 END IF 00388 120 CONTINUE 00389 * 00390 * Compute eigenvalue condition numbers only and compare 00391 * 00392 VMAX = ZERO 00393 DUM( 1 ) = -ONE 00394 CALL SCOPY( N, DUM, 0, STMP, 1 ) 00395 CALL SCOPY( N, DUM, 0, SEPTMP, 1 ) 00396 CALL STRSNA( 'Eigcond', 'All', SELECT, N, T, LDT, LE, LDT, RE, 00397 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO ) 00398 IF( INFO.NE.0 ) THEN 00399 LMAX( 3 ) = KNT 00400 NINFO( 3 ) = NINFO( 3 ) + 1 00401 GO TO 240 00402 END IF 00403 DO 130 I = 1, N 00404 IF( STMP( I ).NE.S( I ) ) 00405 $ VMAX = ONE / EPS 00406 IF( SEPTMP( I ).NE.DUM( 1 ) ) 00407 $ VMAX = ONE / EPS 00408 130 CONTINUE 00409 * 00410 * Compute eigenvector condition numbers only and compare 00411 * 00412 CALL SCOPY( N, DUM, 0, STMP, 1 ) 00413 CALL SCOPY( N, DUM, 0, SEPTMP, 1 ) 00414 CALL STRSNA( 'Veccond', 'All', SELECT, N, T, LDT, LE, LDT, RE, 00415 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO ) 00416 IF( INFO.NE.0 ) THEN 00417 LMAX( 3 ) = KNT 00418 NINFO( 3 ) = NINFO( 3 ) + 1 00419 GO TO 240 00420 END IF 00421 DO 140 I = 1, N 00422 IF( STMP( I ).NE.DUM( 1 ) ) 00423 $ VMAX = ONE / EPS 00424 IF( SEPTMP( I ).NE.SEP( I ) ) 00425 $ VMAX = ONE / EPS 00426 140 CONTINUE 00427 * 00428 * Compute all condition numbers using SELECT and compare 00429 * 00430 DO 150 I = 1, N 00431 SELECT( I ) = .TRUE. 00432 150 CONTINUE 00433 CALL SCOPY( N, DUM, 0, STMP, 1 ) 00434 CALL SCOPY( N, DUM, 0, SEPTMP, 1 ) 00435 CALL STRSNA( 'Bothcond', 'Some', SELECT, N, T, LDT, LE, LDT, 00436 $ RE, LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, 00437 $ INFO ) 00438 IF( INFO.NE.0 ) THEN 00439 LMAX( 3 ) = KNT 00440 NINFO( 3 ) = NINFO( 3 ) + 1 00441 GO TO 240 00442 END IF 00443 DO 160 I = 1, N 00444 IF( SEPTMP( I ).NE.SEP( I ) ) 00445 $ VMAX = ONE / EPS 00446 IF( STMP( I ).NE.S( I ) ) 00447 $ VMAX = ONE / EPS 00448 160 CONTINUE 00449 * 00450 * Compute eigenvalue condition numbers using SELECT and compare 00451 * 00452 CALL SCOPY( N, DUM, 0, STMP, 1 ) 00453 CALL SCOPY( N, DUM, 0, SEPTMP, 1 ) 00454 CALL STRSNA( 'Eigcond', 'Some', SELECT, N, T, LDT, LE, LDT, RE, 00455 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO ) 00456 IF( INFO.NE.0 ) THEN 00457 LMAX( 3 ) = KNT 00458 NINFO( 3 ) = NINFO( 3 ) + 1 00459 GO TO 240 00460 END IF 00461 DO 170 I = 1, N 00462 IF( STMP( I ).NE.S( I ) ) 00463 $ VMAX = ONE / EPS 00464 IF( SEPTMP( I ).NE.DUM( 1 ) ) 00465 $ VMAX = ONE / EPS 00466 170 CONTINUE 00467 * 00468 * Compute eigenvector condition numbers using SELECT and compare 00469 * 00470 CALL SCOPY( N, DUM, 0, STMP, 1 ) 00471 CALL SCOPY( N, DUM, 0, SEPTMP, 1 ) 00472 CALL STRSNA( 'Veccond', 'Some', SELECT, N, T, LDT, LE, LDT, RE, 00473 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO ) 00474 IF( INFO.NE.0 ) THEN 00475 LMAX( 3 ) = KNT 00476 NINFO( 3 ) = NINFO( 3 ) + 1 00477 GO TO 240 00478 END IF 00479 DO 180 I = 1, N 00480 IF( STMP( I ).NE.DUM( 1 ) ) 00481 $ VMAX = ONE / EPS 00482 IF( SEPTMP( I ).NE.SEP( I ) ) 00483 $ VMAX = ONE / EPS 00484 180 CONTINUE 00485 IF( VMAX.GT.RMAX( 1 ) ) THEN 00486 RMAX( 1 ) = VMAX 00487 IF( NINFO( 1 ).EQ.0 ) 00488 $ LMAX( 1 ) = KNT 00489 END IF 00490 * 00491 * Select first real and first complex eigenvalue 00492 * 00493 IF( WI( 1 ).EQ.ZERO ) THEN 00494 LCMP( 1 ) = 1 00495 IFND = 0 00496 DO 190 I = 2, N 00497 IF( IFND.EQ.1 .OR. WI( I ).EQ.ZERO ) THEN 00498 SELECT( I ) = .FALSE. 00499 ELSE 00500 IFND = 1 00501 LCMP( 2 ) = I 00502 LCMP( 3 ) = I + 1 00503 CALL SCOPY( N, RE( 1, I ), 1, RE( 1, 2 ), 1 ) 00504 CALL SCOPY( N, RE( 1, I+1 ), 1, RE( 1, 3 ), 1 ) 00505 CALL SCOPY( N, LE( 1, I ), 1, LE( 1, 2 ), 1 ) 00506 CALL SCOPY( N, LE( 1, I+1 ), 1, LE( 1, 3 ), 1 ) 00507 END IF 00508 190 CONTINUE 00509 IF( IFND.EQ.0 ) THEN 00510 ICMP = 1 00511 ELSE 00512 ICMP = 3 00513 END IF 00514 ELSE 00515 LCMP( 1 ) = 1 00516 LCMP( 2 ) = 2 00517 IFND = 0 00518 DO 200 I = 3, N 00519 IF( IFND.EQ.1 .OR. WI( I ).NE.ZERO ) THEN 00520 SELECT( I ) = .FALSE. 00521 ELSE 00522 LCMP( 3 ) = I 00523 IFND = 1 00524 CALL SCOPY( N, RE( 1, I ), 1, RE( 1, 3 ), 1 ) 00525 CALL SCOPY( N, LE( 1, I ), 1, LE( 1, 3 ), 1 ) 00526 END IF 00527 200 CONTINUE 00528 IF( IFND.EQ.0 ) THEN 00529 ICMP = 2 00530 ELSE 00531 ICMP = 3 00532 END IF 00533 END IF 00534 * 00535 * Compute all selected condition numbers 00536 * 00537 CALL SCOPY( ICMP, DUM, 0, STMP, 1 ) 00538 CALL SCOPY( ICMP, DUM, 0, SEPTMP, 1 ) 00539 CALL STRSNA( 'Bothcond', 'Some', SELECT, N, T, LDT, LE, LDT, 00540 $ RE, LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, 00541 $ INFO ) 00542 IF( INFO.NE.0 ) THEN 00543 LMAX( 3 ) = KNT 00544 NINFO( 3 ) = NINFO( 3 ) + 1 00545 GO TO 240 00546 END IF 00547 DO 210 I = 1, ICMP 00548 J = LCMP( I ) 00549 IF( SEPTMP( I ).NE.SEP( J ) ) 00550 $ VMAX = ONE / EPS 00551 IF( STMP( I ).NE.S( J ) ) 00552 $ VMAX = ONE / EPS 00553 210 CONTINUE 00554 * 00555 * Compute selected eigenvalue condition numbers 00556 * 00557 CALL SCOPY( ICMP, DUM, 0, STMP, 1 ) 00558 CALL SCOPY( ICMP, DUM, 0, SEPTMP, 1 ) 00559 CALL STRSNA( 'Eigcond', 'Some', SELECT, N, T, LDT, LE, LDT, RE, 00560 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO ) 00561 IF( INFO.NE.0 ) THEN 00562 LMAX( 3 ) = KNT 00563 NINFO( 3 ) = NINFO( 3 ) + 1 00564 GO TO 240 00565 END IF 00566 DO 220 I = 1, ICMP 00567 J = LCMP( I ) 00568 IF( STMP( I ).NE.S( J ) ) 00569 $ VMAX = ONE / EPS 00570 IF( SEPTMP( I ).NE.DUM( 1 ) ) 00571 $ VMAX = ONE / EPS 00572 220 CONTINUE 00573 * 00574 * Compute selected eigenvector condition numbers 00575 * 00576 CALL SCOPY( ICMP, DUM, 0, STMP, 1 ) 00577 CALL SCOPY( ICMP, DUM, 0, SEPTMP, 1 ) 00578 CALL STRSNA( 'Veccond', 'Some', SELECT, N, T, LDT, LE, LDT, RE, 00579 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO ) 00580 IF( INFO.NE.0 ) THEN 00581 LMAX( 3 ) = KNT 00582 NINFO( 3 ) = NINFO( 3 ) + 1 00583 GO TO 240 00584 END IF 00585 DO 230 I = 1, ICMP 00586 J = LCMP( I ) 00587 IF( STMP( I ).NE.DUM( 1 ) ) 00588 $ VMAX = ONE / EPS 00589 IF( SEPTMP( I ).NE.SEP( J ) ) 00590 $ VMAX = ONE / EPS 00591 230 CONTINUE 00592 IF( VMAX.GT.RMAX( 1 ) ) THEN 00593 RMAX( 1 ) = VMAX 00594 IF( NINFO( 1 ).EQ.0 ) 00595 $ LMAX( 1 ) = KNT 00596 END IF 00597 240 CONTINUE 00598 GO TO 10 00599 * 00600 * End of SGET37 00601 * 00602 END