185 SUBROUTINE dla_gbamv( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
186 $ incx, beta, y, incy )
194 DOUBLE PRECISION ALPHA, BETA
195 INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
198 DOUBLE PRECISION AB( ldab, * ), X( * ), Y( * )
204 DOUBLE PRECISION ONE, ZERO
205 parameter ( one = 1.0d+0, zero = 0.0d+0 )
209 DOUBLE PRECISION TEMP, SAFE1
210 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
214 DOUBLE PRECISION DLAMCH
221 INTRINSIC max, abs, sign
228 IF ( .NOT.( ( trans.EQ.ilatrans(
'N' ) )
229 $ .OR. ( trans.EQ.ilatrans(
'T' ) )
230 $ .OR. ( trans.EQ.ilatrans(
'C' ) ) ) )
THEN
232 ELSE IF( m.LT.0 )
THEN
234 ELSE IF( n.LT.0 )
THEN
236 ELSE IF( kl.LT.0 .OR. kl.GT.m-1 )
THEN
238 ELSE IF( ku.LT.0 .OR. ku.GT.n-1 )
THEN
240 ELSE IF( ldab.LT.kl+ku+1 )
THEN
242 ELSE IF( incx.EQ.0 )
THEN
244 ELSE IF( incy.EQ.0 )
THEN
248 CALL xerbla(
'DLA_GBAMV ', info )
254 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
255 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
261 IF( trans.EQ.ilatrans(
'N' ) )
THEN
271 kx = 1 - ( lenx - 1 )*incx
276 ky = 1 - ( leny - 1 )*incy
282 safe1 = dlamch(
'Safe minimum' )
294 IF ( incx.EQ.1 )
THEN
295 IF( trans.EQ.ilatrans(
'N' ) )
THEN
297 IF ( beta .EQ. zero )
THEN
300 ELSE IF ( y( iy ) .EQ. zero )
THEN
304 y( iy ) = beta * abs( y( iy ) )
306 IF ( alpha .NE. zero )
THEN
307 DO j = max( i-kl, 1 ), min( i+ku, lenx )
308 temp = abs( ab( kd+i-j, j ) )
309 symb_zero = symb_zero .AND.
310 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
312 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
316 IF ( .NOT.symb_zero )
317 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
322 IF ( beta .EQ. zero )
THEN
325 ELSE IF ( y( iy ) .EQ. zero )
THEN
329 y( iy ) = beta * abs( y( iy ) )
331 IF ( alpha .NE. zero )
THEN
332 DO j = max( i-kl, 1 ), min( i+ku, lenx )
333 temp = abs( ab( ke-i+j, i ) )
334 symb_zero = symb_zero .AND.
335 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
337 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
341 IF ( .NOT.symb_zero )
342 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
347 IF( trans.EQ.ilatrans(
'N' ) )
THEN
349 IF ( beta .EQ. zero )
THEN
352 ELSE IF ( y( iy ) .EQ. zero )
THEN
356 y( iy ) = beta * abs( y( iy ) )
358 IF ( alpha .NE. zero )
THEN
360 DO j = max( i-kl, 1 ), min( i+ku, lenx )
361 temp = abs( ab( kd+i-j, j ) )
362 symb_zero = symb_zero .AND.
363 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
365 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
370 IF ( .NOT.symb_zero )
371 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
377 IF ( beta .EQ. zero )
THEN
380 ELSE IF ( y( iy ) .EQ. zero )
THEN
384 y( iy ) = beta * abs( y( iy ) )
386 IF ( alpha .NE. zero )
THEN
388 DO j = max( i-kl, 1 ), min( i+ku, lenx )
389 temp = abs( ab( ke-i+j, i ) )
390 symb_zero = symb_zero .AND.
391 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
393 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
398 IF ( .NOT.symb_zero )
399 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
double precision function dlamch(CMACH)
DLAMCH
subroutine dla_gbamv(TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X, INCX, BETA, Y, INCY)
DLA_GBAMV performs a matrix-vector operation to calculate error bounds.
integer function ilatrans(TRANS)
ILATRANS
subroutine xerbla(SRNAME, INFO)
XERBLA