LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine sla_gbamv ( integer  TRANS,
integer  M,
integer  N,
integer  KL,
integer  KU,
real  ALPHA,
real, dimension( ldab, * )  AB,
integer  LDAB,
real, dimension( * )  X,
integer  INCX,
real  BETA,
real, dimension( * )  Y,
integer  INCY 
)

SLA_GBAMV performs a matrix-vector operation to calculate error bounds.

Download SLA_GBAMV + dependencies [TGZ] [ZIP] [TXT]

Purpose: 
 SLA_GBAMV  performs one of the matrix-vector operations

         y := alpha*abs(A)*abs(x) + beta*abs(y),
    or   y := alpha*abs(A)**T*abs(x) + beta*abs(y),

 where alpha and beta are scalars, x and y are vectors and A is an
 m by n matrix.

 This function is primarily used in calculating error bounds.
 To protect against underflow during evaluation, components in
 the resulting vector are perturbed away from zero by (N+1)
 times the underflow threshold.  To prevent unnecessarily large
 errors for block-structure embedded in general matrices,
 "symbolically" zero components are not perturbed.  A zero
 entry is considered "symbolic" if all multiplications involved
 in computing that entry have at least one zero multiplicand.
Parameters
[in]TRANS
          TRANS is INTEGER
           On entry, TRANS specifies the operation to be performed as
           follows:

             BLAS_NO_TRANS      y := alpha*abs(A)*abs(x) + beta*abs(y)
             BLAS_TRANS         y := alpha*abs(A**T)*abs(x) + beta*abs(y)
             BLAS_CONJ_TRANS    y := alpha*abs(A**T)*abs(x) + beta*abs(y)

           Unchanged on exit.
[in]M
          M is INTEGER
           On entry, M specifies the number of rows of the matrix A.
           M must be at least zero.
           Unchanged on exit.
[in]N
          N is INTEGER
           On entry, N specifies the number of columns of the matrix A.
           N must be at least zero.
           Unchanged on exit.
[in]KL
          KL is INTEGER
           The number of subdiagonals within the band of A.  KL >= 0.
[in]KU
          KU is INTEGER
           The number of superdiagonals within the band of A.  KU >= 0.
[in]ALPHA
          ALPHA is REAL
           On entry, ALPHA specifies the scalar alpha.
           Unchanged on exit.
[in]AB
          AB is REAL array of DIMENSION ( LDAB, n )
           Before entry, the leading m by n part of the array AB must
           contain the matrix of coefficients.
           Unchanged on exit.
[in]LDAB
          LDAB is INTEGER
           On entry, LDA specifies the first dimension of AB as declared
           in the calling (sub) program. LDAB must be at least
           max( 1, m ).
           Unchanged on exit.
[in]X
          X is REAL array, dimension
           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
           and at least
           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
           Before entry, the incremented array X must contain the
           vector x.
           Unchanged on exit.
[in]INCX
          INCX is INTEGER
           On entry, INCX specifies the increment for the elements of
           X. INCX must not be zero.
           Unchanged on exit.
[in]BETA
          BETA is REAL
           On entry, BETA specifies the scalar beta. When BETA is
           supplied as zero then Y need not be set on input.
           Unchanged on exit.
[in,out]Y
          Y is REAL array, dimension
           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
           and at least
           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
           Before entry with BETA non-zero, the incremented array Y
           must contain the vector y. On exit, Y is overwritten by the
           updated vector y.
[in]INCY
          INCY is INTEGER
           On entry, INCY specifies the increment for the elements of
           Y. INCY must not be zero.
           Unchanged on exit.

  Level 2 Blas routine.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 187 of file sla_gbamv.f.

