You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

zgelqf.f 7.8 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
  1. *> \brief \b ZGELQF
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ZGELQF + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgelqf.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgelqf.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgelqf.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE ZGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
  22. *
  23. * .. Scalar Arguments ..
  24. * INTEGER INFO, LDA, LWORK, M, N
  25. * ..
  26. * .. Array Arguments ..
  27. * COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
  28. * ..
  29. *
  30. *
  31. *> \par Purpose:
  32. * =============
  33. *>
  34. *> \verbatim
  35. *>
  36. *> ZGELQF computes an LQ factorization of a complex M-by-N matrix A:
  37. *>
  38. *> A = ( L 0 ) * Q
  39. *>
  40. *> where:
  41. *>
  42. *> Q is a N-by-N orthogonal matrix;
  43. *> L is a lower-triangular M-by-M matrix;
  44. *> 0 is a M-by-(N-M) zero matrix, if M < N.
  45. *>
  46. *> \endverbatim
  47. *
  48. * Arguments:
  49. * ==========
  50. *
  51. *> \param[in] M
  52. *> \verbatim
  53. *> M is INTEGER
  54. *> The number of rows of the matrix A. M >= 0.
  55. *> \endverbatim
  56. *>
  57. *> \param[in] N
  58. *> \verbatim
  59. *> N is INTEGER
  60. *> The number of columns of the matrix A. N >= 0.
  61. *> \endverbatim
  62. *>
  63. *> \param[in,out] A
  64. *> \verbatim
  65. *> A is COMPLEX*16 array, dimension (LDA,N)
  66. *> On entry, the M-by-N matrix A.
  67. *> On exit, the elements on and below the diagonal of the array
  68. *> contain the m-by-min(m,n) lower trapezoidal matrix L (L is
  69. *> lower triangular if m <= n); the elements above the diagonal,
  70. *> with the array TAU, represent the unitary matrix Q as a
  71. *> product of elementary reflectors (see Further Details).
  72. *> \endverbatim
  73. *>
  74. *> \param[in] LDA
  75. *> \verbatim
  76. *> LDA is INTEGER
  77. *> The leading dimension of the array A. LDA >= max(1,M).
  78. *> \endverbatim
  79. *>
  80. *> \param[out] TAU
  81. *> \verbatim
  82. *> TAU is COMPLEX*16 array, dimension (min(M,N))
  83. *> The scalar factors of the elementary reflectors (see Further
  84. *> Details).
  85. *> \endverbatim
  86. *>
  87. *> \param[out] WORK
  88. *> \verbatim
  89. *> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
  90. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  91. *> \endverbatim
  92. *>
  93. *> \param[in] LWORK
  94. *> \verbatim
  95. *> LWORK is INTEGER
  96. *> The dimension of the array WORK.
  97. *> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise.
  98. *> For optimum performance LWORK >= M*NB, where NB is the
  99. *> optimal blocksize.
  100. *>
  101. *> If LWORK = -1, then a workspace query is assumed; the routine
  102. *> only calculates the optimal size of the WORK array, returns
  103. *> this value as the first entry of the WORK array, and no error
  104. *> message related to LWORK is issued by XERBLA.
  105. *> \endverbatim
  106. *>
  107. *> \param[out] INFO
  108. *> \verbatim
  109. *> INFO is INTEGER
  110. *> = 0: successful exit
  111. *> < 0: if INFO = -i, the i-th argument had an illegal value
  112. *> \endverbatim
  113. *
  114. * Authors:
  115. * ========
  116. *
  117. *> \author Univ. of Tennessee
  118. *> \author Univ. of California Berkeley
  119. *> \author Univ. of Colorado Denver
  120. *> \author NAG Ltd.
  121. *
  122. *> \ingroup gelqf
  123. *
  124. *> \par Further Details:
  125. * =====================
  126. *>
  127. *> \verbatim
  128. *>
  129. *> The matrix Q is represented as a product of elementary reflectors
  130. *>
  131. *> Q = H(k)**H . . . H(2)**H H(1)**H, where k = min(m,n).
  132. *>
  133. *> Each H(i) has the form
  134. *>
  135. *> H(i) = I - tau * v * v**H
  136. *>
  137. *> where tau is a complex scalar, and v is a complex vector with
  138. *> v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in
  139. *> A(i,i+1:n), and tau in TAU(i).
  140. *> \endverbatim
  141. *>
  142. * =====================================================================
  143. SUBROUTINE ZGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
  144. *
  145. * -- LAPACK computational routine --
  146. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  147. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  148. *
  149. * .. Scalar Arguments ..
  150. INTEGER INFO, LDA, LWORK, M, N
  151. * ..
  152. * .. Array Arguments ..
  153. COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
  154. * ..
  155. *
  156. * =====================================================================
  157. *
  158. * .. Local Scalars ..
  159. LOGICAL LQUERY
  160. INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
  161. $ NBMIN, NX
  162. * ..
  163. * .. External Subroutines ..
  164. EXTERNAL XERBLA, ZGELQ2, ZLARFB, ZLARFT
  165. * ..
  166. * .. Intrinsic Functions ..
  167. INTRINSIC MAX, MIN
  168. * ..
  169. * .. External Functions ..
  170. INTEGER ILAENV
  171. EXTERNAL ILAENV
  172. * ..
  173. * .. Executable Statements ..
  174. *
  175. * Test the input arguments
  176. *
  177. INFO = 0
  178. K = MIN( M, N )
  179. NB = ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
  180. LQUERY = ( LWORK.EQ.-1 )
  181. IF( M.LT.0 ) THEN
  182. INFO = -1
  183. ELSE IF( N.LT.0 ) THEN
  184. INFO = -2
  185. ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
  186. INFO = -4
  187. ELSE IF( .NOT.LQUERY ) THEN
  188. IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) )
  189. $ INFO = -7
  190. END IF
  191. IF( INFO.NE.0 ) THEN
  192. CALL XERBLA( 'ZGELQF', -INFO )
  193. RETURN
  194. ELSE IF( LQUERY ) THEN
  195. IF( K.EQ.0 ) THEN
  196. LWKOPT = 1
  197. ELSE
  198. LWKOPT = M*NB
  199. END IF
  200. WORK( 1 ) = LWKOPT
  201. RETURN
  202. END IF
  203. *
  204. * Quick return if possible
  205. *
  206. IF( K.EQ.0 ) THEN
  207. WORK( 1 ) = 1
  208. RETURN
  209. END IF
  210. *
  211. NBMIN = 2
  212. NX = 0
  213. IWS = M
  214. IF( NB.GT.1 .AND. NB.LT.K ) THEN
  215. *
  216. * Determine when to cross over from blocked to unblocked code.
  217. *
  218. NX = MAX( 0, ILAENV( 3, 'ZGELQF', ' ', M, N, -1, -1 ) )
  219. IF( NX.LT.K ) THEN
  220. *
  221. * Determine if workspace is large enough for blocked code.
  222. *
  223. LDWORK = M
  224. IWS = LDWORK*NB
  225. IF( LWORK.LT.IWS ) THEN
  226. *
  227. * Not enough workspace to use optimal NB: reduce NB and
  228. * determine the minimum value of NB.
  229. *
  230. NB = LWORK / LDWORK
  231. NBMIN = MAX( 2, ILAENV( 2, 'ZGELQF', ' ', M, N, -1,
  232. $ -1 ) )
  233. END IF
  234. END IF
  235. END IF
  236. *
  237. IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
  238. *
  239. * Use blocked code initially
  240. *
  241. DO 10 I = 1, K - NX, NB
  242. IB = MIN( K-I+1, NB )
  243. *
  244. * Compute the LQ factorization of the current block
  245. * A(i:i+ib-1,i:n)
  246. *
  247. CALL ZGELQ2( IB, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
  248. $ IINFO )
  249. IF( I+IB.LE.M ) THEN
  250. *
  251. * Form the triangular factor of the block reflector
  252. * H = H(i) H(i+1) . . . H(i+ib-1)
  253. *
  254. CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
  255. $ LDA, TAU( I ), WORK, LDWORK )
  256. *
  257. * Apply H to A(i+ib:m,i:n) from the right
  258. *
  259. CALL ZLARFB( 'Right', 'No transpose', 'Forward',
  260. $ 'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ),
  261. $ LDA, WORK, LDWORK, A( I+IB, I ), LDA,
  262. $ WORK( IB+1 ), LDWORK )
  263. END IF
  264. 10 CONTINUE
  265. ELSE
  266. I = 1
  267. END IF
  268. *
  269. * Use unblocked code to factor the last or only block.
  270. *
  271. IF( I.LE.K )
  272. $ CALL ZGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
  273. $ IINFO )
  274. *
  275. WORK( 1 ) = IWS
  276. RETURN
  277. *
  278. * End of ZGELQF
  279. *
  280. END