1*> \brief \b CSBMV
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 CSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y,
12*                         INCY )
13*
14*       .. Scalar Arguments ..
15*       CHARACTER          UPLO
16*       INTEGER            INCX, INCY, K, LDA, N
17*       COMPLEX            ALPHA, BETA
18*       ..
19*       .. Array Arguments ..
20*       COMPLEX            A( LDA, * ), X( * ), Y( * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> CSBMV  performs the matrix-vector  operation
30*>
31*>    y := alpha*A*x + beta*y,
32*>
33*> where alpha and beta are scalars, x and y are n element vectors and
34*> A is an n by n symmetric band matrix, with k super-diagonals.
35*> \endverbatim
36*
37*  Arguments:
38*  ==========
39*
40*> \verbatim
41*>  UPLO   - 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*>
52*>           Unchanged on exit.
53*>
54*>  N      - INTEGER
55*>           On entry, N specifies the order of the matrix A.
56*>           N must be at least zero.
57*>           Unchanged on exit.
58*>
59*>  K      - INTEGER
60*>           On entry, K specifies the number of super-diagonals of the
61*>           matrix A. K must satisfy  0 .le. K.
62*>           Unchanged on exit.
63*>
64*>  ALPHA  - COMPLEX
65*>           On entry, ALPHA specifies the scalar alpha.
66*>           Unchanged on exit.
67*>
68*>  A      - COMPLEX array, dimension( LDA, N )
69*>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
70*>           by n part of the array A must contain the upper triangular
71*>           band part of the symmetric matrix, supplied column by
72*>           column, with the leading diagonal of the matrix in row
73*>           ( k + 1 ) of the array, the first super-diagonal starting at
74*>           position 2 in row k, and so on. The top left k by k triangle
75*>           of the array A is not referenced.
76*>           The following program segment will transfer the upper
77*>           triangular part of a symmetric band matrix from conventional
78*>           full matrix storage to band storage:
79*>
80*>                 DO 20, J = 1, N
81*>                    M = K + 1 - J
82*>                    DO 10, I = MAX( 1, J - K ), J
83*>                       A( M + I, J ) = matrix( I, J )
84*>              10    CONTINUE
85*>              20 CONTINUE
86*>
87*>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
88*>           by n part of the array A must contain the lower triangular
89*>           band part of the symmetric matrix, supplied column by
90*>           column, with the leading diagonal of the matrix in row 1 of
91*>           the array, the first sub-diagonal starting at position 1 in
92*>           row 2, and so on. The bottom right k by k triangle of the
93*>           array A is not referenced.
94*>           The following program segment will transfer the lower
95*>           triangular part of a symmetric band matrix from conventional
96*>           full matrix storage to band storage:
97*>
98*>                 DO 20, J = 1, N
99*>                    M = 1 - J
100*>                    DO 10, I = J, MIN( N, J + K )
101*>                       A( M + I, J ) = matrix( I, J )
102*>              10    CONTINUE
103*>              20 CONTINUE
104*>
105*>           Unchanged on exit.
106*>
107*>  LDA    - INTEGER
108*>           On entry, LDA specifies the first dimension of A as declared
109*>           in the calling (sub) program. LDA must be at least
110*>           ( k + 1 ).
111*>           Unchanged on exit.
112*>
113*>  X      - COMPLEX array, dimension at least
114*>           ( 1 + ( N - 1 )*abs( INCX ) ).
115*>           Before entry, the incremented array X must contain the
116*>           vector x.
117*>           Unchanged on exit.
118*>
119*>  INCX   - INTEGER
120*>           On entry, INCX specifies the increment for the elements of
121*>           X. INCX must not be zero.
122*>           Unchanged on exit.
123*>
124*>  BETA   - COMPLEX
125*>           On entry, BETA specifies the scalar beta.
126*>           Unchanged on exit.
127*>
128*>  Y      - COMPLEX array, dimension at least
129*>           ( 1 + ( N - 1 )*abs( INCY ) ).
130*>           Before entry, the incremented array Y must contain the
131*>           vector y. On exit, Y is overwritten by the updated vector y.
132*>
133*>  INCY   - INTEGER
134*>           On entry, INCY specifies the increment for the elements of
135*>           Y. INCY must not be zero.
136*>           Unchanged on exit.
137*> \endverbatim
138*
139*  Authors:
140*  ========
141*
142*> \author Univ. of Tennessee
143*> \author Univ. of California Berkeley
144*> \author Univ. of Colorado Denver
145*> \author NAG Ltd.
146*
147*> \ingroup complex_eig
148*
149*  =====================================================================
150      SUBROUTINE CSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y,
151     $                  INCY )
152*
153*  -- LAPACK test routine --
154*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
155*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
156*
157*     .. Scalar Arguments ..
158      CHARACTER          UPLO
159      INTEGER            INCX, INCY, K, LDA, N
160      COMPLEX            ALPHA, BETA
161*     ..
162*     .. Array Arguments ..
163      COMPLEX            A( LDA, * ), X( * ), Y( * )
164*     ..
165*
166*  =====================================================================
167*
168*     .. Parameters ..
169      COMPLEX            ONE
170      PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
171      COMPLEX            ZERO
172      PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
173*     ..
174*     .. Local Scalars ..
175      INTEGER            I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L
176      COMPLEX            TEMP1, TEMP2
177*     ..
178*     .. External Functions ..
179      LOGICAL            LSAME
180      EXTERNAL           LSAME
181*     ..
182*     .. External Subroutines ..
183      EXTERNAL           XERBLA
184*     ..
185*     .. Intrinsic Functions ..
186      INTRINSIC          MAX, MIN
187*     ..
188*     .. Executable Statements ..
189*
190*     Test the input parameters.
191*
192      INFO = 0
193      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
194         INFO = 1
195      ELSE IF( N.LT.0 ) THEN
196         INFO = 2
197      ELSE IF( K.LT.0 ) THEN
198         INFO = 3
199      ELSE IF( LDA.LT.( K+1 ) ) THEN
200         INFO = 6
201      ELSE IF( INCX.EQ.0 ) THEN
202         INFO = 8
203      ELSE IF( INCY.EQ.0 ) THEN
204         INFO = 11
205      END IF
206      IF( INFO.NE.0 ) THEN
207         CALL XERBLA( 'CSBMV ', INFO )
208         RETURN
209      END IF
210*
211*     Quick return if possible.
212*
213      IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) )
214     $   RETURN
215*
216*     Set up the start points in  X  and  Y.
217*
218      IF( INCX.GT.0 ) THEN
219         KX = 1
220      ELSE
221         KX = 1 - ( N-1 )*INCX
222      END IF
223      IF( INCY.GT.0 ) THEN
224         KY = 1
225      ELSE
226         KY = 1 - ( N-1 )*INCY
227      END IF
228*
229*     Start the operations. In this version the elements of the array A
230*     are accessed sequentially with one pass through A.
231*
232*     First form  y := beta*y.
233*
234      IF( BETA.NE.ONE ) THEN
235         IF( INCY.EQ.1 ) THEN
236            IF( BETA.EQ.ZERO ) THEN
237               DO 10 I = 1, N
238                  Y( I ) = ZERO
239   10          CONTINUE
240            ELSE
241               DO 20 I = 1, N
242                  Y( I ) = BETA*Y( I )
243   20          CONTINUE
244            END IF
245         ELSE
246            IY = KY
247            IF( BETA.EQ.ZERO ) THEN
248               DO 30 I = 1, N
249                  Y( IY ) = ZERO
250                  IY = IY + INCY
251   30          CONTINUE
252            ELSE
253               DO 40 I = 1, N
254                  Y( IY ) = BETA*Y( IY )
255                  IY = IY + INCY
256   40          CONTINUE
257            END IF
258         END IF
259      END IF
260      IF( ALPHA.EQ.ZERO )
261     $   RETURN
262      IF( LSAME( UPLO, 'U' ) ) THEN
263*
264*        Form  y  when upper triangle of A is stored.
265*
266         KPLUS1 = K + 1
267         IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
268            DO 60 J = 1, N
269               TEMP1 = ALPHA*X( J )
270               TEMP2 = ZERO
271               L = KPLUS1 - J
272               DO 50 I = MAX( 1, J-K ), J - 1
273                  Y( I ) = Y( I ) + TEMP1*A( L+I, J )
274                  TEMP2 = TEMP2 + A( L+I, J )*X( I )
275   50          CONTINUE
276               Y( J ) = Y( J ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2
277   60       CONTINUE
278         ELSE
279            JX = KX
280            JY = KY
281            DO 80 J = 1, N
282               TEMP1 = ALPHA*X( JX )
283               TEMP2 = ZERO
284               IX = KX
285               IY = KY
286               L = KPLUS1 - J
287               DO 70 I = MAX( 1, J-K ), J - 1
288                  Y( IY ) = Y( IY ) + TEMP1*A( L+I, J )
289                  TEMP2 = TEMP2 + A( L+I, J )*X( IX )
290                  IX = IX + INCX
291                  IY = IY + INCY
292   70          CONTINUE
293               Y( JY ) = Y( JY ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2
294               JX = JX + INCX
295               JY = JY + INCY
296               IF( J.GT.K ) THEN
297                  KX = KX + INCX
298                  KY = KY + INCY
299               END IF
300   80       CONTINUE
301         END IF
302      ELSE
303*
304*        Form  y  when lower triangle of A is stored.
305*
306         IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
307            DO 100 J = 1, N
308               TEMP1 = ALPHA*X( J )
309               TEMP2 = ZERO
310               Y( J ) = Y( J ) + TEMP1*A( 1, J )
311               L = 1 - J
312               DO 90 I = J + 1, MIN( N, J+K )
313                  Y( I ) = Y( I ) + TEMP1*A( L+I, J )
314                  TEMP2 = TEMP2 + A( L+I, J )*X( I )
315   90          CONTINUE
316               Y( J ) = Y( J ) + ALPHA*TEMP2
317  100       CONTINUE
318         ELSE
319            JX = KX
320            JY = KY
321            DO 120 J = 1, N
322               TEMP1 = ALPHA*X( JX )
323               TEMP2 = ZERO
324               Y( JY ) = Y( JY ) + TEMP1*A( 1, J )
325               L = 1 - J
326               IX = JX
327               IY = JY
328               DO 110 I = J + 1, MIN( N, J+K )
329                  IX = IX + INCX
330                  IY = IY + INCY
331                  Y( IY ) = Y( IY ) + TEMP1*A( L+I, J )
332                  TEMP2 = TEMP2 + A( L+I, J )*X( IX )
333  110          CONTINUE
334               Y( JY ) = Y( JY ) + ALPHA*TEMP2
335               JX = JX + INCX
336               JY = JY + INCY
337  120       CONTINUE
338         END IF
339      END IF
340*
341      RETURN
342*
343*     End of CSBMV
344*
345      END
346