LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dla_gbamv.f
Go to the documentation of this file.
1*> \brief \b DLA_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 DLA_GBAMV + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_gbamv.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_gbamv.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_gbamv.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE DLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
20* INCX, BETA, Y, INCY )
21*
22* .. Scalar Arguments ..
23* DOUBLE PRECISION ALPHA, BETA
24* INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
25* ..
26* .. Array Arguments ..
27* DOUBLE PRECISION AB( LDAB, * ), X( * ), Y( * )
28* ..
29*
30*
31*> \par Purpose:
32* =============
33*>
34*> \verbatim
35*>
36*> DLA_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 DOUBLE PRECISION
101*> On entry, ALPHA specifies the scalar alpha.
102*> Unchanged on exit.
103*> \endverbatim
104*>
105*> \param[in] AB
106*> \verbatim
107*> AB is DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION
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 DOUBLE PRECISION 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 dla_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 DOUBLE PRECISION ALPHA, BETA
192 INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
193* ..
194* .. Array Arguments ..
195 DOUBLE PRECISION AB( LDAB, * ), X( * ), Y( * )
196* ..
197*
198* =====================================================================
199*
200* .. Parameters ..
201 DOUBLE PRECISION ONE, ZERO
202 parameter( one = 1.0d+0, zero = 0.0d+0 )
203* ..
204* .. Local Scalars ..
205 LOGICAL SYMB_ZERO
206 DOUBLE PRECISION TEMP, SAFE1
207 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
208* ..
209* .. External Subroutines ..
210 EXTERNAL xerbla, dlamch
211 DOUBLE PRECISION DLAMCH
212* ..
213* .. External Functions ..
214 EXTERNAL ilatrans
215 INTEGER ILATRANS
216* ..
217* .. Intrinsic Functions ..
218 INTRINSIC max, abs, sign
219* ..
220* .. Executable Statements ..
221*
222* Test the input parameters.
223*
224 info = 0
225 IF ( .NOT.( ( trans.EQ.ilatrans( 'N' ) )
226 $ .OR. ( trans.EQ.ilatrans( 'T' ) )
227 $ .OR. ( trans.EQ.ilatrans( 'C' ) ) ) ) THEN
228 info = 1
229 ELSE IF( m.LT.0 )THEN
230 info = 2
231 ELSE IF( n.LT.0 )THEN
232 info = 3
233 ELSE IF( kl.LT.0 .OR. kl.GT.m-1 ) THEN
234 info = 4
235 ELSE IF( ku.LT.0 .OR. ku.GT.n-1 ) THEN
236 info = 5
237 ELSE IF( ldab.LT.kl+ku+1 )THEN
238 info = 6
239 ELSE IF( incx.EQ.0 )THEN
240 info = 8
241 ELSE IF( incy.EQ.0 )THEN
242 info = 11
243 END IF
244 IF( info.NE.0 )THEN
245 CALL xerbla( 'DLA_GBAMV ', info )
246 RETURN
247 END IF
248*
249* Quick return if possible.
250*
251 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
252 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
253 $ RETURN
254*
255* Set LENX and LENY, the lengths of the vectors x and y, and set
256* up the start points in X and Y.
257*
258 IF( trans.EQ.ilatrans( 'N' ) )THEN
259 lenx = n
260 leny = m
261 ELSE
262 lenx = m
263 leny = n
264 END IF
265 IF( incx.GT.0 )THEN
266 kx = 1
267 ELSE
268 kx = 1 - ( lenx - 1 )*incx
269 END IF
270 IF( incy.GT.0 )THEN
271 ky = 1
272 ELSE
273 ky = 1 - ( leny - 1 )*incy
274 END IF
275*
276* Set SAFE1 essentially to be the underflow threshold times the
277* number of additions in each row.
278*
279 safe1 = dlamch( 'Safe minimum' )
280 safe1 = (n+1)*safe1
281*
282* Form y := alpha*abs(A)*abs(x) + beta*abs(y).
283*
284* The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
285* the inexact flag. Still doesn't help change the iteration order
286* to per-column.
287*
288 kd = ku + 1
289 ke = kl + 1
290 iy = ky
291 IF ( incx.EQ.1 ) THEN
292 IF( trans.EQ.ilatrans( 'N' ) )THEN
293 DO i = 1, leny
294 IF ( beta .EQ. zero ) THEN
295 symb_zero = .true.
296 y( iy ) = 0.0d+0
297 ELSE IF ( y( iy ) .EQ. zero ) THEN
298 symb_zero = .true.
299 ELSE
300 symb_zero = .false.
301 y( iy ) = beta * abs( y( iy ) )
302 END IF
303 IF ( alpha .NE. zero ) THEN
304 DO j = max( i-kl, 1 ), min( i+ku, lenx )
305 temp = abs( ab( kd+i-j, j ) )
306 symb_zero = symb_zero .AND.
307 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
308
309 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
310 END DO
311 END IF
312
313 IF ( .NOT.symb_zero )
314 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
315 iy = iy + incy
316 END DO
317 ELSE
318 DO i = 1, leny
319 IF ( beta .EQ. zero ) THEN
320 symb_zero = .true.
321 y( iy ) = 0.0d+0
322 ELSE IF ( y( iy ) .EQ. zero ) THEN
323 symb_zero = .true.
324 ELSE
325 symb_zero = .false.
326 y( iy ) = beta * abs( y( iy ) )
327 END IF
328 IF ( alpha .NE. zero ) THEN
329 DO j = max( i-kl, 1 ), min( i+ku, lenx )
330 temp = abs( ab( ke-i+j, i ) )
331 symb_zero = symb_zero .AND.
332 $ ( x( j ) .EQ. zero .OR. temp .EQ. zero )
333
334 y( iy ) = y( iy ) + alpha*abs( x( j ) )*temp
335 END DO
336 END IF
337
338 IF ( .NOT.symb_zero )
339 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
340 iy = iy + incy
341 END DO
342 END IF
343 ELSE
344 IF( trans.EQ.ilatrans( 'N' ) )THEN
345 DO i = 1, leny
346 IF ( beta .EQ. zero ) THEN
347 symb_zero = .true.
348 y( iy ) = 0.0d+0
349 ELSE IF ( y( iy ) .EQ. zero ) THEN
350 symb_zero = .true.
351 ELSE
352 symb_zero = .false.
353 y( iy ) = beta * abs( y( iy ) )
354 END IF
355 IF ( alpha .NE. zero ) THEN
356 jx = kx
357 DO j = max( i-kl, 1 ), min( i+ku, lenx )
358 temp = abs( ab( kd+i-j, j ) )
359 symb_zero = symb_zero .AND.
360 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
361
362 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
363 jx = jx + incx
364 END DO
365 END IF
366
367 IF ( .NOT.symb_zero )
368 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
369
370 iy = iy + incy
371 END DO
372 ELSE
373 DO i = 1, leny
374 IF ( beta .EQ. zero ) THEN
375 symb_zero = .true.
376 y( iy ) = 0.0d+0
377 ELSE IF ( y( iy ) .EQ. zero ) THEN
378 symb_zero = .true.
379 ELSE
380 symb_zero = .false.
381 y( iy ) = beta * abs( y( iy ) )
382 END IF
383 IF ( alpha .NE. zero ) THEN
384 jx = kx
385 DO j = max( i-kl, 1 ), min( i+ku, lenx )
386 temp = abs( ab( ke-i+j, i ) )
387 symb_zero = symb_zero .AND.
388 $ ( x( jx ) .EQ. zero .OR. temp .EQ. zero )
389
390 y( iy ) = y( iy ) + alpha*abs( x( jx ) )*temp
391 jx = jx + incx
392 END DO
393 END IF
394
395 IF ( .NOT.symb_zero )
396 $ y( iy ) = y( iy ) + sign( safe1, y( iy ) )
397
398 iy = iy + incy
399 END DO
400 END IF
401
402 END IF
403*
404 RETURN
405*
406* End of DLA_GBAMV
407*
408 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ilatrans
integer function ilatrans(trans)
ILATRANS
Definition ilatrans.f:56
dla_gbamv
subroutine dla_gbamv(trans, m, n, kl, ku, alpha, ab, ldab, x, incx, beta, y, incy)
DLA_GBAMV performs a matrix-vector operation to calculate error bounds.
Definition dla_gbamv.f:185
dlamch
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69