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

◆ dla_gbamv()

subroutine dla_gbamv ( integer  trans,
integer  m,
integer  n,
integer  kl,
integer  ku,
double precision  alpha,
double precision, dimension( ldab, * )  ab,
integer  ldab,
double precision, dimension( * )  x,
integer  incx,
double precision  beta,
double precision, dimension( * )  y,
integer  incy 
)

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

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

Purpose:
 DLA_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 DOUBLE PRECISION
           On entry, ALPHA specifies the scalar alpha.
           Unchanged on exit.
[in]AB
          AB is DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION
           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 DOUBLE PRECISION 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 dla_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 DOUBLE PRECISION ALPHA, BETA
194 INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
195* ..
196* .. Array Arguments ..
197 DOUBLE PRECISION AB( LDAB, * ), X( * ), Y( * )
198* ..
199*
200* =====================================================================
201*
202* .. Parameters ..
203 DOUBLE PRECISION ONE, ZERO
204 parameter( one = 1.0d+0, zero = 0.0d+0 )
205* ..
206* .. Local Scalars ..
207 LOGICAL SYMB_ZERO
208 DOUBLE PRECISION TEMP, SAFE1
209 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
210* ..
211* .. External Subroutines ..
212 EXTERNAL xerbla, dlamch
213 DOUBLE PRECISION DLAMCH
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( 'DLA_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 = dlamch( '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.0d+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.0d+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.0d+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.0d+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 DLA_GBAMV
409*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ilatrans
integer function ilatrans(trans)
ILATRANS
Definition ilatrans.f:58
dlamch
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
Here is the call graph for this function:
Here is the caller graph for this function: