LAPACK 3.3.0
|
00001 SUBROUTINE DLAED5( I, D, Z, DELTA, RHO, DLAM ) 00002 * 00003 * -- LAPACK routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 INTEGER I 00010 DOUBLE PRECISION DLAM, RHO 00011 * .. 00012 * .. Array Arguments .. 00013 DOUBLE PRECISION D( 2 ), DELTA( 2 ), Z( 2 ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * This subroutine computes the I-th eigenvalue of a symmetric rank-one 00020 * modification of a 2-by-2 diagonal matrix 00021 * 00022 * diag( D ) + RHO * Z * transpose(Z) . 00023 * 00024 * The diagonal elements in the array D are assumed to satisfy 00025 * 00026 * D(i) < D(j) for i < j . 00027 * 00028 * We also assume RHO > 0 and that the Euclidean norm of the vector 00029 * Z is one. 00030 * 00031 * Arguments 00032 * ========= 00033 * 00034 * I (input) INTEGER 00035 * The index of the eigenvalue to be computed. I = 1 or I = 2. 00036 * 00037 * D (input) DOUBLE PRECISION array, dimension (2) 00038 * The original eigenvalues. We assume D(1) < D(2). 00039 * 00040 * Z (input) DOUBLE PRECISION array, dimension (2) 00041 * The components of the updating vector. 00042 * 00043 * DELTA (output) DOUBLE PRECISION array, dimension (2) 00044 * The vector DELTA contains the information necessary 00045 * to construct the eigenvectors. 00046 * 00047 * RHO (input) DOUBLE PRECISION 00048 * The scalar in the symmetric updating formula. 00049 * 00050 * DLAM (output) DOUBLE PRECISION 00051 * The computed lambda_I, the I-th updated eigenvalue. 00052 * 00053 * Further Details 00054 * =============== 00055 * 00056 * Based on contributions by 00057 * Ren-Cang Li, Computer Science Division, University of California 00058 * at Berkeley, USA 00059 * 00060 * ===================================================================== 00061 * 00062 * .. Parameters .. 00063 DOUBLE PRECISION ZERO, ONE, TWO, FOUR 00064 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0, 00065 $ FOUR = 4.0D0 ) 00066 * .. 00067 * .. Local Scalars .. 00068 DOUBLE PRECISION B, C, DEL, TAU, TEMP, W 00069 * .. 00070 * .. Intrinsic Functions .. 00071 INTRINSIC ABS, SQRT 00072 * .. 00073 * .. Executable Statements .. 00074 * 00075 DEL = D( 2 ) - D( 1 ) 00076 IF( I.EQ.1 ) THEN 00077 W = ONE + TWO*RHO*( Z( 2 )*Z( 2 )-Z( 1 )*Z( 1 ) ) / DEL 00078 IF( W.GT.ZERO ) THEN 00079 B = DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) ) 00080 C = RHO*Z( 1 )*Z( 1 )*DEL 00081 * 00082 * B > ZERO, always 00083 * 00084 TAU = TWO*C / ( B+SQRT( ABS( B*B-FOUR*C ) ) ) 00085 DLAM = D( 1 ) + TAU 00086 DELTA( 1 ) = -Z( 1 ) / TAU 00087 DELTA( 2 ) = Z( 2 ) / ( DEL-TAU ) 00088 ELSE 00089 B = -DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) ) 00090 C = RHO*Z( 2 )*Z( 2 )*DEL 00091 IF( B.GT.ZERO ) THEN 00092 TAU = -TWO*C / ( B+SQRT( B*B+FOUR*C ) ) 00093 ELSE 00094 TAU = ( B-SQRT( B*B+FOUR*C ) ) / TWO 00095 END IF 00096 DLAM = D( 2 ) + TAU 00097 DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU ) 00098 DELTA( 2 ) = -Z( 2 ) / TAU 00099 END IF 00100 TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) ) 00101 DELTA( 1 ) = DELTA( 1 ) / TEMP 00102 DELTA( 2 ) = DELTA( 2 ) / TEMP 00103 ELSE 00104 * 00105 * Now I=2 00106 * 00107 B = -DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) ) 00108 C = RHO*Z( 2 )*Z( 2 )*DEL 00109 IF( B.GT.ZERO ) THEN 00110 TAU = ( B+SQRT( B*B+FOUR*C ) ) / TWO 00111 ELSE 00112 TAU = TWO*C / ( -B+SQRT( B*B+FOUR*C ) ) 00113 END IF 00114 DLAM = D( 2 ) + TAU 00115 DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU ) 00116 DELTA( 2 ) = -Z( 2 ) / TAU 00117 TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) ) 00118 DELTA( 1 ) = DELTA( 1 ) / TEMP 00119 DELTA( 2 ) = DELTA( 2 ) / TEMP 00120 END IF 00121 RETURN 00122 * 00123 * End OF DLAED5 00124 * 00125 END