dget37.f

来自「famous linear algebra library (LAPACK) p」· F 代码 · 共 550 行 · 第 1/2 页

            ELSE IF( SEPIN( I )+TOLIN.LT.SEPTMP( I )-TOL ) THEN
               VMAX = ( SEPTMP( I )-TOL ) / ( SEPIN( I )+TOLIN )
            ELSE
               VMAX = ONE
            END IF
            IF( VMAX.GT.RMAX( 2 ) ) THEN
               RMAX( 2 ) = VMAX
               IF( NINFO( 2 ).EQ.0 )
     $            LMAX( 2 ) = KNT
            END IF
  100    CONTINUE
*
*        Compare condition numbers for eigenvalues
*        without taking their condition numbers into account
*
         DO 110 I = 1, N
            IF( SIN( I ).LE.DBLE( 2*N )*EPS .AND. STMP( I ).LE.
     $          DBLE( 2*N )*EPS ) THEN
               VMAX = ONE
            ELSE IF( EPS*SIN( I ).GT.STMP( I ) ) THEN
               VMAX = ONE / EPS
            ELSE IF( SIN( I ).GT.STMP( I ) ) THEN
               VMAX = SIN( I ) / STMP( I )
            ELSE IF( SIN( I ).LT.EPS*STMP( I ) ) THEN
               VMAX = ONE / EPS
            ELSE IF( SIN( I ).LT.STMP( I ) ) THEN
               VMAX = STMP( I ) / SIN( I )
            ELSE
               VMAX = ONE
            END IF
            IF( VMAX.GT.RMAX( 3 ) ) THEN
               RMAX( 3 ) = VMAX
               IF( NINFO( 3 ).EQ.0 )
     $            LMAX( 3 ) = KNT
            END IF
  110    CONTINUE
*
*        Compare condition numbers for eigenvectors
*        without taking their condition numbers into account
*
         DO 120 I = 1, N
            IF( SEPIN( I ).LE.V .AND. SEPTMP( I ).LE.V ) THEN
               VMAX = ONE
            ELSE IF( EPS*SEPIN( I ).GT.SEPTMP( I ) ) THEN
               VMAX = ONE / EPS
            ELSE IF( SEPIN( I ).GT.SEPTMP( I ) ) THEN
               VMAX = SEPIN( I ) / SEPTMP( I )
            ELSE IF( SEPIN( I ).LT.EPS*SEPTMP( I ) ) THEN
               VMAX = ONE / EPS
            ELSE IF( SEPIN( I ).LT.SEPTMP( I ) ) THEN
               VMAX = SEPTMP( I ) / SEPIN( I )
            ELSE
               VMAX = ONE
            END IF
            IF( VMAX.GT.RMAX( 3 ) ) THEN
               RMAX( 3 ) = VMAX
               IF( NINFO( 3 ).EQ.0 )
     $            LMAX( 3 ) = KNT
            END IF
  120    CONTINUE
