LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ zla_heamv()

subroutine zla_heamv ( 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_HEAMV computes a matrix-vector product using a Hermitian indefinite matrix to calculate error bounds.

Download ZLA_HEAMV + 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 176 of file zla_heamv.f.

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