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

◆ zla_geamv()

subroutine zla_geamv ( integer trans,
integer m,
integer n,
double precision alpha,
complex*16, dimension( lda, * ) a,
integer lda,
complex*16, dimension( * ) x,
integer incx,
double precision beta,
double precision, dimension( * ) y,
integer incy )

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

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

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