LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dget37.f
Go to the documentation of this file.
00001 *> \brief \b DGET37
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 DGET37( RMAX, LMAX, NINFO, KNT, NIN )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            KNT, NIN
00015 *       ..
00016 *       .. Array Arguments ..
00017 *       INTEGER            LMAX( 3 ), NINFO( 3 )
00018 *       DOUBLE PRECISION   RMAX( 3 )
00019 *       ..
00020 *  
00021 *
00022 *> \par Purpose:
00023 *  =============
00024 *>
00025 *> \verbatim
00026 *>
00027 *> DGET37 tests DTRSNA, 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 DOUBLE PRECISION array, dimension (3)
00039 *>          Value of the largest test ratio.
00040 *>          RMAX(1) = largest ratio comparing different calls to DTRSNA
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 DGEHRD returns INFO nonzero on example i, LMAX(1)=i
00054 *>          If DHSEQR returns INFO nonzero on example i, LMAX(2)=i
00055 *>          If DTRSNA 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 DGEHRD returned INFO nonzero
00062 *>          NINFO(2) = No. of times DHSEQR returned INFO nonzero
00063 *>          NINFO(3) = No. of times DTRSNA 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 double_eig
00089 *
00090 *  =====================================================================
00091       SUBROUTINE DGET37( 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       DOUBLE PRECISION   RMAX( 3 )
00104 *     ..
00105 *
00106 *  =====================================================================
00107 *
00108 *     .. Parameters ..
00109       DOUBLE PRECISION   ZERO, ONE, TWO
00110       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 )
00111       DOUBLE PRECISION   EPSIN
00112       PARAMETER          ( EPSIN = 5.9605D-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       DOUBLE PRECISION   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       DOUBLE PRECISION   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       DOUBLE PRECISION   DLAMCH, DLANGE
00134       EXTERNAL           DLAMCH, DLANGE
00135 *     ..
00136 *     .. External Subroutines ..
00137       EXTERNAL           DCOPY, DGEHRD, DHSEQR, DLABAD, DLACPY, DSCAL,
00138      $                   DTREVC, DTRSNA
00139 *     ..
00140 *     .. Intrinsic Functions ..
00141       INTRINSIC          DBLE, MAX, SQRT
00142 *     ..
00143 *     .. Executable Statements ..
00144 *
00145       EPS = DLAMCH( 'P' )
00146       SMLNUM = DLAMCH( 'S' ) / EPS
00147       BIGNUM = ONE / SMLNUM
00148       CALL DLABAD( 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 = DLANGE( '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 DLACPY( 'F', N, N, TMP, LDT, T, LDT )
00192          VMUL = VAL( ISCL )
00193          DO 40 I = 1, N
00194             CALL DSCAL( 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 DGEHRD( 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 DHSEQR( '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 DTREVC( 'Both', 'All', SELECT, N, T, LDT, LE, LDT, RE,
00227      $                LDT, N, M, WORK, INFO )
00228 *
00229 *        Compute condition numbers
00230 *
00231          CALL DTRSNA( '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 DCOPY( N, WR, 1, WRTMP, 1 )
00243          CALL DCOPY( N, WI, 1, WITMP, 1 )
00244          CALL DCOPY( N, S, 1, STMP, 1 )
00245          CALL DCOPY( N, SEP, 1, SEPTMP, 1 )
00246          CALL DSCAL( 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*DBLE( 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.DBLE( 2*N )*EPS .AND. STMP( I ).LE.
00346      $          DBLE( 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 DCOPY( N, DUM, 0, STMP, 1 )
00395          CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
00396          CALL DTRSNA( '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 DCOPY( N, DUM, 0, STMP, 1 )
00413          CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
00414          CALL DTRSNA( '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 DCOPY( N, DUM, 0, STMP, 1 )
00434          CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
00435          CALL DTRSNA( '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 DCOPY( N, DUM, 0, STMP, 1 )
00453          CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
00454          CALL DTRSNA( '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 DCOPY( N, DUM, 0, STMP, 1 )
00471          CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
00472          CALL DTRSNA( '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 DCOPY( N, RE( 1, I ), 1, RE( 1, 2 ), 1 )
00504                   CALL DCOPY( N, RE( 1, I+1 ), 1, RE( 1, 3 ), 1 )
00505                   CALL DCOPY( N, LE( 1, I ), 1, LE( 1, 2 ), 1 )
00506                   CALL DCOPY( 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 DCOPY( N, RE( 1, I ), 1, RE( 1, 3 ), 1 )
00525                   CALL DCOPY( 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 DCOPY( ICMP, DUM, 0, STMP, 1 )
00538          CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
00539          CALL DTRSNA( '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 DCOPY( ICMP, DUM, 0, STMP, 1 )
00558          CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
00559          CALL DTRSNA( '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 DCOPY( ICMP, DUM, 0, STMP, 1 )
00577          CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
00578          CALL DTRSNA( '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 DGET37
00601 *
00602       END
 All Files Functions