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