LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
•All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages
sla_gbamv.f
Go to the documentation of this file.
1*> \brief \b SLA_GBAMV performs a matrix-vector operation to calculate error bounds.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> Download SLA_GBAMV + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_gbamv.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_gbamv.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_gbamv.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE SLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
20* INCX, BETA, Y, INCY )
21*
22* .. Scalar Arguments ..
23* REAL ALPHA, BETA
24* INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
25* ..
26* .. Array Arguments ..
27* REAL AB( LDAB, * ), X( * ), Y( * )
28* ..
29*
30*
31*> \par Purpose:
32* =============
33*>
34*> \verbatim
35*>
36*> SLA_GBAMV performs one of the matrix-vector operations
37*>
38*> y := alpha*abs(A)*abs(x) + beta*abs(y),
39*> or y := alpha*abs(A)**T*abs(x) + beta*abs(y),
40*>
41*> where alpha and beta are scalars, x and y are vectors and A is an
42*> m by n matrix.
43*>
44*> This function is primarily used in calculating error bounds.
45*> To protect against underflow during evaluation, components in
46*> the resulting vector are perturbed away from zero by (N+1)
47*> times the underflow threshold. To prevent unnecessarily large
48*> errors for block-structure embedded in general matrices,
49*> "symbolically" zero components are not perturbed. A zero
50*> entry is considered "symbolic" if all multiplications involved
51*> in computing that entry have at least one zero multiplicand.
52*> \endverbatim
53*
54* Arguments:
55* ==========
56*
57*> \param[in] TRANS
58*> \verbatim
59*> TRANS is INTEGER
60*> On entry, TRANS specifies the operation to be performed as
61*> follows:
62*>
63*> BLAS_NO_TRANS y := alpha*abs(A)*abs(x) + beta*abs(y)
64*> BLAS_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
65*> BLAS_CONJ_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
66*>
67*> Unchanged on exit.
68*> \endverbatim
69*>
70*> \param[in] M
71*> \verbatim
72*> M is INTEGER
73*> On entry, M specifies the number of rows of the matrix A.
74*> M must be at least zero.
75*> Unchanged on exit.
76*> \endverbatim
77*>
78*> \param[in] N
79*> \verbatim
80*> N is INTEGER
81*> On entry, N specifies the number of columns of the matrix A.
82*> N must be at least zero.
83*> Unchanged on exit.
84*> \endverbatim
85*>
86*> \param[in] KL
87*> \verbatim
88*> KL is INTEGER
89*> The number of subdiagonals within the band of A. KL >= 0.
90*> \endverbatim
91*>
92*> \param[in] KU
93*> \verbatim
94*> KU is INTEGER
95*> The number of superdiagonals within the band of A. KU >= 0.
96*> \endverbatim
97*>
98*> \param[in] ALPHA
99*> \verbatim
100*> ALPHA is REAL
101*> On entry, ALPHA specifies the scalar alpha.
102*> Unchanged on exit.
103*> \endverbatim
104*>
105*> \param[in] AB
106*> \verbatim
107*> AB is REAL array, dimension ( LDAB, n )
108*> Before entry, the leading m by n part of the array AB must
109*> contain the matrix of coefficients.
110*> Unchanged on exit.
111*> \endverbatim
112*>
113*> \param[in] LDAB
114*> \verbatim
115*> LDAB is INTEGER
116*> On entry, LDA specifies the first dimension of AB as declared
117*> in the calling (sub) program. LDAB must be at least
118*> max( 1, m ).
119*> Unchanged on exit.
120*> \endverbatim
121*>
122*> \param[in] X
123*> \verbatim
124*> X is REAL array, dimension
125*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
126*> and at least
127*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
128*> Before entry, the incremented array X must contain the
129*> vector x.
130*> Unchanged on exit.
131*> \endverbatim
132*>
133*> \param[in] INCX
134*> \verbatim
135*> INCX is INTEGER
136*> On entry, INCX specifies the increment for the elements of
137*> X. INCX must not be zero.
138*> Unchanged on exit.
139*> \endverbatim
140*>
141*> \param[in] BETA
142*> \verbatim
143*> BETA is REAL
144*> On entry, BETA specifies the scalar beta. When BETA is
145*> supplied as zero then Y need not be set on input.
146*> Unchanged on exit.
147*> \endverbatim
148*>
149*> \param[in,out] Y
150*> \verbatim
151*> Y is REAL array, dimension
152*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
153*> and at least
154*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
155*> Before entry with BETA non-zero, the incremented array Y
156*> must contain the vector y. On exit, Y is overwritten by the
157*> updated vector y.
158*> If either m or n is zero, then Y not referenced and the function
159*> performs a quick return.
160*> \endverbatim
161*>
162*> \param[in] INCY
163*> \verbatim
164*> INCY is INTEGER
165*> On entry, INCY specifies the increment for the elements of
166*> Y. INCY must not be zero.
167*> Unchanged on exit.
168*>
169*> Level 2 Blas routine.
170*> \endverbatim
171*
172* Authors:
173* ========
174*
175*> \author Univ. of Tennessee
176*> \author Univ. of California Berkeley
177*> \author Univ. of Colorado Denver
178*> \author NAG Ltd.
179*
180*> \ingroup la_gbamv
181*
182* =====================================================================
183 SUBROUTINE sla_gbamv( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
184 $ INCX, BETA, Y, INCY )
185*
186* -- LAPACK computational routine --
187* -- LAPACK is a software package provided by Univ. of Tennessee, --
188* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
189*
190* .. Scalar Arguments ..
191 REAL ALPHA, BETA
192 INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
193* ..
194* .. Array Arguments ..
195 REAL AB( LDAB, * ), X( * ), Y( * )
196* ..
197*
198* =====================================================================
199* .. Parameters ..
200 REAL ONE, ZERO
201 parameter( one = 1.0e+0, zero = 0.0e+0 )
202* ..
203* .. Local Scalars ..
204 LOGICAL SYMB_ZERO
205 REAL TEMP, SAFE1
206 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
207* ..
208* .. External Subroutines ..
209 EXTERNAL xerbla, slamch
210 REAL SLAMCH
211* ..
212* .. External Functions ..
213 EXTERNAL ilatrans
214 INTEGER ILATRANS
215* ..
216* .. Intrinsic Functions ..
217 INTRINSIC max, abs, sign
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( kl.LT.0 .OR. kl.GT.m-1 ) THEN
233 info = 4
234 ELSE IF( ku.LT.0 .OR. ku.GT.n-1 ) THEN
235 info = 5
236 ELSE IF( ldab.LT.kl+ku+1 )THEN
237 info = 6
238 ELSE IF( incx.EQ.0 )THEN
239 info = 8
240 ELSE IF( incy.EQ.0 )THEN
241 info = 11
242 END IF
243 IF( info.NE.0 )THEN
244 CALL xerbla( 'SLA_GBAMV ', info )
245 RETURN
246 END IF
247*
248* Quick return if possible.
249*
250 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
251 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
252 $ RETURN
253*
254* Set LENX and LENY, the lengths of the vectors x and y, and set
255* up the start points in X and Y.
256*
257 IF( trans.EQ.ilatrans( 'N' ) )THEN
258 lenx = n
259 leny = m
260 ELSE
261 lenx = m
262 leny = n
263 END IF
264 IF( incx.GT.0 )THEN
265 kx = 1
266 ELSE
267 kx = 1 - ( lenx - 1 )*incx
268 END IF
269 IF( incy.GT.0 )THEN
270 ky = 1
271 ELSE
272 ky = 1 - ( leny - 1 )*incy
273 END IF
274*
275* Set SAFE1 essentially to be the underflow threshold times the
276* number of additions in each row.
277*
278 safe1 = slamch( 'Safe minimum' )
279 safe1 = (n+1)*safe1
280*
281* Form y := alpha*abs(A)*abs(x) + beta*abs(y).
282*
283* The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
284* the inexact flag. Still doesn't help change the iteration order
285* to per-column.
286*
287 kd = ku + 1
288 ke = kl + 1
289 iy = ky
290 IF ( incx.EQ.1 ) THEN
291 IF( trans.EQ.ilatrans( 'N' ) )THEN
292 DO i = 1, leny
293 IF ( beta .EQ. zero ) THEN
294 symb_zero = .true.
295 y( iy ) = 0.0
296 ELSE IF ( y( iy ) .EQ. zero ) THEN
297 symb_zero = .true.
298 ELSE
299 symb_zero = .false.
300 y( iy ) = beta * abs( y( iy ) )
301 END IF
302 IF ( alpha .NE. zero ) THEN
303 DO j = max( i-kl, 1 ), min( i+ku, lenx )
304 temp = abs( ab( kd+i-j, j ) )
305 symb_zero = symb_zero .AND.
306 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
307
308 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
309 END DO
310 END IF
311
312 IF ( .NOT.symb_zero )
313 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
314 iy = iy + incy
315 END DO
316 ELSE
317 DO i = 1, leny
318 IF ( beta .EQ. zero ) THEN
319 symb_zero = .true.
320 y( iy ) = 0.0
321 ELSE IF ( y( iy ) .EQ. zero ) THEN
322 symb_zero = .true.
323 ELSE
324 symb_zero = .false.
325 y( iy ) = beta * abs( y( iy ) )
326 END IF
327 IF ( alpha .NE. zero ) THEN
328 DO j = max( i-kl, 1 ), min( i+ku, lenx )
329 temp = abs( ab( ke-i+j, i ) )
330 symb_zero = symb_zero .AND.
331 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
332
333 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
334 END DO
335 END IF
336
337 IF ( .NOT.symb_zero )
338 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
339 iy = iy + incy
340 END DO
341 END IF
342 ELSE
343 IF( trans.EQ.ilatrans( 'N' ) )THEN
344 DO i = 1, leny
345 IF ( beta .EQ. zero ) THEN
346 symb_zero = .true.
347 y( iy ) = 0.0
348 ELSE IF ( y( iy ) .EQ. zero ) THEN
349 symb_zero = .true.
350 ELSE
351 symb_zero = .false.
352 y( iy ) = beta * abs( y( iy ) )
353 END IF
354 IF ( alpha .NE. zero ) THEN
355 jx = kx
356 DO j = max( i-kl, 1 ), min( i+ku, lenx )
357 temp = abs( ab( kd+i-j, j ) )
358 symb_zero = symb_zero .AND.
359 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
360
361 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
362 jx = jx + incx
363 END DO
364 END IF
365
366 IF ( .NOT.symb_zero )
367 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
368
369 iy = iy + incy
370 END DO
371 ELSE
372 DO i = 1, leny
373 IF ( beta .EQ. zero ) THEN
374 symb_zero = .true.
375 y( iy ) = 0.0
376 ELSE IF ( y( iy ) .EQ. zero ) THEN
377 symb_zero = .true.
378 ELSE
379 symb_zero = .false.
380 y( iy ) = beta * abs( y( iy ) )
381 END IF
382 IF ( alpha .NE. zero ) THEN
383 jx = kx
384 DO j = max( i-kl, 1 ), min( i+ku, lenx )
385 temp = abs( ab( ke-i+j, i ) )
386 symb_zero = symb_zero .AND.
387 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
388
389 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
390 jx = jx + incx
391 END DO
392 END IF
393
394 IF ( .NOT.symb_zero )
395 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
396
397 iy = iy + incy
398 END DO
399 END IF
400
401 END IF
402*
403 RETURN
404*
405* End of SLA_GBAMV
406*
407 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ilatrans
integer function ilatrans(trans)
ILATRANS
Definition ilatrans.f:56
sla_gbamv
subroutine sla_gbamv(trans, m, n, kl, ku, alpha, ab, ldab, x, incx, beta, y, incy)
SLA_GBAMV performs a matrix-vector operation to calculate error bounds.
Definition sla_gbamv.f:185
slamch
real function slamch(cmach)
SLAMCH
Definition slamch.f:68