--- rpl/lapack/lapack/dlags2.f 2010/08/06 15:32:26 1.4 +++ rpl/lapack/lapack/dlags2.f 2023/08/07 08:38:54 1.19 @@ -1,10 +1,158 @@ +*> \brief \b DLAGS2 computes 2-by-2 orthogonal matrices U, V, and Q, and applies them to matrices A and B such that the rows of the transformed A and B are parallel. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLAGS2 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, +* SNV, CSQ, SNQ ) +* +* .. Scalar Arguments .. +* LOGICAL UPPER +* DOUBLE PRECISION A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, SNQ, +* $ SNU, SNV +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such +*> that if ( UPPER ) then +*> +*> U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) +*> ( 0 A3 ) ( x x ) +*> and +*> V**T*B*Q = V**T *( B1 B2 )*Q = ( x 0 ) +*> ( 0 B3 ) ( x x ) +*> +*> or if ( .NOT.UPPER ) then +*> +*> U**T *A*Q = U**T *( A1 0 )*Q = ( x x ) +*> ( A2 A3 ) ( 0 x ) +*> and +*> V**T*B*Q = V**T*( B1 0 )*Q = ( x x ) +*> ( B2 B3 ) ( 0 x ) +*> +*> The rows of the transformed A and B are parallel, where +*> +*> U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) +*> ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) +*> +*> Z**T denotes the transpose of Z. +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPPER +*> \verbatim +*> UPPER is LOGICAL +*> = .TRUE.: the input matrices A and B are upper triangular. +*> = .FALSE.: the input matrices A and B are lower triangular. +*> \endverbatim +*> +*> \param[in] A1 +*> \verbatim +*> A1 is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[in] A2 +*> \verbatim +*> A2 is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[in] A3 +*> \verbatim +*> A3 is DOUBLE PRECISION +*> On entry, A1, A2 and A3 are elements of the input 2-by-2 +*> upper (lower) triangular matrix A. +*> \endverbatim +*> +*> \param[in] B1 +*> \verbatim +*> B1 is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[in] B2 +*> \verbatim +*> B2 is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[in] B3 +*> \verbatim +*> B3 is DOUBLE PRECISION +*> On entry, B1, B2 and B3 are elements of the input 2-by-2 +*> upper (lower) triangular matrix B. +*> \endverbatim +*> +*> \param[out] CSU +*> \verbatim +*> CSU is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[out] SNU +*> \verbatim +*> SNU is DOUBLE PRECISION +*> The desired orthogonal matrix U. +*> \endverbatim +*> +*> \param[out] CSV +*> \verbatim +*> CSV is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[out] SNV +*> \verbatim +*> SNV is DOUBLE PRECISION +*> The desired orthogonal matrix V. +*> \endverbatim +*> +*> \param[out] CSQ +*> \verbatim +*> CSQ is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[out] SNQ +*> \verbatim +*> SNQ is DOUBLE PRECISION +*> The desired orthogonal matrix Q. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup doubleOTHERauxiliary +* +* ===================================================================== SUBROUTINE DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, $ SNV, CSQ, SNQ ) * -* -- LAPACK auxiliary routine (version 3.2) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 * * .. Scalar Arguments .. LOGICAL UPPER @@ -12,65 +160,6 @@ $ SNU, SNV * .. * -* Purpose -* ======= -* -* DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such -* that if ( UPPER ) then -* -* U'*A*Q = U'*( A1 A2 )*Q = ( x 0 ) -* ( 0 A3 ) ( x x ) -* and -* V'*B*Q = V'*( B1 B2 )*Q = ( x 0 ) -* ( 0 B3 ) ( x x ) -* -* or if ( .NOT.UPPER ) then -* -* U'*A*Q = U'*( A1 0 )*Q = ( x x ) -* ( A2 A3 ) ( 0 x ) -* and -* V'*B*Q = V'*( B1 0 )*Q = ( x x ) -* ( B2 B3 ) ( 0 x ) -* -* The rows of the transformed A and B are parallel, where -* -* U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) -* ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) -* -* Z' denotes the transpose of Z. -* -* -* Arguments -* ========= -* -* UPPER (input) LOGICAL -* = .TRUE.: the input matrices A and B are upper triangular. -* = .FALSE.: the input matrices A and B are lower triangular. -* -* A1 (input) DOUBLE PRECISION -* A2 (input) DOUBLE PRECISION -* A3 (input) DOUBLE PRECISION -* On entry, A1, A2 and A3 are elements of the input 2-by-2 -* upper (lower) triangular matrix A. -* -* B1 (input) DOUBLE PRECISION -* B2 (input) DOUBLE PRECISION -* B3 (input) DOUBLE PRECISION -* On entry, B1, B2 and B3 are elements of the input 2-by-2 -* upper (lower) triangular matrix B. -* -* CSU (output) DOUBLE PRECISION -* SNU (output) DOUBLE PRECISION -* The desired orthogonal matrix U. -* -* CSV (output) DOUBLE PRECISION -* SNV (output) DOUBLE PRECISION -* The desired orthogonal matrix V. -* -* CSQ (output) DOUBLE PRECISION -* SNQ (output) DOUBLE PRECISION -* The desired orthogonal matrix Q. -* * ===================================================================== * * .. Parameters .. @@ -112,8 +201,8 @@ IF( ABS( CSL ).GE.ABS( SNL ) .OR. ABS( CSR ).GE.ABS( SNR ) ) $ THEN * -* Compute the (1,1) and (1,2) elements of U'*A and V'*B, -* and (1,2) element of |U|'*|A| and |V|'*|B|. +* Compute the (1,1) and (1,2) elements of U**T *A and V**T *B, +* and (1,2) element of |U|**T *|A| and |V|**T *|B|. * UA11R = CSL*A1 UA12 = CSL*A2 + SNL*A3 @@ -124,7 +213,7 @@ AUA12 = ABS( CSL )*ABS( A2 ) + ABS( SNL )*ABS( A3 ) AVB12 = ABS( CSR )*ABS( B2 ) + ABS( SNR )*ABS( B3 ) * -* zero (1,2) elements of U'*A and V'*B +* zero (1,2) elements of U**T *A and V**T *B * IF( ( ABS( UA11R )+ABS( UA12 ) ).NE.ZERO ) THEN IF( AUA12 / ( ABS( UA11R )+ABS( UA12 ) ).LE.AVB12 / @@ -144,8 +233,8 @@ * ELSE * -* Compute the (2,1) and (2,2) elements of U'*A and V'*B, -* and (2,2) element of |U|'*|A| and |V|'*|B|. +* Compute the (2,1) and (2,2) elements of U**T *A and V**T *B, +* and (2,2) element of |U|**T *|A| and |V|**T *|B|. * UA21 = -SNL*A1 UA22 = -SNL*A2 + CSL*A3 @@ -156,7 +245,7 @@ AUA22 = ABS( SNL )*ABS( A2 ) + ABS( CSL )*ABS( A3 ) AVB22 = ABS( SNR )*ABS( B2 ) + ABS( CSR )*ABS( B3 ) * -* zero (2,2) elements of U'*A and V'*B, and then swap. +* zero (2,2) elements of U**T*A and V**T*B, and then swap. * IF( ( ABS( UA21 )+ABS( UA22 ) ).NE.ZERO ) THEN IF( AUA22 / ( ABS( UA21 )+ABS( UA22 ) ).LE.AVB22 / @@ -197,8 +286,8 @@ IF( ABS( CSR ).GE.ABS( SNR ) .OR. ABS( CSL ).GE.ABS( SNL ) ) $ THEN * -* Compute the (2,1) and (2,2) elements of U'*A and V'*B, -* and (2,1) element of |U|'*|A| and |V|'*|B|. +* Compute the (2,1) and (2,2) elements of U**T *A and V**T *B, +* and (2,1) element of |U|**T *|A| and |V|**T *|B|. * UA21 = -SNR*A1 + CSR*A2 UA22R = CSR*A3 @@ -209,7 +298,7 @@ AUA21 = ABS( SNR )*ABS( A1 ) + ABS( CSR )*ABS( A2 ) AVB21 = ABS( SNL )*ABS( B1 ) + ABS( CSL )*ABS( B2 ) * -* zero (2,1) elements of U'*A and V'*B. +* zero (2,1) elements of U**T *A and V**T *B. * IF( ( ABS( UA21 )+ABS( UA22R ) ).NE.ZERO ) THEN IF( AUA21 / ( ABS( UA21 )+ABS( UA22R ) ).LE.AVB21 / @@ -229,8 +318,8 @@ * ELSE * -* Compute the (1,1) and (1,2) elements of U'*A and V'*B, -* and (1,1) element of |U|'*|A| and |V|'*|B|. +* Compute the (1,1) and (1,2) elements of U**T *A and V**T *B, +* and (1,1) element of |U|**T *|A| and |V|**T *|B|. * UA11 = CSR*A1 + SNR*A2 UA12 = SNR*A3 @@ -241,7 +330,7 @@ AUA11 = ABS( CSR )*ABS( A1 ) + ABS( SNR )*ABS( A2 ) AVB11 = ABS( CSL )*ABS( B1 ) + ABS( SNL )*ABS( B2 ) * -* zero (1,1) elements of U'*A and V'*B, and then swap. +* zero (1,1) elements of U**T*A and V**T*B, and then swap. * IF( ( ABS( UA11 )+ABS( UA12 ) ).NE.ZERO ) THEN IF( AUA11 / ( ABS( UA11 )+ABS( UA12 ) ).LE.AVB11 /