LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ 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.

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, 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)
Definition cblat2.f:3285
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: