175 SUBROUTINE dla_syamv( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
183 DOUBLE PRECISION ALPHA, BETA
184 INTEGER INCX, INCY, LDA, N, UPLO
187 DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
193 DOUBLE PRECISION ONE, ZERO
194 parameter( one = 1.0d+0, zero = 0.0d+0 )
198 DOUBLE PRECISION TEMP, SAFE1
199 INTEGER I, INFO, IY, J, JX, KX, KY
203 DOUBLE PRECISION DLAMCH
210 INTRINSIC max, abs, sign
217 IF ( uplo.NE.ilauplo(
'U' ) .AND.
218 $ uplo.NE.ilauplo(
'L' ) )
THEN
220 ELSE IF( n.LT.0 )
THEN
222 ELSE IF( lda.LT.max( 1, n ) )
THEN
224 ELSE IF( incx.EQ.0 )
THEN
226 ELSE IF( incy.EQ.0 )
THEN
230 CALL xerbla(
'DLA_SYAMV', info )
236 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
244 kx = 1 - ( n - 1 )*incx
249 ky = 1 - ( n - 1 )*incy
255 safe1 = dlamch(
'Safe minimum' )
265 IF ( incx.EQ.1 )
THEN
266 IF ( uplo .EQ. ilauplo(
'U' ) )
THEN
268 IF ( beta .EQ. zero )
THEN
271 ELSE IF ( y( iy ) .EQ. zero )
THEN
275 y( iy ) = beta * abs( y( iy ) )
277 IF ( alpha .NE. zero )
THEN
279 temp = abs( a( j, i ) )
280 symb_zero = symb_zero .AND.
281 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
283 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
286 temp = abs( a( i, j ) )
287 symb_zero = symb_zero .AND.
288 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
290 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
294 IF ( .NOT.symb_zero )
295 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
301 IF ( beta .EQ. zero )
THEN
304 ELSE IF ( y( iy ) .EQ. zero )
THEN
308 y( iy ) = beta * abs( y( iy ) )
310 IF ( alpha .NE. zero )
THEN
312 temp = abs( a( i, j ) )
313 symb_zero = symb_zero .AND.
314 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
316 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
319 temp = abs( a( j, i ) )
320 symb_zero = symb_zero .AND.
321 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
323 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
327 IF ( .NOT.symb_zero )
328 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
334 IF ( uplo .EQ. ilauplo(
'U' ) )
THEN
336 IF ( beta .EQ. zero )
THEN
339 ELSE IF ( y( iy ) .EQ. zero )
THEN
343 y( iy ) = beta * abs( y( iy ) )
346 IF ( alpha .NE. zero )
THEN
348 temp = abs( a( j, i ) )
349 symb_zero = symb_zero .AND.
350 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
352 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
356 temp = abs( a( i, j ) )
357 symb_zero = symb_zero .AND.
358 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
360 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
365 IF ( .NOT.symb_zero )
366 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
372 IF ( beta .EQ. zero )
THEN
375 ELSE IF ( y( iy ) .EQ. zero )
THEN
379 y( iy ) = beta * abs( y( iy ) )
382 IF ( alpha .NE. zero )
THEN
384 temp = abs( a( i, j ) )
385 symb_zero = symb_zero .AND.
386 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
388 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
392 temp = abs( a( j, i ) )
393 symb_zero = symb_zero .AND.
394 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
396 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
401 IF ( .NOT.symb_zero )
402 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
subroutine xerbla(srname, info)
integer function ilauplo(uplo)
ILAUPLO
subroutine dla_syamv(uplo, n, alpha, a, lda, x, incx, beta, y, incy)
DLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bou...
double precision function dlamch(cmach)
DLAMCH