LAPACK 3.11.0
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,
 "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 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.
[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.

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