Télécharger dlanv2.eso

Retour à la liste

Numérotation des lignes :

  1. C DLANV2 SOURCE BP208322 15/10/13 21:15:32 8670
  2. *> \brief \b DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form.
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download DLANV2 + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlanv2.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlanv2.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlanv2.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
  23. *
  24. * .. Scalar Arguments ..
  25. * REAL*8 A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
  26. * ..
  27. *
  28. *
  29. *> \par Purpose:
  30. * =============
  31. *>
  32. *> \verbatim
  33. *>
  34. *> DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric
  35. *> matrix in standard form:
  36. *>
  37. *> [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ]
  38. *> [ C D ] [ SN CS ] [ CC DD ] [-SN CS ]
  39. *>
  40. *> where either
  41. *> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or
  42. *> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex
  43. *> conjugate eigenvalues.
  44. *> \endverbatim
  45. *
  46. * Arguments:
  47. * ==========
  48. *
  49. *> \param[in,out] A
  50. *> \verbatim
  51. *> A is DOUBLE PRECISION
  52. *> \endverbatim
  53. *>
  54. *> \param[in,out] B
  55. *> \verbatim
  56. *> B is DOUBLE PRECISION
  57. *> \endverbatim
  58. *>
  59. *> \param[in,out] C
  60. *> \verbatim
  61. *> C is DOUBLE PRECISION
  62. *> \endverbatim
  63. *>
  64. *> \param[in,out] D
  65. *> \verbatim
  66. *> D is DOUBLE PRECISION
  67. *> On entry, the elements of the input matrix.
  68. *> On exit, they are overwritten by the elements of the
  69. *> standardised Schur form.
  70. *> \endverbatim
  71. *>
  72. *> \param[out] RT1R
  73. *> \verbatim
  74. *> RT1R is DOUBLE PRECISION
  75. *> \endverbatim
  76. *>
  77. *> \param[out] RT1I
  78. *> \verbatim
  79. *> RT1I is DOUBLE PRECISION
  80. *> \endverbatim
  81. *>
  82. *> \param[out] RT2R
  83. *> \verbatim
  84. *> RT2R is DOUBLE PRECISION
  85. *> \endverbatim
  86. *>
  87. *> \param[out] RT2I
  88. *> \verbatim
  89. *> RT2I is DOUBLE PRECISION
  90. *> The real and imaginary parts of the eigenvalues. If the
  91. *> eigenvalues are a complex conjugate pair, RT1I > 0.
  92. *> \endverbatim
  93. *>
  94. *> \param[out] CS
  95. *> \verbatim
  96. *> CS is DOUBLE PRECISION
  97. *> \endverbatim
  98. *>
  99. *> \param[out] SN
  100. *> \verbatim
  101. *> SN is DOUBLE PRECISION
  102. *> Parameters of the rotation matrix.
  103. *> \endverbatim
  104. *
  105. * Authors:
  106. * ========
  107. *
  108. *> \author Univ. of Tennessee
  109. *> \author Univ. of California Berkeley
  110. *> \author Univ. of Colorado Denver
  111. *> \author NAG Ltd.
  112. *
  113. *> \date September 2012
  114. *
  115. *> \ingroup doubleOTHERauxiliary
  116. *
  117. *> \par Further Details:
  118. * =====================
  119. *>
  120. *> \verbatim
  121. *>
  122. *> Modified by V. Sima, Research Institute for Informatics, Bucharest,
  123. *> Romania, to reduce the risk of cancellation errors,
  124. *> when computing real eigenvalues, and to ensure, if possible, that
  125. *> abs(RT1R) >= abs(RT2R).
  126. *> \endverbatim
  127. *>
  128. * =====================================================================
  129. SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
  130. *
  131. * -- LAPACK auxiliary routine (version 3.4.2) --
  132. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  133. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  134. * September 2012
  135. *
  136. * .. Scalar Arguments ..
  137. REAL*8 A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
  138. * ..
  139. *
  140. * =====================================================================
  141. *
  142. * .. Parameters ..
  143. REAL*8 ZERO, HALF, ONE
  144. PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
  145. REAL*8 MULTPL
  146. PARAMETER ( MULTPL = 4.0D+0 )
  147. * ..
  148. * .. Local Scalars ..
  149. REAL*8 AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB,
  150. $ SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z
  151. * ..
  152. * .. External Functions ..
  153. REAL*8 DLAMCH, DLAPY2
  154. EXTERNAL DLAMCH, DLAPY2
  155. * ..
  156. ** .. Intrinsic Functions ..
  157. * INTRINSIC ABS, MAX, MIN, SIGN, SQRT
  158. ** ..
  159. ** .. Executable Statements ..
  160. *
  161. EPS = DLAMCH( 'P' )
  162. IF( C.EQ.ZERO ) THEN
  163. CS = ONE
  164. SN = ZERO
  165. GO TO 10
  166. *
  167. ELSE IF( B.EQ.ZERO ) THEN
  168. *
  169. * Swap rows and columns
  170. *
  171. CS = ZERO
  172. SN = ONE
  173. TEMP = D
  174. D = A
  175. A = TEMP
  176. B = -C
  177. C = ZERO
  178. GO TO 10
  179. ELSE IF( ( A-D ).EQ.ZERO .AND. SIGN( ONE, B ).NE.SIGN( ONE, C ) )
  180. $ THEN
  181. CS = ONE
  182. SN = ZERO
  183. GO TO 10
  184. ELSE
  185. *
  186. TEMP = A - D
  187. P = HALF*TEMP
  188. BCMAX = MAX( ABS( B ), ABS( C ) )
  189. BCMIS = MIN( ABS( B ), ABS( C ) )*SIGN( ONE, B )*SIGN( ONE, C )
  190. SCALE = MAX( ABS( P ), BCMAX )
  191. Z = ( P / SCALE )*P + ( BCMAX / SCALE )*BCMIS
  192. *
  193. * If Z is of the order of the machine accuracy, postpone the
  194. * decision on the nature of eigenvalues
  195. *
  196. IF( Z.GE.MULTPL*EPS ) THEN
  197. *
  198. * Real eigenvalues. Compute A and D.
  199. *
  200. Z = P + SIGN( SQRT( SCALE )*SQRT( Z ), P )
  201. A = D + Z
  202. D = D - ( BCMAX / Z )*BCMIS
  203. *
  204. * Compute B and the rotation matrix
  205. *
  206. TAU = DLAPY2( C, Z )
  207. CS = Z / TAU
  208. SN = C / TAU
  209. B = B - C
  210. C = ZERO
  211. ELSE
  212. *
  213. * Complex eigenvalues, or real (almost) equal eigenvalues.
  214. * Make diagonal elements equal.
  215. *
  216. SIGMA = B + C
  217. TAU = DLAPY2( SIGMA, TEMP )
  218. CS = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) )
  219. SN = -( P / ( TAU*CS ) )*SIGN( ONE, SIGMA )
  220. *
  221. * Compute [ AA BB ] = [ A B ] [ CS -SN ]
  222. * [ CC DD ] [ C D ] [ SN CS ]
  223. *
  224. AA = A*CS + B*SN
  225. BB = -A*SN + B*CS
  226. CC = C*CS + D*SN
  227. DD = -C*SN + D*CS
  228. *
  229. * Compute [ A B ] = [ CS SN ] [ AA BB ]
  230. * [ C D ] [-SN CS ] [ CC DD ]
  231. *
  232. A = AA*CS + CC*SN
  233. B = BB*CS + DD*SN
  234. C = -AA*SN + CC*CS
  235. D = -BB*SN + DD*CS
  236. *
  237. TEMP = HALF*( A+D )
  238. A = TEMP
  239. D = TEMP
  240. *
  241. IF( C.NE.ZERO ) THEN
  242. IF( B.NE.ZERO ) THEN
  243. IF( SIGN( ONE, B ).EQ.SIGN( ONE, C ) ) THEN
  244. *
  245. * Real eigenvalues: reduce to upper triangular form
  246. *
  247. SAB = SQRT( ABS( B ) )
  248. SAC = SQRT( ABS( C ) )
  249. P = SIGN( SAB*SAC, C )
  250. TAU = ONE / SQRT( ABS( B+C ) )
  251. A = TEMP + P
  252. D = TEMP - P
  253. B = B - C
  254. C = ZERO
  255. CS1 = SAB*TAU
  256. SN1 = SAC*TAU
  257. TEMP = CS*CS1 - SN*SN1
  258. SN = CS*SN1 + SN*CS1
  259. CS = TEMP
  260. END IF
  261. ELSE
  262. B = -C
  263. C = ZERO
  264. TEMP = CS
  265. CS = -SN
  266. SN = TEMP
  267. END IF
  268. END IF
  269. END IF
  270. *
  271. END IF
  272. *
  273. 10 CONTINUE
  274. *
  275. * Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I).
  276. *
  277. RT1R = A
  278. RT2R = D
  279. IF( C.EQ.ZERO ) THEN
  280. RT1I = ZERO
  281. RT2I = ZERO
  282. ELSE
  283. RT1I = SQRT( ABS( B ) )*SQRT( ABS( C ) )
  284. RT2I = -RT1I
  285. END IF
  286. RETURN
  287. *
  288. * End of DLANV2
  289. *
  290. END
  291.  
  292.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales