LAPACK 3.12.1
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,
!>  zero components are not perturbed.  A zero
!> entry is considered  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 172 of file sla_geamv.f.

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