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.

clatzm.f 6.1 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222
  1. *> \brief \b CLATZM
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CLATZM + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clatzm.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clatzm.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clatzm.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER SIDE
  25. * INTEGER INCV, LDC, M, N
  26. * COMPLEX TAU
  27. * ..
  28. * .. Array Arguments ..
  29. * COMPLEX C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> This routine is deprecated and has been replaced by routine CUNMRZ.
  39. *>
  40. *> CLATZM applies a Householder matrix generated by CTZRQF to a matrix.
  41. *>
  42. *> Let P = I - tau*u*u**H, u = ( 1 ),
  43. *> ( v )
  44. *> where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
  45. *> SIDE = 'R'.
  46. *>
  47. *> If SIDE equals 'L', let
  48. *> C = [ C1 ] 1
  49. *> [ C2 ] m-1
  50. *> n
  51. *> Then C is overwritten by P*C.
  52. *>
  53. *> If SIDE equals 'R', let
  54. *> C = [ C1, C2 ] m
  55. *> 1 n-1
  56. *> Then C is overwritten by C*P.
  57. *> \endverbatim
  58. *
  59. * Arguments:
  60. * ==========
  61. *
  62. *> \param[in] SIDE
  63. *> \verbatim
  64. *> SIDE is CHARACTER*1
  65. *> = 'L': form P * C
  66. *> = 'R': form C * P
  67. *> \endverbatim
  68. *>
  69. *> \param[in] M
  70. *> \verbatim
  71. *> M is INTEGER
  72. *> The number of rows of the matrix C.
  73. *> \endverbatim
  74. *>
  75. *> \param[in] N
  76. *> \verbatim
  77. *> N is INTEGER
  78. *> The number of columns of the matrix C.
  79. *> \endverbatim
  80. *>
  81. *> \param[in] V
  82. *> \verbatim
  83. *> V is COMPLEX array, dimension
  84. *> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
  85. *> (1 + (N-1)*abs(INCV)) if SIDE = 'R'
  86. *> The vector v in the representation of P. V is not used
  87. *> if TAU = 0.
  88. *> \endverbatim
  89. *>
  90. *> \param[in] INCV
  91. *> \verbatim
  92. *> INCV is INTEGER
  93. *> The increment between elements of v. INCV <> 0
  94. *> \endverbatim
  95. *>
  96. *> \param[in] TAU
  97. *> \verbatim
  98. *> TAU is COMPLEX
  99. *> The value tau in the representation of P.
  100. *> \endverbatim
  101. *>
  102. *> \param[in,out] C1
  103. *> \verbatim
  104. *> C1 is COMPLEX array, dimension
  105. *> (LDC,N) if SIDE = 'L'
  106. *> (M,1) if SIDE = 'R'
  107. *> On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
  108. *> if SIDE = 'R'.
  109. *>
  110. *> On exit, the first row of P*C if SIDE = 'L', or the first
  111. *> column of C*P if SIDE = 'R'.
  112. *> \endverbatim
  113. *>
  114. *> \param[in,out] C2
  115. *> \verbatim
  116. *> C2 is COMPLEX array, dimension
  117. *> (LDC, N) if SIDE = 'L'
  118. *> (LDC, N-1) if SIDE = 'R'
  119. *> On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
  120. *> m x (n - 1) matrix C2 if SIDE = 'R'.
  121. *>
  122. *> On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
  123. *> if SIDE = 'R'.
  124. *> \endverbatim
  125. *>
  126. *> \param[in] LDC
  127. *> \verbatim
  128. *> LDC is INTEGER
  129. *> The leading dimension of the arrays C1 and C2.
  130. *> LDC >= max(1,M).
  131. *> \endverbatim
  132. *>
  133. *> \param[out] WORK
  134. *> \verbatim
  135. *> WORK is COMPLEX array, dimension
  136. *> (N) if SIDE = 'L'
  137. *> (M) if SIDE = 'R'
  138. *> \endverbatim
  139. *
  140. * Authors:
  141. * ========
  142. *
  143. *> \author Univ. of Tennessee
  144. *> \author Univ. of California Berkeley
  145. *> \author Univ. of Colorado Denver
  146. *> \author NAG Ltd.
  147. *
  148. *> \ingroup complexOTHERcomputational
  149. *
  150. * =====================================================================
  151. SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
  152. *
  153. * -- LAPACK computational routine --
  154. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  155. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  156. *
  157. * .. Scalar Arguments ..
  158. CHARACTER SIDE
  159. INTEGER INCV, LDC, M, N
  160. COMPLEX TAU
  161. * ..
  162. * .. Array Arguments ..
  163. COMPLEX C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
  164. * ..
  165. *
  166. * =====================================================================
  167. *
  168. * .. Parameters ..
  169. COMPLEX ONE, ZERO
  170. PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ),
  171. $ ZERO = ( 0.0E+0, 0.0E+0 ) )
  172. * ..
  173. * .. External Subroutines ..
  174. EXTERNAL CAXPY, CCOPY, CGEMV, CGERC, CGERU, CLACGV
  175. * ..
  176. * .. External Functions ..
  177. LOGICAL LSAME
  178. EXTERNAL LSAME
  179. * ..
  180. * .. Intrinsic Functions ..
  181. INTRINSIC MIN
  182. * ..
  183. * .. Executable Statements ..
  184. *
  185. IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
  186. $ RETURN
  187. *
  188. IF( LSAME( SIDE, 'L' ) ) THEN
  189. *
  190. * w := ( C1 + v**H * C2 )**H
  191. *
  192. CALL CCOPY( N, C1, LDC, WORK, 1 )
  193. CALL CLACGV( N, WORK, 1 )
  194. CALL CGEMV( 'Conjugate transpose', M-1, N, ONE, C2, LDC, V,
  195. $ INCV, ONE, WORK, 1 )
  196. *
  197. * [ C1 ] := [ C1 ] - tau* [ 1 ] * w**H
  198. * [ C2 ] [ C2 ] [ v ]
  199. *
  200. CALL CLACGV( N, WORK, 1 )
  201. CALL CAXPY( N, -TAU, WORK, 1, C1, LDC )
  202. CALL CGERU( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
  203. *
  204. ELSE IF( LSAME( SIDE, 'R' ) ) THEN
  205. *
  206. * w := C1 + C2 * v
  207. *
  208. CALL CCOPY( M, C1, 1, WORK, 1 )
  209. CALL CGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
  210. $ WORK, 1 )
  211. *
  212. * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**H]
  213. *
  214. CALL CAXPY( M, -TAU, WORK, 1, C1, 1 )
  215. CALL CGERC( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
  216. END IF
  217. *
  218. RETURN
  219. *
  220. * End of CLATZM
  221. *
  222. END