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

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

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.
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*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
integer function ilauplo(uplo)
ILAUPLO
Definition ilauplo.f:58
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
Here is the call graph for this function:
Here is the caller graph for this function: