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

Download SLA_SYAMV + dependencies [TGZ] [ZIP] [TXT]

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.
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 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*
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: