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

◆ sla_geamv()

subroutine sla_geamv ( integer  TRANS,
integer  M,
integer  N,
real  ALPHA,
real, dimension( lda, * )  A,
integer  LDA,
real, dimension( * )  X,
integer  INCX,
real  BETA,
real, dimension( * )  Y,
integer  INCY 
)

SLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds.

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

Purpose:
 SLA_GEAMV  performs one of the matrix-vector operations

         y := alpha*abs(A)*abs(x) + beta*abs(y),
    or   y := alpha*abs(A)**T*abs(x) + beta*abs(y),

 where alpha and beta are scalars, x and y are vectors and A is an
 m by n 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]TRANS
          TRANS is INTEGER
           On entry, TRANS specifies the operation to be performed as
           follows:

             BLAS_NO_TRANS      y := alpha*abs(A)*abs(x) + beta*abs(y)
             BLAS_TRANS         y := alpha*abs(A**T)*abs(x) + beta*abs(y)
             BLAS_CONJ_TRANS    y := alpha*abs(A**T)*abs(x) + beta*abs(y)

           Unchanged on exit.
[in]M
          M is INTEGER
           On entry, M specifies the number of rows of the matrix A.
           M must be at least zero.
           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, m ).
           Unchanged on exit.
[in]X
          X is REAL array, dimension
           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
           and at least
           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
           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 at least
           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
           and at least
           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
           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.

  Level 2 Blas routine.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 172 of file sla_geamv.f.

174*
175* -- LAPACK computational routine --
176* -- LAPACK is a software package provided by Univ. of Tennessee, --
177* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
178*
179* .. Scalar Arguments ..
180 REAL ALPHA, BETA
181 INTEGER INCX, INCY, LDA, M, N, TRANS
182* ..
183* .. Array Arguments ..
184 REAL A( LDA, * ), X( * ), Y( * )
185* ..
186*
187* =====================================================================
188*
189* .. Parameters ..
190 REAL ONE, ZERO
191 parameter( one = 1.0e+0, zero = 0.0e+0 )
192* ..
193* .. Local Scalars ..
194 LOGICAL SYMB_ZERO
195 REAL TEMP, SAFE1
196 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY
197* ..
198* .. External Subroutines ..
199 EXTERNAL xerbla, slamch
200 REAL SLAMCH
201* ..
202* .. External Functions ..
203 EXTERNAL ilatrans
204 INTEGER ILATRANS
205* ..
206* .. Intrinsic Functions ..
207 INTRINSIC max, abs, sign
208* ..
209* .. Executable Statements ..
210*
211* Test the input parameters.
212*
213 info = 0
214 IF ( .NOT.( ( trans.EQ.ilatrans( 'N' ) )
215 $ .OR. ( trans.EQ.ilatrans( 'T' ) )
216 $ .OR. ( trans.EQ.ilatrans( 'C' )) ) ) THEN
217 info = 1
218 ELSE IF( m.LT.0 )THEN
219 info = 2
220 ELSE IF( n.LT.0 )THEN
221 info = 3
222 ELSE IF( lda.LT.max( 1, m ) )THEN
223 info = 6
224 ELSE IF( incx.EQ.0 )THEN
225 info = 8
226 ELSE IF( incy.EQ.0 )THEN
227 info = 11
228 END IF
229 IF( info.NE.0 )THEN
230 CALL xerbla( 'SLA_GEAMV ', info )
231 RETURN
232 END IF
233*
234* Quick return if possible.
235*
236 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
237 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
238 $ RETURN
239*
240* Set LENX and LENY, the lengths of the vectors x and y, and set
241* up the start points in X and Y.
242*
243 IF( trans.EQ.ilatrans( 'N' ) )THEN
244 lenx = n
245 leny = m
246 ELSE
247 lenx = m
248 leny = n
249 END IF
250 IF( incx.GT.0 )THEN
251 kx = 1
252 ELSE
253 kx = 1 - ( lenx - 1 )*incx
254 END IF
255 IF( incy.GT.0 )THEN
256 ky = 1
257 ELSE
258 ky = 1 - ( leny - 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 = slamch( 'Safe minimum' )
265 safe1 = (n+1)*safe1
266*
267* Form y := alpha*abs(A)*abs(x) + beta*abs(y).
268*
269* The O(M*N) 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( trans.EQ.ilatrans( 'N' ) )THEN
276 DO i = 1, leny
277 IF ( beta .EQ. zero ) THEN
278 symb_zero = .true.
279 y( iy ) = 0.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, lenx
288 temp = abs( a( i, j ) )
289 symb_zero = symb_zero .AND.
290 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
291
292 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
293 END DO
294 END IF
295
296 IF ( .NOT.symb_zero )
297 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
298
299 iy = iy + incy
300 END DO
301 ELSE
302 DO i = 1, leny
303 IF ( beta .EQ. zero ) THEN
304 symb_zero = .true.
305 y( iy ) = 0.0
306 ELSE IF ( y( iy ) .EQ. zero ) THEN
307 symb_zero = .true.
308 ELSE
309 symb_zero = .false.
310 y( iy ) = beta * abs( y( iy ) )
311 END IF
312 IF ( alpha .NE. zero ) THEN
313 DO j = 1, lenx
314 temp = abs( a( j, i ) )
315 symb_zero = symb_zero .AND.
316 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
317
318 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
319 END DO
320 END IF
321
322 IF ( .NOT.symb_zero )
323 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
324
325 iy = iy + incy
326 END DO
327 END IF
328 ELSE
329 IF( trans.EQ.ilatrans( 'N' ) )THEN
330 DO i = 1, leny
331 IF ( beta .EQ. zero ) THEN
332 symb_zero = .true.
333 y( iy ) = 0.0
334 ELSE IF ( y( iy ) .EQ. zero ) THEN
335 symb_zero = .true.
336 ELSE
337 symb_zero = .false.
338 y( iy ) = beta * abs( y( iy ) )
339 END IF
340 IF ( alpha .NE. zero ) THEN
341 jx = kx
342 DO j = 1, lenx
343 temp = abs( a( i, j ) )
344 symb_zero = symb_zero .AND.
345 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
346
347 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
348 jx = jx + incx
349 END DO
350 END IF
351
352 IF (.NOT.symb_zero)
353 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
354
355 iy = iy + incy
356 END DO
357 ELSE
358 DO i = 1, leny
359 IF ( beta .EQ. zero ) THEN
360 symb_zero = .true.
361 y( iy ) = 0.0
362 ELSE IF ( y( iy ) .EQ. zero ) THEN
363 symb_zero = .true.
364 ELSE
365 symb_zero = .false.
366 y( iy ) = beta * abs( y( iy ) )
367 END IF
368 IF ( alpha .NE. zero ) THEN
369 jx = kx
370 DO j = 1, lenx
371 temp = abs( a( j, i ) )
372 symb_zero = symb_zero .AND.
373 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
374
375 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
376 jx = jx + incx
377 END DO
378 END IF
379
380 IF (.NOT.symb_zero)
381 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
382
383 iy = iy + incy
384 END DO
385 END IF
386
387 END IF
388*
389 RETURN
390*
391* End of SLA_GEAMV
392*
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
integer function ilatrans(TRANS)
ILATRANS
Definition: ilatrans.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: