176 SUBROUTINE zla_heamv( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
184 DOUBLE PRECISION ALPHA, BETA
185 INTEGER INCX, INCY, LDA, N, UPLO
188 COMPLEX*16 A( LDA, * ), X( * )
189 DOUBLE PRECISION Y( * )
195 DOUBLE PRECISION ONE, ZERO
196 parameter( one = 1.0d+0, zero = 0.0d+0 )
200 DOUBLE PRECISION TEMP, SAFE1
201 INTEGER I, INFO, IY, J, JX, KX, KY
206 DOUBLE PRECISION DLAMCH
213 INTRINSIC max, abs, sign, real, dimag
216 DOUBLE PRECISION CABS1
219 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
226 IF ( uplo.NE.ilauplo(
'U' ) .AND.
227 $ uplo.NE.ilauplo(
'L' ) )
THEN
229 ELSE IF( n.LT.0 )
THEN
231 ELSE IF( lda.LT.max( 1, n ) )
THEN
233 ELSE IF( incx.EQ.0 )
THEN
235 ELSE IF( incy.EQ.0 )
THEN
239 CALL xerbla(
'ZHEMV ', info )
245 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
253 kx = 1 - ( n - 1 )*incx
258 ky = 1 - ( n - 1 )*incy
264 safe1 = dlamch(
'Safe minimum' )
274 IF ( incx.EQ.1 )
THEN
275 IF ( uplo .EQ. ilauplo(
'U' ) )
THEN
277 IF ( beta .EQ. zero )
THEN
280 ELSE IF ( y( iy ) .EQ. zero )
THEN
284 y( iy ) = beta * abs( y( iy ) )
286 IF ( alpha .NE. zero )
THEN
288 temp = cabs1( a( j, i ) )
289 symb_zero = symb_zero .AND.
290 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
292 y( iy ) = y( iy ) + alpha*cabs1( x( j ) )*temp
295 temp = cabs1( a( i, j ) )
296 symb_zero = symb_zero .AND.
297 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
299 y( iy ) = y( iy ) + alpha*cabs1( x( j ) )*temp
304 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
310 IF ( beta .EQ. zero )
THEN
313 ELSE IF ( y( iy ) .EQ. zero )
THEN
317 y( iy ) = beta * abs( y( iy ) )
319 IF ( alpha .NE. zero )
THEN
321 temp = cabs1( a( i, j ) )
322 symb_zero = symb_zero .AND.
323 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
325 y( iy ) = y( iy ) + alpha*cabs1( x( j ) )*temp
328 temp = cabs1( a( j, i ) )
329 symb_zero = symb_zero .AND.
330 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
332 y( iy ) = y( iy ) + alpha*cabs1( x( j ) )*temp
337 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
343 IF ( uplo .EQ. ilauplo(
'U' ) )
THEN
345 IF ( beta .EQ. zero )
THEN
348 ELSE IF ( y( iy ) .EQ. zero )
THEN
352 y( iy ) = beta * abs( y( iy ) )
355 IF ( alpha .NE. zero )
THEN
357 temp = cabs1( a( j, i ) )
358 symb_zero = symb_zero .AND.
359 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
361 y( iy ) = y( iy ) + alpha*cabs1( x( jx ) )*temp
365 temp = cabs1( a( i, j ) )
366 symb_zero = symb_zero .AND.
367 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
369 y( iy ) = y( iy ) + alpha*cabs1( x( jx ) )*temp
374 IF ( .NOT.symb_zero )
375 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
381 IF ( beta .EQ. zero )
THEN
384 ELSE IF ( y( iy ) .EQ. zero )
THEN
388 y( iy ) = beta * abs( y( iy ) )
391 IF ( alpha .NE. zero )
THEN
393 temp = cabs1( a( i, j ) )
394 symb_zero = symb_zero .AND.
395 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
397 y( iy ) = y( iy ) + alpha*cabs1( x( jx ) )*temp
401 temp = cabs1( a( j, i ) )
402 symb_zero = symb_zero .AND.
403 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
405 y( iy ) = y( iy ) + alpha*cabs1( x( jx ) )*temp
410 IF ( .NOT.symb_zero )
411 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
subroutine xerbla(srname, info)
integer function ilauplo(uplo)
ILAUPLO
subroutine zla_heamv(uplo, n, alpha, a, lda, x, incx, beta, y, incy)
ZLA_HEAMV computes a matrix-vector product using a Hermitian indefinite matrix to calculate error bou...
double precision function dlamch(cmach)
DLAMCH