187 *
188 * -- LAPACK computational routine (version 3.4.2) --
189 * -- LAPACK is a software package provided by Univ. of Tennessee, --
190 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
191 * September 2012
192 *
193 * .. Scalar Arguments ..
194  REAL alpha, beta
195  INTEGER incx, incy, ldab, m, n, kl, ku, trans
196 * ..
197 * .. Array Arguments ..
198  REAL ab( ldab, * ), x( * ), y( * )
199 * ..
200 *
201 * =====================================================================
202 * .. Parameters ..
203  REAL one, zero
204  parameter ( one = 1.0e+0, zero = 0.0e+0 )
205 * ..
206 * .. Local Scalars ..
207  LOGICAL symb_zero
208  REAL temp, safe1
209  INTEGER i, info, iy, j, jx, kx, ky, lenx, leny, kd, ke
210 * ..
211 * .. External Subroutines ..
212  EXTERNAL xerbla, slamch
213  REAL slamch
214 * ..
215 * .. External Functions ..
216  EXTERNAL ilatrans
217  INTEGER ilatrans
218 * ..
219 * .. Intrinsic Functions ..
220  INTRINSIC max, abs, sign
221 * ..
222 * .. Executable Statements ..
223 *
224 * Test the input parameters.
225 *
226  info = 0
227  IF ( .NOT.( ( trans.EQ.ilatrans( 'N' ) )
228  $ .OR. ( trans.EQ.ilatrans( 'T' ) )
229  $ .OR. ( trans.EQ.ilatrans( 'C' ) ) ) ) THEN
230  info = 1
231  ELSE IF( m.LT.0 )THEN
232  info = 2
233  ELSE IF( n.LT.0 )THEN
234  info = 3
235  ELSE IF( kl.LT.0 .OR. kl.GT.m-1 ) THEN
236  info = 4
237  ELSE IF( ku.LT.0 .OR. ku.GT.n-1 ) THEN
238  info = 5
239  ELSE IF( ldab.LT.kl+ku+1 )THEN
240  info = 6
241  ELSE IF( incx.EQ.0 )THEN
242  info = 8
243  ELSE IF( incy.EQ.0 )THEN
244  info = 11
245  END IF
246  IF( info.NE.0 )THEN
247  CALL xerbla( 'SLA_GBAMV ', info )
248  RETURN
249  END IF
250 *
251 * Quick return if possible.
252 *
253  IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
254  $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
255  $ RETURN
256 *
257 * Set LENX and LENY, the lengths of the vectors x and y, and set
258 * up the start points in X and Y.
259 *
260  IF( trans.EQ.ilatrans( 'N' ) )THEN
261  lenx = n
262  leny = m
263  ELSE
264  lenx = m
265  leny = n
266  END IF
267  IF( incx.GT.0 )THEN
268  kx = 1
269  ELSE
270  kx = 1 - ( lenx - 1 )*incx
271  END IF
272  IF( incy.GT.0 )THEN
273  ky = 1
274  ELSE
275  ky = 1 - ( leny - 1 )*incy
276  END IF
277 *
278 * Set SAFE1 essentially to be the underflow threshold times the
279 * number of additions in each row.
280 *
281  safe1 = slamch( 'Safe minimum' )
282  safe1 = (n+1)*safe1
283 *
284 * Form y := alpha*abs(A)*abs(x) + beta*abs(y).
285 *
286 * The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
287 * the inexact flag. Still doesn't help change the iteration order
288 * to per-column.
289 *
290  kd = ku + 1
291  ke = kl + 1
292  iy = ky
293  IF ( incx.EQ.1 ) THEN
294  IF( trans.EQ.ilatrans( 'N' ) )THEN
295  DO i = 1, leny
296  IF ( beta .EQ. zero ) THEN
297  symb_zero = .true.
298  y( iy ) = 0.0
299  ELSE IF ( y( iy ) .EQ. zero ) THEN
300  symb_zero = .true.
301  ELSE
302  symb_zero = .false.
303  y( iy ) = beta * abs( y( iy ) )
304  END IF
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 )
310 
311  y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
312  END DO
313  END IF
314 
315  IF ( .NOT.symb_zero )
316  $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
317  iy = iy + incy
318  END DO
319  ELSE
320  DO i = 1, leny
321  IF ( beta .EQ. zero ) THEN
322  symb_zero = .true.
323  y( iy ) = 0.0
324  ELSE IF ( y( iy ) .EQ. zero ) THEN
325  symb_zero = .true.
326  ELSE
327  symb_zero = .false.
328  y( iy ) = beta * abs( y( iy ) )
329  END IF
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 )
335 
336  y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
337  END DO
338  END IF
339 
340  IF ( .NOT.symb_zero )
341  $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
342  iy = iy + incy
343  END DO
344  END IF
345  ELSE
346  IF( trans.EQ.ilatrans( 'N' ) )THEN
347  DO i = 1, leny
348  IF ( beta .EQ. zero ) THEN
349  symb_zero = .true.
350  y( iy ) = 0.0
351  ELSE IF ( y( iy ) .EQ. zero ) THEN
352  symb_zero = .true.
353  ELSE
354  symb_zero = .false.
355  y( iy ) = beta * abs( y( iy ) )
356  END IF
357  IF ( alpha .NE. zero ) THEN
358  jx = kx
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 )
363 
364  y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
365  jx = jx + incx
366  END DO
367  END IF
368 
369  IF ( .NOT.symb_zero )
370  $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
371 
372  iy = iy + incy
373  END DO
374  ELSE
375  DO i = 1, leny
376  IF ( beta .EQ. zero ) THEN
377  symb_zero = .true.
378  y( iy ) = 0.0
379  ELSE IF ( y( iy ) .EQ. zero ) THEN
380  symb_zero = .true.
381  ELSE
382  symb_zero = .false.
383  y( iy ) = beta * abs( y( iy ) )
384  END IF
385  IF ( alpha .NE. zero ) THEN
386  jx = kx
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 )
391 
392  y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
393  jx = jx + incx
394  END DO
395  END IF
396 
397  IF ( .NOT.symb_zero )
398  $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
399 
400  iy = iy + incy
401  END DO
402  END IF
403 
404  END IF
405 *
406  RETURN
407 *
408 * End of SLA_GBAMV
409 *
ilatrans
integer function ilatrans(TRANS)
ILATRANS
Definition: ilatrans.f:60
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69

Here is the call graph for this function:

Here is the caller graph for this function: