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