LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
slaed5.f
Go to the documentation of this file.
1 *> \brief \b SLAED5 used by SSTEDC. 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 SLAED5 + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed5.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed5.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed5.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLAED5( I, D, Z, DELTA, RHO, DLAM )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER I
25 * REAL DLAM, RHO
26 * ..
27 * .. Array Arguments ..
28 * REAL 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 REAL 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 REAL array, dimension (2)
68 *> The components of the updating vector.
69 *> \endverbatim
70 *>
71 *> \param[out] DELTA
72 *> \verbatim
73 *> DELTA is REAL 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 REAL
81 *> The scalar in the symmetric updating formula.
82 *> \endverbatim
83 *>
84 *> \param[out] DLAM
85 *> \verbatim
86 *> DLAM is REAL
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 slaed5( 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  REAL DLAM, RHO
116 * ..
117 * .. Array Arguments ..
118  REAL D( 2 ), DELTA( 2 ), Z( 2 )
119 * ..
120 *
121 * =====================================================================
122 *
123 * .. Parameters ..
124  REAL ZERO, ONE, TWO, FOUR
125  parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
126  $ four = 4.0e0 )
127 * ..
128 * .. Local Scalars ..
129  REAL 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 SLAED5
185 *
186  END
subroutine slaed5(I, D, Z, DELTA, RHO, DLAM)
SLAED5 used by SSTEDC. Solves the 2-by-2 secular equation.
Definition: slaed5.f:108