LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cla_geamv.f
Go to the documentation of this file.
1*> \brief \b CLA_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 CLA_GEAMV + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cla_geamv.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cla_geamv.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cla_geamv.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CLA_GEAMV( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
22* Y, INCY )
23*
24* .. Scalar Arguments ..
25* REAL ALPHA, BETA
26* INTEGER INCX, INCY, LDA, M, N
27* INTEGER TRANS
28* ..
29* .. Array Arguments ..
30* COMPLEX A( LDA, * ), X( * )
31* REAL Y( * )
32* ..
33*
34*
35*> \par Purpose:
36* =============
37*>
38*> \verbatim
39*>
40*> CLA_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 REAL
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 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 array, dimension
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 REAL
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 REAL 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*> \endverbatim
151*>
152*> \param[in] INCY
153*> \verbatim
154*> INCY is INTEGER
155*> On entry, INCY specifies the increment for the elements of
156*> Y. INCY must not be zero.
157*> Unchanged on exit.
158*>
159*> Level 2 Blas routine.
160*> \endverbatim
161*
162* Authors:
163* ========
164*
165*> \author Univ. of Tennessee
166*> \author Univ. of California Berkeley
167*> \author Univ. of Colorado Denver
168*> \author NAG Ltd.
169*
170*> \ingroup complexGEcomputational
171*
172* =====================================================================
173 SUBROUTINE cla_geamv( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
174 $ Y, INCY )
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 REAL ALPHA, BETA
182 INTEGER INCX, INCY, LDA, M, N
183 INTEGER TRANS
184* ..
185* .. Array Arguments ..
186 COMPLEX A( LDA, * ), X( * )
187 REAL Y( * )
188* ..
189*
190* =====================================================================
191*
192* .. Parameters ..
193 COMPLEX ONE, ZERO
194 parameter( one = 1.0e+0, zero = 0.0e+0 )
195* ..
196* .. Local Scalars ..
197 LOGICAL SYMB_ZERO
198 REAL TEMP, SAFE1
199 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY
200 COMPLEX CDUM
201* ..
202* .. External Subroutines ..
203 EXTERNAL xerbla, slamch
204 REAL SLAMCH
205* ..
206* .. External Functions ..
207 EXTERNAL ilatrans
208 INTEGER ILATRANS
209* ..
210* .. Intrinsic Functions ..
211 INTRINSIC max, abs, real, aimag, sign
212* ..
213* .. Statement Functions ..
214 REAL CABS1
215* ..
216* .. Statement Function Definitions ..
217 cabs1( cdum ) = abs( real( cdum ) ) + abs( aimag( 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( 'CLA_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 = slamch( '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.0 ) THEN
288 symb_zero = .true.
289 y( iy ) = 0.0
290 ELSE IF ( y( iy ) .EQ. 0.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.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.0 ) THEN
314 symb_zero = .true.
315 y( iy ) = 0.0
316 ELSE IF ( y( iy ) .EQ. 0.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.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.0 ) THEN
342 symb_zero = .true.
343 y( iy ) = 0.0
344 ELSE IF ( y( iy ) .EQ. 0.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.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.0 ) THEN
370 symb_zero = .true.
371 y( iy ) = 0.0
372 ELSE IF ( y( iy ) .EQ. 0.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.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 CLA_GEAMV
402*
403 END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
integer function ilatrans(TRANS)
ILATRANS
Definition: ilatrans.f:58
subroutine cla_geamv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds.
Definition: cla_geamv.f:175
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68