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

Download ZLA_SYAMV + 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,
!>  zero components are not perturbed.  A zero
!> entry is considered  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 175 of file zla_syamv.f.

177*
178* -- LAPACK computational routine --
179* -- LAPACK is a software package provided by Univ. of Tennessee, --
180* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
181*
182* .. Scalar Arguments ..
183 DOUBLE PRECISION ALPHA, BETA
184 INTEGER INCX, INCY, LDA, N
185 INTEGER 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( 'ZLA_SYAMV', 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_SYAMV
422*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ilauplo
integer function ilauplo(uplo)
ILAUPLO
Definition ilauplo.f:56
dlamch
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: