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 A( LDA, * ), X( * ), Y( * )
16
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 DOUBLE PRECISION ONE, ZERO
99 parameter( one = 1.0d+0, zero = 0.0d+0 )
100
101
102 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
103 DOUBLE PRECISION ABSX, TALPHA, TEMP
104
105
106 LOGICAL LSAME
108
109
110 EXTERNAL xerbla
111
112
114
115
116
117
118
119 info = 0
120 IF( .NOT.
lsame( trans,
'N' ) .AND.
121 $ .NOT.
lsame( trans,
'T' ) .AND.
122 $ .NOT.
lsame( trans,
'C' ) )
THEN
123 info = 1
124 ELSE IF( m.LT.0 ) THEN
125 info = 2
126 ELSE IF( n.LT.0 ) THEN
127 info = 3
128 ELSE IF( lda.LT.
max( 1, m ) )
THEN
129 info = 6
130 ELSE IF( incx.EQ.0 ) THEN
131 info = 8
132 ELSE IF( incy.EQ.0 ) THEN
133 info = 11
134 END IF
135 IF( info.NE.0 ) THEN
136 CALL xerbla( 'DAGEMV', info )
137 RETURN
138 END IF
139
140
141
142 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
143 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
144 $ RETURN
145
146
147
148
149 IF(
lsame( trans,
'N' ) )
THEN
150 lenx = n
151 leny = m
152 ELSE
153 lenx = m
154 leny = n
155 END IF
156 IF( incx.GT.0 ) THEN
157 kx = 1
158 ELSE
159 kx = 1 - ( lenx - 1 )*incx
160 END IF
161 IF( incy.GT.0 ) THEN
162 ky = 1
163 ELSE
164 ky = 1 - ( leny - 1 )*incy
165 END IF
166
167
168
169
170
171
172 IF( incy.EQ.1 ) THEN
173 IF( beta.EQ.zero ) THEN
174 DO 10, i = 1, leny
175 y( i ) = zero
176 10 CONTINUE
177 ELSE IF( beta.EQ.one ) THEN
178 DO 20, i = 1, leny
179 y( i ) = abs( y( i ) )
180 20 CONTINUE
181 ELSE
182 DO 30, i = 1, leny
183 y( i ) = abs( beta * y( i ) )
184 30 CONTINUE
185 END IF
186 ELSE
187 iy = ky
188 IF( beta.EQ.zero ) THEN
189 DO 40, i = 1, leny
190 y( iy ) = zero
191 iy = iy + incy
192 40 CONTINUE
193 ELSE IF( beta.EQ.one ) THEN
194 DO 50, i = 1, leny
195 y( iy ) = abs( y( iy ) )
196 iy = iy + incy
197 50 CONTINUE
198 ELSE
199 DO 60, i = 1, leny
200 y( iy ) = abs( beta * y( iy ) )
201 iy = iy + incy
202 60 CONTINUE
203 END IF
204 END IF
205
206 IF( alpha.EQ.zero )
207 $ RETURN
208
209 talpha = abs( alpha )
210
211 IF(
lsame( trans,
'N' ) )
THEN
212
213
214
215 jx = kx
216 IF( incy.EQ.1 ) THEN
217 DO 80, j = 1, n
218 absx = abs( x( jx ) )
219 IF( absx.NE.zero ) THEN
220 temp = talpha * absx
221 DO 70, i = 1, m
222 y( i ) = y( i ) + temp * abs( a( i, j ) )
223 70 CONTINUE
224 END IF
225 jx = jx + incx
226 80 CONTINUE
227 ELSE
228 DO 100, j = 1, n
229 absx = abs( x( jx ) )
230 IF( absx.NE.zero ) THEN
231 temp = talpha * absx
232 iy = ky
233 DO 90, i = 1, m
234 y( iy ) = y( iy ) + temp * abs( a( i, j ) )
235 iy = iy + incy
236 90 CONTINUE
237 END IF
238 jx = jx + incx
239 100 CONTINUE
240 END IF
241
242 ELSE
243
244
245
246 jy = ky
247 IF( incx.EQ.1 ) THEN
248 DO 120, j = 1, n
249 temp = zero
250 DO 110, i = 1, m
251 temp = temp + abs( a( i, j ) * x( i ) )
252 110 CONTINUE
253 y( jy ) = y( jy ) + talpha * temp
254 jy = jy + incy
255 120 CONTINUE
256 ELSE
257 DO 140, j = 1, n
258 temp = zero
259 ix = kx
260 DO 130, i = 1, m
261 temp = temp + abs( a( i, j ) * x( ix ) )
262 ix = ix + incx
263 130 CONTINUE
264 y( jy ) = y( jy ) + talpha * temp
265 jy = jy + incy
266 140 CONTINUE
267 END IF
268 END IF
269
270 RETURN
271
272
273