zlahqr.f.html

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

     $                DIMAG( Y ).LT.RZERO )Y = -Y
               END IF
               T = T - U*<a name="ZLADIV.314"></a><a href="zladiv.f.html#ZLADIV.1">ZLADIV</a>( U, ( X+Y ) )
            END IF
         END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Look for two consecutive small subdiagonal elements.
</span><span class="comment">*</span><span class="comment">
</span>         DO 60 M = I - 1, L + 1, -1
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Determine the effect of starting the single-shift QR
</span><span class="comment">*</span><span class="comment">           iteration at row M, and see if this would make H(M,M-1)
</span><span class="comment">*</span><span class="comment">           negligible.
</span><span class="comment">*</span><span class="comment">
</span>            H11 = H( M, M )
            H22 = H( M+1, M+1 )
            H11S = H11 - T
            H21 = H( M+1, M )
            S = CABS1( H11S ) + ABS( H21 )
            H11S = H11S / S
            H21 = H21 / S
            V( 1 ) = H11S
            V( 2 ) = H21
            H10 = H( M, M-1 )
            IF( ABS( H10 )*ABS( H21 ).LE.ULP*
     $          ( CABS1( H11S )*( CABS1( H11 )+CABS1( H22 ) ) ) )
     $          GO TO 70
   60    CONTINUE
         H11 = H( L, L )
         H22 = H( L+1, L+1 )
         H11S = H11 - T
         H21 = H( L+1, L )
         S = CABS1( H11S ) + ABS( H21 )
         H11S = H11S / S
         H21 = H21 / S
         V( 1 ) = H11S
         V( 2 ) = H21
   70    CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Single-shift QR step
</span><span class="comment">*</span><span class="comment">
</span>         DO 120 K = M, I - 1
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           The first iteration of this loop determines a reflection G
</span><span class="comment">*</span><span class="comment">           from the vector V and applies it from left and right to H,
</span><span class="comment">*</span><span class="comment">           thus creating a nonzero bulge below the subdiagonal.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Each subsequent iteration determines a reflection G to
</span><span class="comment">*</span><span class="comment">           restore the Hessenberg form in the (K-1)th column, and thus
</span><span class="comment">*</span><span class="comment">           chases the bulge one step toward the bottom of the active
</span><span class="comment">*</span><span class="comment">           submatrix.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           V(2) is always real before the call to <a name="ZLARFG.364"></a><a href="zlarfg.f.html#ZLARFG.1">ZLARFG</a>, and hence
</span><span class="comment">*</span><span class="comment">           after the call T2 ( = T1*V(2) ) is also real.
</span><span class="comment">*</span><span class="comment">
</span>            IF( K.GT.M )
     $         CALL ZCOPY( 2, H( K, K-1 ), 1, V, 1 )
            CALL <a name="ZLARFG.369"></a><a href="zlarfg.f.html#ZLARFG.1">ZLARFG</a>( 2, V( 1 ), V( 2 ), 1, T1 )
            IF( K.GT.M ) THEN
               H( K, K-1 ) = V( 1 )
               H( K+1, K-1 ) = ZERO
            END IF
            V2 = V( 2 )
            T2 = DBLE( T1*V2 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Apply G from the left to transform the rows of the matrix
</span><span class="comment">*</span><span class="comment">           in columns K to I2.
</span><span class="comment">*</span><span class="comment">
</span>            DO 80 J = K, I2
               SUM = DCONJG( T1 )*H( K, J ) + T2*H( K+1, J )
               H( K, J ) = H( K, J ) - SUM
               H( K+1, J ) = H( K+1, J ) - SUM*V2
   80       CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Apply G from the right to transform the columns of the
</span><span class="comment">*</span><span class="comment">           matrix in rows I1 to min(K+2,I).
</span><span class="comment">*</span><span class="comment">
</span>            DO 90 J = I1, MIN( K+2, I )
               SUM = T1*H( J, K ) + T2*H( J, K+1 )
               H( J, K ) = H( J, K ) - SUM
               H( J, K+1 ) = H( J, K+1 ) - SUM*DCONJG( V2 )
   90       CONTINUE
<span class="comment">*</span><span class="comment">
</span>            IF( WANTZ ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Accumulate transformations in the matrix Z
</span><span class="comment">*</span><span class="comment">
</span>               DO 100 J = ILOZ, IHIZ
                  SUM = T1*Z( J, K ) + T2*Z( J, K+1 )
                  Z( J, K ) = Z( J, K ) - SUM
                  Z( J, K+1 ) = Z( J, K+1 ) - SUM*DCONJG( V2 )
  100          CONTINUE
            END IF
<span class="comment">*</span><span class="comment">
</span>            IF( K.EQ.M .AND. M.GT.L ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              If the QR step was started at row M &gt; L because two
</span><span class="comment">*</span><span class="comment">              consecutive small subdiagonals were found, then extra
</span><span class="comment">*</span><span class="comment">              scaling must be performed to ensure that H(M,M-1) remains
</span><span class="comment">*</span><span class="comment">              real.
</span><span class="comment">*</span><span class="comment">
</span>               TEMP = ONE - T1
               TEMP = TEMP / ABS( TEMP )
               H( M+1, M ) = H( M+1, M )*DCONJG( TEMP )
               IF( M+2.LE.I )
     $            H( M+2, M+1 ) = H( M+2, M+1 )*TEMP
               DO 110 J = M, I
                  IF( J.NE.M+1 ) THEN
                     IF( I2.GT.J )
     $                  CALL ZSCAL( I2-J, TEMP, H( J, J+1 ), LDH )
                     CALL ZSCAL( J-I1, DCONJG( TEMP ), H( I1, J ), 1 )
                     IF( WANTZ ) THEN
                        CALL ZSCAL( NZ, DCONJG( TEMP ), Z( ILOZ, J ),
     $                              1 )
                     END IF
                  END IF
  110          CONTINUE
            END IF
  120    CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Ensure that H(I,I-1) is real.
</span><span class="comment">*</span><span class="comment">
</span>         TEMP = H( I, I-1 )
         IF( DIMAG( TEMP ).NE.RZERO ) THEN
            RTEMP = ABS( TEMP )
            H( I, I-1 ) = RTEMP
            TEMP = TEMP / RTEMP
            IF( I2.GT.I )
     $         CALL ZSCAL( I2-I, DCONJG( TEMP ), H( I, I+1 ), LDH )
            CALL ZSCAL( I-I1, TEMP, H( I1, I ), 1 )
            IF( WANTZ ) THEN
               CALL ZSCAL( NZ, TEMP, Z( ILOZ, I ), 1 )
            END IF
         END IF
<span class="comment">*</span><span class="comment">
</span>  130 CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Failure to converge in remaining number of iterations
</span><span class="comment">*</span><span class="comment">
</span>      INFO = I
      RETURN
<span class="comment">*</span><span class="comment">
</span>  140 CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     H(I,I-1) is negligible: one eigenvalue has converged.
</span><span class="comment">*</span><span class="comment">
</span>      W( I ) = H( I, I )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     return to start of the main loop with new value of I.
</span><span class="comment">*</span><span class="comment">
</span>      I = L - 1
      GO TO 30
<span class="comment">*</span><span class="comment">
</span>  150 CONTINUE
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="ZLAHQR.468"></a><a href="zlahqr.f.html#ZLAHQR.1">ZLAHQR</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>