--- rpl/lapack/lapack/zlags2.f 2010/04/21 13:45:33 1.2 +++ rpl/lapack/lapack/zlags2.f 2011/11/21 22:19:51 1.10 @@ -1,10 +1,167 @@ +*> \brief \b ZLAGS2 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLAGS2 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, +* SNV, CSQ, SNQ ) +* +* .. Scalar Arguments .. +* LOGICAL UPPER +* DOUBLE PRECISION A1, A3, B1, B3, CSQ, CSU, CSV +* COMPLEX*16 A2, B2, SNQ, SNU, SNV +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLAGS2 computes 2-by-2 unitary matrices U, V and Q, such +*> that if ( UPPER ) then +*> +*> U**H *A*Q = U**H *( A1 A2 )*Q = ( x 0 ) +*> ( 0 A3 ) ( x x ) +*> and +*> V**H*B*Q = V**H *( B1 B2 )*Q = ( x 0 ) +*> ( 0 B3 ) ( x x ) +*> +*> or if ( .NOT.UPPER ) then +*> +*> U**H *A*Q = U**H *( A1 0 )*Q = ( x x ) +*> ( A2 A3 ) ( 0 x ) +*> and +*> V**H *B*Q = V**H *( B1 0 )*Q = ( x x ) +*> ( B2 B3 ) ( 0 x ) +*> where +*> +*> U = ( CSU SNU ), V = ( CSV SNV ), +*> ( -SNU**H CSU ) ( -SNV**H CSV ) +*> +*> Q = ( CSQ SNQ ) +*> ( -SNQ**H CSQ ) +*> +*> The rows of the transformed A and B are parallel. Moreover, if the +*> input 2-by-2 matrix A is not zero, then the transformed (1,1) entry +*> of A is not zero. If the input matrices A and B are both not zero, +*> then the transformed (2,2) element of B is not zero, except when the +*> first rows of input A and B are parallel and the second rows are +*> zero. +*> \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 COMPLEX*16 +*> \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 COMPLEX*16 +*> \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 COMPLEX*16 +*> The desired unitary matrix U. +*> \endverbatim +*> +*> \param[out] CSV +*> \verbatim +*> CSV is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[out] SNV +*> \verbatim +*> SNV is COMPLEX*16 +*> The desired unitary matrix V. +*> \endverbatim +*> +*> \param[out] CSQ +*> \verbatim +*> CSQ is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[out] SNQ +*> \verbatim +*> SNQ is COMPLEX*16 +*> The desired unitary matrix Q. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2011 +* +*> \ingroup complex16OTHERauxiliary +* +* ===================================================================== SUBROUTINE ZLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, $ SNV, CSQ, SNQ ) * -* -- LAPACK auxiliary routine (version 3.2) -- +* -- LAPACK auxiliary routine (version 3.4.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 +* November 2011 * * .. Scalar Arguments .. LOGICAL UPPER @@ -12,73 +169,6 @@ COMPLEX*16 A2, B2, SNQ, SNU, SNV * .. * -* Purpose -* ======= -* -* ZLAGS2 computes 2-by-2 unitary 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 ) -* where -* -* U = ( CSU SNU ), V = ( CSV SNV ), -* ( -CONJG(SNU) CSU ) ( -CONJG(SNV) CSV ) -* -* Q = ( CSQ SNQ ) -* ( -CONJG(SNQ) CSQ ) -* -* Z' denotes the conjugate transpose of Z. -* -* The rows of the transformed A and B are parallel. Moreover, if the -* input 2-by-2 matrix A is not zero, then the transformed (1,1) entry -* of A is not zero. If the input matrices A and B are both not zero, -* then the transformed (2,2) element of B is not zero, except when the -* first rows of input A and B are parallel and the second rows are -* zero. -* -* 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) COMPLEX*16 -* 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) COMPLEX*16 -* 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) COMPLEX*16 -* The desired unitary matrix U. -* -* CSV (output) DOUBLE PRECISION -* SNV (output) COMPLEX*16 -* The desired unitary matrix V. -* -* CSQ (output) DOUBLE PRECISION -* SNQ (output) COMPLEX*16 -* The desired unitary matrix Q. -* * ===================================================================== * * .. Parameters .. @@ -135,8 +225,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**H *A and V**H *B, +* and (1,2) element of |U|**H *|A| and |V|**H *|B|. * UA11R = CSL*A1 UA12 = CSL*A2 + D1*SNL*A3 @@ -147,7 +237,7 @@ AUA12 = ABS( CSL )*ABS1( A2 ) + ABS( SNL )*ABS( A3 ) AVB12 = ABS( CSR )*ABS1( B2 ) + ABS( SNR )*ABS( B3 ) * -* zero (1,2) elements of U'*A and V'*B +* zero (1,2) elements of U**H *A and V**H *B * IF( ( ABS( UA11R )+ABS1( UA12 ) ).EQ.ZERO ) THEN CALL ZLARTG( -DCMPLX( VB11R ), DCONJG( VB12 ), CSQ, SNQ, @@ -171,8 +261,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**H *A and V**H *B, +* and (2,2) element of |U|**H *|A| and |V|**H *|B|. * UA21 = -DCONJG( D1 )*SNL*A1 UA22 = -DCONJG( D1 )*SNL*A2 + CSL*A3 @@ -183,7 +273,7 @@ AUA22 = ABS( SNL )*ABS1( A2 ) + ABS( CSL )*ABS( A3 ) AVB22 = ABS( SNR )*ABS1( B2 ) + ABS( CSR )*ABS( B3 ) * -* zero (2,2) elements of U'*A and V'*B, and then swap. +* zero (2,2) elements of U**H *A and V**H *B, and then swap. * IF( ( ABS1( UA21 )+ABS1( UA22 ) ).EQ.ZERO ) THEN CALL ZLARTG( -DCONJG( VB21 ), DCONJG( VB22 ), CSQ, SNQ, @@ -236,8 +326,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**H *A and V**H *B, +* and (2,1) element of |U|**H *|A| and |V|**H *|B|. * UA21 = -D1*SNR*A1 + CSR*A2 UA22R = CSR*A3 @@ -248,7 +338,7 @@ AUA21 = ABS( SNR )*ABS( A1 ) + ABS( CSR )*ABS1( A2 ) AVB21 = ABS( SNL )*ABS( B1 ) + ABS( CSL )*ABS1( B2 ) * -* zero (2,1) elements of U'*A and V'*B. +* zero (2,1) elements of U**H *A and V**H *B. * IF( ( ABS1( UA21 )+ABS( UA22R ) ).EQ.ZERO ) THEN CALL ZLARTG( DCMPLX( VB22R ), VB21, CSQ, SNQ, R ) @@ -268,8 +358,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**H *A and V**H *B, +* and (1,1) element of |U|**H *|A| and |V|**H *|B|. * UA11 = CSR*A1 + DCONJG( D1 )*SNR*A2 UA12 = DCONJG( D1 )*SNR*A3 @@ -280,7 +370,7 @@ AUA11 = ABS( CSR )*ABS( A1 ) + ABS( SNR )*ABS1( A2 ) AVB11 = ABS( CSL )*ABS( B1 ) + ABS( SNL )*ABS1( B2 ) * -* zero (1,1) elements of U'*A and V'*B, and then swap. +* zero (1,1) elements of U**H *A and V**H *B, and then swap. * IF( ( ABS1( UA11 )+ABS1( UA12 ) ).EQ.ZERO ) THEN CALL ZLARTG( VB12, VB11, CSQ, SNQ, R )