LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ dla_syamv()

subroutine dla_syamv ( integer  UPLO,
integer  N,
double precision  ALPHA,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( * )  X,
integer  INCX,
double precision  BETA,
double precision, dimension( * )  Y,
integer  INCY 
)

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

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

Purpose:
 DLA_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 DOUBLE PRECISION .
           On entry, ALPHA specifies the scalar alpha.
           Unchanged on exit.
[in]A
          A is DOUBLE PRECISION 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, n ).
           Unchanged on exit.
[in]X
          X is DOUBLE PRECISION 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 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 + ( 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.
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 175 of file dla_syamv.f.

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