LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ zla_geamv()

subroutine zla_geamv ( integer  TRANS,
integer  M,
integer  N,
double precision  ALPHA,
complex*16, dimension( lda, * )  A,
integer  LDA,
complex*16, dimension( * )  X,
integer  INCX,
double precision  BETA,
double precision, dimension( * )  Y,
integer  INCY 
)

ZLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds.

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

Purpose:
 ZLA_GEAMV  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]ALPHA
          ALPHA is DOUBLE PRECISION
           On entry, ALPHA specifies the scalar alpha.
           Unchanged on exit.
[in]A
          A is COMPLEX*16 array, dimension ( LDA, n )
           Before entry, the leading m by n part of the array A must
           contain the matrix of coefficients.
           Unchanged on exit.
[in]LDA
          LDA is INTEGER
           On entry, LDA specifies the first dimension of A as declared
           in the calling (sub) program. LDA must be at least
           max( 1, m ).
           Unchanged on exit.
[in]X
          X is COMPLEX*16 array, dimension at least
           ( 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.

Definition at line 173 of file zla_geamv.f.

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