![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLASD5 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLASD5 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd5.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd5.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd5.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SLASD5( I, D, Z, DELTA, RHO, DSIGMA, WORK ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER I 00025 * REAL DSIGMA, RHO 00026 * .. 00027 * .. Array Arguments .. 00028 * REAL D( 2 ), DELTA( 2 ), WORK( 2 ), Z( 2 ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> This subroutine computes the square root of the I-th eigenvalue 00038 *> of a positive symmetric rank-one modification of a 2-by-2 diagonal 00039 *> matrix 00040 *> 00041 *> diag( D ) * diag( D ) + RHO * Z * transpose(Z) . 00042 *> 00043 *> The diagonal entries in the array D are assumed to satisfy 00044 *> 00045 *> 0 <= D(i) < D(j) for i < j . 00046 *> 00047 *> We also assume RHO > 0 and that the Euclidean norm of the vector 00048 *> Z is one. 00049 *> \endverbatim 00050 * 00051 * Arguments: 00052 * ========== 00053 * 00054 *> \param[in] I 00055 *> \verbatim 00056 *> I is INTEGER 00057 *> The index of the eigenvalue to be computed. I = 1 or I = 2. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] D 00061 *> \verbatim 00062 *> D is REAL array, dimension (2) 00063 *> The original eigenvalues. We assume 0 <= D(1) < D(2). 00064 *> \endverbatim 00065 *> 00066 *> \param[in] Z 00067 *> \verbatim 00068 *> Z is REAL array, dimension (2) 00069 *> The components of the updating vector. 00070 *> \endverbatim 00071 *> 00072 *> \param[out] DELTA 00073 *> \verbatim 00074 *> DELTA is REAL array, dimension (2) 00075 *> Contains (D(j) - sigma_I) in its j-th component. 00076 *> The vector DELTA contains the information necessary 00077 *> to construct the eigenvectors. 00078 *> \endverbatim 00079 *> 00080 *> \param[in] RHO 00081 *> \verbatim 00082 *> RHO is REAL 00083 *> The scalar in the symmetric updating formula. 00084 *> \endverbatim 00085 *> 00086 *> \param[out] DSIGMA 00087 *> \verbatim 00088 *> DSIGMA is REAL 00089 *> The computed sigma_I, the I-th updated eigenvalue. 00090 *> \endverbatim 00091 *> 00092 *> \param[out] WORK 00093 *> \verbatim 00094 *> WORK is REAL array, dimension (2) 00095 *> WORK contains (D(j) + sigma_I) in its j-th component. 00096 *> \endverbatim 00097 * 00098 * Authors: 00099 * ======== 00100 * 00101 *> \author Univ. of Tennessee 00102 *> \author Univ. of California Berkeley 00103 *> \author Univ. of Colorado Denver 00104 *> \author NAG Ltd. 00105 * 00106 *> \date November 2011 00107 * 00108 *> \ingroup auxOTHERauxiliary 00109 * 00110 *> \par Contributors: 00111 * ================== 00112 *> 00113 *> Ren-Cang Li, Computer Science Division, University of California 00114 *> at Berkeley, USA 00115 *> 00116 * ===================================================================== 00117 SUBROUTINE SLASD5( I, D, Z, DELTA, RHO, DSIGMA, WORK ) 00118 * 00119 * -- LAPACK auxiliary routine (version 3.4.0) -- 00120 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00121 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00122 * November 2011 00123 * 00124 * .. Scalar Arguments .. 00125 INTEGER I 00126 REAL DSIGMA, RHO 00127 * .. 00128 * .. Array Arguments .. 00129 REAL D( 2 ), DELTA( 2 ), WORK( 2 ), Z( 2 ) 00130 * .. 00131 * 00132 * ===================================================================== 00133 * 00134 * .. Parameters .. 00135 REAL ZERO, ONE, TWO, THREE, FOUR 00136 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0, 00137 $ THREE = 3.0E+0, FOUR = 4.0E+0 ) 00138 * .. 00139 * .. Local Scalars .. 00140 REAL B, C, DEL, DELSQ, TAU, W 00141 * .. 00142 * .. Intrinsic Functions .. 00143 INTRINSIC ABS, SQRT 00144 * .. 00145 * .. Executable Statements .. 00146 * 00147 DEL = D( 2 ) - D( 1 ) 00148 DELSQ = DEL*( D( 2 )+D( 1 ) ) 00149 IF( I.EQ.1 ) THEN 00150 W = ONE + FOUR*RHO*( Z( 2 )*Z( 2 ) / ( D( 1 )+THREE*D( 2 ) )- 00151 $ Z( 1 )*Z( 1 ) / ( THREE*D( 1 )+D( 2 ) ) ) / DEL 00152 IF( W.GT.ZERO ) THEN 00153 B = DELSQ + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) ) 00154 C = RHO*Z( 1 )*Z( 1 )*DELSQ 00155 * 00156 * B > ZERO, always 00157 * 00158 * The following TAU is DSIGMA * DSIGMA - D( 1 ) * D( 1 ) 00159 * 00160 TAU = TWO*C / ( B+SQRT( ABS( B*B-FOUR*C ) ) ) 00161 * 00162 * The following TAU is DSIGMA - D( 1 ) 00163 * 00164 TAU = TAU / ( D( 1 )+SQRT( D( 1 )*D( 1 )+TAU ) ) 00165 DSIGMA = D( 1 ) + TAU 00166 DELTA( 1 ) = -TAU 00167 DELTA( 2 ) = DEL - TAU 00168 WORK( 1 ) = TWO*D( 1 ) + TAU 00169 WORK( 2 ) = ( D( 1 )+TAU ) + D( 2 ) 00170 * DELTA( 1 ) = -Z( 1 ) / TAU 00171 * DELTA( 2 ) = Z( 2 ) / ( DEL-TAU ) 00172 ELSE 00173 B = -DELSQ + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) ) 00174 C = RHO*Z( 2 )*Z( 2 )*DELSQ 00175 * 00176 * The following TAU is DSIGMA * DSIGMA - D( 2 ) * D( 2 ) 00177 * 00178 IF( B.GT.ZERO ) THEN 00179 TAU = -TWO*C / ( B+SQRT( B*B+FOUR*C ) ) 00180 ELSE 00181 TAU = ( B-SQRT( B*B+FOUR*C ) ) / TWO 00182 END IF 00183 * 00184 * The following TAU is DSIGMA - D( 2 ) 00185 * 00186 TAU = TAU / ( D( 2 )+SQRT( ABS( D( 2 )*D( 2 )+TAU ) ) ) 00187 DSIGMA = D( 2 ) + TAU 00188 DELTA( 1 ) = -( DEL+TAU ) 00189 DELTA( 2 ) = -TAU 00190 WORK( 1 ) = D( 1 ) + TAU + D( 2 ) 00191 WORK( 2 ) = TWO*D( 2 ) + TAU 00192 * DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU ) 00193 * DELTA( 2 ) = -Z( 2 ) / TAU 00194 END IF 00195 * TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) ) 00196 * DELTA( 1 ) = DELTA( 1 ) / TEMP 00197 * DELTA( 2 ) = DELTA( 2 ) / TEMP 00198 ELSE 00199 * 00200 * Now I=2 00201 * 00202 B = -DELSQ + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) ) 00203 C = RHO*Z( 2 )*Z( 2 )*DELSQ 00204 * 00205 * The following TAU is DSIGMA * DSIGMA - D( 2 ) * D( 2 ) 00206 * 00207 IF( B.GT.ZERO ) THEN 00208 TAU = ( B+SQRT( B*B+FOUR*C ) ) / TWO 00209 ELSE 00210 TAU = TWO*C / ( -B+SQRT( B*B+FOUR*C ) ) 00211 END IF 00212 * 00213 * The following TAU is DSIGMA - D( 2 ) 00214 * 00215 TAU = TAU / ( D( 2 )+SQRT( D( 2 )*D( 2 )+TAU ) ) 00216 DSIGMA = D( 2 ) + TAU 00217 DELTA( 1 ) = -( DEL+TAU ) 00218 DELTA( 2 ) = -TAU 00219 WORK( 1 ) = D( 1 ) + TAU + D( 2 ) 00220 WORK( 2 ) = TWO*D( 2 ) + TAU 00221 * DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU ) 00222 * DELTA( 2 ) = -Z( 2 ) / TAU 00223 * TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) ) 00224 * DELTA( 1 ) = DELTA( 1 ) / TEMP 00225 * DELTA( 2 ) = DELTA( 2 ) / TEMP 00226 END IF 00227 RETURN 00228 * 00229 * End of SLASD5 00230 * 00231 END