slags2.f.html

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

     $             ( ABS( VB11R )+ABS( VB12 ) ) ) THEN
                  CALL <a name="SLARTG.131"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( -UA11R, UA12, CSQ, SNQ, R )
               ELSE
                  CALL <a name="SLARTG.133"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( -VB11R, VB12, CSQ, SNQ, R )
               END IF
            ELSE
               CALL <a name="SLARTG.136"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( -VB11R, VB12, CSQ, SNQ, R )
            END IF
<span class="comment">*</span><span class="comment">
</span>            CSU = CSL
            SNU = -SNL
            CSV = CSR
            SNV = -SNR
<span class="comment">*</span><span class="comment">
</span>         ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Compute the (2,1) and (2,2) elements of U'*A and V'*B,
</span><span class="comment">*</span><span class="comment">           and (2,2) element of |U|'*|A| and |V|'*|B|.
</span><span class="comment">*</span><span class="comment">
</span>            UA21 = -SNL*A1
            UA22 = -SNL*A2 + CSL*A3
<span class="comment">*</span><span class="comment">
</span>            VB21 = -SNR*B1
            VB22 = -SNR*B2 + CSR*B3
<span class="comment">*</span><span class="comment">
</span>            AUA22 = ABS( SNL )*ABS( A2 ) + ABS( CSL )*ABS( A3 )
            AVB22 = ABS( SNR )*ABS( B2 ) + ABS( CSR )*ABS( B3 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           zero (2,2) elements of U'*A and V'*B, and then swap.
</span><span class="comment">*</span><span class="comment">
</span>            IF( ( ABS( UA21 )+ABS( UA22 ) ).NE.ZERO ) THEN
               IF( AUA22 / ( ABS( UA21 )+ABS( UA22 ) ).LE.AVB22 /
     $             ( ABS( VB21 )+ABS( VB22 ) ) ) THEN
                  CALL <a name="SLARTG.163"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( -UA21, UA22, CSQ, SNQ, R )
               ELSE
                  CALL <a name="SLARTG.165"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( -VB21, VB22, CSQ, SNQ, R )
               END IF
            ELSE
               CALL <a name="SLARTG.168"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( -VB21, VB22, CSQ, SNQ, R )
            END IF
<span class="comment">*</span><span class="comment">
</span>            CSU = SNL
            SNU = CSL
            CSV = SNR
            SNV = CSR
<span class="comment">*</span><span class="comment">
</span>         END IF
<span class="comment">*</span><span class="comment">
</span>      ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Input matrices A and B are lower triangular matrices
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Form matrix C = A*adj(B) = ( a 0 )
</span><span class="comment">*</span><span class="comment">                                   ( c d )
</span><span class="comment">*</span><span class="comment">
</span>         A = A1*B3
         D = A3*B1
         C = A2*B3 - A3*B2
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        The SVD of real 2-by-2 triangular C
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">         ( CSL -SNL )*( A 0 )*(  CSR  SNR ) = ( R 0 )
</span><span class="comment">*</span><span class="comment">         ( SNL  CSL ) ( C D ) ( -SNR  CSR )   ( 0 T )
</span><span class="comment">*</span><span class="comment">
</span>         CALL <a name="SLASV2.194"></a><a href="slasv2.f.html#SLASV2.1">SLASV2</a>( A, C, D, S1, S2, SNR, CSR, SNL, CSL )
<span class="comment">*</span><span class="comment">
</span>         IF( ABS( CSR ).GE.ABS( SNR ) .OR. ABS( CSL ).GE.ABS( SNL ) )
     $        THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Compute the (2,1) and (2,2) elements of U'*A and V'*B,
</span><span class="comment">*</span><span class="comment">           and (2,1) element of |U|'*|A| and |V|'*|B|.
</span><span class="comment">*</span><span class="comment">
</span>            UA21 = -SNR*A1 + CSR*A2
            UA22R = CSR*A3
<span class="comment">*</span><span class="comment">
</span>            VB21 = -SNL*B1 + CSL*B2
            VB22R = CSL*B3
<span class="comment">*</span><span class="comment">
</span>            AUA21 = ABS( SNR )*ABS( A1 ) + ABS( CSR )*ABS( A2 )
            AVB21 = ABS( SNL )*ABS( B1 ) + ABS( CSL )*ABS( B2 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           zero (2,1) elements of U'*A and V'*B.
</span><span class="comment">*</span><span class="comment">
</span>            IF( ( ABS( UA21 )+ABS( UA22R ) ).NE.ZERO ) THEN
               IF( AUA21 / ( ABS( UA21 )+ABS( UA22R ) ).LE.AVB21 /
     $             ( ABS( VB21 )+ABS( VB22R ) ) ) THEN
                  CALL <a name="SLARTG.216"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( UA22R, UA21, CSQ, SNQ, R )
               ELSE
                  CALL <a name="SLARTG.218"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( VB22R, VB21, CSQ, SNQ, R )
               END IF
            ELSE
               CALL <a name="SLARTG.221"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( VB22R, VB21, CSQ, SNQ, R )
            END IF
<span class="comment">*</span><span class="comment">
</span>            CSU = CSR
            SNU = -SNR
            CSV = CSL
            SNV = -SNL
<span class="comment">*</span><span class="comment">
</span>         ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Compute the (1,1) and (1,2) elements of U'*A and V'*B,
</span><span class="comment">*</span><span class="comment">           and (1,1) element of |U|'*|A| and |V|'*|B|.
</span><span class="comment">*</span><span class="comment">
</span>            UA11 = CSR*A1 + SNR*A2
            UA12 = SNR*A3
<span class="comment">*</span><span class="comment">
</span>            VB11 = CSL*B1 + SNL*B2
            VB12 = SNL*B3
<span class="comment">*</span><span class="comment">
</span>            AUA11 = ABS( CSR )*ABS( A1 ) + ABS( SNR )*ABS( A2 )
            AVB11 = ABS( CSL )*ABS( B1 ) + ABS( SNL )*ABS( B2 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           zero (1,1) elements of U'*A and V'*B, and then swap.
</span><span class="comment">*</span><span class="comment">
</span>            IF( ( ABS( UA11 )+ABS( UA12 ) ).NE.ZERO ) THEN
               IF( AUA11 / ( ABS( UA11 )+ABS( UA12 ) ).LE.AVB11 /
     $             ( ABS( VB11 )+ABS( VB12 ) ) ) THEN
                  CALL <a name="SLARTG.248"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( UA12, UA11, CSQ, SNQ, R )
               ELSE
                  CALL <a name="SLARTG.250"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( VB12, VB11, CSQ, SNQ, R )
               END IF
            ELSE
               CALL <a name="SLARTG.253"></a><a href="slartg.f.html#SLARTG.1">SLARTG</a>( VB12, VB11, CSQ, SNQ, R )
            END IF
<span class="comment">*</span><span class="comment">
</span>            CSU = SNR
            SNU = CSR
            CSV = SNL
            SNV = CSL
<span class="comment">*</span><span class="comment">
</span>         END IF
<span class="comment">*</span><span class="comment">
</span>      END IF
<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="SLAGS2.267"></a><a href="slags2.f.html#SLAGS2.1">SLAGS2</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>