*
*        Compute eigenvalue condition numbers only and compare
*
         VMAX = ZERO
         DUM( 1 ) = -ONE
         CALL DCOPY( N, DUM, 0, STMP, 1 )
         CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
         CALL DTRSNA( 'Eigcond', 'All', SELECT, N, T, LDT, LE, LDT, RE,
     $                LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 240
         END IF
         DO 130 I = 1, N
            IF( STMP( I ).NE.S( I ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
  130    CONTINUE
*
*        Compute eigenvector condition numbers only and compare
*
         CALL DCOPY( N, DUM, 0, STMP, 1 )
         CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
         CALL DTRSNA( 'Veccond', 'All', SELECT, N, T, LDT, LE, LDT, RE,
     $                LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 240
         END IF
         DO 140 I = 1, N
            IF( STMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.SEP( I ) )
     $         VMAX = ONE / EPS
  140    CONTINUE
*
*        Compute all condition numbers using SELECT and compare
*
         DO 150 I = 1, N
            SELECT( I ) = .TRUE.
  150    CONTINUE
         CALL DCOPY( N, DUM, 0, STMP, 1 )
         CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
         CALL DTRSNA( 'Bothcond', 'Some', SELECT, N, T, LDT, LE, LDT,
     $                RE, LDT, STMP, SEPTMP, N, M, WORK, N, IWORK,
     $                INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 240
         END IF
         DO 160 I = 1, N
            IF( SEPTMP( I ).NE.SEP( I ) )
     $         VMAX = ONE / EPS
            IF( STMP( I ).NE.S( I ) )
     $         VMAX = ONE / EPS
  160    CONTINUE
*
*        Compute eigenvalue condition numbers using SELECT and compare
*
         CALL DCOPY( N, DUM, 0, STMP, 1 )
         CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
         CALL DTRSNA( 'Eigcond', 'Some', SELECT, N, T, LDT, LE, LDT, RE,
     $                LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 240
         END IF
         DO 170 I = 1, N
            IF( STMP( I ).NE.S( I ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
  170    CONTINUE
*
*        Compute eigenvector condition numbers using SELECT and compare
*
         CALL DCOPY( N, DUM, 0, STMP, 1 )
         CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
         CALL DTRSNA( 'Veccond', 'Some', SELECT, N, T, LDT, LE, LDT, RE,
     $                LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 240
         END IF
         DO 180 I = 1, N
            IF( STMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.SEP( I ) )
     $         VMAX = ONE / EPS
  180    CONTINUE
         IF( VMAX.GT.RMAX( 1 ) ) THEN
            RMAX( 1 ) = VMAX
            IF( NINFO( 1 ).EQ.0 )
     $         LMAX( 1 ) = KNT
         END IF
*
*        Select first real and first complex eigenvalue
*
         IF( WI( 1 ).EQ.ZERO ) THEN
            LCMP( 1 ) = 1
            IFND = 0
            DO 190 I = 2, N
               IF( IFND.EQ.1 .OR. WI( I ).EQ.ZERO ) THEN
                  SELECT( I ) = .FALSE.
               ELSE
                  IFND = 1
                  LCMP( 2 ) = I
                  LCMP( 3 ) = I + 1
                  CALL DCOPY( N, RE( 1, I ), 1, RE( 1, 2 ), 1 )
                  CALL DCOPY( N, RE( 1, I+1 ), 1, RE( 1, 3 ), 1 )
                  CALL DCOPY( N, LE( 1, I ), 1, LE( 1, 2 ), 1 )
                  CALL DCOPY( N, LE( 1, I+1 ), 1, LE( 1, 3 ), 1 )
               END IF
  190       CONTINUE
            IF( IFND.EQ.0 ) THEN
               ICMP = 1
            ELSE
               ICMP = 3
            END IF
         ELSE
            LCMP( 1 ) = 1
            LCMP( 2 ) = 2
            IFND = 0
            DO 200 I = 3, N
               IF( IFND.EQ.1 .OR. WI( I ).NE.ZERO ) THEN
                  SELECT( I ) = .FALSE.
               ELSE
                  LCMP( 3 ) = I
                  IFND = 1
                  CALL DCOPY( N, RE( 1, I ), 1, RE( 1, 3 ), 1 )
                  CALL DCOPY( N, LE( 1, I ), 1, LE( 1, 3 ), 1 )
               END IF
  200       CONTINUE
            IF( IFND.EQ.0 ) THEN
               ICMP = 2
            ELSE
               ICMP = 3
            END IF
         END IF
*
*        Compute all selected condition numbers
*
         CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
         CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
         CALL DTRSNA( 'Bothcond', 'Some', SELECT, N, T, LDT, LE, LDT,
     $                RE, LDT, STMP, SEPTMP, N, M, WORK, N, IWORK,
     $                INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 240
         END IF
         DO 210 I = 1, ICMP
            J = LCMP( I )
            IF( SEPTMP( I ).NE.SEP( J ) )
     $         VMAX = ONE / EPS
            IF( STMP( I ).NE.S( J ) )
     $         VMAX = ONE / EPS
  210    CONTINUE
*
*        Compute selected eigenvalue condition numbers
*
         CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
         CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
         CALL DTRSNA( 'Eigcond', 'Some', SELECT, N, T, LDT, LE, LDT, RE,
     $                LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 240
         END IF
         DO 220 I = 1, ICMP
            J = LCMP( I )
            IF( STMP( I ).NE.S( J ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
  220    CONTINUE
*
*        Compute selected eigenvector condition numbers
*
         CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
         CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
         CALL DTRSNA( 'Veccond', 'Some', SELECT, N, T, LDT, LE, LDT, RE,
     $                LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 240
         END IF
         DO 230 I = 1, ICMP
            J = LCMP( I )
            IF( STMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.SEP( J ) )
     $         VMAX = ONE / EPS
  230    CONTINUE
         IF( VMAX.GT.RMAX( 1 ) ) THEN
            RMAX( 1 ) = VMAX
            IF( NINFO( 1 ).EQ.0 )
     $         LMAX( 1 ) = KNT
         END IF
  240 CONTINUE
      GO TO 10
*
*     End of DGET37
*
      END