Télécharger dgemv.eso

Retour à la liste

Numérotation des lignes :

  1. C DGEMV SOURCE BP208322 15/10/13 21:15:20 8670
  2. SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
  3. $ BETA, Y, INCY )
  4. * .. Scalar Arguments ..
  5. REAL*8 ALPHA, BETA
  6. INTEGER INCX, INCY, LDA, M, N
  7. CHARACTER*1 TRANS
  8. * .. Array Arguments ..
  9. REAL*8 A( LDA, * ), X( * ), Y( * )
  10. * ..
  11. *
  12. * Purpose
  13. * =======
  14. *
  15. * DGEMV performs one of the matrix-vector operations
  16. *
  17. * y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
  18. *
  19. * where alpha and beta are scalars, x and y are vectors and A is an
  20. * m by n matrix.
  21. *
  22. * Parameters
  23. * ==========
  24. *
  25. * TRANS - CHARACTER*1.
  26. * On entry, TRANS specifies the operation to be performed as
  27. * follows:
  28. *
  29. * TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
  30. *
  31. * TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
  32. *
  33. * TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
  34. *
  35. * Unchanged on exit.
  36. *
  37. * M - INTEGER.
  38. * On entry, M specifies the number of rows of the matrix A.
  39. * M must be at least zero.
  40. * Unchanged on exit.
  41. *
  42. * N - INTEGER.
  43. * On entry, N specifies the number of columns of the matrix A.
  44. * N must be at least zero.
  45. * Unchanged on exit.
  46. *
  47. * ALPHA - DOUBLE PRECISION.
  48. * On entry, ALPHA specifies the scalar alpha.
  49. * Unchanged on exit.
  50. *
  51. * A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
  52. * Before entry, the leading m by n part of the array A must
  53. * contain the matrix of coefficients.
  54. * Unchanged on exit.
  55. *
  56. * LDA - INTEGER.
  57. * On entry, LDA specifies the first dimension of A as declared
  58. * in the calling (sub) program. LDA must be at least
  59. * max( 1, m ).
  60. * Unchanged on exit.
  61. *
  62. * X - DOUBLE PRECISION array of DIMENSION at least
  63. * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
  64. * and at least
  65. * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
  66. * Before entry, the incremented array X must contain the
  67. * vector x.
  68. * Unchanged on exit.
  69. *
  70. * INCX - INTEGER.
  71. * On entry, INCX specifies the increment for the elements of
  72. * X. INCX must not be zero.
  73. * Unchanged on exit.
  74. *
  75. * BETA - DOUBLE PRECISION.
  76. * On entry, BETA specifies the scalar beta. When BETA is
  77. * supplied as zero then Y need not be set on input.
  78. * Unchanged on exit.
  79. *
  80. * Y - DOUBLE PRECISION array of DIMENSION at least
  81. * ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
  82. * and at least
  83. * ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
  84. * Before entry with BETA non-zero, the incremented array Y
  85. * must contain the vector y. On exit, Y is overwritten by the
  86. * updated vector y.
  87. *
  88. * INCY - INTEGER.
  89. * On entry, INCY specifies the increment for the elements of
  90. * Y. INCY must not be zero.
  91. * Unchanged on exit.
  92. *
  93. *
  94. * Level 2 Blas routine.
  95. *
  96. * -- Written on 22-October-1986.
  97. * Jack Dongarra, Argonne National Lab.
  98. * Jeremy Du Croz, Nag Central Office.
  99. * Sven Hammarling, Nag Central Office.
  100. * Richard Hanson, Sandia National Labs.
  101. *
  102. *
  103. * .. Parameters ..
  104. REAL*8 ONE , ZERO
  105. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  106. * .. Local Scalars ..
  107. REAL*8 TEMP
  108. INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
  109. * .. External Functions ..
  110. LOGICAL LSAME
  111. EXTERNAL LSAME
  112. * .. External Subroutines ..
  113. EXTERNAL XERBLA
  114. ** .. Intrinsic Functions ..
  115. * INTRINSIC MAX
  116. ** ..
  117. ** .. Executable Statements ..
  118. *
  119. * Test the input parameters.
  120. *
  121. INFO = 0
  122. IF ( .NOT.LSAME( TRANS, 'N' ).AND.
  123. $ .NOT.LSAME( TRANS, 'T' ).AND.
  124. $ .NOT.LSAME( TRANS, 'C' ) )THEN
  125. INFO = 1
  126. ELSE IF( M.LT.0 )THEN
  127. INFO = 2
  128. ELSE IF( N.LT.0 )THEN
  129. INFO = 3
  130. ELSE IF( LDA.LT.MAX( 1, M ) )THEN
  131. INFO = 6
  132. ELSE IF( INCX.EQ.0 )THEN
  133. INFO = 8
  134. ELSE IF( INCY.EQ.0 )THEN
  135. INFO = 11
  136. END IF
  137. IF( INFO.NE.0 )THEN
  138. CALL XERBLA( 'DGEMV ', INFO )
  139. RETURN
  140. END IF
  141. *
  142. * Quick return if possible.
  143. *
  144. IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
  145. $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
  146. $ RETURN
  147. *
  148. * Set LENX and LENY, the lengths of the vectors x and y, and set
  149. * up the start points in X and Y.
  150. *
  151. IF( LSAME( TRANS, 'N' ) )THEN
  152. LENX = N
  153. LENY = M
  154. ELSE
  155. LENX = M
  156. LENY = N
  157. END IF
  158. IF( INCX.GT.0 )THEN
  159. KX = 1
  160. ELSE
  161. KX = 1 - ( LENX - 1 )*INCX
  162. END IF
  163. IF( INCY.GT.0 )THEN
  164. KY = 1
  165. ELSE
  166. KY = 1 - ( LENY - 1 )*INCY
  167. END IF
  168. *
  169. * Start the operations. In this version the elements of A are
  170. * accessed sequentially with one pass through A.
  171. *
  172. * First form y := beta*y.
  173. *
  174. IF( BETA.NE.ONE )THEN
  175. IF( INCY.EQ.1 )THEN
  176. IF( BETA.EQ.ZERO )THEN
  177. DO 10, I = 1, LENY
  178. Y( I ) = ZERO
  179. 10 CONTINUE
  180. ELSE
  181. DO 20, I = 1, LENY
  182. Y( I ) = BETA*Y( I )
  183. 20 CONTINUE
  184. END IF
  185. ELSE
  186. IY = KY
  187. IF( BETA.EQ.ZERO )THEN
  188. DO 30, I = 1, LENY
  189. Y( IY ) = ZERO
  190. IY = IY + INCY
  191. 30 CONTINUE
  192. ELSE
  193. DO 40, I = 1, LENY
  194. Y( IY ) = BETA*Y( IY )
  195. IY = IY + INCY
  196. 40 CONTINUE
  197. END IF
  198. END IF
  199. END IF
  200. IF( ALPHA.EQ.ZERO )
  201. $ RETURN
  202. IF( LSAME( TRANS, 'N' ) )THEN
  203. *
  204. * Form y := alpha*A*x + y.
  205. *
  206. JX = KX
  207. IF( INCY.EQ.1 )THEN
  208. DO 60, J = 1, N
  209. IF( X( JX ).NE.ZERO )THEN
  210. TEMP = ALPHA*X( JX )
  211. DO 50, I = 1, M
  212. Y( I ) = Y( I ) + TEMP*A( I, J )
  213. 50 CONTINUE
  214. END IF
  215. JX = JX + INCX
  216. 60 CONTINUE
  217. ELSE
  218. DO 80, J = 1, N
  219. IF( X( JX ).NE.ZERO )THEN
  220. TEMP = ALPHA*X( JX )
  221. IY = KY
  222. DO 70, I = 1, M
  223. Y( IY ) = Y( IY ) + TEMP*A( I, J )
  224. IY = IY + INCY
  225. 70 CONTINUE
  226. END IF
  227. JX = JX + INCX
  228. 80 CONTINUE
  229. END IF
  230. ELSE
  231. *
  232. * Form y := alpha*A'*x + y.
  233. *
  234. JY = KY
  235. IF( INCX.EQ.1 )THEN
  236. DO 100, J = 1, N
  237. TEMP = ZERO
  238. DO 90, I = 1, M
  239. TEMP = TEMP + A( I, J )*X( I )
  240. 90 CONTINUE
  241. Y( JY ) = Y( JY ) + ALPHA*TEMP
  242. JY = JY + INCY
  243. 100 CONTINUE
  244. ELSE
  245. DO 120, J = 1, N
  246. TEMP = ZERO
  247. IX = KX
  248. DO 110, I = 1, M
  249. TEMP = TEMP + A( I, J )*X( IX )
  250. IX = IX + INCX
  251. 110 CONTINUE
  252. Y( JY ) = Y( JY ) + ALPHA*TEMP
  253. JY = JY + INCY
  254. 120 CONTINUE
  255. END IF
  256. END IF
  257. *
  258. RETURN
  259. *
  260. * End of DGEMV .
  261. *
  262. END
  263.  
  264.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales