3
4
5
6
7
8
9
10 CHARACTER*1 TRANS
11 INTEGER INCX, INCY, LDA, M, N
12 DOUBLE PRECISION ALPHA, BETA
13
14
15 DOUBLE PRECISION Y( * )
16 COMPLEX*16 A( LDA, * ), X( * )
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104 DOUBLE PRECISION ONE, ZERO
105 parameter( one = 1.0d+0, zero = 0.0d+0 )
106
107
108 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
109 DOUBLE PRECISION ABSX, TALPHA, TEMP
110 COMPLEX*16 ZDUM
111
112
113 LOGICAL LSAME
115
116
117 EXTERNAL xerbla
118
119
120 INTRINSIC abs, dble, dimag,
max
121
122
123 DOUBLE PRECISION CABS1
124 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
125
126
127
128
129
130 info = 0
131 IF( .NOT.
lsame( trans,
'N' ) .AND.
132 $ .NOT.
lsame( trans,
'T' ) .AND.
133 $ .NOT.
lsame( trans,
'C' ) )
THEN
134 info = 1
135 ELSE IF( m.LT.0 ) THEN
136 info = 2
137 ELSE IF( n.LT.0 ) THEN
138 info = 3
139 ELSE IF( lda.LT.
max( 1, m ) )
THEN
140 info = 6
141 ELSE IF( incx.EQ.0 ) THEN
142 info = 8
143 ELSE IF( incy.EQ.0 ) THEN
144 info = 11
145 END IF
146 IF( info.NE.0 ) THEN
147 CALL xerbla( 'ZAGEMV', info )
148 RETURN
149 END IF
150
151
152
153 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
154 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
155 $ RETURN
156
157
158
159
160 IF(
lsame( trans,
'N' ) )
THEN
161 lenx = n
162 leny = m
163 ELSE
164 lenx = m
165 leny = n
166 END IF
167 IF( incx.GT.0 ) THEN
168 kx = 1
169 ELSE
170 kx = 1 - ( lenx - 1 )*incx
171 END IF
172 IF( incy.GT.0 ) THEN
173 ky = 1
174 ELSE
175 ky = 1 - ( leny - 1 )*incy
176 END IF
177
178
179
180
181
182
183 IF( incy.EQ.1 ) THEN
184 IF( beta.EQ.zero ) THEN
185 DO 10, i = 1, leny
186 y( i ) = zero
187 10 CONTINUE
188 ELSE IF( beta.EQ.one ) THEN
189 DO 20, i = 1, leny
190 y( i ) = abs( y( i ) )
191 20 CONTINUE
192 ELSE
193 DO 30, i = 1, leny
194 y( i ) = abs( beta * y( i ) )
195 30 CONTINUE
196 END IF
197 ELSE
198 iy = ky
199 IF( beta.EQ.zero ) THEN
200 DO 40, i = 1, leny
201 y( iy ) = zero
202 iy = iy + incy
203 40 CONTINUE
204 ELSE IF( beta.EQ.one ) THEN
205 DO 50, i = 1, leny
206 y( iy ) = abs( y( iy ) )
207 iy = iy + incy
208 50 CONTINUE
209 ELSE
210 DO 60, i = 1, leny
211 y( iy ) = abs( beta * y( iy ) )
212 iy = iy + incy
213 60 CONTINUE
214 END IF
215 END IF
216
217 IF( alpha.EQ.zero )
218 $ RETURN
219
220 talpha = abs( alpha )
221
222 IF(
lsame( trans,
'N' ) )
THEN
223
224
225
226 jx = kx
227 IF( incy.EQ.1 ) THEN
228 DO 80, j = 1, n
229 absx = cabs1( x( jx ) )
230 IF( absx.NE.zero ) THEN
231 temp = talpha * absx
232 DO 70, i = 1, m
233 y( i ) = y( i ) + temp * cabs1( a( i, j ) )
234 70 CONTINUE
235 END IF
236 jx = jx + incx
237 80 CONTINUE
238 ELSE
239 DO 100, j = 1, n
240 absx = cabs1( x( jx ) )
241 IF( absx.NE.zero ) THEN
242 temp = talpha * absx
243 iy = ky
244 DO 90, i = 1, m
245 y( iy ) = y( iy ) + temp * cabs1( a( i, j ) )
246 iy = iy + incy
247 90 CONTINUE
248 END IF
249 jx = jx + incx
250 100 CONTINUE
251 END IF
252
253 ELSE
254
255
256
257 jy = ky
258 IF( incx.EQ.1 ) THEN
259 DO 120, j = 1, n
260 temp = zero
261 DO 110, i = 1, m
262 temp = temp + cabs1( a( i, j ) ) * cabs1( x( i ) )
263 110 CONTINUE
264 y( jy ) = y( jy ) + talpha * temp
265 jy = jy + incy
266 120 CONTINUE
267 ELSE
268 DO 140, j = 1, n
269 temp = zero
270 ix = kx
271 DO 130, i = 1, m
272 temp = temp + cabs1( a( i, j ) ) * cabs1( x( ix ) )
273 ix = ix + incx
274 130 CONTINUE
275 y( jy ) = y( jy ) + talpha * temp
276 jy = jy + incy
277 140 CONTINUE
278 END IF
279 END IF
280
281 RETURN
282
283
284