1
2 /* -- translated by f2c (version 19940927).
3 You must link the resulting object file with the libraries:
4 -lf2c -lm (in that order)
5 */
6
7 #include "f2c.h"
8
sgemv_(char * trans,integer * m,integer * n,real * alpha,real * a,integer * lda,real * x,integer * incx,real * beta,real * y,integer * incy)9 /* Subroutine */ int sgemv_(char *trans, integer *m, integer *n, real *alpha,
10 real *a, integer *lda, real *x, integer *incx, real *beta, real *y,
11 integer *incy)
12 {
13
14
15 /* System generated locals */
16 integer a_dim1, a_offset, i__1, i__2;
17
18 /* Local variables */
19 static integer info;
20 static real temp;
21 static integer lenx, leny, i, j;
22 extern logical lsame_(char *, char *);
23 static integer ix, iy, jx, jy, kx, ky;
24 extern /* Subroutine */ int xerbla_(char *, integer *);
25
26
27 /* Purpose
28 =======
29
30 SGEMV performs one of the matrix-vector operations
31
32 y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
33
34 where alpha and beta are scalars, x and y are vectors and A is an
35 m by n matrix.
36
37 Parameters
38 ==========
39
40 TRANS - CHARACTER*1.
41 On entry, TRANS specifies the operation to be performed as
42 follows:
43
44 TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
45
46 TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
47
48 TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
49
50 Unchanged on exit.
51
52 M - INTEGER.
53 On entry, M specifies the number of rows of the matrix A.
54 M must be at least zero.
55 Unchanged on exit.
56
57 N - INTEGER.
58 On entry, N specifies the number of columns of the matrix A.
59
60 N must be at least zero.
61 Unchanged on exit.
62
63 ALPHA - REAL .
64 On entry, ALPHA specifies the scalar alpha.
65 Unchanged on exit.
66
67 A - REAL array of DIMENSION ( LDA, n ).
68 Before entry, the leading m by n part of the array A must
69 contain the matrix of coefficients.
70 Unchanged on exit.
71
72 LDA - INTEGER.
73 On entry, LDA specifies the first dimension of A as declared
74
75 in the calling (sub) program. LDA must be at least
76 max( 1, m ).
77 Unchanged on exit.
78
79 X - REAL array of DIMENSION at least
80 ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
81 and at least
82 ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
83 Before entry, the incremented array X must contain the
84 vector x.
85 Unchanged on exit.
86
87 INCX - INTEGER.
88 On entry, INCX specifies the increment for the elements of
89 X. INCX must not be zero.
90 Unchanged on exit.
91
92 BETA - REAL .
93 On entry, BETA specifies the scalar beta. When BETA is
94 supplied as zero then Y need not be set on input.
95 Unchanged on exit.
96
97 Y - REAL array of DIMENSION at least
98 ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
99 and at least
100 ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
101 Before entry with BETA non-zero, the incremented array Y
102 must contain the vector y. On exit, Y is overwritten by the
103
104 updated vector y.
105
106 INCY - INTEGER.
107 On entry, INCY specifies the increment for the elements of
108 Y. INCY must not be zero.
109 Unchanged on exit.
110
111
112 Level 2 Blas routine.
113
114 -- Written on 22-October-1986.
115 Jack Dongarra, Argonne National Lab.
116 Jeremy Du Croz, Nag Central Office.
117 Sven Hammarling, Nag Central Office.
118 Richard Hanson, Sandia National Labs.
119
120
121
122 Test the input parameters.
123
124
125 Parameter adjustments
126 Function Body */
127 #define X(I) x[(I)-1]
128 #define Y(I) y[(I)-1]
129
130 #define A(I,J) a[(I)-1 + ((J)-1)* ( *lda)]
131
132 info = 0;
133 if (! lsame_(trans, "N") && ! lsame_(trans, "T") && !
134 lsame_(trans, "C")) {
135 info = 1;
136 } else if (*m < 0) {
137 info = 2;
138 } else if (*n < 0) {
139 info = 3;
140 } else if (*lda < max(1,*m)) {
141 info = 6;
142 } else if (*incx == 0) {
143 info = 8;
144 } else if (*incy == 0) {
145 info = 11;
146 }
147 if (info != 0) {
148 xerbla_("SGEMV ", &info);
149 return 0;
150 }
151
152 /* Quick return if possible. */
153
154 if (*m == 0 || *n == 0 || *alpha == 0.f && *beta == 1.f) {
155 return 0;
156 }
157
158 /* Set LENX and LENY, the lengths of the vectors x and y, and set
159
160 up the start points in X and Y. */
161
162 if (lsame_(trans, "N")) {
163 lenx = *n;
164 leny = *m;
165 } else {
166 lenx = *m;
167 leny = *n;
168 }
169 if (*incx > 0) {
170 kx = 1;
171 } else {
172 kx = 1 - (lenx - 1) * *incx;
173 }
174 if (*incy > 0) {
175 ky = 1;
176 } else {
177 ky = 1 - (leny - 1) * *incy;
178 }
179
180 /* Start the operations. In this version the elements of A are
181 accessed sequentially with one pass through A.
182
183 First form y := beta*y. */
184
185 if (*beta != 1.f) {
186 if (*incy == 1) {
187 if (*beta == 0.f) {
188 i__1 = leny;
189 for (i = 1; i <= leny; ++i) {
190 Y(i) = 0.f;
191 /* L10: */
192 }
193 } else {
194 i__1 = leny;
195 for (i = 1; i <= leny; ++i) {
196 Y(i) = *beta * Y(i);
197 /* L20: */
198 }
199 }
200 } else {
201 iy = ky;
202 if (*beta == 0.f) {
203 i__1 = leny;
204 for (i = 1; i <= leny; ++i) {
205 Y(iy) = 0.f;
206 iy += *incy;
207 /* L30: */
208 }
209 } else {
210 i__1 = leny;
211 for (i = 1; i <= leny; ++i) {
212 Y(iy) = *beta * Y(iy);
213 iy += *incy;
214 /* L40: */
215 }
216 }
217 }
218 }
219 if (*alpha == 0.f) {
220 return 0;
221 }
222 if (lsame_(trans, "N")) {
223
224 /* Form y := alpha*A*x + y. */
225
226 jx = kx;
227 if (*incy == 1) {
228 i__1 = *n;
229 for (j = 1; j <= *n; ++j) {
230 if (X(jx) != 0.f) {
231 temp = *alpha * X(jx);
232 i__2 = *m;
233 for (i = 1; i <= *m; ++i) {
234 Y(i) += temp * A(i,j);
235 /* L50: */
236 }
237 }
238 jx += *incx;
239 /* L60: */
240 }
241 } else {
242 i__1 = *n;
243 for (j = 1; j <= *n; ++j) {
244 if (X(jx) != 0.f) {
245 temp = *alpha * X(jx);
246 iy = ky;
247 i__2 = *m;
248 for (i = 1; i <= *m; ++i) {
249 Y(iy) += temp * A(i,j);
250 iy += *incy;
251 /* L70: */
252 }
253 }
254 jx += *incx;
255 /* L80: */
256 }
257 }
258 } else {
259
260 /* Form y := alpha*A'*x + y. */
261
262 jy = ky;
263 if (*incx == 1) {
264 i__1 = *n;
265 for (j = 1; j <= *n; ++j) {
266 temp = 0.f;
267 i__2 = *m;
268 for (i = 1; i <= *m; ++i) {
269 temp += A(i,j) * X(i);
270 /* L90: */
271 }
272 Y(jy) += *alpha * temp;
273 jy += *incy;
274 /* L100: */
275 }
276 } else {
277 i__1 = *n;
278 for (j = 1; j <= *n; ++j) {
279 temp = 0.f;
280 ix = kx;
281 i__2 = *m;
282 for (i = 1; i <= *m; ++i) {
283 temp += A(i,j) * X(ix);
284 ix += *incx;
285 /* L110: */
286 }
287 Y(jy) += *alpha * temp;
288 jy += *incy;
289 /* L120: */
290 }
291 }
292 }
293
294 return 0;
295
296 /* End of SGEMV . */
297
298 } /* sgemv_ */
299
300