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

◆ zla_gbamv()

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, 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.
           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 186 of file zla_gbamv.f.

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