LAPACK 3.12.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.
           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 175 of file zla_geamv.f.

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