version 1.2, 2010/04/21 13:45:16
|
version 1.8, 2011/07/22 07:38:06
|
Line 1
|
Line 1
|
SUBROUTINE DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, |
SUBROUTINE DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, |
$ SNV, CSQ, SNQ ) |
$ SNV, CSQ, SNQ ) |
* |
* |
* -- LAPACK auxiliary routine (version 3.2) -- |
* -- LAPACK auxiliary routine (version 3.3.1) -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* November 2006 |
* -- April 2011 -- |
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
LOGICAL UPPER |
LOGICAL UPPER |
Line 18
|
Line 18
|
* DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such |
* DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such |
* that if ( UPPER ) then |
* that if ( UPPER ) then |
* |
* |
* U'*A*Q = U'*( A1 A2 )*Q = ( x 0 ) |
* U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) |
* ( 0 A3 ) ( x x ) |
* ( 0 A3 ) ( x x ) |
* and |
* and |
* V'*B*Q = V'*( B1 B2 )*Q = ( x 0 ) |
* V**T*B*Q = V**T *( B1 B2 )*Q = ( x 0 ) |
* ( 0 B3 ) ( x x ) |
* ( 0 B3 ) ( x x ) |
* |
* |
* or if ( .NOT.UPPER ) then |
* or if ( .NOT.UPPER ) then |
* |
* |
* U'*A*Q = U'*( A1 0 )*Q = ( x x ) |
* U**T *A*Q = U**T *( A1 0 )*Q = ( x x ) |
* ( A2 A3 ) ( 0 x ) |
* ( A2 A3 ) ( 0 x ) |
* and |
* and |
* V'*B*Q = V'*( B1 0 )*Q = ( x x ) |
* V**T*B*Q = V**T*( B1 0 )*Q = ( x x ) |
* ( B2 B3 ) ( 0 x ) |
* ( B2 B3 ) ( 0 x ) |
* |
* |
* The rows of the transformed A and B are parallel, where |
* The rows of the transformed A and B are parallel, where |
* |
* |
* U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) |
* U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) |
* ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) |
* ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) |
* |
* |
* Z' denotes the transpose of Z. |
* Z**T denotes the transpose of Z. |
* |
* |
* |
* |
* Arguments |
* Arguments |
Line 112
|
Line 112
|
IF( ABS( CSL ).GE.ABS( SNL ) .OR. ABS( CSR ).GE.ABS( SNR ) ) |
IF( ABS( CSL ).GE.ABS( SNL ) .OR. ABS( CSR ).GE.ABS( SNR ) ) |
$ THEN |
$ THEN |
* |
* |
* Compute the (1,1) and (1,2) elements 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|'*|A| and |V|'*|B|. |
* and (1,2) element of |U|**T *|A| and |V|**T *|B|. |
* |
* |
UA11R = CSL*A1 |
UA11R = CSL*A1 |
UA12 = CSL*A2 + SNL*A3 |
UA12 = CSL*A2 + SNL*A3 |
Line 124
|
Line 124
|
AUA12 = ABS( CSL )*ABS( A2 ) + ABS( SNL )*ABS( A3 ) |
AUA12 = ABS( CSL )*ABS( A2 ) + ABS( SNL )*ABS( A3 ) |
AVB12 = ABS( CSR )*ABS( B2 ) + ABS( SNR )*ABS( B3 ) |
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( ( ABS( UA11R )+ABS( UA12 ) ).NE.ZERO ) THEN |
IF( AUA12 / ( ABS( UA11R )+ABS( UA12 ) ).LE.AVB12 / |
IF( AUA12 / ( ABS( UA11R )+ABS( UA12 ) ).LE.AVB12 / |
Line 144
|
Line 144
|
* |
* |
ELSE |
ELSE |
* |
* |
* Compute the (2,1) and (2,2) elements 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|'*|A| and |V|'*|B|. |
* and (2,2) element of |U|**T *|A| and |V|**T *|B|. |
* |
* |
UA21 = -SNL*A1 |
UA21 = -SNL*A1 |
UA22 = -SNL*A2 + CSL*A3 |
UA22 = -SNL*A2 + CSL*A3 |
Line 156
|
Line 156
|
AUA22 = ABS( SNL )*ABS( A2 ) + ABS( CSL )*ABS( A3 ) |
AUA22 = ABS( SNL )*ABS( A2 ) + ABS( CSL )*ABS( A3 ) |
AVB22 = ABS( SNR )*ABS( B2 ) + ABS( CSR )*ABS( B3 ) |
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( ( ABS( UA21 )+ABS( UA22 ) ).NE.ZERO ) THEN |
IF( AUA22 / ( ABS( UA21 )+ABS( UA22 ) ).LE.AVB22 / |
IF( AUA22 / ( ABS( UA21 )+ABS( UA22 ) ).LE.AVB22 / |
Line 197
|
Line 197
|
IF( ABS( CSR ).GE.ABS( SNR ) .OR. ABS( CSL ).GE.ABS( SNL ) ) |
IF( ABS( CSR ).GE.ABS( SNR ) .OR. ABS( CSL ).GE.ABS( SNL ) ) |
$ THEN |
$ THEN |
* |
* |
* Compute the (2,1) and (2,2) elements 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|'*|A| and |V|'*|B|. |
* and (2,1) element of |U|**T *|A| and |V|**T *|B|. |
* |
* |
UA21 = -SNR*A1 + CSR*A2 |
UA21 = -SNR*A1 + CSR*A2 |
UA22R = CSR*A3 |
UA22R = CSR*A3 |
Line 209
|
Line 209
|
AUA21 = ABS( SNR )*ABS( A1 ) + ABS( CSR )*ABS( A2 ) |
AUA21 = ABS( SNR )*ABS( A1 ) + ABS( CSR )*ABS( A2 ) |
AVB21 = ABS( SNL )*ABS( B1 ) + ABS( CSL )*ABS( B2 ) |
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( ( ABS( UA21 )+ABS( UA22R ) ).NE.ZERO ) THEN |
IF( AUA21 / ( ABS( UA21 )+ABS( UA22R ) ).LE.AVB21 / |
IF( AUA21 / ( ABS( UA21 )+ABS( UA22R ) ).LE.AVB21 / |
Line 229
|
Line 229
|
* |
* |
ELSE |
ELSE |
* |
* |
* Compute the (1,1) and (1,2) elements 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|'*|A| and |V|'*|B|. |
* and (1,1) element of |U|**T *|A| and |V|**T *|B|. |
* |
* |
UA11 = CSR*A1 + SNR*A2 |
UA11 = CSR*A1 + SNR*A2 |
UA12 = SNR*A3 |
UA12 = SNR*A3 |
Line 241
|
Line 241
|
AUA11 = ABS( CSR )*ABS( A1 ) + ABS( SNR )*ABS( A2 ) |
AUA11 = ABS( CSR )*ABS( A1 ) + ABS( SNR )*ABS( A2 ) |
AVB11 = ABS( CSL )*ABS( B1 ) + ABS( SNL )*ABS( B2 ) |
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( ( ABS( UA11 )+ABS( UA12 ) ).NE.ZERO ) THEN |
IF( AUA11 / ( ABS( UA11 )+ABS( UA12 ) ).LE.AVB11 / |
IF( AUA11 / ( ABS( UA11 )+ABS( UA12 ) ).LE.AVB11 / |