PLASMA  2.4.5
PLASMA - Parallel Linear Algebra for Scalable Multi-core Architectures
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
csbmv.f
Go to the documentation of this file.
1  SUBROUTINE csbmv( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y,
2  $ incy )
3 *
4 * -- LAPACK auxiliary routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9  CHARACTER uplo
10  INTEGER incx, incy, k, lda, n
11  COMPLEX alpha, beta
12 * ..
13 * .. Array Arguments ..
14  COMPLEX a( lda, * ), x( * ), y( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * CSBMV performs the matrix-vector operation
21 *
22 * y := alpha*A*x + beta*y,
23 *
24 * where alpha and beta are scalars, x and y are n element vectors and
25 * A is an n by n symmetric band matrix, with k super-diagonals.
26 *
27 * Arguments
28 * ==========
29 *
30 * UPLO - CHARACTER*1
31 * On entry, UPLO specifies whether the upper or lower
32 * triangular part of the band matrix A is being supplied as
33 * follows:
34 *
35 * UPLO = 'U' or 'u' The upper triangular part of A is
36 * being supplied.
37 *
38 * UPLO = 'L' or 'l' The lower triangular part of A is
39 * being supplied.
40 *
41 * Unchanged on exit.
42 *
43 * N - INTEGER
44 * On entry, N specifies the order of the matrix A.
45 * N must be at least zero.
46 * Unchanged on exit.
47 *
48 * K - INTEGER
49 * On entry, K specifies the number of super-diagonals of the
50 * matrix A. K must satisfy 0 .le. K.
51 * Unchanged on exit.
52 *
53 * ALPHA - COMPLEX
54 * On entry, ALPHA specifies the scalar alpha.
55 * Unchanged on exit.
56 *
57 * A - COMPLEX array, dimension( LDA, N )
58 * Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
59 * by n part of the array A must contain the upper triangular
60 * band part of the symmetric matrix, supplied column by
61 * column, with the leading diagonal of the matrix in row
62 * ( k + 1 ) of the array, the first super-diagonal starting at
63 * position 2 in row k, and so on. The top left k by k triangle
64 * of the array A is not referenced.
65 * The following program segment will transfer the upper
66 * triangular part of a symmetric band matrix from conventional
67 * full matrix storage to band storage:
68 *
69 * DO 20, J = 1, N
70 * M = K + 1 - J
71 * DO 10, I = MAX( 1, J - K ), J
72 * A( M + I, J ) = matrix( I, J )
73 * 10 CONTINUE
74 * 20 CONTINUE
75 *
76 * Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
77 * by n part of the array A must contain the lower triangular
78 * band part of the symmetric matrix, supplied column by
79 * column, with the leading diagonal of the matrix in row 1 of
80 * the array, the first sub-diagonal starting at position 1 in
81 * row 2, and so on. The bottom right k by k triangle of the
82 * array A is not referenced.
83 * The following program segment will transfer the lower
84 * triangular part of a symmetric band matrix from conventional
85 * full matrix storage to band storage:
86 *
87 * DO 20, J = 1, N
88 * M = 1 - J
89 * DO 10, I = J, MIN( N, J + K )
90 * A( M + I, J ) = matrix( I, J )
91 * 10 CONTINUE
92 * 20 CONTINUE
93 *
94 * Unchanged on exit.
95 *
96 * LDA - INTEGER
97 * On entry, LDA specifies the first dimension of A as declared
98 * in the calling (sub) program. LDA must be at least
99 * ( k + 1 ).
100 * Unchanged on exit.
101 *
102 * X - COMPLEX array, dimension at least
103 * ( 1 + ( N - 1 )*abs( INCX ) ).
104 * Before entry, the incremented array X must contain the
105 * vector x.
106 * Unchanged on exit.
107 *
108 * INCX - INTEGER
109 * On entry, INCX specifies the increment for the elements of
110 * X. INCX must not be zero.
111 * Unchanged on exit.
112 *
113 * BETA - COMPLEX
114 * On entry, BETA specifies the scalar beta.
115 * Unchanged on exit.
116 *
117 * Y - COMPLEX array, dimension at least
118 * ( 1 + ( N - 1 )*abs( INCY ) ).
119 * Before entry, the incremented array Y must contain the
120 * vector y. On exit, Y is overwritten by the updated vector y.
121 *
122 * INCY - INTEGER
123 * On entry, INCY specifies the increment for the elements of
124 * Y. INCY must not be zero.
125 * Unchanged on exit.
126 *
127 * =====================================================================
128 *
129 * .. Parameters ..
130  COMPLEX one
131  parameter( one = ( 1.0e+0, 0.0e+0 ) )
132  COMPLEX zero
133  parameter( zero = ( 0.0e+0, 0.0e+0 ) )
134 * ..
135 * .. Local Scalars ..
136  INTEGER i, info, ix, iy, j, jx, jy, kplus1, kx, ky, l
137  COMPLEX temp1, temp2
138 * ..
139 * .. External Functions ..
140  LOGICAL lsame
141  EXTERNAL lsame
142 * ..
143 * .. External Subroutines ..
144  EXTERNAL xerbla
145 * ..
146 * .. Intrinsic Functions ..
147  INTRINSIC max, min
148 * ..
149 * .. Executable Statements ..
150 *
151 * Test the input parameters.
152 *
153  info = 0
154  IF( .NOT.lsame( uplo, 'U' ) .AND. .NOT.lsame( uplo, 'L' ) ) THEN
155  info = 1
156  ELSE IF( n.LT.0 ) THEN
157  info = 2
158  ELSE IF( k.LT.0 ) THEN
159  info = 3
160  ELSE IF( lda.LT.( k+1 ) ) THEN
161  info = 6
162  ELSE IF( incx.EQ.0 ) THEN
163  info = 8
164  ELSE IF( incy.EQ.0 ) THEN
165  info = 11
166  END IF
167  IF( info.NE.0 ) THEN
168  CALL xerbla( 'CSBMV ', info )
169  return
170  END IF
171 *
172 * Quick return if possible.
173 *
174  IF( ( n.EQ.0 ) .OR. ( ( alpha.EQ.zero ) .AND. ( beta.EQ.one ) ) )
175  $ return
176 *
177 * Set up the start points in X and Y.
178 *
179  IF( incx.GT.0 ) THEN
180  kx = 1
181  ELSE
182  kx = 1 - ( n-1 )*incx
183  END IF
184  IF( incy.GT.0 ) THEN
185  ky = 1
186  ELSE
187  ky = 1 - ( n-1 )*incy
188  END IF
189 *
190 * Start the operations. In this version the elements of the array A
191 * are accessed sequentially with one pass through A.
192 *
193 * First form y := beta*y.
194 *
195  IF( beta.NE.one ) THEN
196  IF( incy.EQ.1 ) THEN
197  IF( beta.EQ.zero ) THEN
198  DO 10 i = 1, n
199  y( i ) = zero
200  10 continue
201  ELSE
202  DO 20 i = 1, n
203  y( i ) = beta*y( i )
204  20 continue
205  END IF
206  ELSE
207  iy = ky
208  IF( beta.EQ.zero ) THEN
209  DO 30 i = 1, n
210  y( iy ) = zero
211  iy = iy + incy
212  30 continue
213  ELSE
214  DO 40 i = 1, n
215  y( iy ) = beta*y( iy )
216  iy = iy + incy
217  40 continue
218  END IF
219  END IF
220  END IF
221  IF( alpha.EQ.zero )
222  $ return
223  IF( lsame( uplo, 'U' ) ) THEN
224 *
225 * Form y when upper triangle of A is stored.
226 *
227  kplus1 = k + 1
228  IF( ( incx.EQ.1 ) .AND. ( incy.EQ.1 ) ) THEN
229  DO 60 j = 1, n
230  temp1 = alpha*x( j )
231  temp2 = zero
232  l = kplus1 - j
233  DO 50 i = max( 1, j-k ), j - 1
234  y( i ) = y( i ) + temp1*a( l+i, j )
235  temp2 = temp2 + a( l+i, j )*x( i )
236  50 continue
237  y( j ) = y( j ) + temp1*a( kplus1, j ) + alpha*temp2
238  60 continue
239  ELSE
240  jx = kx
241  jy = ky
242  DO 80 j = 1, n
243  temp1 = alpha*x( jx )
244  temp2 = zero
245  ix = kx
246  iy = ky
247  l = kplus1 - j
248  DO 70 i = max( 1, j-k ), j - 1
249  y( iy ) = y( iy ) + temp1*a( l+i, j )
250  temp2 = temp2 + a( l+i, j )*x( ix )
251  ix = ix + incx
252  iy = iy + incy
253  70 continue
254  y( jy ) = y( jy ) + temp1*a( kplus1, j ) + alpha*temp2
255  jx = jx + incx
256  jy = jy + incy
257  IF( j.GT.k ) THEN
258  kx = kx + incx
259  ky = ky + incy
260  END IF
261  80 continue
262  END IF
263  ELSE
264 *
265 * Form y when lower triangle of A is stored.
266 *
267  IF( ( incx.EQ.1 ) .AND. ( incy.EQ.1 ) ) THEN
268  DO 100 j = 1, n
269  temp1 = alpha*x( j )
270  temp2 = zero
271  y( j ) = y( j ) + temp1*a( 1, j )
272  l = 1 - j
273  DO 90 i = j + 1, min( n, j+k )
274  y( i ) = y( i ) + temp1*a( l+i, j )
275  temp2 = temp2 + a( l+i, j )*x( i )
276  90 continue
277  y( j ) = y( j ) + alpha*temp2
278  100 continue
279  ELSE
280  jx = kx
281  jy = ky
282  DO 120 j = 1, n
283  temp1 = alpha*x( jx )
284  temp2 = zero
285  y( jy ) = y( jy ) + temp1*a( 1, j )
286  l = 1 - j
287  ix = jx
288  iy = jy
289  DO 110 i = j + 1, min( n, j+k )
290  ix = ix + incx
291  iy = iy + incy
292  y( iy ) = y( iy ) + temp1*a( l+i, j )
293  temp2 = temp2 + a( l+i, j )*x( ix )
294  110 continue
295  y( jy ) = y( jy ) + alpha*temp2
296  jx = jx + incx
297  jy = jy + incy
298  120 continue
299  END IF
300  END IF
301 *
302  return
303 *
304 * End of CSBMV
305 *
306  END