Télécharger dgehd2.eso

Retour à la liste

Numérotation des lignes :

  1. C DGEHD2 SOURCE BP208322 20/09/18 21:15:49 10718
  2. *> \brief \b DGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download DGEHD2 + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgehd2.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgehd2.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgehd2.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * INTEGER IHI, ILO, INFO, LDA, N
  26. * ..
  27. * .. Array Arguments ..
  28. * REAL*8 A( LDA, * ), TAU( * ), WORK( * )
  29. * ..
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> DGEHD2 reduces a real general matrix A to upper Hessenberg form H by
  38. *> an orthogonal similarity transformation: Q**T * A * Q = H .
  39. *> \endverbatim
  40. *
  41. * Arguments:
  42. * ==========
  43. *
  44. *> \param[in] N
  45. *> \verbatim
  46. *> N is INTEGER
  47. *> The order of the matrix A. N >= 0.
  48. *> \endverbatim
  49. *>
  50. *> \param[in] ILO
  51. *> \verbatim
  52. *> ILO is INTEGER
  53. *> \endverbatim
  54. *>
  55. *> \param[in] IHI
  56. *> \verbatim
  57. *> IHI is INTEGER
  58. *>
  59. *> It is assumed that A is already upper triangular in rows
  60. *> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
  61. *> set by a previous call to DGEBAL; otherwise they should be
  62. *> set to 1 and N respectively. See Further Details.
  63. *> 1 <= ILO <= IHI <= max(1,N).
  64. *> \endverbatim
  65. *>
  66. *> \param[in,out] A
  67. *> \verbatim
  68. *> A is REAL*8 array, dimension (LDA,N)
  69. *> On entry, the n by n general matrix to be reduced.
  70. *> On exit, the upper triangle and the first subdiagonal of A
  71. *> are overwritten with the upper Hessenberg matrix H, and the
  72. *> elements below the first subdiagonal, with the array TAU,
  73. *> represent the orthogonal matrix Q as a product of elementary
  74. *> reflectors. See Further Details.
  75. *> \endverbatim
  76. *>
  77. *> \param[in] LDA
  78. *> \verbatim
  79. *> LDA is INTEGER
  80. *> The leading dimension of the array A. LDA >= max(1,N).
  81. *> \endverbatim
  82. *>
  83. *> \param[out] TAU
  84. *> \verbatim
  85. *> TAU is REAL*8 array, dimension (N-1)
  86. *> The scalar factors of the elementary reflectors (see Further
  87. *> Details).
  88. *> \endverbatim
  89. *>
  90. *> \param[out] WORK
  91. *> \verbatim
  92. *> WORK is REAL*8 array, dimension (N)
  93. *> \endverbatim
  94. *>
  95. *> \param[out] INFO
  96. *> \verbatim
  97. *> INFO is INTEGER
  98. *> = 0: successful exit.
  99. *> < 0: if INFO = -i, the i-th argument had an illegal value.
  100. *> \endverbatim
  101. *
  102. * Authors:
  103. * ========
  104. *
  105. *> \author Univ. of Tennessee
  106. *> \author Univ. of California Berkeley
  107. *> \author Univ. of Colorado Denver
  108. *> \author NAG Ltd.
  109. *
  110. *> \date December 2016
  111. *
  112. *> \ingroup doubleGEcomputational
  113. *
  114. *> \par Further Details:
  115. * =====================
  116. *>
  117. *> \verbatim
  118. *>
  119. *> The matrix Q is represented as a product of (ihi-ilo) elementary
  120. *> reflectors
  121. *>
  122. *> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
  123. *>
  124. *> Each H(i) has the form
  125. *>
  126. *> H(i) = I - tau * v * v**T
  127. *>
  128. *> where tau is a real scalar, and v is a real vector with
  129. *> v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
  130. *> exit in A(i+2:ihi,i), and tau in TAU(i).
  131. *>
  132. *> The contents of A are illustrated by the following example, with
  133. *> n = 7, ilo = 2 and ihi = 6:
  134. *>
  135. *> on entry, on exit,
  136. *>
  137. *> ( a a a a a a a ) ( a a h h h h a )
  138. *> ( a a a a a a ) ( a h h h h a )
  139. *> ( a a a a a a ) ( h h h h h h )
  140. *> ( a a a a a a ) ( v2 h h h h h )
  141. *> ( a a a a a a ) ( v2 v3 h h h h )
  142. *> ( a a a a a a ) ( v2 v3 v4 h h h )
  143. *> ( a ) ( a )
  144. *>
  145. *> where a denotes an element of the original matrix A, h denotes a
  146. *> modified element of the upper Hessenberg matrix H, and vi denotes an
  147. *> element of the vector defining H(i).
  148. *> \endverbatim
  149. *>
  150. * =====================================================================
  151. SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
  152. *
  153. * -- LAPACK computational routine (version 3.7.0) --
  154. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  155. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  156. * December 2016
  157.  
  158. IMPLICIT INTEGER(I-N)
  159. IMPLICIT REAL*8(A-H,O-Z)
  160. *
  161. * .. Scalar Arguments ..
  162. INTEGER IHI, ILO, INFO, LDA, N
  163. * ..
  164. * .. Array Arguments ..
  165. REAL*8 A( LDA, * ), TAU( * ), WORK( * )
  166. * ..
  167. *
  168. * =====================================================================
  169. *
  170. * .. Parameters ..
  171. REAL*8 ONE
  172. PARAMETER ( ONE = 1.0D+0 )
  173. * ..
  174. * .. Local Scalars ..
  175. INTEGER I
  176. REAL*8 AII
  177. * ..
  178. * .. External Subroutines ..
  179. * EXTERNAL DLARF, DLARFG, XERBLA
  180. * ..
  181. * .. Intrinsic Functions ..
  182. * INTRINSIC MAX, MIN
  183. * ..
  184. * .. Executable Statements ..
  185. *
  186. * Test the input parameters
  187. *
  188. INFO = 0
  189. IF( N.LT.0 ) THEN
  190. INFO = -1
  191. ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
  192. INFO = -2
  193. ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
  194. INFO = -3
  195. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  196. INFO = -5
  197. END IF
  198. IF( INFO.NE.0 ) THEN
  199. CALL XERBLA( 'DGEHD2', -INFO )
  200. RETURN
  201. END IF
  202. *
  203. DO 10 I = ILO, IHI - 1
  204. *
  205. * Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
  206. *
  207. CALL DLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
  208. $ TAU( I ) )
  209. AII = A( I+1, I )
  210. A( I+1, I ) = ONE
  211. *
  212. * Apply H(i) to A(1:ihi,i+1:ihi) from the right
  213. *
  214. CALL DLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
  215. $ A( 1, I+1 ), LDA, WORK )
  216. *
  217. * Apply H(i) to A(i+1:ihi,i+1:n) from the left
  218. *
  219. CALL DLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ),
  220. $ A( I+1, I+1 ), LDA, WORK )
  221. *
  222. A( I+1, I ) = AII
  223. 10 CONTINUE
  224. *
  225. RETURN
  226. *
  227. * End of DGEHD2
  228. *
  229. END
  230.  
  231.  
  232.  

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