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