LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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.

Download CLA_HEAMV + 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 of 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
September 2012
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 180 of file cla_heamv.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: