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.

cgbmv.f 11 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390
  1. *> \brief \b CGBMV
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * SUBROUTINE CGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
  12. *
  13. * .. Scalar Arguments ..
  14. * COMPLEX ALPHA,BETA
  15. * INTEGER INCX,INCY,KL,KU,LDA,M,N
  16. * CHARACTER TRANS
  17. * ..
  18. * .. Array Arguments ..
  19. * COMPLEX A(LDA,*),X(*),Y(*)
  20. * ..
  21. *
  22. *
  23. *> \par Purpose:
  24. * =============
  25. *>
  26. *> \verbatim
  27. *>
  28. *> CGBMV performs one of the matrix-vector operations
  29. *>
  30. *> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or
  31. *>
  32. *> y := alpha*A**H*x + beta*y,
  33. *>
  34. *> where alpha and beta are scalars, x and y are vectors and A is an
  35. *> m by n band matrix, with kl sub-diagonals and ku super-diagonals.
  36. *> \endverbatim
  37. *
  38. * Arguments:
  39. * ==========
  40. *
  41. *> \param[in] TRANS
  42. *> \verbatim
  43. *> TRANS is CHARACTER*1
  44. *> On entry, TRANS specifies the operation to be performed as
  45. *> follows:
  46. *>
  47. *> TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
  48. *>
  49. *> TRANS = 'T' or 't' y := alpha*A**T*x + beta*y.
  50. *>
  51. *> TRANS = 'C' or 'c' y := alpha*A**H*x + beta*y.
  52. *> \endverbatim
  53. *>
  54. *> \param[in] M
  55. *> \verbatim
  56. *> M is INTEGER
  57. *> On entry, M specifies the number of rows of the matrix A.
  58. *> M must be at least zero.
  59. *> \endverbatim
  60. *>
  61. *> \param[in] N
  62. *> \verbatim
  63. *> N is INTEGER
  64. *> On entry, N specifies the number of columns of the matrix A.
  65. *> N must be at least zero.
  66. *> \endverbatim
  67. *>
  68. *> \param[in] KL
  69. *> \verbatim
  70. *> KL is INTEGER
  71. *> On entry, KL specifies the number of sub-diagonals of the
  72. *> matrix A. KL must satisfy 0 .le. KL.
  73. *> \endverbatim
  74. *>
  75. *> \param[in] KU
  76. *> \verbatim
  77. *> KU is INTEGER
  78. *> On entry, KU specifies the number of super-diagonals of the
  79. *> matrix A. KU must satisfy 0 .le. KU.
  80. *> \endverbatim
  81. *>
  82. *> \param[in] ALPHA
  83. *> \verbatim
  84. *> ALPHA is COMPLEX
  85. *> On entry, ALPHA specifies the scalar alpha.
  86. *> \endverbatim
  87. *>
  88. *> \param[in] A
  89. *> \verbatim
  90. *> A is COMPLEX array, dimension ( LDA, N )
  91. *> Before entry, the leading ( kl + ku + 1 ) by n part of the
  92. *> array A must contain the matrix of coefficients, supplied
  93. *> column by column, with the leading diagonal of the matrix in
  94. *> row ( ku + 1 ) of the array, the first super-diagonal
  95. *> starting at position 2 in row ku, the first sub-diagonal
  96. *> starting at position 1 in row ( ku + 2 ), and so on.
  97. *> Elements in the array A that do not correspond to elements
  98. *> in the band matrix (such as the top left ku by ku triangle)
  99. *> are not referenced.
  100. *> The following program segment will transfer a band matrix
  101. *> from conventional full matrix storage to band storage:
  102. *>
  103. *> DO 20, J = 1, N
  104. *> K = KU + 1 - J
  105. *> DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
  106. *> A( K + I, J ) = matrix( I, J )
  107. *> 10 CONTINUE
  108. *> 20 CONTINUE
  109. *> \endverbatim
  110. *>
  111. *> \param[in] LDA
  112. *> \verbatim
  113. *> LDA is INTEGER
  114. *> On entry, LDA specifies the first dimension of A as declared
  115. *> in the calling (sub) program. LDA must be at least
  116. *> ( kl + ku + 1 ).
  117. *> \endverbatim
  118. *>
  119. *> \param[in] X
  120. *> \verbatim
  121. *> X is COMPLEX array, dimension at least
  122. *> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
  123. *> and at least
  124. *> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
  125. *> Before entry, the incremented array X must contain the
  126. *> vector x.
  127. *> \endverbatim
  128. *>
  129. *> \param[in] INCX
  130. *> \verbatim
  131. *> INCX is INTEGER
  132. *> On entry, INCX specifies the increment for the elements of
  133. *> X. INCX must not be zero.
  134. *> \endverbatim
  135. *>
  136. *> \param[in] BETA
  137. *> \verbatim
  138. *> BETA is COMPLEX
  139. *> On entry, BETA specifies the scalar beta. When BETA is
  140. *> supplied as zero then Y need not be set on input.
  141. *> \endverbatim
  142. *>
  143. *> \param[in,out] Y
  144. *> \verbatim
  145. *> Y is COMPLEX array, dimension at least
  146. *> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
  147. *> and at least
  148. *> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
  149. *> Before entry, the incremented array Y must contain the
  150. *> vector y. On exit, Y is overwritten by the updated vector y.
  151. *> \endverbatim
  152. *>
  153. *> \param[in] INCY
  154. *> \verbatim
  155. *> INCY is INTEGER
  156. *> On entry, INCY specifies the increment for the elements of
  157. *> Y. INCY must not be zero.
  158. *> \endverbatim
  159. *
  160. * Authors:
  161. * ========
  162. *
  163. *> \author Univ. of Tennessee
  164. *> \author Univ. of California Berkeley
  165. *> \author Univ. of Colorado Denver
  166. *> \author NAG Ltd.
  167. *
  168. *> \date December 2016
  169. *
  170. *> \ingroup complex_blas_level2
  171. *
  172. *> \par Further Details:
  173. * =====================
  174. *>
  175. *> \verbatim
  176. *>
  177. *> Level 2 Blas routine.
  178. *> The vector and matrix arguments are not referenced when N = 0, or M = 0
  179. *>
  180. *> -- Written on 22-October-1986.
  181. *> Jack Dongarra, Argonne National Lab.
  182. *> Jeremy Du Croz, Nag Central Office.
  183. *> Sven Hammarling, Nag Central Office.
  184. *> Richard Hanson, Sandia National Labs.
  185. *> \endverbatim
  186. *>
  187. * =====================================================================
  188. SUBROUTINE CGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
  189. *
  190. * -- Reference BLAS level2 routine (version 3.7.0) --
  191. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  192. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  193. * December 2016
  194. *
  195. * .. Scalar Arguments ..
  196. COMPLEX ALPHA,BETA
  197. INTEGER INCX,INCY,KL,KU,LDA,M,N
  198. CHARACTER TRANS
  199. * ..
  200. * .. Array Arguments ..
  201. COMPLEX A(LDA,*),X(*),Y(*)
  202. * ..
  203. *
  204. * =====================================================================
  205. *
  206. * .. Parameters ..
  207. COMPLEX ONE
  208. PARAMETER (ONE= (1.0E+0,0.0E+0))
  209. COMPLEX ZERO
  210. PARAMETER (ZERO= (0.0E+0,0.0E+0))
  211. * ..
  212. * .. Local Scalars ..
  213. COMPLEX TEMP
  214. INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
  215. LOGICAL NOCONJ
  216. * ..
  217. * .. External Functions ..
  218. LOGICAL LSAME
  219. EXTERNAL LSAME
  220. * ..
  221. * .. External Subroutines ..
  222. EXTERNAL XERBLA
  223. * ..
  224. * .. Intrinsic Functions ..
  225. INTRINSIC CONJG,MAX,MIN
  226. * ..
  227. *
  228. * Test the input parameters.
  229. *
  230. INFO = 0
  231. IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
  232. + .NOT.LSAME(TRANS,'C')) THEN
  233. INFO = 1
  234. ELSE IF (M.LT.0) THEN
  235. INFO = 2
  236. ELSE IF (N.LT.0) THEN
  237. INFO = 3
  238. ELSE IF (KL.LT.0) THEN
  239. INFO = 4
  240. ELSE IF (KU.LT.0) THEN
  241. INFO = 5
  242. ELSE IF (LDA.LT. (KL+KU+1)) THEN
  243. INFO = 8
  244. ELSE IF (INCX.EQ.0) THEN
  245. INFO = 10
  246. ELSE IF (INCY.EQ.0) THEN
  247. INFO = 13
  248. END IF
  249. IF (INFO.NE.0) THEN
  250. CALL XERBLA('CGBMV ',INFO)
  251. RETURN
  252. END IF
  253. *
  254. * Quick return if possible.
  255. *
  256. IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
  257. + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
  258. *
  259. NOCONJ = LSAME(TRANS,'T')
  260. *
  261. * Set LENX and LENY, the lengths of the vectors x and y, and set
  262. * up the start points in X and Y.
  263. *
  264. IF (LSAME(TRANS,'N')) THEN
  265. LENX = N
  266. LENY = M
  267. ELSE
  268. LENX = M
  269. LENY = N
  270. END IF
  271. IF (INCX.GT.0) THEN
  272. KX = 1
  273. ELSE
  274. KX = 1 - (LENX-1)*INCX
  275. END IF
  276. IF (INCY.GT.0) THEN
  277. KY = 1
  278. ELSE
  279. KY = 1 - (LENY-1)*INCY
  280. END IF
  281. *
  282. * Start the operations. In this version the elements of A are
  283. * accessed sequentially with one pass through the band part of A.
  284. *
  285. * First form y := beta*y.
  286. *
  287. IF (BETA.NE.ONE) THEN
  288. IF (INCY.EQ.1) THEN
  289. IF (BETA.EQ.ZERO) THEN
  290. DO 10 I = 1,LENY
  291. Y(I) = ZERO
  292. 10 CONTINUE
  293. ELSE
  294. DO 20 I = 1,LENY
  295. Y(I) = BETA*Y(I)
  296. 20 CONTINUE
  297. END IF
  298. ELSE
  299. IY = KY
  300. IF (BETA.EQ.ZERO) THEN
  301. DO 30 I = 1,LENY
  302. Y(IY) = ZERO
  303. IY = IY + INCY
  304. 30 CONTINUE
  305. ELSE
  306. DO 40 I = 1,LENY
  307. Y(IY) = BETA*Y(IY)
  308. IY = IY + INCY
  309. 40 CONTINUE
  310. END IF
  311. END IF
  312. END IF
  313. IF (ALPHA.EQ.ZERO) RETURN
  314. KUP1 = KU + 1
  315. IF (LSAME(TRANS,'N')) THEN
  316. *
  317. * Form y := alpha*A*x + y.
  318. *
  319. JX = KX
  320. IF (INCY.EQ.1) THEN
  321. DO 60 J = 1,N
  322. TEMP = ALPHA*X(JX)
  323. K = KUP1 - J
  324. DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
  325. Y(I) = Y(I) + TEMP*A(K+I,J)
  326. 50 CONTINUE
  327. JX = JX + INCX
  328. 60 CONTINUE
  329. ELSE
  330. DO 80 J = 1,N
  331. TEMP = ALPHA*X(JX)
  332. IY = KY
  333. K = KUP1 - J
  334. DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
  335. Y(IY) = Y(IY) + TEMP*A(K+I,J)
  336. IY = IY + INCY
  337. 70 CONTINUE
  338. JX = JX + INCX
  339. IF (J.GT.KU) KY = KY + INCY
  340. 80 CONTINUE
  341. END IF
  342. ELSE
  343. *
  344. * Form y := alpha*A**T*x + y or y := alpha*A**H*x + y.
  345. *
  346. JY = KY
  347. IF (INCX.EQ.1) THEN
  348. DO 110 J = 1,N
  349. TEMP = ZERO
  350. K = KUP1 - J
  351. IF (NOCONJ) THEN
  352. DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
  353. TEMP = TEMP + A(K+I,J)*X(I)
  354. 90 CONTINUE
  355. ELSE
  356. DO 100 I = MAX(1,J-KU),MIN(M,J+KL)
  357. TEMP = TEMP + CONJG(A(K+I,J))*X(I)
  358. 100 CONTINUE
  359. END IF
  360. Y(JY) = Y(JY) + ALPHA*TEMP
  361. JY = JY + INCY
  362. 110 CONTINUE
  363. ELSE
  364. DO 140 J = 1,N
  365. TEMP = ZERO
  366. IX = KX
  367. K = KUP1 - J
  368. IF (NOCONJ) THEN
  369. DO 120 I = MAX(1,J-KU),MIN(M,J+KL)
  370. TEMP = TEMP + A(K+I,J)*X(IX)
  371. IX = IX + INCX
  372. 120 CONTINUE
  373. ELSE
  374. DO 130 I = MAX(1,J-KU),MIN(M,J+KL)
  375. TEMP = TEMP + CONJG(A(K+I,J))*X(IX)
  376. IX = IX + INCX
  377. 130 CONTINUE
  378. END IF
  379. Y(JY) = Y(JY) + ALPHA*TEMP
  380. JY = JY + INCY
  381. IF (J.GT.KU) KX = KX + INCX
  382. 140 CONTINUE
  383. END IF
  384. END IF
  385. *
  386. RETURN
  387. *
  388. * End of CGBMV .
  389. *
  390. END