1*> \brief \b DLAED5 used by DSTEDC. Solves the 2-by-2 secular equation.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DLAED5 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed5.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed5.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed5.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE DLAED5( I, D, Z, DELTA, RHO, DLAM )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            I
25*       DOUBLE PRECISION   DLAM, RHO
26*       ..
27*       .. Array Arguments ..
28*       DOUBLE PRECISION   D( 2 ), DELTA( 2 ), Z( 2 )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> This subroutine computes the I-th eigenvalue of a symmetric rank-one
38*> modification of a 2-by-2 diagonal matrix
39*>
40*>            diag( D )  +  RHO * Z * transpose(Z) .
41*>
42*> The diagonal elements in the array D are assumed to satisfy
43*>
44*>            D(i) < D(j)  for  i < j .
45*>
46*> We also assume RHO > 0 and that the Euclidean norm of the vector
47*> Z is one.
48*> \endverbatim
49*
50*  Arguments:
51*  ==========
52*
53*> \param[in] I
54*> \verbatim
55*>          I is INTEGER
56*>         The index of the eigenvalue to be computed.  I = 1 or I = 2.
57*> \endverbatim
58*>
59*> \param[in] D
60*> \verbatim
61*>          D is DOUBLE PRECISION array, dimension (2)
62*>         The original eigenvalues.  We assume D(1) < D(2).
63*> \endverbatim
64*>
65*> \param[in] Z
66*> \verbatim
67*>          Z is DOUBLE PRECISION array, dimension (2)
68*>         The components of the updating vector.
69*> \endverbatim
70*>
71*> \param[out] DELTA
72*> \verbatim
73*>          DELTA is DOUBLE PRECISION array, dimension (2)
74*>         The vector DELTA contains the information necessary
75*>         to construct the eigenvectors.
76*> \endverbatim
77*>
78*> \param[in] RHO
79*> \verbatim
80*>          RHO is DOUBLE PRECISION
81*>         The scalar in the symmetric updating formula.
82*> \endverbatim
83*>
84*> \param[out] DLAM
85*> \verbatim
86*>          DLAM is DOUBLE PRECISION
87*>         The computed lambda_I, the I-th updated eigenvalue.
88*> \endverbatim
89*
90*  Authors:
91*  ========
92*
93*> \author Univ. of Tennessee
94*> \author Univ. of California Berkeley
95*> \author Univ. of Colorado Denver
96*> \author NAG Ltd.
97*
98*> \ingroup auxOTHERcomputational
99*
100*> \par Contributors:
101*  ==================
102*>
103*>     Ren-Cang Li, Computer Science Division, University of California
104*>     at Berkeley, USA
105*>
106*  =====================================================================
107      SUBROUTINE DLAED5( I, D, Z, DELTA, RHO, DLAM )
108*
109*  -- LAPACK computational routine --
110*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
111*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
112*
113*     .. Scalar Arguments ..
114      INTEGER            I
115      DOUBLE PRECISION   DLAM, RHO
116*     ..
117*     .. Array Arguments ..
118      DOUBLE PRECISION   D( 2 ), DELTA( 2 ), Z( 2 )
119*     ..
120*
121*  =====================================================================
122*
123*     .. Parameters ..
124      DOUBLE PRECISION   ZERO, ONE, TWO, FOUR
125      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
126     $                   FOUR = 4.0D0 )
127*     ..
128*     .. Local Scalars ..
129      DOUBLE PRECISION   B, C, DEL, TAU, TEMP, W
130*     ..
131*     .. Intrinsic Functions ..
132      INTRINSIC          ABS, SQRT
133*     ..
134*     .. Executable Statements ..
135*
136      DEL = D( 2 ) - D( 1 )
137      IF( I.EQ.1 ) THEN
138         W = ONE + TWO*RHO*( Z( 2 )*Z( 2 )-Z( 1 )*Z( 1 ) ) / DEL
139         IF( W.GT.ZERO ) THEN
140            B = DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
141            C = RHO*Z( 1 )*Z( 1 )*DEL
142*
143*           B > ZERO, always
144*
145            TAU = TWO*C / ( B+SQRT( ABS( B*B-FOUR*C ) ) )
146            DLAM = D( 1 ) + TAU
147            DELTA( 1 ) = -Z( 1 ) / TAU
148            DELTA( 2 ) = Z( 2 ) / ( DEL-TAU )
149         ELSE
150            B = -DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
151            C = RHO*Z( 2 )*Z( 2 )*DEL
152            IF( B.GT.ZERO ) THEN
153               TAU = -TWO*C / ( B+SQRT( B*B+FOUR*C ) )
154            ELSE
155               TAU = ( B-SQRT( B*B+FOUR*C ) ) / TWO
156            END IF
157            DLAM = D( 2 ) + TAU
158            DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
159            DELTA( 2 ) = -Z( 2 ) / TAU
160         END IF
161         TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
162         DELTA( 1 ) = DELTA( 1 ) / TEMP
163         DELTA( 2 ) = DELTA( 2 ) / TEMP
164      ELSE
165*
166*     Now I=2
167*
168         B = -DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
169         C = RHO*Z( 2 )*Z( 2 )*DEL
170         IF( B.GT.ZERO ) THEN
171            TAU = ( B+SQRT( B*B+FOUR*C ) ) / TWO
172         ELSE
173            TAU = TWO*C / ( -B+SQRT( B*B+FOUR*C ) )
174         END IF
175         DLAM = D( 2 ) + TAU
176         DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
177         DELTA( 2 ) = -Z( 2 ) / TAU
178         TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
179         DELTA( 1 ) = DELTA( 1 ) / TEMP
180         DELTA( 2 ) = DELTA( 2 ) / TEMP
181      END IF
182      RETURN
183*
184*     End of DLAED5
185*
186      END
187