173 SUBROUTINE zla_geamv( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
181 DOUBLE PRECISION ALPHA, BETA
182 INTEGER INCX, INCY, LDA, M, N
186 COMPLEX*16 A( LDA, * ), X( * )
187 DOUBLE PRECISION Y( * )
194 parameter( one = 1.0d+0, zero = 0.0d+0 )
198 DOUBLE PRECISION TEMP, SAFE1
199 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY
204 DOUBLE PRECISION DLAMCH
211 INTRINSIC max, abs, real, dimag, sign
214 DOUBLE PRECISION CABS1
217 cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
224 IF ( .NOT.( ( trans.EQ.ilatrans(
'N' ) )
225 $ .OR. ( trans.EQ.ilatrans(
'T' ) )
226 $ .OR. ( trans.EQ.ilatrans(
'C' ) ) ) )
THEN
228 ELSE IF( m.LT.0 )
THEN
230 ELSE IF( n.LT.0 )
THEN
232 ELSE IF( lda.LT.max( 1, m ) )
THEN
234 ELSE IF( incx.EQ.0 )
THEN
236 ELSE IF( incy.EQ.0 )
THEN
240 CALL xerbla(
'ZLA_GEAMV ', info )
246 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
247 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
253 IF( trans.EQ.ilatrans(
'N' ) )
THEN
263 kx = 1 - ( lenx - 1 )*incx
268 ky = 1 - ( leny - 1 )*incy
274 safe1 = dlamch(
'Safe minimum' )
284 IF ( incx.EQ.1 )
THEN
285 IF( trans.EQ.ilatrans(
'N' ) )
THEN
287 IF ( beta .EQ. 0.0d+0 )
THEN
290 ELSE IF ( y( iy ) .EQ. 0.0d+0 )
THEN
294 y( iy ) = beta * abs( y( iy ) )
296 IF ( alpha .NE. 0.0d+0 )
THEN
298 temp = cabs1( a( i, j ) )
299 symb_zero = symb_zero .AND.
300 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
302 y( iy ) = y( iy ) + alpha*cabs1( x( j ) )*temp
306 IF ( .NOT.symb_zero ) y( iy ) =
307 $ y( iy ) + sign( safe1, y( iy ) )
313 IF ( beta .EQ. 0.0d+0 )
THEN
316 ELSE IF ( y( iy ) .EQ. 0.0d+0 )
THEN
320 y( iy ) = beta * abs( y( iy ) )
322 IF ( alpha .NE. 0.0d+0 )
THEN
324 temp = cabs1( a( j, i ) )
325 symb_zero = symb_zero .AND.
326 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
328 y( iy ) = y( iy ) + alpha*cabs1( x( j ) )*temp
332 IF ( .NOT.symb_zero ) y( iy ) =
333 $ y( iy ) + sign( safe1, y( iy ) )
339 IF( trans.EQ.ilatrans(
'N' ) )
THEN
341 IF ( beta .EQ. 0.0d+0 )
THEN
344 ELSE IF ( y( iy ) .EQ. 0.0d+0 )
THEN
348 y( iy ) = beta * abs( y( iy ) )
350 IF ( alpha .NE. 0.0d+0 )
THEN
353 temp = cabs1( a( i, j ) )
354 symb_zero = symb_zero .AND.
355 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
357 y( iy ) = y( iy ) + alpha*cabs1( x( jx ) )*temp
362 IF ( .NOT.symb_zero ) y( iy ) =
363 $ y( iy ) + sign( safe1, y( iy ) )
369 IF ( beta .EQ. 0.0d+0 )
THEN
372 ELSE IF ( y( iy ) .EQ. 0.0d+0 )
THEN
376 y( iy ) = beta * abs( y( iy ) )
378 IF ( alpha .NE. 0.0d+0 )
THEN
381 temp = cabs1( a( j, i ) )
382 symb_zero = symb_zero .AND.
383 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
385 y( iy ) = y( iy ) + alpha*cabs1( x( jx ) )*temp
390 IF ( .NOT.symb_zero ) y( iy ) =
391 $ y( iy ) + sign( safe1, y( iy ) )
double precision function dlamch(CMACH)
DLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
integer function ilatrans(TRANS)
ILATRANS
subroutine zla_geamv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds.