LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cla_geamv ( integer  TRANS,
integer  M,
integer  N,
real  ALPHA,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( * )  X,
integer  INCX,
real  BETA,
real, dimension( * )  Y,
integer  INCY 
)

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

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

Purpose: 
 CLA_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 REAL
           On entry, ALPHA specifies the scalar alpha.
           Unchanged on exit.
[in]A
          A is COMPLEX 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 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.
Date
September 2012

Definition at line 177 of file cla_geamv.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: