1 SUBROUTINE ZLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
2 $ Y, INCY )
3 *
4 * -- LAPACK routine (version 3.3.1) --
5 * -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
6 * -- Jason Riedy of Univ. of California Berkeley. --
7 * -- June 2010 --
8 *
9 * -- LAPACK is a software package provided by Univ. of Tennessee, --
10 * -- Univ. of California Berkeley and NAG Ltd. --
11 *
12 IMPLICIT NONE
13 * ..
14 * .. Scalar Arguments ..
15 DOUBLE PRECISION ALPHA, BETA
16 INTEGER INCX, INCY, LDA, M, N
17 INTEGER TRANS
18 * ..
19 * .. Array Arguments ..
20 COMPLEX*16 A( LDA, * ), X( * )
21 DOUBLE PRECISION Y( * )
22 * ..
23 *
24 * Purpose
25 * =======
26 *
27 * ZLA_GEAMV performs one of the matrix-vector operations
28 *
29 * y := alpha*abs(A)*abs(x) + beta*abs(y),
30 * or y := alpha*abs(A)**T*abs(x) + beta*abs(y),
31 *
32 * where alpha and beta are scalars, x and y are vectors and A is an
33 * m by n matrix.
34 *
35 * This function is primarily used in calculating error bounds.
36 * To protect against underflow during evaluation, components in
37 * the resulting vector are perturbed away from zero by (N+1)
38 * times the underflow threshold. To prevent unnecessarily large
39 * errors for block-structure embedded in general matrices,
40 * "symbolically" zero components are not perturbed. A zero
41 * entry is considered "symbolic" if all multiplications involved
42 * in computing that entry have at least one zero multiplicand.
43 *
44 * Arguments
45 * ==========
46 *
47 * TRANS (input) INTEGER
48 * On entry, TRANS specifies the operation to be performed as
49 * follows:
50 *
51 * BLAS_NO_TRANS y := alpha*abs(A)*abs(x) + beta*abs(y)
52 * BLAS_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
53 * BLAS_CONJ_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
54 *
55 * Unchanged on exit.
56 *
57 * M (input) INTEGER
58 * On entry, M specifies the number of rows of the matrix A.
59 * M must be at least zero.
60 * Unchanged on exit.
61 *
62 * N (input) INTEGER
63 * On entry, N specifies the number of columns of the matrix A.
64 * N must be at least zero.
65 * Unchanged on exit.
66 *
67 * ALPHA (input) DOUBLE PRECISION
68 * On entry, ALPHA specifies the scalar alpha.
69 * Unchanged on exit.
70 *
71 * A (input) COMPLEX*16 array of DIMENSION ( LDA, n )
72 * Before entry, the leading m by n part of the array A must
73 * contain the matrix of coefficients.
74 * Unchanged on exit.
75 *
76 * LDA (input) INTEGER
77 * On entry, LDA specifies the first dimension of A as declared
78 * in the calling (sub) program. LDA must be at least
79 * max( 1, m ).
80 * Unchanged on exit.
81 *
82 * X (input) COMPLEX*16 array of DIMENSION at least
83 * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
84 * and at least
85 * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
86 * Before entry, the incremented array X must contain the
87 * vector x.
88 * Unchanged on exit.
89 *
90 * INCX (input) INTEGER
91 * On entry, INCX specifies the increment for the elements of
92 * X. INCX must not be zero.
93 * Unchanged on exit.
94 *
95 * BETA (input) DOUBLE PRECISION
96 * On entry, BETA specifies the scalar beta. When BETA is
97 * supplied as zero then Y need not be set on input.
98 * Unchanged on exit.
99 *
100 * Y (input/output) DOUBLE PRECISION array, dimension
101 * ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
102 * and at least
103 * ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
104 * Before entry with BETA non-zero, the incremented array Y
105 * must contain the vector y. On exit, Y is overwritten by the
106 * updated vector y.
107 *
108 * INCY (input) INTEGER
109 * On entry, INCY specifies the increment for the elements of
110 * Y. INCY must not be zero.
111 * Unchanged on exit.
112 *
113 *
114 * Level 2 Blas routine.
115 *
116 * =====================================================================
117 *
118 * .. Parameters ..
119 COMPLEX*16 ONE, ZERO
120 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
121 * ..
122 * .. Local Scalars ..
123 LOGICAL SYMB_ZERO
124 DOUBLE PRECISION TEMP, SAFE1
125 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY
126 COMPLEX*16 CDUM
127 * ..
128 * .. External Subroutines ..
129 EXTERNAL XERBLA, DLAMCH
130 DOUBLE PRECISION DLAMCH
131 * ..
132 * .. External Functions ..
133 EXTERNAL ILATRANS
134 INTEGER ILATRANS
135 * ..
136 * .. Intrinsic Functions ..
137 INTRINSIC MAX, ABS, REAL, DIMAG, SIGN
138 * ..
139 * .. Statement Functions ..
140 DOUBLE PRECISION CABS1
141 * ..
142 * .. Statement Function Definitions ..
143 CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
144 * ..
145 * .. Executable Statements ..
146 *
147 * Test the input parameters.
148 *
149 INFO = 0
150 IF ( .NOT.( ( TRANS.EQ.ILATRANS( 'N' ) )
151 $ .OR. ( TRANS.EQ.ILATRANS( 'T' ) )
152 $ .OR. ( TRANS.EQ.ILATRANS( 'C' ) ) ) ) THEN
153 INFO = 1
154 ELSE IF( M.LT.0 )THEN
155 INFO = 2
156 ELSE IF( N.LT.0 )THEN
157 INFO = 3
158 ELSE IF( LDA.LT.MAX( 1, M ) )THEN
159 INFO = 6
160 ELSE IF( INCX.EQ.0 )THEN
161 INFO = 8
162 ELSE IF( INCY.EQ.0 )THEN
163 INFO = 11
164 END IF
165 IF( INFO.NE.0 )THEN
166 CALL XERBLA( 'ZLA_GEAMV ', INFO )
167 RETURN
168 END IF
169 *
170 * Quick return if possible.
171 *
172 IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
173 $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
174 $ RETURN
175 *
176 * Set LENX and LENY, the lengths of the vectors x and y, and set
177 * up the start points in X and Y.
178 *
179 IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
180 LENX = N
181 LENY = M
182 ELSE
183 LENX = M
184 LENY = N
185 END IF
186 IF( INCX.GT.0 )THEN
187 KX = 1
188 ELSE
189 KX = 1 - ( LENX - 1 )*INCX
190 END IF
191 IF( INCY.GT.0 )THEN
192 KY = 1
193 ELSE
194 KY = 1 - ( LENY - 1 )*INCY
195 END IF
196 *
197 * Set SAFE1 essentially to be the underflow threshold times the
198 * number of additions in each row.
199 *
200 SAFE1 = DLAMCH( 'Safe minimum' )
201 SAFE1 = (N+1)*SAFE1
202 *
203 * Form y := alpha*abs(A)*abs(x) + beta*abs(y).
204 *
205 * The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
206 * the inexact flag. Still doesn't help change the iteration order
207 * to per-column.
208 *
209 IY = KY
210 IF ( INCX.EQ.1 ) THEN
211 IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
212 DO I = 1, LENY
213 IF ( BETA .EQ. 0.0D+0 ) THEN
214 SYMB_ZERO = .TRUE.
215 Y( IY ) = 0.0D+0
216 ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
217 SYMB_ZERO = .TRUE.
218 ELSE
219 SYMB_ZERO = .FALSE.
220 Y( IY ) = BETA * ABS( Y( IY ) )
221 END IF
222 IF ( ALPHA .NE. 0.0D+0 ) THEN
223 DO J = 1, LENX
224 TEMP = CABS1( A( I, J ) )
225 SYMB_ZERO = SYMB_ZERO .AND.
226 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
227
228 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
229 END DO
230 END IF
231
232 IF ( .NOT.SYMB_ZERO ) Y( IY ) =
233 $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
234
235 IY = IY + INCY
236 END DO
237 ELSE
238 DO I = 1, LENY
239 IF ( BETA .EQ. 0.0D+0 ) THEN
240 SYMB_ZERO = .TRUE.
241 Y( IY ) = 0.0D+0
242 ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
243 SYMB_ZERO = .TRUE.
244 ELSE
245 SYMB_ZERO = .FALSE.
246 Y( IY ) = BETA * ABS( Y( IY ) )
247 END IF
248 IF ( ALPHA .NE. 0.0D+0 ) THEN
249 DO J = 1, LENX
250 TEMP = CABS1( A( J, I ) )
251 SYMB_ZERO = SYMB_ZERO .AND.
252 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
253
254 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
255 END DO
256 END IF
257
258 IF ( .NOT.SYMB_ZERO ) Y( IY ) =
259 $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
260
261 IY = IY + INCY
262 END DO
263 END IF
264 ELSE
265 IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
266 DO I = 1, LENY
267 IF ( BETA .EQ. 0.0D+0 ) THEN
268 SYMB_ZERO = .TRUE.
269 Y( IY ) = 0.0D+0
270 ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
271 SYMB_ZERO = .TRUE.
272 ELSE
273 SYMB_ZERO = .FALSE.
274 Y( IY ) = BETA * ABS( Y( IY ) )
275 END IF
276 IF ( ALPHA .NE. 0.0D+0 ) THEN
277 JX = KX
278 DO J = 1, LENX
279 TEMP = CABS1( A( I, J ) )
280 SYMB_ZERO = SYMB_ZERO .AND.
281 $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
282
283 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
284 JX = JX + INCX
285 END DO
286 END IF
287
288 IF ( .NOT.SYMB_ZERO ) Y( IY ) =
289 $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
290
291 IY = IY + INCY
292 END DO
293 ELSE
294 DO I = 1, LENY
295 IF ( BETA .EQ. 0.0D+0 ) THEN
296 SYMB_ZERO = .TRUE.
297 Y( IY ) = 0.0D+0
298 ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
299 SYMB_ZERO = .TRUE.
300 ELSE
301 SYMB_ZERO = .FALSE.
302 Y( IY ) = BETA * ABS( Y( IY ) )
303 END IF
304 IF ( ALPHA .NE. 0.0D+0 ) THEN
305 JX = KX
306 DO J = 1, LENX
307 TEMP = CABS1( A( J, I ) )
308 SYMB_ZERO = SYMB_ZERO .AND.
309 $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
310
311 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
312 JX = JX + INCX
313 END DO
314 END IF
315
316 IF ( .NOT.SYMB_ZERO ) Y( IY ) =
317 $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
318
319 IY = IY + INCY
320 END DO
321 END IF
322
323 END IF
324 *
325 RETURN
326 *
327 * End of ZLA_GEAMV
328 *
329 END
2 $ Y, INCY )
3 *
4 * -- LAPACK routine (version 3.3.1) --
5 * -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
6 * -- Jason Riedy of Univ. of California Berkeley. --
7 * -- June 2010 --
8 *
9 * -- LAPACK is a software package provided by Univ. of Tennessee, --
10 * -- Univ. of California Berkeley and NAG Ltd. --
11 *
12 IMPLICIT NONE
13 * ..
14 * .. Scalar Arguments ..
15 DOUBLE PRECISION ALPHA, BETA
16 INTEGER INCX, INCY, LDA, M, N
17 INTEGER TRANS
18 * ..
19 * .. Array Arguments ..
20 COMPLEX*16 A( LDA, * ), X( * )
21 DOUBLE PRECISION Y( * )
22 * ..
23 *
24 * Purpose
25 * =======
26 *
27 * ZLA_GEAMV performs one of the matrix-vector operations
28 *
29 * y := alpha*abs(A)*abs(x) + beta*abs(y),
30 * or y := alpha*abs(A)**T*abs(x) + beta*abs(y),
31 *
32 * where alpha and beta are scalars, x and y are vectors and A is an
33 * m by n matrix.
34 *
35 * This function is primarily used in calculating error bounds.
36 * To protect against underflow during evaluation, components in
37 * the resulting vector are perturbed away from zero by (N+1)
38 * times the underflow threshold. To prevent unnecessarily large
39 * errors for block-structure embedded in general matrices,
40 * "symbolically" zero components are not perturbed. A zero
41 * entry is considered "symbolic" if all multiplications involved
42 * in computing that entry have at least one zero multiplicand.
43 *
44 * Arguments
45 * ==========
46 *
47 * TRANS (input) INTEGER
48 * On entry, TRANS specifies the operation to be performed as
49 * follows:
50 *
51 * BLAS_NO_TRANS y := alpha*abs(A)*abs(x) + beta*abs(y)
52 * BLAS_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
53 * BLAS_CONJ_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
54 *
55 * Unchanged on exit.
56 *
57 * M (input) INTEGER
58 * On entry, M specifies the number of rows of the matrix A.
59 * M must be at least zero.
60 * Unchanged on exit.
61 *
62 * N (input) INTEGER
63 * On entry, N specifies the number of columns of the matrix A.
64 * N must be at least zero.
65 * Unchanged on exit.
66 *
67 * ALPHA (input) DOUBLE PRECISION
68 * On entry, ALPHA specifies the scalar alpha.
69 * Unchanged on exit.
70 *
71 * A (input) COMPLEX*16 array of DIMENSION ( LDA, n )
72 * Before entry, the leading m by n part of the array A must
73 * contain the matrix of coefficients.
74 * Unchanged on exit.
75 *
76 * LDA (input) INTEGER
77 * On entry, LDA specifies the first dimension of A as declared
78 * in the calling (sub) program. LDA must be at least
79 * max( 1, m ).
80 * Unchanged on exit.
81 *
82 * X (input) COMPLEX*16 array of DIMENSION at least
83 * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
84 * and at least
85 * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
86 * Before entry, the incremented array X must contain the
87 * vector x.
88 * Unchanged on exit.
89 *
90 * INCX (input) INTEGER
91 * On entry, INCX specifies the increment for the elements of
92 * X. INCX must not be zero.
93 * Unchanged on exit.
94 *
95 * BETA (input) DOUBLE PRECISION
96 * On entry, BETA specifies the scalar beta. When BETA is
97 * supplied as zero then Y need not be set on input.
98 * Unchanged on exit.
99 *
100 * Y (input/output) DOUBLE PRECISION array, dimension
101 * ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
102 * and at least
103 * ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
104 * Before entry with BETA non-zero, the incremented array Y
105 * must contain the vector y. On exit, Y is overwritten by the
106 * updated vector y.
107 *
108 * INCY (input) INTEGER
109 * On entry, INCY specifies the increment for the elements of
110 * Y. INCY must not be zero.
111 * Unchanged on exit.
112 *
113 *
114 * Level 2 Blas routine.
115 *
116 * =====================================================================
117 *
118 * .. Parameters ..
119 COMPLEX*16 ONE, ZERO
120 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
121 * ..
122 * .. Local Scalars ..
123 LOGICAL SYMB_ZERO
124 DOUBLE PRECISION TEMP, SAFE1
125 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY
126 COMPLEX*16 CDUM
127 * ..
128 * .. External Subroutines ..
129 EXTERNAL XERBLA, DLAMCH
130 DOUBLE PRECISION DLAMCH
131 * ..
132 * .. External Functions ..
133 EXTERNAL ILATRANS
134 INTEGER ILATRANS
135 * ..
136 * .. Intrinsic Functions ..
137 INTRINSIC MAX, ABS, REAL, DIMAG, SIGN
138 * ..
139 * .. Statement Functions ..
140 DOUBLE PRECISION CABS1
141 * ..
142 * .. Statement Function Definitions ..
143 CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
144 * ..
145 * .. Executable Statements ..
146 *
147 * Test the input parameters.
148 *
149 INFO = 0
150 IF ( .NOT.( ( TRANS.EQ.ILATRANS( 'N' ) )
151 $ .OR. ( TRANS.EQ.ILATRANS( 'T' ) )
152 $ .OR. ( TRANS.EQ.ILATRANS( 'C' ) ) ) ) THEN
153 INFO = 1
154 ELSE IF( M.LT.0 )THEN
155 INFO = 2
156 ELSE IF( N.LT.0 )THEN
157 INFO = 3
158 ELSE IF( LDA.LT.MAX( 1, M ) )THEN
159 INFO = 6
160 ELSE IF( INCX.EQ.0 )THEN
161 INFO = 8
162 ELSE IF( INCY.EQ.0 )THEN
163 INFO = 11
164 END IF
165 IF( INFO.NE.0 )THEN
166 CALL XERBLA( 'ZLA_GEAMV ', INFO )
167 RETURN
168 END IF
169 *
170 * Quick return if possible.
171 *
172 IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
173 $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
174 $ RETURN
175 *
176 * Set LENX and LENY, the lengths of the vectors x and y, and set
177 * up the start points in X and Y.
178 *
179 IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
180 LENX = N
181 LENY = M
182 ELSE
183 LENX = M
184 LENY = N
185 END IF
186 IF( INCX.GT.0 )THEN
187 KX = 1
188 ELSE
189 KX = 1 - ( LENX - 1 )*INCX
190 END IF
191 IF( INCY.GT.0 )THEN
192 KY = 1
193 ELSE
194 KY = 1 - ( LENY - 1 )*INCY
195 END IF
196 *
197 * Set SAFE1 essentially to be the underflow threshold times the
198 * number of additions in each row.
199 *
200 SAFE1 = DLAMCH( 'Safe minimum' )
201 SAFE1 = (N+1)*SAFE1
202 *
203 * Form y := alpha*abs(A)*abs(x) + beta*abs(y).
204 *
205 * The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
206 * the inexact flag. Still doesn't help change the iteration order
207 * to per-column.
208 *
209 IY = KY
210 IF ( INCX.EQ.1 ) THEN
211 IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
212 DO I = 1, LENY
213 IF ( BETA .EQ. 0.0D+0 ) THEN
214 SYMB_ZERO = .TRUE.
215 Y( IY ) = 0.0D+0
216 ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
217 SYMB_ZERO = .TRUE.
218 ELSE
219 SYMB_ZERO = .FALSE.
220 Y( IY ) = BETA * ABS( Y( IY ) )
221 END IF
222 IF ( ALPHA .NE. 0.0D+0 ) THEN
223 DO J = 1, LENX
224 TEMP = CABS1( A( I, J ) )
225 SYMB_ZERO = SYMB_ZERO .AND.
226 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
227
228 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
229 END DO
230 END IF
231
232 IF ( .NOT.SYMB_ZERO ) Y( IY ) =
233 $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
234
235 IY = IY + INCY
236 END DO
237 ELSE
238 DO I = 1, LENY
239 IF ( BETA .EQ. 0.0D+0 ) THEN
240 SYMB_ZERO = .TRUE.
241 Y( IY ) = 0.0D+0
242 ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
243 SYMB_ZERO = .TRUE.
244 ELSE
245 SYMB_ZERO = .FALSE.
246 Y( IY ) = BETA * ABS( Y( IY ) )
247 END IF
248 IF ( ALPHA .NE. 0.0D+0 ) THEN
249 DO J = 1, LENX
250 TEMP = CABS1( A( J, I ) )
251 SYMB_ZERO = SYMB_ZERO .AND.
252 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
253
254 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
255 END DO
256 END IF
257
258 IF ( .NOT.SYMB_ZERO ) Y( IY ) =
259 $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
260
261 IY = IY + INCY
262 END DO
263 END IF
264 ELSE
265 IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
266 DO I = 1, LENY
267 IF ( BETA .EQ. 0.0D+0 ) THEN
268 SYMB_ZERO = .TRUE.
269 Y( IY ) = 0.0D+0
270 ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
271 SYMB_ZERO = .TRUE.
272 ELSE
273 SYMB_ZERO = .FALSE.
274 Y( IY ) = BETA * ABS( Y( IY ) )
275 END IF
276 IF ( ALPHA .NE. 0.0D+0 ) THEN
277 JX = KX
278 DO J = 1, LENX
279 TEMP = CABS1( A( I, J ) )
280 SYMB_ZERO = SYMB_ZERO .AND.
281 $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
282
283 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
284 JX = JX + INCX
285 END DO
286 END IF
287
288 IF ( .NOT.SYMB_ZERO ) Y( IY ) =
289 $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
290
291 IY = IY + INCY
292 END DO
293 ELSE
294 DO I = 1, LENY
295 IF ( BETA .EQ. 0.0D+0 ) THEN
296 SYMB_ZERO = .TRUE.
297 Y( IY ) = 0.0D+0
298 ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
299 SYMB_ZERO = .TRUE.
300 ELSE
301 SYMB_ZERO = .FALSE.
302 Y( IY ) = BETA * ABS( Y( IY ) )
303 END IF
304 IF ( ALPHA .NE. 0.0D+0 ) THEN
305 JX = KX
306 DO J = 1, LENX
307 TEMP = CABS1( A( J, I ) )
308 SYMB_ZERO = SYMB_ZERO .AND.
309 $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
310
311 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
312 JX = JX + INCX
313 END DO
314 END IF
315
316 IF ( .NOT.SYMB_ZERO ) Y( IY ) =
317 $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
318
319 IY = IY + INCY
320 END DO
321 END IF
322
323 END IF
324 *
325 RETURN
326 *
327 * End of ZLA_GEAMV
328 *
329 END