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.

sger.f 5.6 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227
  1. *> \brief \b SGER
  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 SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
  12. *
  13. * .. Scalar Arguments ..
  14. * REAL ALPHA
  15. * INTEGER INCX,INCY,LDA,M,N
  16. * ..
  17. * .. Array Arguments ..
  18. * REAL A(LDA,*),X(*),Y(*)
  19. * ..
  20. *
  21. *
  22. *> \par Purpose:
  23. * =============
  24. *>
  25. *> \verbatim
  26. *>
  27. *> SGER performs the rank 1 operation
  28. *>
  29. *> A := alpha*x*y**T + A,
  30. *>
  31. *> where alpha is a scalar, x is an m element vector, y is an n element
  32. *> vector and A is an m by n matrix.
  33. *> \endverbatim
  34. *
  35. * Arguments:
  36. * ==========
  37. *
  38. *> \param[in] M
  39. *> \verbatim
  40. *> M is INTEGER
  41. *> On entry, M specifies the number of rows of the matrix A.
  42. *> M must be at least zero.
  43. *> \endverbatim
  44. *>
  45. *> \param[in] N
  46. *> \verbatim
  47. *> N is INTEGER
  48. *> On entry, N specifies the number of columns of the matrix A.
  49. *> N must be at least zero.
  50. *> \endverbatim
  51. *>
  52. *> \param[in] ALPHA
  53. *> \verbatim
  54. *> ALPHA is REAL
  55. *> On entry, ALPHA specifies the scalar alpha.
  56. *> \endverbatim
  57. *>
  58. *> \param[in] X
  59. *> \verbatim
  60. *> X is REAL array, dimension at least
  61. *> ( 1 + ( m - 1 )*abs( INCX ) ).
  62. *> Before entry, the incremented array X must contain the m
  63. *> element vector x.
  64. *> \endverbatim
  65. *>
  66. *> \param[in] INCX
  67. *> \verbatim
  68. *> INCX is INTEGER
  69. *> On entry, INCX specifies the increment for the elements of
  70. *> X. INCX must not be zero.
  71. *> \endverbatim
  72. *>
  73. *> \param[in] Y
  74. *> \verbatim
  75. *> Y is REAL array, dimension at least
  76. *> ( 1 + ( n - 1 )*abs( INCY ) ).
  77. *> Before entry, the incremented array Y must contain the n
  78. *> element vector y.
  79. *> \endverbatim
  80. *>
  81. *> \param[in] INCY
  82. *> \verbatim
  83. *> INCY is INTEGER
  84. *> On entry, INCY specifies the increment for the elements of
  85. *> Y. INCY must not be zero.
  86. *> \endverbatim
  87. *>
  88. *> \param[in,out] A
  89. *> \verbatim
  90. *> A is REAL array, dimension ( LDA, N )
  91. *> Before entry, the leading m by n part of the array A must
  92. *> contain the matrix of coefficients. On exit, A is
  93. *> overwritten by the updated matrix.
  94. *> \endverbatim
  95. *>
  96. *> \param[in] LDA
  97. *> \verbatim
  98. *> LDA is INTEGER
  99. *> On entry, LDA specifies the first dimension of A as declared
  100. *> in the calling (sub) program. LDA must be at least
  101. *> max( 1, m ).
  102. *> \endverbatim
  103. *
  104. * Authors:
  105. * ========
  106. *
  107. *> \author Univ. of Tennessee
  108. *> \author Univ. of California Berkeley
  109. *> \author Univ. of Colorado Denver
  110. *> \author NAG Ltd.
  111. *
  112. *> \date December 2016
  113. *
  114. *> \ingroup single_blas_level2
  115. *
  116. *> \par Further Details:
  117. * =====================
  118. *>
  119. *> \verbatim
  120. *>
  121. *> Level 2 Blas routine.
  122. *>
  123. *> -- Written on 22-October-1986.
  124. *> Jack Dongarra, Argonne National Lab.
  125. *> Jeremy Du Croz, Nag Central Office.
  126. *> Sven Hammarling, Nag Central Office.
  127. *> Richard Hanson, Sandia National Labs.
  128. *> \endverbatim
  129. *>
  130. * =====================================================================
  131. SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
  132. *
  133. * -- Reference BLAS level2 routine (version 3.7.0) --
  134. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  135. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  136. * December 2016
  137. *
  138. * .. Scalar Arguments ..
  139. REAL ALPHA
  140. INTEGER INCX,INCY,LDA,M,N
  141. * ..
  142. * .. Array Arguments ..
  143. REAL A(LDA,*),X(*),Y(*)
  144. * ..
  145. *
  146. * =====================================================================
  147. *
  148. * .. Parameters ..
  149. REAL ZERO
  150. PARAMETER (ZERO=0.0E+0)
  151. * ..
  152. * .. Local Scalars ..
  153. REAL TEMP
  154. INTEGER I,INFO,IX,J,JY,KX
  155. * ..
  156. * .. External Subroutines ..
  157. EXTERNAL XERBLA
  158. * ..
  159. * .. Intrinsic Functions ..
  160. INTRINSIC MAX
  161. * ..
  162. *
  163. * Test the input parameters.
  164. *
  165. INFO = 0
  166. IF (M.LT.0) THEN
  167. INFO = 1
  168. ELSE IF (N.LT.0) THEN
  169. INFO = 2
  170. ELSE IF (INCX.EQ.0) THEN
  171. INFO = 5
  172. ELSE IF (INCY.EQ.0) THEN
  173. INFO = 7
  174. ELSE IF (LDA.LT.MAX(1,M)) THEN
  175. INFO = 9
  176. END IF
  177. IF (INFO.NE.0) THEN
  178. CALL XERBLA('SGER ',INFO)
  179. RETURN
  180. END IF
  181. *
  182. * Quick return if possible.
  183. *
  184. IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
  185. *
  186. * Start the operations. In this version the elements of A are
  187. * accessed sequentially with one pass through A.
  188. *
  189. IF (INCY.GT.0) THEN
  190. JY = 1
  191. ELSE
  192. JY = 1 - (N-1)*INCY
  193. END IF
  194. IF (INCX.EQ.1) THEN
  195. DO 20 J = 1,N
  196. IF (Y(JY).NE.ZERO) THEN
  197. TEMP = ALPHA*Y(JY)
  198. DO 10 I = 1,M
  199. A(I,J) = A(I,J) + X(I)*TEMP
  200. 10 CONTINUE
  201. END IF
  202. JY = JY + INCY
  203. 20 CONTINUE
  204. ELSE
  205. IF (INCX.GT.0) THEN
  206. KX = 1
  207. ELSE
  208. KX = 1 - (M-1)*INCX
  209. END IF
  210. DO 40 J = 1,N
  211. IF (Y(JY).NE.ZERO) THEN
  212. TEMP = ALPHA*Y(JY)
  213. IX = KX
  214. DO 30 I = 1,M
  215. A(I,J) = A(I,J) + X(IX)*TEMP
  216. IX = IX + INCX
  217. 30 CONTINUE
  218. END IF
  219. JY = JY + INCY
  220. 40 CONTINUE
  221. END IF
  222. *
  223. RETURN
  224. *
  225. * End of SGER .
  226. *
  227. END