LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ sla_gbamv()

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, 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.
           If either m or n is zero, then Y not referenced and the function
           performs a quick return.
[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.

Definition at line 185 of file sla_gbamv.f.

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