 LAPACK  3.10.1 LAPACK: Linear Algebra PACKage

## ◆ cla_heamv()

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

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.```
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 cla_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  REAL ALPHA, BETA
185  INTEGER INCX, INCY, LDA, N, UPLO
186 * ..
187 * .. Array Arguments ..
188  COMPLEX A( LDA, * ), X( * )
189  REAL Y( * )
190 * ..
191 *
192 * =====================================================================
193 *
194 * .. Parameters ..
195  REAL ONE, ZERO
196  parameter( one = 1.0e+0, zero = 0.0e+0 )
197 * ..
198 * .. Local Scalars ..
199  LOGICAL SYMB_ZERO
200  REAL TEMP, SAFE1
201  INTEGER I, INFO, IY, J, JX, KX, KY
202  COMPLEX ZDUM
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, real, aimag
214 * ..
215 * .. Statement Functions ..
216  REAL CABS1
217 * ..
218 * .. Statement Function Definitions ..
219  cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( 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( 'CHEMV ', 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 = slamch( '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.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.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.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.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 CLA_HEAMV
422 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
integer function ilauplo(UPLO)
ILAUPLO
Definition: ilauplo.f:58
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: