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.

zunmhr.f 8.3 kB

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