![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLANV2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLANV2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slanv2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slanv2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slanv2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN ) 00022 * 00023 * .. Scalar Arguments .. 00024 * REAL A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN 00025 * .. 00026 * 00027 * 00028 *> \par Purpose: 00029 * ============= 00030 *> 00031 *> \verbatim 00032 *> 00033 *> SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric 00034 *> matrix in standard form: 00035 *> 00036 *> [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] 00037 *> [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] 00038 *> 00039 *> where either 00040 *> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or 00041 *> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex 00042 *> conjugate eigenvalues. 00043 *> \endverbatim 00044 * 00045 * Arguments: 00046 * ========== 00047 * 00048 *> \param[in,out] A 00049 *> \verbatim 00050 *> A is REAL 00051 *> \endverbatim 00052 *> 00053 *> \param[in,out] B 00054 *> \verbatim 00055 *> B is REAL 00056 *> \endverbatim 00057 *> 00058 *> \param[in,out] C 00059 *> \verbatim 00060 *> C is REAL 00061 *> \endverbatim 00062 *> 00063 *> \param[in,out] D 00064 *> \verbatim 00065 *> D is REAL 00066 *> On entry, the elements of the input matrix. 00067 *> On exit, they are overwritten by the elements of the 00068 *> standardised Schur form. 00069 *> \endverbatim 00070 *> 00071 *> \param[out] RT1R 00072 *> \verbatim 00073 *> RT1R is REAL 00074 *> \endverbatim 00075 *> 00076 *> \param[out] RT1I 00077 *> \verbatim 00078 *> RT1I is REAL 00079 *> \endverbatim 00080 *> 00081 *> \param[out] RT2R 00082 *> \verbatim 00083 *> RT2R is REAL 00084 *> \endverbatim 00085 *> 00086 *> \param[out] RT2I 00087 *> \verbatim 00088 *> RT2I is REAL 00089 *> The real and imaginary parts of the eigenvalues. If the 00090 *> eigenvalues are a complex conjugate pair, RT1I > 0. 00091 *> \endverbatim 00092 *> 00093 *> \param[out] CS 00094 *> \verbatim 00095 *> CS is REAL 00096 *> \endverbatim 00097 *> 00098 *> \param[out] SN 00099 *> \verbatim 00100 *> SN is REAL 00101 *> Parameters of the rotation matrix. 00102 *> \endverbatim 00103 * 00104 * Authors: 00105 * ======== 00106 * 00107 *> \author Univ. of Tennessee 00108 *> \author Univ. of California Berkeley 00109 *> \author Univ. of Colorado Denver 00110 *> \author NAG Ltd. 00111 * 00112 *> \date November 2011 00113 * 00114 *> \ingroup realOTHERauxiliary 00115 * 00116 *> \par Further Details: 00117 * ===================== 00118 *> 00119 *> \verbatim 00120 *> 00121 *> Modified by V. Sima, Research Institute for Informatics, Bucharest, 00122 *> Romania, to reduce the risk of cancellation errors, 00123 *> when computing real eigenvalues, and to ensure, if possible, that 00124 *> abs(RT1R) >= abs(RT2R). 00125 *> \endverbatim 00126 *> 00127 * ===================================================================== 00128 SUBROUTINE SLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN ) 00129 * 00130 * -- LAPACK auxiliary routine (version 3.4.0) -- 00131 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00132 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00133 * November 2011 00134 * 00135 * .. Scalar Arguments .. 00136 REAL A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN 00137 * .. 00138 * 00139 * ===================================================================== 00140 * 00141 * .. Parameters .. 00142 REAL ZERO, HALF, ONE 00143 PARAMETER ( ZERO = 0.0E+0, HALF = 0.5E+0, ONE = 1.0E+0 ) 00144 REAL MULTPL 00145 PARAMETER ( MULTPL = 4.0E+0 ) 00146 * .. 00147 * .. Local Scalars .. 00148 REAL AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB, 00149 $ SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z 00150 * .. 00151 * .. External Functions .. 00152 REAL SLAMCH, SLAPY2 00153 EXTERNAL SLAMCH, SLAPY2 00154 * .. 00155 * .. Intrinsic Functions .. 00156 INTRINSIC ABS, MAX, MIN, SIGN, SQRT 00157 * .. 00158 * .. Executable Statements .. 00159 * 00160 EPS = SLAMCH( 'P' ) 00161 IF( C.EQ.ZERO ) THEN 00162 CS = ONE 00163 SN = ZERO 00164 GO TO 10 00165 * 00166 ELSE IF( B.EQ.ZERO ) THEN 00167 * 00168 * Swap rows and columns 00169 * 00170 CS = ZERO 00171 SN = ONE 00172 TEMP = D 00173 D = A 00174 A = TEMP 00175 B = -C 00176 C = ZERO 00177 GO TO 10 00178 ELSE IF( (A-D).EQ.ZERO .AND. SIGN( ONE, B ).NE. 00179 $ SIGN( ONE, C ) ) THEN 00180 CS = ONE 00181 SN = ZERO 00182 GO TO 10 00183 ELSE 00184 * 00185 TEMP = A - D 00186 P = HALF*TEMP 00187 BCMAX = MAX( ABS( B ), ABS( C ) ) 00188 BCMIS = MIN( ABS( B ), ABS( C ) )*SIGN( ONE, B )*SIGN( ONE, C ) 00189 SCALE = MAX( ABS( P ), BCMAX ) 00190 Z = ( P / SCALE )*P + ( BCMAX / SCALE )*BCMIS 00191 * 00192 * If Z is of the order of the machine accuracy, postpone the 00193 * decision on the nature of eigenvalues 00194 * 00195 IF( Z.GE.MULTPL*EPS ) THEN 00196 * 00197 * Real eigenvalues. Compute A and D. 00198 * 00199 Z = P + SIGN( SQRT( SCALE )*SQRT( Z ), P ) 00200 A = D + Z 00201 D = D - ( BCMAX / Z )*BCMIS 00202 * 00203 * Compute B and the rotation matrix 00204 * 00205 TAU = SLAPY2( C, Z ) 00206 CS = Z / TAU 00207 SN = C / TAU 00208 B = B - C 00209 C = ZERO 00210 ELSE 00211 * 00212 * Complex eigenvalues, or real (almost) equal eigenvalues. 00213 * Make diagonal elements equal. 00214 * 00215 SIGMA = B + C 00216 TAU = SLAPY2( SIGMA, TEMP ) 00217 CS = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) ) 00218 SN = -( P / ( TAU*CS ) )*SIGN( ONE, SIGMA ) 00219 * 00220 * Compute [ AA BB ] = [ A B ] [ CS -SN ] 00221 * [ CC DD ] [ C D ] [ SN CS ] 00222 * 00223 AA = A*CS + B*SN 00224 BB = -A*SN + B*CS 00225 CC = C*CS + D*SN 00226 DD = -C*SN + D*CS 00227 * 00228 * Compute [ A B ] = [ CS SN ] [ AA BB ] 00229 * [ C D ] [-SN CS ] [ CC DD ] 00230 * 00231 A = AA*CS + CC*SN 00232 B = BB*CS + DD*SN 00233 C = -AA*SN + CC*CS 00234 D = -BB*SN + DD*CS 00235 * 00236 TEMP = HALF*( A+D ) 00237 A = TEMP 00238 D = TEMP 00239 * 00240 IF( C.NE.ZERO ) THEN 00241 IF( B.NE.ZERO ) THEN 00242 IF( SIGN( ONE, B ).EQ.SIGN( ONE, C ) ) THEN 00243 * 00244 * Real eigenvalues: reduce to upper triangular form 00245 * 00246 SAB = SQRT( ABS( B ) ) 00247 SAC = SQRT( ABS( C ) ) 00248 P = SIGN( SAB*SAC, C ) 00249 TAU = ONE / SQRT( ABS( B+C ) ) 00250 A = TEMP + P 00251 D = TEMP - P 00252 B = B - C 00253 C = ZERO 00254 CS1 = SAB*TAU 00255 SN1 = SAC*TAU 00256 TEMP = CS*CS1 - SN*SN1 00257 SN = CS*SN1 + SN*CS1 00258 CS = TEMP 00259 END IF 00260 ELSE 00261 B = -C 00262 C = ZERO 00263 TEMP = CS 00264 CS = -SN 00265 SN = TEMP 00266 END IF 00267 END IF 00268 END IF 00269 * 00270 END IF 00271 * 00272 10 CONTINUE 00273 * 00274 * Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). 00275 * 00276 RT1R = A 00277 RT2R = D 00278 IF( C.EQ.ZERO ) THEN 00279 RT1I = ZERO 00280 RT2I = ZERO 00281 ELSE 00282 RT1I = SQRT( ABS( B ) )*SQRT( ABS( C ) ) 00283 RT2I = -RT1I 00284 END IF 00285 RETURN 00286 * 00287 * End of SLANV2 00288 * 00289 END