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.

csymv.f 10 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343
  1. *> \brief \b CSYMV computes a matrix-vector product for a complex symmetric matrix.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CSYMV + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csymv.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csymv.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csymv.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER UPLO
  25. * INTEGER INCX, INCY, LDA, N
  26. * COMPLEX ALPHA, BETA
  27. * ..
  28. * .. Array Arguments ..
  29. * COMPLEX A( LDA, * ), X( * ), Y( * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> CSYMV performs the matrix-vector operation
  39. *>
  40. *> y := alpha*A*x + beta*y,
  41. *>
  42. *> where alpha and beta are scalars, x and y are n element vectors and
  43. *> A is an n by n symmetric matrix.
  44. *> \endverbatim
  45. *
  46. * Arguments:
  47. * ==========
  48. *
  49. *> \param[in] UPLO
  50. *> \verbatim
  51. *> UPLO is CHARACTER*1
  52. *> On entry, UPLO specifies whether the upper or lower
  53. *> triangular part of the array A is to be referenced as
  54. *> follows:
  55. *>
  56. *> UPLO = 'U' or 'u' Only the upper triangular part of A
  57. *> is to be referenced.
  58. *>
  59. *> UPLO = 'L' or 'l' Only the lower triangular part of A
  60. *> is to be referenced.
  61. *>
  62. *> Unchanged on exit.
  63. *> \endverbatim
  64. *>
  65. *> \param[in] N
  66. *> \verbatim
  67. *> N is INTEGER
  68. *> On entry, N specifies the order of the matrix A.
  69. *> N must be at least zero.
  70. *> Unchanged on exit.
  71. *> \endverbatim
  72. *>
  73. *> \param[in] ALPHA
  74. *> \verbatim
  75. *> ALPHA is COMPLEX
  76. *> On entry, ALPHA specifies the scalar alpha.
  77. *> Unchanged on exit.
  78. *> \endverbatim
  79. *>
  80. *> \param[in] A
  81. *> \verbatim
  82. *> A is COMPLEX array, dimension ( LDA, N )
  83. *> Before entry, with UPLO = 'U' or 'u', the leading n by n
  84. *> upper triangular part of the array A must contain the upper
  85. *> triangular part of the symmetric matrix and the strictly
  86. *> lower triangular part of A is not referenced.
  87. *> Before entry, with UPLO = 'L' or 'l', the leading n by n
  88. *> lower triangular part of the array A must contain the lower
  89. *> triangular part of the symmetric matrix and the strictly
  90. *> upper triangular part of A is not referenced.
  91. *> Unchanged on exit.
  92. *> \endverbatim
  93. *>
  94. *> \param[in] LDA
  95. *> \verbatim
  96. *> LDA is INTEGER
  97. *> On entry, LDA specifies the first dimension of A as declared
  98. *> in the calling (sub) program. LDA must be at least
  99. *> max( 1, N ).
  100. *> Unchanged on exit.
  101. *> \endverbatim
  102. *>
  103. *> \param[in] X
  104. *> \verbatim
  105. *> X is COMPLEX array, dimension at least
  106. *> ( 1 + ( N - 1 )*abs( INCX ) ).
  107. *> Before entry, the incremented array X must contain the N-
  108. *> element vector x.
  109. *> Unchanged on exit.
  110. *> \endverbatim
  111. *>
  112. *> \param[in] INCX
  113. *> \verbatim
  114. *> INCX is INTEGER
  115. *> On entry, INCX specifies the increment for the elements of
  116. *> X. INCX must not be zero.
  117. *> Unchanged on exit.
  118. *> \endverbatim
  119. *>
  120. *> \param[in] BETA
  121. *> \verbatim
  122. *> BETA is COMPLEX
  123. *> On entry, BETA specifies the scalar beta. When BETA is
  124. *> supplied as zero then Y need not be set on input.
  125. *> Unchanged on exit.
  126. *> \endverbatim
  127. *>
  128. *> \param[in,out] Y
  129. *> \verbatim
  130. *> Y is COMPLEX array, dimension at least
  131. *> ( 1 + ( N - 1 )*abs( INCY ) ).
  132. *> Before entry, the incremented array Y must contain the n
  133. *> element vector y. On exit, Y is overwritten by the updated
  134. *> vector y.
  135. *> \endverbatim
  136. *>
  137. *> \param[in] INCY
  138. *> \verbatim
  139. *> INCY is INTEGER
  140. *> On entry, INCY specifies the increment for the elements of
  141. *> Y. INCY must not be zero.
  142. *> Unchanged on exit.
  143. *> \endverbatim
  144. *
  145. * Authors:
  146. * ========
  147. *
  148. *> \author Univ. of Tennessee
  149. *> \author Univ. of California Berkeley
  150. *> \author Univ. of Colorado Denver
  151. *> \author NAG Ltd.
  152. *
  153. *> \date September 2012
  154. *
  155. *> \ingroup complexSYauxiliary
  156. *
  157. * =====================================================================
  158. SUBROUTINE CSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY )
  159. *
  160. * -- LAPACK auxiliary routine (version 3.4.2) --
  161. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  162. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  163. * September 2012
  164. *
  165. * .. Scalar Arguments ..
  166. CHARACTER UPLO
  167. INTEGER INCX, INCY, LDA, N
  168. COMPLEX ALPHA, BETA
  169. * ..
  170. * .. Array Arguments ..
  171. COMPLEX A( LDA, * ), X( * ), Y( * )
  172. * ..
  173. *
  174. * =====================================================================
  175. *
  176. * .. Parameters ..
  177. COMPLEX ONE
  178. PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
  179. COMPLEX ZERO
  180. PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) )
  181. * ..
  182. * .. Local Scalars ..
  183. INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
  184. COMPLEX TEMP1, TEMP2
  185. * ..
  186. * .. External Functions ..
  187. LOGICAL LSAME
  188. EXTERNAL LSAME
  189. * ..
  190. * .. External Subroutines ..
  191. EXTERNAL XERBLA
  192. * ..
  193. * .. Intrinsic Functions ..
  194. INTRINSIC MAX
  195. * ..
  196. * .. Executable Statements ..
  197. *
  198. * Test the input parameters.
  199. *
  200. INFO = 0
  201. IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  202. INFO = 1
  203. ELSE IF( N.LT.0 ) THEN
  204. INFO = 2
  205. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  206. INFO = 5
  207. ELSE IF( INCX.EQ.0 ) THEN
  208. INFO = 7
  209. ELSE IF( INCY.EQ.0 ) THEN
  210. INFO = 10
  211. END IF
  212. IF( INFO.NE.0 ) THEN
  213. CALL XERBLA( 'CSYMV ', INFO )
  214. RETURN
  215. END IF
  216. *
  217. * Quick return if possible.
  218. *
  219. IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) )
  220. $ RETURN
  221. *
  222. * Set up the start points in X and Y.
  223. *
  224. IF( INCX.GT.0 ) THEN
  225. KX = 1
  226. ELSE
  227. KX = 1 - ( N-1 )*INCX
  228. END IF
  229. IF( INCY.GT.0 ) THEN
  230. KY = 1
  231. ELSE
  232. KY = 1 - ( N-1 )*INCY
  233. END IF
  234. *
  235. * Start the operations. In this version the elements of A are
  236. * accessed sequentially with one pass through the triangular part
  237. * of A.
  238. *
  239. * First form y := beta*y.
  240. *
  241. IF( BETA.NE.ONE ) THEN
  242. IF( INCY.EQ.1 ) THEN
  243. IF( BETA.EQ.ZERO ) THEN
  244. DO 10 I = 1, N
  245. Y( I ) = ZERO
  246. 10 CONTINUE
  247. ELSE
  248. DO 20 I = 1, N
  249. Y( I ) = BETA*Y( I )
  250. 20 CONTINUE
  251. END IF
  252. ELSE
  253. IY = KY
  254. IF( BETA.EQ.ZERO ) THEN
  255. DO 30 I = 1, N
  256. Y( IY ) = ZERO
  257. IY = IY + INCY
  258. 30 CONTINUE
  259. ELSE
  260. DO 40 I = 1, N
  261. Y( IY ) = BETA*Y( IY )
  262. IY = IY + INCY
  263. 40 CONTINUE
  264. END IF
  265. END IF
  266. END IF
  267. IF( ALPHA.EQ.ZERO )
  268. $ RETURN
  269. IF( LSAME( UPLO, 'U' ) ) THEN
  270. *
  271. * Form y when A is stored in upper triangle.
  272. *
  273. IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
  274. DO 60 J = 1, N
  275. TEMP1 = ALPHA*X( J )
  276. TEMP2 = ZERO
  277. DO 50 I = 1, J - 1
  278. Y( I ) = Y( I ) + TEMP1*A( I, J )
  279. TEMP2 = TEMP2 + A( I, J )*X( I )
  280. 50 CONTINUE
  281. Y( J ) = Y( J ) + TEMP1*A( J, J ) + ALPHA*TEMP2
  282. 60 CONTINUE
  283. ELSE
  284. JX = KX
  285. JY = KY
  286. DO 80 J = 1, N
  287. TEMP1 = ALPHA*X( JX )
  288. TEMP2 = ZERO
  289. IX = KX
  290. IY = KY
  291. DO 70 I = 1, J - 1
  292. Y( IY ) = Y( IY ) + TEMP1*A( I, J )
  293. TEMP2 = TEMP2 + A( I, J )*X( IX )
  294. IX = IX + INCX
  295. IY = IY + INCY
  296. 70 CONTINUE
  297. Y( JY ) = Y( JY ) + TEMP1*A( J, J ) + ALPHA*TEMP2
  298. JX = JX + INCX
  299. JY = JY + INCY
  300. 80 CONTINUE
  301. END IF
  302. ELSE
  303. *
  304. * Form y when A is stored in lower triangle.
  305. *
  306. IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
  307. DO 100 J = 1, N
  308. TEMP1 = ALPHA*X( J )
  309. TEMP2 = ZERO
  310. Y( J ) = Y( J ) + TEMP1*A( J, J )
  311. DO 90 I = J + 1, N
  312. Y( I ) = Y( I ) + TEMP1*A( I, J )
  313. TEMP2 = TEMP2 + A( I, J )*X( I )
  314. 90 CONTINUE
  315. Y( J ) = Y( J ) + ALPHA*TEMP2
  316. 100 CONTINUE
  317. ELSE
  318. JX = KX
  319. JY = KY
  320. DO 120 J = 1, N
  321. TEMP1 = ALPHA*X( JX )
  322. TEMP2 = ZERO
  323. Y( JY ) = Y( JY ) + TEMP1*A( J, J )
  324. IX = JX
  325. IY = JY
  326. DO 110 I = J + 1, N
  327. IX = IX + INCX
  328. IY = IY + INCY
  329. Y( IY ) = Y( IY ) + TEMP1*A( I, J )
  330. TEMP2 = TEMP2 + A( I, J )*X( IX )
  331. 110 CONTINUE
  332. Y( JY ) = Y( JY ) + ALPHA*TEMP2
  333. JX = JX + INCX
  334. JY = JY + INCY
  335. 120 CONTINUE
  336. END IF
  337. END IF
  338. *
  339. RETURN
  340. *
  341. * End of CSYMV
  342. *
  343. END