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.

zgemlq.f 8.1 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292
  1. *> \brief \b ZGEMLQ
  2. *
  3. * Definition:
  4. * ===========
  5. *
  6. * SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T,
  7. * $ TSIZE, C, LDC, WORK, LWORK, INFO )
  8. *
  9. *
  10. * .. Scalar Arguments ..
  11. * CHARACTER SIDE, TRANS
  12. * INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
  13. * ..
  14. * .. Array Arguments ..
  15. * COMPLEX*16 A( LDA, * ), T( * ), C(LDC, * ), WORK( * )
  16. *> \par Purpose:
  17. * =============
  18. *>
  19. *> \verbatim
  20. *>
  21. *> ZGEMLQ overwrites the general real M-by-N matrix C with
  22. *>
  23. *> SIDE = 'L' SIDE = 'R'
  24. *> TRANS = 'N': Q * C C * Q
  25. *> TRANS = 'C': Q**H * C C * Q**H
  26. *> where Q is a complex unitary matrix defined as the product
  27. *> of blocked elementary reflectors computed by short wide
  28. *> LQ factorization (ZGELQ)
  29. *>
  30. *> \endverbatim
  31. *
  32. * Arguments:
  33. * ==========
  34. *
  35. *> \param[in] SIDE
  36. *> \verbatim
  37. *> SIDE is CHARACTER*1
  38. *> = 'L': apply Q or Q**H from the Left;
  39. *> = 'R': apply Q or Q**H from the Right.
  40. *> \endverbatim
  41. *>
  42. *> \param[in] TRANS
  43. *> \verbatim
  44. *> TRANS is CHARACTER*1
  45. *> = 'N': No transpose, apply Q;
  46. *> = 'C': Conjugate transpose, apply Q**H.
  47. *> \endverbatim
  48. *>
  49. *> \param[in] M
  50. *> \verbatim
  51. *> M is INTEGER
  52. *> The number of rows of the matrix A. M >=0.
  53. *> \endverbatim
  54. *>
  55. *> \param[in] N
  56. *> \verbatim
  57. *> N is INTEGER
  58. *> The number of columns of the matrix C. N >= 0.
  59. *> \endverbatim
  60. *>
  61. *> \param[in] K
  62. *> \verbatim
  63. *> K is INTEGER
  64. *> The number of elementary reflectors whose product defines
  65. *> the matrix Q.
  66. *> If SIDE = 'L', M >= K >= 0;
  67. *> if SIDE = 'R', N >= K >= 0.
  68. *>
  69. *> \endverbatim
  70. *>
  71. *> \param[in] A
  72. *> \verbatim
  73. *> A is COMPLEX*16 array, dimension
  74. *> (LDA,M) if SIDE = 'L',
  75. *> (LDA,N) if SIDE = 'R'
  76. *> Part of the data structure to represent Q as returned by ZGELQ.
  77. *> \endverbatim
  78. *>
  79. *> \param[in] LDA
  80. *> \verbatim
  81. *> LDA is INTEGER
  82. *> The leading dimension of the array A. LDA >= max(1,K).
  83. *> \endverbatim
  84. *>
  85. *> \param[in] T
  86. *> \verbatim
  87. *> T is COMPLEX*16 array, dimension (MAX(5,TSIZE)).
  88. *> Part of the data structure to represent Q as returned by ZGELQ.
  89. *> \endverbatim
  90. *>
  91. *> \param[in] TSIZE
  92. *> \verbatim
  93. *> TSIZE is INTEGER
  94. *> The dimension of the array T. TSIZE >= 5.
  95. *> \endverbatim
  96. *>
  97. *> \param[in,out] C
  98. *> \verbatim
  99. *> C is COMPLEX*16 array, dimension (LDC,N)
  100. *> On entry, the M-by-N matrix C.
  101. *> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
  102. *> \endverbatim
  103. *>
  104. *> \param[in] LDC
  105. *> \verbatim
  106. *> LDC is INTEGER
  107. *> The leading dimension of the array C. LDC >= max(1,M).
  108. *> \endverbatim
  109. *>
  110. *> \param[out] WORK
  111. *> \verbatim
  112. *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
  113. *> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
  114. *> \endverbatim
  115. *>
  116. *> \param[in] LWORK
  117. *> \verbatim
  118. *> LWORK is INTEGER
  119. *> The dimension of the array WORK. LWORK >= 1.
  120. *> If LWORK = -1, then a workspace query is assumed. The routine
  121. *> only calculates the size of the WORK array, returns this
  122. *> value as WORK(1), and no error message related to WORK
  123. *> is issued by XERBLA.
  124. *> \endverbatim
  125. *>
  126. *> \param[out] INFO
  127. *> \verbatim
  128. *> INFO is INTEGER
  129. *> = 0: successful exit
  130. *> < 0: if INFO = -i, the i-th argument had an illegal value
  131. *> \endverbatim
  132. *
  133. * Authors:
  134. * ========
  135. *
  136. *> \author Univ. of Tennessee
  137. *> \author Univ. of California Berkeley
  138. *> \author Univ. of Colorado Denver
  139. *> \author NAG Ltd.
  140. *
  141. *> \par Further Details
  142. * ====================
  143. *>
  144. *> \verbatim
  145. *>
  146. *> These details are particular for this LAPACK implementation. Users should not
  147. *> take them for granted. These details may change in the future, and are not likely
  148. *> true for another LAPACK implementation. These details are relevant if one wants
  149. *> to try to understand the code. They are not part of the interface.
  150. *>
  151. *> In this version,
  152. *>
  153. *> T(2): row block size (MB)
  154. *> T(3): column block size (NB)
  155. *> T(6:TSIZE): data structure needed for Q, computed by
  156. *> ZLASWLQ or ZGELQT
  157. *>
  158. *> Depending on the matrix dimensions M and N, and row and column
  159. *> block sizes MB and NB returned by ILAENV, ZGELQ will use either
  160. *> ZLASWLQ (if the matrix is wide-and-short) or ZGELQT to compute
  161. *> the LQ factorization.
  162. *> This version of ZGEMLQ will use either ZLAMSWLQ or ZGEMLQT to
  163. *> multiply matrix Q by another matrix.
  164. *> Further Details in ZLAMSWLQ or ZGEMLQT.
  165. *> \endverbatim
  166. *>
  167. *> \ingroup gemlq
  168. *>
  169. * =====================================================================
  170. SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
  171. $ C, LDC, WORK, LWORK, INFO )
  172. *
  173. * -- LAPACK computational routine --
  174. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  175. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  176. *
  177. * .. Scalar Arguments ..
  178. CHARACTER SIDE, TRANS
  179. INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
  180. * ..
  181. * .. Array Arguments ..
  182. COMPLEX*16 A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
  183. * ..
  184. *
  185. * =====================================================================
  186. *
  187. * ..
  188. * .. Local Scalars ..
  189. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
  190. INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
  191. * ..
  192. * .. External Functions ..
  193. LOGICAL LSAME
  194. EXTERNAL LSAME
  195. * ..
  196. * .. External Subroutines ..
  197. EXTERNAL ZLAMSWLQ, ZGEMLQT, XERBLA
  198. * ..
  199. * .. Intrinsic Functions ..
  200. INTRINSIC INT, MAX, MIN, MOD
  201. * ..
  202. * .. Executable Statements ..
  203. *
  204. * Test the input arguments
  205. *
  206. LQUERY = ( LWORK.EQ.-1 )
  207. NOTRAN = LSAME( TRANS, 'N' )
  208. TRAN = LSAME( TRANS, 'C' )
  209. LEFT = LSAME( SIDE, 'L' )
  210. RIGHT = LSAME( SIDE, 'R' )
  211. *
  212. MB = INT( T( 2 ) )
  213. NB = INT( T( 3 ) )
  214. IF( LEFT ) THEN
  215. LW = N * MB
  216. MN = M
  217. ELSE
  218. LW = M * MB
  219. MN = N
  220. END IF
  221. *
  222. MINMNK = MIN( M, N, K )
  223. IF( MINMNK.EQ.0 ) THEN
  224. LWMIN = 1
  225. ELSE
  226. LWMIN = MAX( 1, LW )
  227. END IF
  228. *
  229. IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
  230. IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
  231. NBLCKS = ( MN - K ) / ( NB - K )
  232. ELSE
  233. NBLCKS = ( MN - K ) / ( NB - K ) + 1
  234. END IF
  235. ELSE
  236. NBLCKS = 1
  237. END IF
  238. *
  239. INFO = 0
  240. IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
  241. INFO = -1
  242. ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
  243. INFO = -2
  244. ELSE IF( M.LT.0 ) THEN
  245. INFO = -3
  246. ELSE IF( N.LT.0 ) THEN
  247. INFO = -4
  248. ELSE IF( K.LT.0 .OR. K.GT.MN ) THEN
  249. INFO = -5
  250. ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
  251. INFO = -7
  252. ELSE IF( TSIZE.LT.5 ) THEN
  253. INFO = -9
  254. ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
  255. INFO = -11
  256. ELSE IF( ( LWORK.LT.LWMIN ) .AND. ( .NOT.LQUERY ) ) THEN
  257. INFO = -13
  258. END IF
  259. *
  260. IF( INFO.EQ.0 ) THEN
  261. WORK( 1 ) = LW
  262. END IF
  263. *
  264. IF( INFO.NE.0 ) THEN
  265. CALL XERBLA( 'ZGEMLQ', -INFO )
  266. RETURN
  267. ELSE IF( LQUERY ) THEN
  268. RETURN
  269. END IF
  270. *
  271. * Quick return if possible
  272. *
  273. IF( MINMNK.EQ.0 ) THEN
  274. RETURN
  275. END IF
  276. *
  277. IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K )
  278. $ .OR. ( NB.LE.K ) .OR. ( NB.GE.MAX( M, N, K ) ) ) THEN
  279. CALL ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA,
  280. $ T( 6 ), MB, C, LDC, WORK, INFO )
  281. ELSE
  282. CALL ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
  283. $ MB, C, LDC, WORK, LWORK, INFO )
  284. END IF
  285. *
  286. WORK( 1 ) = LW
  287. *
  288. RETURN
  289. *
  290. * End of ZGEMLQ
  291. *
  292. END