Télécharger dorg2r.eso

Retour à la liste

Numérotation des lignes :

  1. C DORG2R SOURCE BP208322 20/09/18 21:16:08 10718
  2. *> \brief \b DORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf (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 DORG2R + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorg2r.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorg2r.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorg2r.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * INTEGER INFO, K, LDA, M, N
  26. * ..
  27. * .. Array Arguments ..
  28. * DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
  29. * ..
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> DORG2R generates an m by n real matrix Q with orthonormal columns,
  38. *> which is defined as the first n columns of a product of k elementary
  39. *> reflectors of order m
  40. *>
  41. *> Q = H(1) H(2) . . . H(k)
  42. *>
  43. *> as returned by DGEQRF.
  44. *> \endverbatim
  45. *
  46. * Arguments:
  47. * ==========
  48. *
  49. *> \param[in] M
  50. *> \verbatim
  51. *> M is INTEGER
  52. *> The number of rows of the matrix Q. M >= 0.
  53. *> \endverbatim
  54. *>
  55. *> \param[in] N
  56. *> \verbatim
  57. *> N is INTEGER
  58. *> The number of columns of the matrix Q. M >= N >= 0.
  59. *> \endverbatim
  60. *>
  61. *> \param[in] K
  62. *> \verbatim
  63. *> K is INTEGER
  64. *> The number of elementary reflectors whose product defines the
  65. *> matrix Q. N >= K >= 0.
  66. *> \endverbatim
  67. *>
  68. *> \param[in,out] A
  69. *> \verbatim
  70. *> A is DOUBLE PRECISION array, dimension (LDA,N)
  71. *> On entry, the i-th column must contain the vector which
  72. *> defines the elementary reflector H(i), for i = 1,2,...,k, as
  73. *> returned by DGEQRF in the first k columns of its array
  74. *> argument A.
  75. *> On exit, the m-by-n matrix Q.
  76. *> \endverbatim
  77. *>
  78. *> \param[in] LDA
  79. *> \verbatim
  80. *> LDA is INTEGER
  81. *> The first dimension of the array A. LDA >= max(1,M).
  82. *> \endverbatim
  83. *>
  84. *> \param[in] TAU
  85. *> \verbatim
  86. *> TAU is DOUBLE PRECISION array, dimension (K)
  87. *> TAU(i) must contain the scalar factor of the elementary
  88. *> reflector H(i), as returned by DGEQRF.
  89. *> \endverbatim
  90. *>
  91. *> \param[out] WORK
  92. *> \verbatim
  93. *> WORK is DOUBLE PRECISION array, dimension (N)
  94. *> \endverbatim
  95. *>
  96. *> \param[out] INFO
  97. *> \verbatim
  98. *> INFO is INTEGER
  99. *> = 0: successful exit
  100. *> < 0: if INFO = -i, the i-th argument has an illegal value
  101. *> \endverbatim
  102. *
  103. * Authors:
  104. * ========
  105. *
  106. *> \author Univ. of Tennessee
  107. *> \author Univ. of California Berkeley
  108. *> \author Univ. of Colorado Denver
  109. *> \author NAG Ltd.
  110. *
  111. *> \date December 2016
  112. *
  113. *> \ingroup doubleOTHERcomputational
  114. *
  115. * =====================================================================
  116. SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
  117. *
  118. * -- LAPACK computational routine (version 3.7.0) --
  119. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  120. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  121. * December 2016
  122.  
  123. IMPLICIT INTEGER(I-N)
  124. IMPLICIT REAL*8(A-H,O-Z)
  125. *
  126. * .. Scalar Arguments ..
  127. INTEGER INFO, K, LDA, M, N
  128. * ..
  129. * .. Array Arguments ..
  130. REAL*8 A( LDA, * ), TAU( * ), WORK( * )
  131. * ..
  132. *
  133. * =====================================================================
  134. *
  135. * .. Parameters ..
  136. REAL*8 ONE, ZERO
  137. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  138. * ..
  139. * .. Local Scalars ..
  140. INTEGER I, J, L
  141. * ..
  142. * .. External Subroutines ..
  143. * EXTERNAL DLARF, DSCAL, XERBLA
  144. * ..
  145. * .. Intrinsic Functions ..
  146. * INTRINSIC MAX
  147. * ..
  148. * .. Executable Statements ..
  149. *
  150. * Test the input arguments
  151. *
  152. INFO = 0
  153. IF( M.LT.0 ) THEN
  154. INFO = -1
  155. ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
  156. INFO = -2
  157. ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
  158. INFO = -3
  159. ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
  160. INFO = -5
  161. END IF
  162. IF( INFO.NE.0 ) THEN
  163. CALL XERBLA( 'DORG2R', -INFO )
  164. RETURN
  165. END IF
  166. *
  167. * Quick return if possible
  168. *
  169. IF( N.LE.0 )
  170. $ RETURN
  171. *
  172. * Initialise columns k+1:n to columns of the unit matrix
  173. *
  174. DO 20 J = K + 1, N
  175. DO 10 L = 1, M
  176. A( L, J ) = ZERO
  177. 10 CONTINUE
  178. A( J, J ) = ONE
  179. 20 CONTINUE
  180. *
  181. DO 40 I = K, 1, -1
  182. *
  183. * Apply H(i) to A(i:m,i:n) from the left
  184. *
  185. IF( I.LT.N ) THEN
  186. A( I, I ) = ONE
  187. CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
  188. $ A( I, I+1 ), LDA, WORK )
  189. END IF
  190. IF( I.LT.M )
  191. $ CALL DSCAL( M-I, -TAU( I ), A( I+1, I ), 1 )
  192. A( I, I ) = ONE - TAU( I )
  193. *
  194. * Set A(1:i-1,i) to zero
  195. *
  196. DO 30 L = 1, I - 1
  197. A( L, I ) = ZERO
  198. 30 CONTINUE
  199. 40 CONTINUE
  200. RETURN
  201. *
  202. * End of DORG2R
  203. *
  204. END
  205.  
  206.  
  207.  

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