sgebal.f.html

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

   10    CONTINUE
         GO TO 210
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( <a name="LSAME.160"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOB, <span class="string">'S'</span> ) )
     $   GO TO 120
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Permutation to isolate eigenvalues if possible
</span><span class="comment">*</span><span class="comment">
</span>      GO TO 50
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Row and column exchange.
</span><span class="comment">*</span><span class="comment">
</span>   20 CONTINUE
      SCALE( M ) = J
      IF( J.EQ.M )
     $   GO TO 30
<span class="comment">*</span><span class="comment">
</span>      CALL SSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
      CALL SSWAP( N-K+1, A( J, K ), LDA, A( M, K ), LDA )
<span class="comment">*</span><span class="comment">
</span>   30 CONTINUE
      GO TO ( 40, 80 )IEXC
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Search for rows isolating an eigenvalue and push them down.
</span><span class="comment">*</span><span class="comment">
</span>   40 CONTINUE
      IF( L.EQ.1 )
     $   GO TO 210
      L = L - 1
<span class="comment">*</span><span class="comment">
</span>   50 CONTINUE
      DO 70 J = L, 1, -1
<span class="comment">*</span><span class="comment">
</span>         DO 60 I = 1, L
            IF( I.EQ.J )
     $         GO TO 60
            IF( A( J, I ).NE.ZERO )
     $         GO TO 70
   60    CONTINUE
<span class="comment">*</span><span class="comment">
</span>         M = L
         IEXC = 1
         GO TO 20
   70 CONTINUE
<span class="comment">*</span><span class="comment">
</span>      GO TO 90
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Search for columns isolating an eigenvalue and push them left.
</span><span class="comment">*</span><span class="comment">
</span>   80 CONTINUE
      K = K + 1
<span class="comment">*</span><span class="comment">
</span>   90 CONTINUE
      DO 110 J = K, L
<span class="comment">*</span><span class="comment">
</span>         DO 100 I = K, L
            IF( I.EQ.J )
     $         GO TO 100
            IF( A( I, J ).NE.ZERO )
     $         GO TO 110
  100    CONTINUE
<span class="comment">*</span><span class="comment">
</span>         M = K
         IEXC = 2
         GO TO 20
  110 CONTINUE
<span class="comment">*</span><span class="comment">
</span>  120 CONTINUE
      DO 130 I = K, L
         SCALE( I ) = ONE
  130 CONTINUE
<span class="comment">*</span><span class="comment">
</span>      IF( <a name="LSAME.229"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOB, <span class="string">'P'</span> ) )
     $   GO TO 210
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Balance the submatrix in rows K to L.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Iterative loop for norm reduction
</span><span class="comment">*</span><span class="comment">
</span>      SFMIN1 = <a name="SLAMCH.236"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>( <span class="string">'S'</span> ) / <a name="SLAMCH.236"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>( <span class="string">'P'</span> )
      SFMAX1 = ONE / SFMIN1
      SFMIN2 = SFMIN1*SCLFAC
      SFMAX2 = ONE / SFMIN2
  140 CONTINUE
      NOCONV = .FALSE.
<span class="comment">*</span><span class="comment">
</span>      DO 200 I = K, L
         C = ZERO
         R = ZERO
<span class="comment">*</span><span class="comment">
</span>         DO 150 J = K, L
            IF( J.EQ.I )
     $         GO TO 150
            C = C + ABS( A( J, I ) )
            R = R + ABS( A( I, J ) )
  150    CONTINUE
         ICA = ISAMAX( L, A( 1, I ), 1 )
         CA = ABS( A( ICA, I ) )
         IRA = ISAMAX( N-K+1, A( I, K ), LDA )
         RA = ABS( A( I, IRA+K-1 ) )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Guard against zero C or R due to underflow.
</span><span class="comment">*</span><span class="comment">
</span>         IF( C.EQ.ZERO .OR. R.EQ.ZERO )
     $      GO TO 200
         G = R / SCLFAC
         F = ONE
         S = C + R
  160    CONTINUE
         IF( C.GE.G .OR. MAX( F, C, CA ).GE.SFMAX2 .OR.
     $       MIN( R, G, RA ).LE.SFMIN2 )GO TO 170
         F = F*SCLFAC
         C = C*SCLFAC
         CA = CA*SCLFAC
         R = R / SCLFAC
         G = G / SCLFAC
         RA = RA / SCLFAC
         GO TO 160
<span class="comment">*</span><span class="comment">
</span>  170    CONTINUE
         G = C / SCLFAC
  180    CONTINUE
         IF( G.LT.R .OR. MAX( R, RA ).GE.SFMAX2 .OR.
     $       MIN( F, C, G, CA ).LE.SFMIN2 )GO TO 190
         F = F / SCLFAC
         C = C / SCLFAC
         G = G / SCLFAC
         CA = CA / SCLFAC
         R = R*SCLFAC
         RA = RA*SCLFAC
         GO TO 180
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Now balance.
</span><span class="comment">*</span><span class="comment">
</span>  190    CONTINUE
         IF( ( C+R ).GE.FACTOR*S )
     $      GO TO 200
         IF( F.LT.ONE .AND. SCALE( I ).LT.ONE ) THEN
            IF( F*SCALE( I ).LE.SFMIN1 )
     $         GO TO 200
         END IF
         IF( F.GT.ONE .AND. SCALE( I ).GT.ONE ) THEN
            IF( SCALE( I ).GE.SFMAX1 / F )
     $         GO TO 200
         END IF
         G = ONE / F
         SCALE( I ) = SCALE( I )*F
         NOCONV = .TRUE.
<span class="comment">*</span><span class="comment">
</span>         CALL SSCAL( N-K+1, G, A( I, K ), LDA )
         CALL SSCAL( L, F, A( 1, I ), 1 )
<span class="comment">*</span><span class="comment">
</span>  200 CONTINUE
<span class="comment">*</span><span class="comment">
</span>      IF( NOCONV )
     $   GO TO 140
<span class="comment">*</span><span class="comment">
</span>  210 CONTINUE
      ILO = K
      IHI = L
<span class="comment">*</span><span class="comment">
</span>      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="SGEBAL.320"></a><a href="sgebal.f.html#SGEBAL.1">SGEBAL</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>