LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
sgbmv.f
Go to the documentation of this file.
1 *> \brief \b SGBMV
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
12 *
13 * .. Scalar Arguments ..
14 * REAL ALPHA,BETA
15 * INTEGER INCX,INCY,KL,KU,LDA,M,N
16 * CHARACTER TRANS
17 * ..
18 * .. Array Arguments ..
19 * REAL A(LDA,*),X(*),Y(*)
20 * ..
21 *
22 *
23 *> \par Purpose:
24 * =============
25 *>
26 *> \verbatim
27 *>
28 *> SGBMV performs one of the matrix-vector operations
29 *>
30 *> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y,
31 *>
32 *> where alpha and beta are scalars, x and y are vectors and A is an
33 *> m by n band matrix, with kl sub-diagonals and ku super-diagonals.
34 *> \endverbatim
35 *
36 * Arguments:
37 * ==========
38 *
39 *> \param[in] TRANS
40 *> \verbatim
41 *> TRANS is CHARACTER*1
42 *> On entry, TRANS specifies the operation to be performed as
43 *> follows:
44 *>
45 *> TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
46 *>
47 *> TRANS = 'T' or 't' y := alpha*A**T*x + beta*y.
48 *>
49 *> TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y.
50 *> \endverbatim
51 *>
52 *> \param[in] M
53 *> \verbatim
54 *> M is INTEGER
55 *> On entry, M specifies the number of rows of the matrix A.
56 *> M must be at least zero.
57 *> \endverbatim
58 *>
59 *> \param[in] N
60 *> \verbatim
61 *> N is INTEGER
62 *> On entry, N specifies the number of columns of the matrix A.
63 *> N must be at least zero.
64 *> \endverbatim
65 *>
66 *> \param[in] KL
67 *> \verbatim
68 *> KL is INTEGER
69 *> On entry, KL specifies the number of sub-diagonals of the
70 *> matrix A. KL must satisfy 0 .le. KL.
71 *> \endverbatim
72 *>
73 *> \param[in] KU
74 *> \verbatim
75 *> KU is INTEGER
76 *> On entry, KU specifies the number of super-diagonals of the
77 *> matrix A. KU must satisfy 0 .le. KU.
78 *> \endverbatim
79 *>
80 *> \param[in] ALPHA
81 *> \verbatim
82 *> ALPHA is REAL
83 *> On entry, ALPHA specifies the scalar alpha.
84 *> \endverbatim
85 *>
86 *> \param[in] A
87 *> \verbatim
88 *> A is REAL array of DIMENSION ( LDA, n ).
89 *> Before entry, the leading ( kl + ku + 1 ) by n part of the
90 *> array A must contain the matrix of coefficients, supplied
91 *> column by column, with the leading diagonal of the matrix in
92 *> row ( ku + 1 ) of the array, the first super-diagonal
93 *> starting at position 2 in row ku, the first sub-diagonal
94 *> starting at position 1 in row ( ku + 2 ), and so on.
95 *> Elements in the array A that do not correspond to elements
96 *> in the band matrix (such as the top left ku by ku triangle)
97 *> are not referenced.
98 *> The following program segment will transfer a band matrix
99 *> from conventional full matrix storage to band storage:
100 *>
101 *> DO 20, J = 1, N
102 *> K = KU + 1 - J
103 *> DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
104 *> A( K + I, J ) = matrix( I, J )
105 *> 10 CONTINUE
106 *> 20 CONTINUE
107 *> \endverbatim
108 *>
109 *> \param[in] LDA
110 *> \verbatim
111 *> LDA is INTEGER
112 *> On entry, LDA specifies the first dimension of A as declared
113 *> in the calling (sub) program. LDA must be at least
114 *> ( kl + ku + 1 ).
115 *> \endverbatim
116 *>
117 *> \param[in] X
118 *> \verbatim
119 *> X is REAL array of DIMENSION at least
120 *> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
121 *> and at least
122 *> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
123 *> Before entry, the incremented array X must contain the
124 *> vector x.
125 *> \endverbatim
126 *>
127 *> \param[in] INCX
128 *> \verbatim
129 *> INCX is INTEGER
130 *> On entry, INCX specifies the increment for the elements of
131 *> X. INCX must not be zero.
132 *> \endverbatim
133 *>
134 *> \param[in] BETA
135 *> \verbatim
136 *> BETA is REAL
137 *> On entry, BETA specifies the scalar beta. When BETA is
138 *> supplied as zero then Y need not be set on input.
139 *> \endverbatim
140 *>
141 *> \param[in,out] Y
142 *> \verbatim
143 *> Y is REAL array of DIMENSION at least
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, the incremented array Y must contain the
148 *> vector y. On exit, Y is overwritten by the 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 *> \endverbatim
157 *
158 * Authors:
159 * ========
160 *
161 *> \author Univ. of Tennessee
162 *> \author Univ. of California Berkeley
163 *> \author Univ. of Colorado Denver
164 *> \author NAG Ltd.
165 *
166 *> \date November 2011
167 *
168 *> \ingroup single_blas_level2
169 *
170 *> \par Further Details:
171 * =====================
172 *>
173 *> \verbatim
174 *>
175 *> Level 2 Blas routine.
176 *> The vector and matrix arguments are not referenced when N = 0, or M = 0
177 *>
178 *> -- Written on 22-October-1986.
179 *> Jack Dongarra, Argonne National Lab.
180 *> Jeremy Du Croz, Nag Central Office.
181 *> Sven Hammarling, Nag Central Office.
182 *> Richard Hanson, Sandia National Labs.
183 *> \endverbatim
184 *>
185 * =====================================================================
186  SUBROUTINE sgbmv(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
187 *
188 * -- Reference BLAS level2 routine (version 3.4.0) --
189 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
190 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
191 * November 2011
192 *
193 * .. Scalar Arguments ..
194  REAL alpha,beta
195  INTEGER incx,incy,kl,ku,lda,m,n
196  CHARACTER trans
197 * ..
198 * .. Array Arguments ..
199  REAL a(lda,*),x(*),y(*)
200 * ..
201 *
202 * =====================================================================
203 *
204 * .. Parameters ..
205  REAL one,zero
206  parameter(one=1.0e+0,zero=0.0e+0)
207 * ..
208 * .. Local Scalars ..
209  REAL temp
210  INTEGER i,info,ix,iy,j,jx,jy,k,kup1,kx,ky,lenx,leny
211 * ..
212 * .. External Functions ..
213  LOGICAL lsame
214  EXTERNAL lsame
215 * ..
216 * .. External Subroutines ..
217  EXTERNAL xerbla
218 * ..
219 * .. Intrinsic Functions ..
220  INTRINSIC max,min
221 * ..
222 *
223 * Test the input parameters.
224 *
225  info = 0
226  IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
227  + .NOT.lsame(trans,'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) THEN
234  info = 4
235  ELSE IF (ku.LT.0) THEN
236  info = 5
237  ELSE IF (lda.LT. (kl+ku+1)) THEN
238  info = 8
239  ELSE IF (incx.EQ.0) THEN
240  info = 10
241  ELSE IF (incy.EQ.0) THEN
242  info = 13
243  END IF
244  IF (info.NE.0) THEN
245  CALL xerbla('SGBMV ',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))) 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 (lsame(trans,'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 * Start the operations. In this version the elements of A are
276 * accessed sequentially with one pass through the band part of A.
277 *
278 * First form y := beta*y.
279 *
280  IF (beta.NE.one) THEN
281  IF (incy.EQ.1) THEN
282  IF (beta.EQ.zero) THEN
283  DO 10 i = 1,leny
284  y(i) = zero
285  10 continue
286  ELSE
287  DO 20 i = 1,leny
288  y(i) = beta*y(i)
289  20 continue
290  END IF
291  ELSE
292  iy = ky
293  IF (beta.EQ.zero) THEN
294  DO 30 i = 1,leny
295  y(iy) = zero
296  iy = iy + incy
297  30 continue
298  ELSE
299  DO 40 i = 1,leny
300  y(iy) = beta*y(iy)
301  iy = iy + incy
302  40 continue
303  END IF
304  END IF
305  END IF
306  IF (alpha.EQ.zero) return
307  kup1 = ku + 1
308  IF (lsame(trans,'N')) THEN
309 *
310 * Form y := alpha*A*x + y.
311 *
312  jx = kx
313  IF (incy.EQ.1) THEN
314  DO 60 j = 1,n
315  IF (x(jx).NE.zero) THEN
316  temp = alpha*x(jx)
317  k = kup1 - j
318  DO 50 i = max(1,j-ku),min(m,j+kl)
319  y(i) = y(i) + temp*a(k+i,j)
320  50 continue
321  END IF
322  jx = jx + incx
323  60 continue
324  ELSE
325  DO 80 j = 1,n
326  IF (x(jx).NE.zero) THEN
327  temp = alpha*x(jx)
328  iy = ky
329  k = kup1 - j
330  DO 70 i = max(1,j-ku),min(m,j+kl)
331  y(iy) = y(iy) + temp*a(k+i,j)
332  iy = iy + incy
333  70 continue
334  END IF
335  jx = jx + incx
336  IF (j.GT.ku) ky = ky + incy
337  80 continue
338  END IF
339  ELSE
340 *
341 * Form y := alpha*A**T*x + y.
342 *
343  jy = ky
344  IF (incx.EQ.1) THEN
345  DO 100 j = 1,n
346  temp = zero
347  k = kup1 - j
348  DO 90 i = max(1,j-ku),min(m,j+kl)
349  temp = temp + a(k+i,j)*x(i)
350  90 continue
351  y(jy) = y(jy) + alpha*temp
352  jy = jy + incy
353  100 continue
354  ELSE
355  DO 120 j = 1,n
356  temp = zero
357  ix = kx
358  k = kup1 - j
359  DO 110 i = max(1,j-ku),min(m,j+kl)
360  temp = temp + a(k+i,j)*x(ix)
361  ix = ix + incx
362  110 continue
363  y(jy) = y(jy) + alpha*temp
364  jy = jy + incy
365  IF (j.GT.ku) kx = kx + incx
366  120 continue
367  END IF
368  END IF
369 *
370  return
371 *
372 * End of SGBMV .
373 *
374  END