LAPACK 3.3.1
Linear Algebra PACKage

dget37.f

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