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