LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cla_syamv()

subroutine cla_syamv ( integer  UPLO,
integer  N,
real  ALPHA,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( * )  X,
integer  INCX,
real  BETA,
real, dimension( * )  Y,
integer  INCY 
)

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

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

Purpose:
 CLA_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 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, n ).
           Unchanged on exit.
[in]X
          X is COMPLEX 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
June 2017
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 181 of file cla_syamv.f.

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