LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
chbmv.f
Go to the documentation of this file.
1 *> \brief \b CHBMV
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 CHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
12 *
13 * .. Scalar Arguments ..
14 * COMPLEX ALPHA,BETA
15 * INTEGER INCX,INCY,K,LDA,N
16 * CHARACTER UPLO
17 * ..
18 * .. Array Arguments ..
19 * COMPLEX A(LDA,*),X(*),Y(*)
20 * ..
21 *
22 *
23 *> \par Purpose:
24 * =============
25 *>
26 *> \verbatim
27 *>
28 *> CHBMV performs the matrix-vector operation
29 *>
30 *> y := alpha*A*x + beta*y,
31 *>
32 *> where alpha and beta are scalars, x and y are n element vectors and
33 *> A is an n by n hermitian band matrix, with k super-diagonals.
34 *> \endverbatim
35 *
36 * Arguments:
37 * ==========
38 *
39 *> \param[in] UPLO
40 *> \verbatim
41 *> UPLO is CHARACTER*1
42 *> On entry, UPLO specifies whether the upper or lower
43 *> triangular part of the band matrix A is being supplied as
44 *> follows:
45 *>
46 *> UPLO = 'U' or 'u' The upper triangular part of A is
47 *> being supplied.
48 *>
49 *> UPLO = 'L' or 'l' The lower triangular part of A is
50 *> being supplied.
51 *> \endverbatim
52 *>
53 *> \param[in] N
54 *> \verbatim
55 *> N is INTEGER
56 *> On entry, N specifies the order of the matrix A.
57 *> N must be at least zero.
58 *> \endverbatim
59 *>
60 *> \param[in] K
61 *> \verbatim
62 *> K is INTEGER
63 *> On entry, K specifies the number of super-diagonals of the
64 *> matrix A. K must satisfy 0 .le. K.
65 *> \endverbatim
66 *>
67 *> \param[in] ALPHA
68 *> \verbatim
69 *> ALPHA is COMPLEX
70 *> On entry, ALPHA specifies the scalar alpha.
71 *> \endverbatim
72 *>
73 *> \param[in] A
74 *> \verbatim
75 *> A is COMPLEX array of DIMENSION ( LDA, n ).
76 *> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
77 *> by n part of the array A must contain the upper triangular
78 *> band part of the hermitian matrix, supplied column by
79 *> column, with the leading diagonal of the matrix in row
80 *> ( k + 1 ) of the array, the first super-diagonal starting at
81 *> position 2 in row k, and so on. The top left k by k triangle
82 *> of the array A is not referenced.
83 *> The following program segment will transfer the upper
84 *> triangular part of a hermitian band matrix from conventional
85 *> full matrix storage to band storage:
86 *>
87 *> DO 20, J = 1, N
88 *> M = K + 1 - J
89 *> DO 10, I = MAX( 1, J - K ), J
90 *> A( M + I, J ) = matrix( I, J )
91 *> 10 CONTINUE
92 *> 20 CONTINUE
93 *>
94 *> Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
95 *> by n part of the array A must contain the lower triangular
96 *> band part of the hermitian matrix, supplied column by
97 *> column, with the leading diagonal of the matrix in row 1 of
98 *> the array, the first sub-diagonal starting at position 1 in
99 *> row 2, and so on. The bottom right k by k triangle of the
100 *> array A is not referenced.
101 *> The following program segment will transfer the lower
102 *> triangular part of a hermitian band matrix from conventional
103 *> full matrix storage to band storage:
104 *>
105 *> DO 20, J = 1, N
106 *> M = 1 - J
107 *> DO 10, I = J, MIN( N, J + K )
108 *> A( M + I, J ) = matrix( I, J )
109 *> 10 CONTINUE
110 *> 20 CONTINUE
111 *>
112 *> Note that the imaginary parts of the diagonal elements need
113 *> not be set and are assumed to be zero.
114 *> \endverbatim
115 *>
116 *> \param[in] LDA
117 *> \verbatim
118 *> LDA is INTEGER
119 *> On entry, LDA specifies the first dimension of A as declared
120 *> in the calling (sub) program. LDA must be at least
121 *> ( k + 1 ).
122 *> \endverbatim
123 *>
124 *> \param[in] X
125 *> \verbatim
126 *> X is COMPLEX array of DIMENSION at least
127 *> ( 1 + ( n - 1 )*abs( INCX ) ).
128 *> Before entry, the incremented array X must contain the
129 *> vector x.
130 *> \endverbatim
131 *>
132 *> \param[in] INCX
133 *> \verbatim
134 *> INCX is INTEGER
135 *> On entry, INCX specifies the increment for the elements of
136 *> X. INCX must not be zero.
137 *> \endverbatim
138 *>
139 *> \param[in] BETA
140 *> \verbatim
141 *> BETA is COMPLEX
142 *> On entry, BETA specifies the scalar beta.
143 *> \endverbatim
144 *>
145 *> \param[in,out] Y
146 *> \verbatim
147 *> Y is COMPLEX array of DIMENSION at least
148 *> ( 1 + ( n - 1 )*abs( INCY ) ).
149 *> Before entry, the incremented array Y must contain the
150 *> vector y. On exit, Y is overwritten by the updated vector y.
151 *> \endverbatim
152 *>
153 *> \param[in] INCY
154 *> \verbatim
155 *> INCY is INTEGER
156 *> On entry, INCY specifies the increment for the elements of
157 *> Y. INCY must not be zero.
158 *> \endverbatim
159 *
160 * Authors:
161 * ========
162 *
163 *> \author Univ. of Tennessee
164 *> \author Univ. of California Berkeley
165 *> \author Univ. of Colorado Denver
166 *> \author NAG Ltd.
167 *
168 *> \date November 2011
169 *
170 *> \ingroup complex_blas_level2
171 *
172 *> \par Further Details:
173 * =====================
174 *>
175 *> \verbatim
176 *>
177 *> Level 2 Blas routine.
178 *> The vector and matrix arguments are not referenced when N = 0, or M = 0
179 *>
180 *> -- Written on 22-October-1986.
181 *> Jack Dongarra, Argonne National Lab.
182 *> Jeremy Du Croz, Nag Central Office.
183 *> Sven Hammarling, Nag Central Office.
184 *> Richard Hanson, Sandia National Labs.
185 *> \endverbatim
186 *>
187 * =====================================================================
188  SUBROUTINE chbmv(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
189 *
190 * -- Reference BLAS level2 routine (version 3.4.0) --
191 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
192 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
193 * November 2011
194 *
195 * .. Scalar Arguments ..
196  COMPLEX alpha,beta
197  INTEGER incx,incy,k,lda,n
198  CHARACTER uplo
199 * ..
200 * .. Array Arguments ..
201  COMPLEX a(lda,*),x(*),y(*)
202 * ..
203 *
204 * =====================================================================
205 *
206 * .. Parameters ..
207  COMPLEX one
208  parameter(one= (1.0e+0,0.0e+0))
209  COMPLEX zero
210  parameter(zero= (0.0e+0,0.0e+0))
211 * ..
212 * .. Local Scalars ..
213  COMPLEX temp1,temp2
214  INTEGER i,info,ix,iy,j,jx,jy,kplus1,kx,ky,l
215 * ..
216 * .. External Functions ..
217  LOGICAL lsame
218  EXTERNAL lsame
219 * ..
220 * .. External Subroutines ..
221  EXTERNAL xerbla
222 * ..
223 * .. Intrinsic Functions ..
224  INTRINSIC conjg,max,min,real
225 * ..
226 *
227 * Test the input parameters.
228 *
229  info = 0
230  IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
231  info = 1
232  ELSE IF (n.LT.0) THEN
233  info = 2
234  ELSE IF (k.LT.0) THEN
235  info = 3
236  ELSE IF (lda.LT. (k+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('CHBMV ',info)
245  return
246  END IF
247 *
248 * Quick return if possible.
249 *
250  IF ((n.EQ.0) .OR. ((alpha.EQ.zero).AND. (beta.EQ.one))) return
251 *
252 * Set up the start points in X and Y.
253 *
254  IF (incx.GT.0) THEN
255  kx = 1
256  ELSE
257  kx = 1 - (n-1)*incx
258  END IF
259  IF (incy.GT.0) THEN
260  ky = 1
261  ELSE
262  ky = 1 - (n-1)*incy
263  END IF
264 *
265 * Start the operations. In this version the elements of the array A
266 * are accessed sequentially with one pass through A.
267 *
268 * First form y := beta*y.
269 *
270  IF (beta.NE.one) THEN
271  IF (incy.EQ.1) THEN
272  IF (beta.EQ.zero) THEN
273  DO 10 i = 1,n
274  y(i) = zero
275  10 continue
276  ELSE
277  DO 20 i = 1,n
278  y(i) = beta*y(i)
279  20 continue
280  END IF
281  ELSE
282  iy = ky
283  IF (beta.EQ.zero) THEN
284  DO 30 i = 1,n
285  y(iy) = zero
286  iy = iy + incy
287  30 continue
288  ELSE
289  DO 40 i = 1,n
290  y(iy) = beta*y(iy)
291  iy = iy + incy
292  40 continue
293  END IF
294  END IF
295  END IF
296  IF (alpha.EQ.zero) return
297  IF (lsame(uplo,'U')) THEN
298 *
299 * Form y when upper triangle of A is stored.
300 *
301  kplus1 = k + 1
302  IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
303  DO 60 j = 1,n
304  temp1 = alpha*x(j)
305  temp2 = zero
306  l = kplus1 - j
307  DO 50 i = max(1,j-k),j - 1
308  y(i) = y(i) + temp1*a(l+i,j)
309  temp2 = temp2 + conjg(a(l+i,j))*x(i)
310  50 continue
311  y(j) = y(j) + temp1*REAL(A(KPLUS1,J)) + alpha*temp2
312  60 continue
313  ELSE
314  jx = kx
315  jy = ky
316  DO 80 j = 1,n
317  temp1 = alpha*x(jx)
318  temp2 = zero
319  ix = kx
320  iy = ky
321  l = kplus1 - j
322  DO 70 i = max(1,j-k),j - 1
323  y(iy) = y(iy) + temp1*a(l+i,j)
324  temp2 = temp2 + conjg(a(l+i,j))*x(ix)
325  ix = ix + incx
326  iy = iy + incy
327  70 continue
328  y(jy) = y(jy) + temp1*REAL(A(KPLUS1,J)) + alpha*temp2
329  jx = jx + incx
330  jy = jy + incy
331  IF (j.GT.k) THEN
332  kx = kx + incx
333  ky = ky + incy
334  END IF
335  80 continue
336  END IF
337  ELSE
338 *
339 * Form y when lower triangle of A is stored.
340 *
341  IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
342  DO 100 j = 1,n
343  temp1 = alpha*x(j)
344  temp2 = zero
345  y(j) = y(j) + temp1*REAL(a(1,j))
346  l = 1 - j
347  DO 90 i = j + 1,min(n,j+k)
348  y(i) = y(i) + temp1*a(l+i,j)
349  temp2 = temp2 + conjg(a(l+i,j))*x(i)
350  90 continue
351  y(j) = y(j) + alpha*temp2
352  100 continue
353  ELSE
354  jx = kx
355  jy = ky
356  DO 120 j = 1,n
357  temp1 = alpha*x(jx)
358  temp2 = zero
359  y(jy) = y(jy) + temp1*REAL(a(1,j))
360  l = 1 - j
361  ix = jx
362  iy = jy
363  DO 110 i = j + 1,min(n,j+k)
364  ix = ix + incx
365  iy = iy + incy
366  y(iy) = y(iy) + temp1*a(l+i,j)
367  temp2 = temp2 + conjg(a(l+i,j))*x(ix)
368  110 continue
369  y(jy) = y(jy) + alpha*temp2
370  jx = jx + incx
371  jy = jy + incy
372  120 continue
373  END IF
374  END IF
375 *
376  return
377 *
378 * End of CHBMV .
379 *
380  END