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