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.

dgemlq.f 8.1 kB

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