Télécharger dorghr.eso

Retour à la liste

Numérotation des lignes :

  1. C DORGHR SOURCE BP208322 20/09/18 21:16:08 10718
  2. *> \brief \b DORGHR
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download DORGHR + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorghr.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorghr.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorghr.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * INTEGER IHI, ILO, INFO, LDA, LWORK, N
  26. * ..
  27. * .. Array Arguments ..
  28. * REAL*8 A( LDA, * ), TAU( * ), WORK( * )
  29. * ..
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> DORGHR generates a real orthogonal matrix Q which is defined as the
  38. *> product of IHI-ILO elementary reflectors of order N, as returned by
  39. *> DGEHRD:
  40. *>
  41. *> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
  42. *> \endverbatim
  43. *
  44. * Arguments:
  45. * ==========
  46. *
  47. *> \param[in] N
  48. *> \verbatim
  49. *> N is INTEGER
  50. *> The order of the matrix Q. N >= 0.
  51. *> \endverbatim
  52. *>
  53. *> \param[in] ILO
  54. *> \verbatim
  55. *> ILO is INTEGER
  56. *> \endverbatim
  57. *>
  58. *> \param[in] IHI
  59. *> \verbatim
  60. *> IHI is INTEGER
  61. *>
  62. *> ILO and IHI must have the same values as in the previous call
  63. *> of DGEHRD. Q is equal to the unit matrix except in the
  64. *> submatrix Q(ilo+1:ihi,ilo+1:ihi).
  65. *> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
  66. *> \endverbatim
  67. *>
  68. *> \param[in,out] A
  69. *> \verbatim
  70. *> A is REAL*8 array, dimension (LDA,N)
  71. *> On entry, the vectors which define the elementary reflectors,
  72. *> as returned by DGEHRD.
  73. *> On exit, the N-by-N orthogonal matrix Q.
  74. *> \endverbatim
  75. *>
  76. *> \param[in] LDA
  77. *> \verbatim
  78. *> LDA is INTEGER
  79. *> The leading dimension of the array A. LDA >= max(1,N).
  80. *> \endverbatim
  81. *>
  82. *> \param[in] TAU
  83. *> \verbatim
  84. *> TAU is REAL*8 array, dimension (N-1)
  85. *> TAU(i) must contain the scalar factor of the elementary
  86. *> reflector H(i), as returned by DGEHRD.
  87. *> \endverbatim
  88. *>
  89. *> \param[out] WORK
  90. *> \verbatim
  91. *> WORK is REAL*8 array, dimension (MAX(1,LWORK))
  92. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  93. *> \endverbatim
  94. *>
  95. *> \param[in] LWORK
  96. *> \verbatim
  97. *> LWORK is INTEGER
  98. *> The dimension of the array WORK. LWORK >= IHI-ILO.
  99. *> For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
  100. *> the optimal blocksize.
  101. *>
  102. *> If LWORK = -1, then a workspace query is assumed; the routine
  103. *> only calculates the optimal size of the WORK array, returns
  104. *> this value as the first entry of the WORK array, and no error
  105. *> message related to LWORK is issued by XERBLA.
  106. *> \endverbatim
  107. *>
  108. *> \param[out] INFO
  109. *> \verbatim
  110. *> INFO is INTEGER
  111. *> = 0: successful exit
  112. *> < 0: if INFO = -i, the i-th argument had an illegal value
  113. *> \endverbatim
  114. *
  115. * Authors:
  116. * ========
  117. *
  118. *> \author Univ. of Tennessee
  119. *> \author Univ. of California Berkeley
  120. *> \author Univ. of Colorado Denver
  121. *> \author NAG Ltd.
  122. *
  123. *> \date December 2016
  124. *
  125. *> \ingroup doubleOTHERcomputational
  126. *
  127. * =====================================================================
  128. SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
  129. *
  130. * -- LAPACK computational routine (version 3.7.0) --
  131. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  132. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  133. * December 2016
  134.  
  135. IMPLICIT INTEGER(I-N)
  136. IMPLICIT REAL*8(A-H,O-Z)
  137. *
  138. * .. Scalar Arguments ..
  139. INTEGER IHI, ILO, INFO, LDA, LWORK, N
  140. * ..
  141. * .. Array Arguments ..
  142. REAL*8 A( LDA, * ), TAU( * ), WORK( * )
  143. * ..
  144. *
  145. * =====================================================================
  146. *
  147. * .. Parameters ..
  148. REAL*8 ZERO, ONE
  149. PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
  150. * ..
  151. * .. Local Scalars ..
  152. LOGICAL LQUERY
  153. INTEGER I, IINFO, J, LWKOPT, NB, NH
  154. * ..
  155. * .. External Subroutines ..
  156. * EXTERNAL DORGQR, XERBLA
  157. * ..
  158. * .. External Functions ..
  159. INTEGER ILAENV
  160. * EXTERNAL ILAENV
  161. * ..
  162. * .. Intrinsic Functions ..
  163. * INTRINSIC MAX, MIN
  164. * ..
  165. * .. Executable Statements ..
  166. *
  167. * Test the input arguments
  168. *
  169. INFO = 0
  170. NH = IHI - ILO
  171. LQUERY = ( LWORK.EQ.-1 )
  172. IF( N.LT.0 ) THEN
  173. INFO = -1
  174. ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
  175. INFO = -2
  176. ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
  177. INFO = -3
  178. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  179. INFO = -5
  180. ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
  181. INFO = -8
  182. END IF
  183. *
  184. IF( INFO.EQ.0 ) THEN
  185. NB = ILAENV( 1, 'DORGQR', ' ', NH, NH, NH, -1 )
  186. LWKOPT = MAX( 1, NH )*NB
  187. WORK( 1 ) = LWKOPT
  188. END IF
  189. *
  190. IF( INFO.NE.0 ) THEN
  191. CALL XERBLA( 'DORGHR', -INFO )
  192. RETURN
  193. ELSE IF( LQUERY ) THEN
  194. RETURN
  195. END IF
  196. *
  197. * Quick return if possible
  198. *
  199. IF( N.EQ.0 ) THEN
  200. WORK( 1 ) = 1
  201. RETURN
  202. END IF
  203. *
  204. * Shift the vectors which define the elementary reflectors one
  205. * column to the right, and set the first ilo and the last n-ihi
  206. * rows and columns to those of the unit matrix
  207. *
  208. DO 40 J = IHI, ILO + 1, -1
  209. DO 10 I = 1, J - 1
  210. A( I, J ) = ZERO
  211. 10 CONTINUE
  212. DO 20 I = J + 1, IHI
  213. A( I, J ) = A( I, J-1 )
  214. 20 CONTINUE
  215. DO 30 I = IHI + 1, N
  216. A( I, J ) = ZERO
  217. 30 CONTINUE
  218. 40 CONTINUE
  219. DO 60 J = 1, ILO
  220. DO 50 I = 1, N
  221. A( I, J ) = ZERO
  222. 50 CONTINUE
  223. A( J, J ) = ONE
  224. 60 CONTINUE
  225. DO 80 J = IHI + 1, N
  226. DO 70 I = 1, N
  227. A( I, J ) = ZERO
  228. 70 CONTINUE
  229. A( J, J ) = ONE
  230. 80 CONTINUE
  231. *
  232. IF( NH.GT.0 ) THEN
  233. *
  234. * Generate Q(ilo+1:ihi,ilo+1:ihi)
  235. *
  236. CALL DORGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
  237. $ WORK, LWORK, IINFO )
  238. END IF
  239. WORK( 1 ) = LWKOPT
  240. RETURN
  241. *
  242. * End of DORGHR
  243. *
  244. END
  245.  
  246.  
  247.  

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