LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
sla_geamv.f
Go to the documentation of this file.
1 *> \brief \b SLA_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 SLA_GEAMV + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_geamv.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_geamv.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_geamv.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLA_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, TRANS
27 * ..
28 * .. Array Arguments ..
29 * REAL A( LDA, * ), X( * ), Y( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> SLA_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 REAL
91 *> On entry, ALPHA specifies the scalar alpha.
92 *> Unchanged on exit.
93 *> \endverbatim
94 *>
95 *> \param[in] A
96 *> \verbatim
97 *> A is REAL 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 REAL 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 REAL
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 REAL 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 *> \endverbatim
150 *>
151 *> \param[in] INCY
152 *> \verbatim
153 *> INCY is INTEGER
154 *> On entry, INCY specifies the increment for the elements of
155 *> Y. INCY must not be zero.
156 *> Unchanged on exit.
157 *>
158 *> Level 2 Blas routine.
159 *> \endverbatim
160 *
161 * Authors:
162 * ========
163 *
164 *> \author Univ. of Tennessee
165 *> \author Univ. of California Berkeley
166 *> \author Univ. of Colorado Denver
167 *> \author NAG Ltd.
168 *
169 *> \ingroup realGEcomputational
170 *
171 * =====================================================================
172  SUBROUTINE sla_geamv( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
173  $ Y, INCY )
174 *
175 * -- LAPACK computational routine --
176 * -- LAPACK is a software package provided by Univ. of Tennessee, --
177 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
178 *
179 * .. Scalar Arguments ..
180  REAL ALPHA, BETA
181  INTEGER INCX, INCY, LDA, M, N, TRANS
182 * ..
183 * .. Array Arguments ..
184  REAL A( LDA, * ), X( * ), Y( * )
185 * ..
186 *
187 * =====================================================================
188 *
189 * .. Parameters ..
190  REAL ONE, ZERO
191  parameter( one = 1.0e+0, zero = 0.0e+0 )
192 * ..
193 * .. Local Scalars ..
194  LOGICAL SYMB_ZERO
195  REAL TEMP, SAFE1
196  INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY
197 * ..
198 * .. External Subroutines ..
199  EXTERNAL xerbla, slamch
200  REAL SLAMCH
201 * ..
202 * .. External Functions ..
203  EXTERNAL ilatrans
204  INTEGER ILATRANS
205 * ..
206 * .. Intrinsic Functions ..
207  INTRINSIC max, abs, sign
208 * ..
209 * .. Executable Statements ..
210 *
211 * Test the input parameters.
212 *
213  info = 0
214  IF ( .NOT.( ( trans.EQ.ilatrans( 'N' ) )
215  $ .OR. ( trans.EQ.ilatrans( 'T' ) )
216  $ .OR. ( trans.EQ.ilatrans( 'C' )) ) ) THEN
217  info = 1
218  ELSE IF( m.LT.0 )THEN
219  info = 2
220  ELSE IF( n.LT.0 )THEN
221  info = 3
222  ELSE IF( lda.LT.max( 1, m ) )THEN
223  info = 6
224  ELSE IF( incx.EQ.0 )THEN
225  info = 8
226  ELSE IF( incy.EQ.0 )THEN
227  info = 11
228  END IF
229  IF( info.NE.0 )THEN
230  CALL xerbla( 'SLA_GEAMV ', info )
231  RETURN
232  END IF
233 *
234 * Quick return if possible.
235 *
236  IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
237  $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
238  $ RETURN
239 *
240 * Set LENX and LENY, the lengths of the vectors x and y, and set
241 * up the start points in X and Y.
242 *
243  IF( trans.EQ.ilatrans( 'N' ) )THEN
244  lenx = n
245  leny = m
246  ELSE
247  lenx = m
248  leny = n
249  END IF
250  IF( incx.GT.0 )THEN
251  kx = 1
252  ELSE
253  kx = 1 - ( lenx - 1 )*incx
254  END IF
255  IF( incy.GT.0 )THEN
256  ky = 1
257  ELSE
258  ky = 1 - ( leny - 1 )*incy
259  END IF
260 *
261 * Set SAFE1 essentially to be the underflow threshold times the
262 * number of additions in each row.
263 *
264  safe1 = slamch( 'Safe minimum' )
265  safe1 = (n+1)*safe1
266 *
267 * Form y := alpha*abs(A)*abs(x) + beta*abs(y).
268 *
269 * The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
270 * the inexact flag. Still doesn't help change the iteration order
271 * to per-column.
272 *
273  iy = ky
274  IF ( incx.EQ.1 ) THEN
275  IF( trans.EQ.ilatrans( 'N' ) )THEN
276  DO i = 1, leny
277  IF ( beta .EQ. zero ) THEN
278  symb_zero = .true.
279  y( iy ) = 0.0
280  ELSE IF ( y( iy ) .EQ. zero ) THEN
281  symb_zero = .true.
282  ELSE
283  symb_zero = .false.
284  y( iy ) = beta * abs( y( iy ) )
285  END IF
286  IF ( alpha .NE. zero ) THEN
287  DO j = 1, lenx
288  temp = abs( a( i, j ) )
289  symb_zero = symb_zero .AND.
290  $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
291 
292  y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
293  END DO
294  END IF
295 
296  IF ( .NOT.symb_zero )
297  $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
298 
299  iy = iy + incy
300  END DO
301  ELSE
302  DO i = 1, leny
303  IF ( beta .EQ. zero ) THEN
304  symb_zero = .true.
305  y( iy ) = 0.0
306  ELSE IF ( y( iy ) .EQ. zero ) THEN
307  symb_zero = .true.
308  ELSE
309  symb_zero = .false.
310  y( iy ) = beta * abs( y( iy ) )
311  END IF
312  IF ( alpha .NE. zero ) THEN
313  DO j = 1, lenx
314  temp = abs( a( j, i ) )
315  symb_zero = symb_zero .AND.
316  $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
317 
318  y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
319  END DO
320  END IF
321 
322  IF ( .NOT.symb_zero )
323  $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
324 
325  iy = iy + incy
326  END DO
327  END IF
328  ELSE
329  IF( trans.EQ.ilatrans( 'N' ) )THEN
330  DO i = 1, leny
331  IF ( beta .EQ. zero ) THEN
332  symb_zero = .true.
333  y( iy ) = 0.0
334  ELSE IF ( y( iy ) .EQ. zero ) THEN
335  symb_zero = .true.
336  ELSE
337  symb_zero = .false.
338  y( iy ) = beta * abs( y( iy ) )
339  END IF
340  IF ( alpha .NE. zero ) THEN
341  jx = kx
342  DO j = 1, lenx
343  temp = abs( a( i, j ) )
344  symb_zero = symb_zero .AND.
345  $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
346 
347  y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
348  jx = jx + incx
349  END DO
350  END IF
351 
352  IF (.NOT.symb_zero)
353  $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
354 
355  iy = iy + incy
356  END DO
357  ELSE
358  DO i = 1, leny
359  IF ( beta .EQ. zero ) THEN
360  symb_zero = .true.
361  y( iy ) = 0.0
362  ELSE IF ( y( iy ) .EQ. zero ) THEN
363  symb_zero = .true.
364  ELSE
365  symb_zero = .false.
366  y( iy ) = beta * abs( y( iy ) )
367  END IF
368  IF ( alpha .NE. zero ) THEN
369  jx = kx
370  DO j = 1, lenx
371  temp = abs( a( j, i ) )
372  symb_zero = symb_zero .AND.
373  $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
374 
375  y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
376  jx = jx + incx
377  END DO
378  END IF
379 
380  IF (.NOT.symb_zero)
381  $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
382 
383  iy = iy + incy
384  END DO
385  END IF
386 
387  END IF
388 *
389  RETURN
390 *
391 * End of SLA_GEAMV
392 *
393  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
integer function ilatrans(TRANS)
ILATRANS
Definition: ilatrans.f:58
subroutine sla_geamv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds.
Definition: sla_geamv.f:174
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68