185 SUBROUTINE sla_gbamv( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
186 $ incx, beta, y, incy )
195 INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
198 REAL AB( ldab, * ), X( * ), Y( * )
204 parameter ( one = 1.0e+0, zero = 0.0e+0 )
209 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
220 INTRINSIC max, abs, sign
227 IF ( .NOT.( ( trans.EQ.ilatrans(
'N' ) )
228 $ .OR. ( trans.EQ.ilatrans(
'T' ) )
229 $ .OR. ( trans.EQ.ilatrans(
'C' ) ) ) )
THEN
231 ELSE IF( m.LT.0 )
THEN
233 ELSE IF( n.LT.0 )
THEN
235 ELSE IF( kl.LT.0 .OR. kl.GT.m-1 )
THEN
237 ELSE IF( ku.LT.0 .OR. ku.GT.n-1 )
THEN
239 ELSE IF( ldab.LT.kl+ku+1 )
THEN
241 ELSE IF( incx.EQ.0 )
THEN
243 ELSE IF( incy.EQ.0 )
THEN
247 CALL xerbla(
'SLA_GBAMV ', info )
253 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
254 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
260 IF( trans.EQ.ilatrans(
'N' ) )
THEN
270 kx = 1 - ( lenx - 1 )*incx
275 ky = 1 - ( leny - 1 )*incy
281 safe1 = slamch(
'Safe minimum' )
293 IF ( incx.EQ.1 )
THEN
294 IF( trans.EQ.ilatrans(
'N' ) )
THEN
296 IF ( beta .EQ. zero )
THEN
299 ELSE IF ( y( iy ) .EQ. zero )
THEN
303 y( iy ) = beta * abs( y( iy ) )
305 IF ( alpha .NE. zero )
THEN
306 DO j = max( i-kl, 1 ), min( i+ku, lenx )
307 temp = abs( ab( kd+i-j, j ) )
308 symb_zero = symb_zero .AND.
309 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
311 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
315 IF ( .NOT.symb_zero )
316 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
321 IF ( beta .EQ. zero )
THEN
324 ELSE IF ( y( iy ) .EQ. zero )
THEN
328 y( iy ) = beta * abs( y( iy ) )
330 IF ( alpha .NE. zero )
THEN
331 DO j = max( i-kl, 1 ), min( i+ku, lenx )
332 temp = abs( ab( ke-i+j, i ) )
333 symb_zero = symb_zero .AND.
334 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
336 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
340 IF ( .NOT.symb_zero )
341 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
346 IF( trans.EQ.ilatrans(
'N' ) )
THEN
348 IF ( beta .EQ. zero )
THEN
351 ELSE IF ( y( iy ) .EQ. zero )
THEN
355 y( iy ) = beta * abs( y( iy ) )
357 IF ( alpha .NE. zero )
THEN
359 DO j = max( i-kl, 1 ), min( i+ku, lenx )
360 temp = abs( ab( kd+i-j, j ) )
361 symb_zero = symb_zero .AND.
362 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
364 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
369 IF ( .NOT.symb_zero )
370 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
376 IF ( beta .EQ. zero )
THEN
379 ELSE IF ( y( iy ) .EQ. zero )
THEN
383 y( iy ) = beta * abs( y( iy ) )
385 IF ( alpha .NE. zero )
THEN
387 DO j = max( i-kl, 1 ), min( i+ku, lenx )
388 temp = abs( ab( ke-i+j, i ) )
389 symb_zero = symb_zero .AND.
390 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
392 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
397 IF ( .NOT.symb_zero )
398 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
subroutine sla_gbamv(TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X, INCX, BETA, Y, INCY)
SLA_GBAMV performs a matrix-vector operation to calculate error bounds.
integer function ilatrans(TRANS)
ILATRANS
subroutine xerbla(SRNAME, INFO)
XERBLA
real function slamch(CMACH)
SLAMCH