1 SUBROUTINE ZLAEV2( A, B, C, RT1, RT2, CS1, SN1 )
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 DOUBLE PRECISION CS1, RT1, RT2
10 COMPLEX*16 A, B, C, SN1
11 * ..
12 *
13 * Purpose
14 * =======
15 *
16 * ZLAEV2 computes the eigendecomposition of a 2-by-2 Hermitian matrix
17 * [ A B ]
18 * [ CONJG(B) C ].
19 * On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
20 * eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
21 * eigenvector for RT1, giving the decomposition
22 *
23 * [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ]
24 * [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ].
25 *
26 * Arguments
27 * =========
28 *
29 * A (input) COMPLEX*16
30 * The (1,1) element of the 2-by-2 matrix.
31 *
32 * B (input) COMPLEX*16
33 * The (1,2) element and the conjugate of the (2,1) element of
34 * the 2-by-2 matrix.
35 *
36 * C (input) COMPLEX*16
37 * The (2,2) element of the 2-by-2 matrix.
38 *
39 * RT1 (output) DOUBLE PRECISION
40 * The eigenvalue of larger absolute value.
41 *
42 * RT2 (output) DOUBLE PRECISION
43 * The eigenvalue of smaller absolute value.
44 *
45 * CS1 (output) DOUBLE PRECISION
46 * SN1 (output) COMPLEX*16
47 * The vector (CS1, SN1) is a unit right eigenvector for RT1.
48 *
49 * Further Details
50 * ===============
51 *
52 * RT1 is accurate to a few ulps barring over/underflow.
53 *
54 * RT2 may be inaccurate if there is massive cancellation in the
55 * determinant A*C-B*B; higher precision or correctly rounded or
56 * correctly truncated arithmetic would be needed to compute RT2
57 * accurately in all cases.
58 *
59 * CS1 and SN1 are accurate to a few ulps barring over/underflow.
60 *
61 * Overflow is possible only if RT1 is within a factor of 5 of overflow.
62 * Underflow is harmless if the input data is 0 or exceeds
63 * underflow_threshold / macheps.
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68 DOUBLE PRECISION ZERO
69 PARAMETER ( ZERO = 0.0D0 )
70 DOUBLE PRECISION ONE
71 PARAMETER ( ONE = 1.0D0 )
72 * ..
73 * .. Local Scalars ..
74 DOUBLE PRECISION T
75 COMPLEX*16 W
76 * ..
77 * .. External Subroutines ..
78 EXTERNAL DLAEV2
79 * ..
80 * .. Intrinsic Functions ..
81 INTRINSIC ABS, DBLE, DCONJG
82 * ..
83 * .. Executable Statements ..
84 *
85 IF( ABS( B ).EQ.ZERO ) THEN
86 W = ONE
87 ELSE
88 W = DCONJG( B ) / ABS( B )
89 END IF
90 CALL DLAEV2( DBLE( A ), ABS( B ), DBLE( C ), RT1, RT2, CS1, T )
91 SN1 = W*T
92 RETURN
93 *
94 * End of ZLAEV2
95 *
96 END
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 DOUBLE PRECISION CS1, RT1, RT2
10 COMPLEX*16 A, B, C, SN1
11 * ..
12 *
13 * Purpose
14 * =======
15 *
16 * ZLAEV2 computes the eigendecomposition of a 2-by-2 Hermitian matrix
17 * [ A B ]
18 * [ CONJG(B) C ].
19 * On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
20 * eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
21 * eigenvector for RT1, giving the decomposition
22 *
23 * [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ]
24 * [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ].
25 *
26 * Arguments
27 * =========
28 *
29 * A (input) COMPLEX*16
30 * The (1,1) element of the 2-by-2 matrix.
31 *
32 * B (input) COMPLEX*16
33 * The (1,2) element and the conjugate of the (2,1) element of
34 * the 2-by-2 matrix.
35 *
36 * C (input) COMPLEX*16
37 * The (2,2) element of the 2-by-2 matrix.
38 *
39 * RT1 (output) DOUBLE PRECISION
40 * The eigenvalue of larger absolute value.
41 *
42 * RT2 (output) DOUBLE PRECISION
43 * The eigenvalue of smaller absolute value.
44 *
45 * CS1 (output) DOUBLE PRECISION
46 * SN1 (output) COMPLEX*16
47 * The vector (CS1, SN1) is a unit right eigenvector for RT1.
48 *
49 * Further Details
50 * ===============
51 *
52 * RT1 is accurate to a few ulps barring over/underflow.
53 *
54 * RT2 may be inaccurate if there is massive cancellation in the
55 * determinant A*C-B*B; higher precision or correctly rounded or
56 * correctly truncated arithmetic would be needed to compute RT2
57 * accurately in all cases.
58 *
59 * CS1 and SN1 are accurate to a few ulps barring over/underflow.
60 *
61 * Overflow is possible only if RT1 is within a factor of 5 of overflow.
62 * Underflow is harmless if the input data is 0 or exceeds
63 * underflow_threshold / macheps.
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68 DOUBLE PRECISION ZERO
69 PARAMETER ( ZERO = 0.0D0 )
70 DOUBLE PRECISION ONE
71 PARAMETER ( ONE = 1.0D0 )
72 * ..
73 * .. Local Scalars ..
74 DOUBLE PRECISION T
75 COMPLEX*16 W
76 * ..
77 * .. External Subroutines ..
78 EXTERNAL DLAEV2
79 * ..
80 * .. Intrinsic Functions ..
81 INTRINSIC ABS, DBLE, DCONJG
82 * ..
83 * .. Executable Statements ..
84 *
85 IF( ABS( B ).EQ.ZERO ) THEN
86 W = ONE
87 ELSE
88 W = DCONJG( B ) / ABS( B )
89 END IF
90 CALL DLAEV2( DBLE( A ), ABS( B ), DBLE( C ), RT1, RT2, CS1, T )
91 SN1 = W*T
92 RETURN
93 *
94 * End of ZLAEV2
95 *
96 END