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