LAPACK 3.12.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.
           If either m or n is zero, then Y not referenced and the function
           performs a quick return.
[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 174 of file sla_geamv.f.

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