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

SLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds.

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

Purpose: 
 SLA_SYAMV  performs the matrix-vector operation

         y := alpha*abs(A)*abs(x) + beta*abs(y),

 where alpha and beta are scalars, x and y are vectors and A is an
 n by n symmetric 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]UPLO
          UPLO is INTEGER
           On entry, UPLO specifies whether the upper or lower
           triangular part of the array A is to be referenced as
           follows:

              UPLO = BLAS_UPPER   Only the upper triangular part of A
                                  is to be referenced.

              UPLO = BLAS_LOWER   Only the lower triangular part of A
                                  is to be referenced.

           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, n ).
           Unchanged on exit.
[in]X
          X is REAL array, dimension
           ( 1 + ( n - 1 )*abs( INCX ) )
           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 + ( n - 1 )*abs( INCY ) )
           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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012
Further Details: 
  Level 2 Blas routine.

  -- Written on 22-October-1986.
     Jack Dongarra, Argonne National Lab.
     Jeremy Du Croz, Nag Central Office.
     Sven Hammarling, Nag Central Office.
     Richard Hanson, Sandia National Labs.
  -- Modified for the absolute-value product, April 2006
     Jason Riedy, UC Berkeley

Definition at line 179 of file sla_syamv.f.

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