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

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

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

Purpose: 
 SLA_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 REAL array of 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 REAL 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 of DIMENSION at least
           ( 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 176 of file sla_geamv.f.

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