LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ zla_syamv()

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

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

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

Purpose:
 ZLA_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 COMPLEX*16 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*16 array, dimension at least
           ( 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 177 of file zla_syamv.f.

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