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