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

◆ cla_syamv()

subroutine cla_syamv ( 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_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds.

Download CLA_SYAMV + 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.
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 177 of file cla_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 REAL ALPHA, BETA
186 INTEGER INCX, INCY, LDA, N
187 INTEGER UPLO
188* ..
189* .. Array Arguments ..
190 COMPLEX A( LDA, * ), X( * )
191 REAL Y( * )
192* ..
193*
194* =====================================================================
195*
196* .. Parameters ..
197 REAL ONE, ZERO
198 parameter( one = 1.0e+0, zero = 0.0e+0 )
199* ..
200* .. Local Scalars ..
201 LOGICAL SYMB_ZERO
202 REAL TEMP, SAFE1
203 INTEGER I, INFO, IY, J, JX, KX, KY
204 COMPLEX ZDUM
205* ..
206* .. External Subroutines ..
207 EXTERNAL xerbla, slamch
208 REAL SLAMCH
209* ..
210* .. External Functions ..
211 EXTERNAL ilauplo
212 INTEGER ILAUPLO
213* ..
214* .. Intrinsic Functions ..
215 INTRINSIC max, abs, sign, real, aimag
216* ..
217* .. Statement Functions ..
218 REAL CABS1
219* ..
220* .. Statement Function Definitions ..
221 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( 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( 'CLA_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 = slamch( '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.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.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.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.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 CLA_SYAMV
424*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ilauplo
integer function ilauplo(uplo)
ILAUPLO
Definition ilauplo.f:58
slamch
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: