LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ cla_gbamv()

subroutine cla_gbamv ( integer  TRANS,
integer  M,
integer  N,
integer  KL,
integer  KU,
real  ALPHA,
complex, dimension( ldab, * )  AB,
integer  LDAB,
complex, dimension( * )  X,
integer  INCX,
real  BETA,
real, dimension( * )  Y,
integer  INCY 
)

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

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

Purpose:
 CLA_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 COMPLEX 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, 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 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.

Definition at line 184 of file cla_gbamv.f.

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