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

## ◆ sla_syamv()

 subroutine sla_syamv ( integer uplo, integer n, real alpha, real, dimension( lda, * ) a, integer lda, real, dimension( * ) x, integer incx, real beta, real, dimension( * ) y, integer incy )

SLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds.

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