LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zla_gbamv ( integer  TRANS,
integer  M,
integer  N,
integer  KL,
integer  KU,
double precision  ALPHA,
complex*16, dimension( ldab, * )  AB,
integer  LDAB,
complex*16, dimension( * )  X,
integer  INCX,
double precision  BETA,
double precision, dimension( * )  Y,
integer  INCY 
)

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

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

Purpose: 
 ZLA_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 COMPLEX*16 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, LDAB 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 COMPLEX*16 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.
[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 188 of file zla_gbamv.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: