zget37.f

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

            IF( V.GT.SEPTMP( I )*STMP( I ) ) THEN
               TOL = SEPTMP( I )
            ELSE
               TOL = V / STMP( I )
            END IF
            IF( V.GT.SEPIN( I )*SIN( I ) ) THEN
               TOLIN = SEPIN( I )
            ELSE
               TOLIN = V / SIN( I )
            END IF
            TOL = MAX( TOL, SMLNUM / EPS )
            TOLIN = MAX( TOLIN, SMLNUM / EPS )
            IF( EPS*( SEPIN( I )-TOLIN ).GT.SEPTMP( I )+TOL ) THEN
               VMAX = ONE / EPS
            ELSE IF( SEPIN( I )-TOLIN.GT.SEPTMP( I )+TOL ) THEN
               VMAX = ( SEPIN( I )-TOLIN ) / ( SEPTMP( I )+TOL )
            ELSE IF( SEPIN( I )+TOLIN.LT.EPS*( SEPTMP( I )-TOL ) ) THEN
               VMAX = ONE / EPS
            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
  130    CONTINUE
*
*        Compare condition numbers for eigenvalues
*        without taking their condition numbers into account
*
         DO 140 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
  140    CONTINUE
*
*        Compare condition numbers for eigenvectors
*        without taking their condition numbers into account
*
         DO 150 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
  150    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 ZTRSNA( 'E', 'A', SELECT, N, T, LDT, LE, LDT, RE, LDT,
     $                STMP, SEPTMP, N, M, WORK, N, RWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 260
         END IF
         DO 160 I = 1, N
            IF( STMP( I ).NE.S( I ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
  160    CONTINUE
*
*        Compute eigenvector condition numbers only and compare
*
         CALL DCOPY( N, DUM, 0, STMP, 1 )
         CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
         CALL ZTRSNA( 'V', 'A', SELECT, N, T, LDT, LE, LDT, RE, LDT,
     $                STMP, SEPTMP, N, M, WORK, N, RWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 260
         END IF
         DO 170 I = 1, N
            IF( STMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.SEP( I ) )
     $         VMAX = ONE / EPS
  170    CONTINUE
*
*        Compute all condition numbers using SELECT and compare
*
         DO 180 I = 1, N
            SELECT( I ) = .TRUE.
  180    CONTINUE
         CALL DCOPY( N, DUM, 0, STMP, 1 )
         CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
         CALL ZTRSNA( 'B', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT,
     $                STMP, SEPTMP, N, M, WORK, N, RWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 260
         END IF
         DO 190 I = 1, N
            IF( SEPTMP( I ).NE.SEP( I ) )
     $         VMAX = ONE / EPS
            IF( STMP( I ).NE.S( I ) )
     $         VMAX = ONE / EPS
  190    CONTINUE
*
*        Compute eigenvalue condition numbers using SELECT and compare
*
         CALL DCOPY( N, DUM, 0, STMP, 1 )
         CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
         CALL ZTRSNA( 'E', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT,
     $                STMP, SEPTMP, N, M, WORK, N, RWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 260
         END IF
         DO 200 I = 1, N
            IF( STMP( I ).NE.S( I ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
  200    CONTINUE
*
*        Compute eigenvector condition numbers using SELECT and compare
*
         CALL DCOPY( N, DUM, 0, STMP, 1 )
         CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
         CALL ZTRSNA( 'V', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT,
     $                STMP, SEPTMP, N, M, WORK, N, RWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 260
         END IF
         DO 210 I = 1, N
            IF( STMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.SEP( I ) )
     $         VMAX = ONE / EPS
  210    CONTINUE
         IF( VMAX.GT.RMAX( 1 ) ) THEN
            RMAX( 1 ) = VMAX
            IF( NINFO( 1 ).EQ.0 )
     $         LMAX( 1 ) = KNT
         END IF
*
*        Select second and next to last eigenvalues
*
         DO 220 I = 1, N
            SELECT( I ) = .FALSE.
  220    CONTINUE
         ICMP = 0
         IF( N.GT.1 ) THEN
            ICMP = 1
            LCMP( 1 ) = 2
            SELECT( 2 ) = .TRUE.
            CALL ZCOPY( N, RE( 1, 2 ), 1, RE( 1, 1 ), 1 )
            CALL ZCOPY( N, LE( 1, 2 ), 1, LE( 1, 1 ), 1 )
         END IF
         IF( N.GT.3 ) THEN
            ICMP = 2
            LCMP( 2 ) = N - 1
            SELECT( N-1 ) = .TRUE.
            CALL ZCOPY( N, RE( 1, N-1 ), 1, RE( 1, 2 ), 1 )
            CALL ZCOPY( N, LE( 1, N-1 ), 1, LE( 1, 2 ), 1 )
         END IF
*
*        Compute all selected condition numbers
*
         CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
         CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
         CALL ZTRSNA( 'B', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT,
     $                STMP, SEPTMP, N, M, WORK, N, RWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 260
         END IF
         DO 230 I = 1, ICMP
            J = LCMP( I )
            IF( SEPTMP( I ).NE.SEP( J ) )
     $         VMAX = ONE / EPS
            IF( STMP( I ).NE.S( J ) )
     $         VMAX = ONE / EPS
  230    CONTINUE
*
*        Compute selected eigenvalue condition numbers
*
         CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
         CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
         CALL ZTRSNA( 'E', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT,
     $                STMP, SEPTMP, N, M, WORK, N, RWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 260
         END IF
         DO 240 I = 1, ICMP
            J = LCMP( I )
            IF( STMP( I ).NE.S( J ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
  240    CONTINUE
*
*        Compute selected eigenvector condition numbers
*
         CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
         CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
         CALL ZTRSNA( 'V', 'S', SELECT, N, T, LDT, LE, LDT, RE, LDT,
     $                STMP, SEPTMP, N, M, WORK, N, RWORK, INFO )
         IF( INFO.NE.0 ) THEN
            LMAX( 3 ) = KNT
            NINFO( 3 ) = NINFO( 3 ) + 1
            GO TO 260
         END IF
         DO 250 I = 1, ICMP
            J = LCMP( I )
            IF( STMP( I ).NE.DUM( 1 ) )
     $         VMAX = ONE / EPS
            IF( SEPTMP( I ).NE.SEP( J ) )
     $         VMAX = ONE / EPS
  250    CONTINUE
         IF( VMAX.GT.RMAX( 1 ) ) THEN
            RMAX( 1 ) = VMAX
            IF( NINFO( 1 ).EQ.0 )
     $         LMAX( 1 ) = KNT
         END IF
  260 CONTINUE
      GO TO 10
*
*     End of ZGET37
*
      END