LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dla_geamv.f
Go to the documentation of this file.
1*> \brief \b DLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DLA_GEAMV + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_geamv.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_geamv.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_geamv.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE DLA_GEAMV( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
22* Y, INCY )
23*
24* .. Scalar Arguments ..
25* DOUBLE PRECISION ALPHA, BETA
26* INTEGER INCX, INCY, LDA, M, N, TRANS
27* ..
28* .. Array Arguments ..
29* DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> DLA_GEAMV performs one of the matrix-vector operations
39*>
40*> y := alpha*abs(A)*abs(x) + beta*abs(y),
41*> or y := alpha*abs(A)**T*abs(x) + beta*abs(y),
42*>
43*> where alpha and beta are scalars, x and y are vectors and A is an
44*> m by n matrix.
45*>
46*> This function is primarily used in calculating error bounds.
47*> To protect against underflow during evaluation, components in
48*> the resulting vector are perturbed away from zero by (N+1)
49*> times the underflow threshold. To prevent unnecessarily large
50*> errors for block-structure embedded in general matrices,
51*> "symbolically" zero components are not perturbed. A zero
52*> entry is considered "symbolic" if all multiplications involved
53*> in computing that entry have at least one zero multiplicand.
54*> \endverbatim
55*
56* Arguments:
57* ==========
58*
59*> \param[in] TRANS
60*> \verbatim
61*> TRANS is INTEGER
62*> On entry, TRANS specifies the operation to be performed as
63*> follows:
64*>
65*> BLAS_NO_TRANS y := alpha*abs(A)*abs(x) + beta*abs(y)
66*> BLAS_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
67*> BLAS_CONJ_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
68*>
69*> Unchanged on exit.
70*> \endverbatim
71*>
72*> \param[in] M
73*> \verbatim
74*> M is INTEGER
75*> On entry, M specifies the number of rows of the matrix A.
76*> M must be at least zero.
77*> Unchanged on exit.
78*> \endverbatim
79*>
80*> \param[in] N
81*> \verbatim
82*> N is INTEGER
83*> On entry, N specifies the number of columns of the matrix A.
84*> N must be at least zero.
85*> Unchanged on exit.
86*> \endverbatim
87*>
88*> \param[in] ALPHA
89*> \verbatim
90*> ALPHA is DOUBLE PRECISION
91*> On entry, ALPHA specifies the scalar alpha.
92*> Unchanged on exit.
93*> \endverbatim
94*>
95*> \param[in] A
96*> \verbatim
97*> A is DOUBLE PRECISION array, dimension ( LDA, n )
98*> Before entry, the leading m by n part of the array A must
99*> contain the matrix of coefficients.
100*> Unchanged on exit.
101*> \endverbatim
102*>
103*> \param[in] LDA
104*> \verbatim
105*> LDA is INTEGER
106*> On entry, LDA specifies the first dimension of A as declared
107*> in the calling (sub) program. LDA must be at least
108*> max( 1, m ).
109*> Unchanged on exit.
110*> \endverbatim
111*>
112*> \param[in] X
113*> \verbatim
114*> X is DOUBLE PRECISION array, dimension
115*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
116*> and at least
117*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
118*> Before entry, the incremented array X must contain the
119*> vector x.
120*> Unchanged on exit.
121*> \endverbatim
122*>
123*> \param[in] INCX
124*> \verbatim
125*> INCX is INTEGER
126*> On entry, INCX specifies the increment for the elements of
127*> X. INCX must not be zero.
128*> Unchanged on exit.
129*> \endverbatim
130*>
131*> \param[in] BETA
132*> \verbatim
133*> BETA is DOUBLE PRECISION
134*> On entry, BETA specifies the scalar beta. When BETA is
135*> supplied as zero then Y need not be set on input.
136*> Unchanged on exit.
137*> \endverbatim
138*>
139*> \param[in,out] Y
140*> \verbatim
141*> Y is DOUBLE PRECISION array,
142*> dimension at least
143*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
144*> and at least
145*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
146*> Before entry with BETA non-zero, the incremented array Y
147*> must contain the vector y. On exit, Y is overwritten by the
148*> updated vector y.
149*> If either m or n is zero, then Y not referenced and the function
150*> performs a quick return.
151*> \endverbatim
152*>
153*> \param[in] INCY
154*> \verbatim
155*> INCY is INTEGER
156*> On entry, INCY specifies the increment for the elements of
157*> Y. INCY must not be zero.
158*> Unchanged on exit.
159*>
160*> Level 2 Blas routine.
161*> \endverbatim
162*
163* Authors:
164* ========
165*
166*> \author Univ. of Tennessee
167*> \author Univ. of California Berkeley
168*> \author Univ. of Colorado Denver
169*> \author NAG Ltd.
170*
171*> \ingroup la_geamv
172*
173* =====================================================================
174 SUBROUTINE dla_geamv ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
175 $ Y, INCY )
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, TRANS
184* ..
185* .. Array Arguments ..
186 DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
187* ..
188*
189* =====================================================================
190*
191* .. Parameters ..
192 DOUBLE PRECISION ONE, ZERO
193 parameter( one = 1.0d+0, zero = 0.0d+0 )
194* ..
195* .. Local Scalars ..
196 LOGICAL SYMB_ZERO
197 DOUBLE PRECISION TEMP, SAFE1
198 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY
199* ..
200* .. External Subroutines ..
201 EXTERNAL xerbla, dlamch
202 DOUBLE PRECISION DLAMCH
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( 'DLA_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 = dlamch( '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.0d+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.0d+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.0d+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.0d+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 DLA_GEAMV
394*
395 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
integer function ilatrans(trans)
ILATRANS
Definition ilatrans.f:58
subroutine dla_geamv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
DLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds.
Definition dla_geamv.f:176
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69