Télécharger dormhr.eso

Retour à la liste

Numérotation des lignes :

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

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