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