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*> \date December 2016
148*
149*> \ingroup complex_lin
150*
151*  =====================================================================
152      SUBROUTINE CSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y,
153     $                  INCY )
154*
155*  -- LAPACK test routine (version 3.7.0) --
156*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
157*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
158*     December 2016
159*
160*     .. Scalar Arguments ..
161      CHARACTER          UPLO
162      INTEGER            INCX, INCY, K, LDA, N
163      COMPLEX            ALPHA, BETA
164*     ..
165*     .. Array Arguments ..
166      COMPLEX            A( LDA, * ), X( * ), Y( * )
167*     ..
168*
169*  =====================================================================
170*
171*     .. Parameters ..
172      COMPLEX            ONE
173      PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
174      COMPLEX            ZERO
175      PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
176*     ..
177*     .. Local Scalars ..
178      INTEGER            I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L
179      COMPLEX            TEMP1, TEMP2
180*     ..
181*     .. External Functions ..
182      LOGICAL            LSAME
183      EXTERNAL           LSAME
184*     ..
185*     .. External Subroutines ..
186      EXTERNAL           XERBLA
187*     ..
188*     .. Intrinsic Functions ..
189      INTRINSIC          MAX, MIN
190*     ..
191*     .. Executable Statements ..
192*
193*     Test the input parameters.
194*
195      INFO = 0
196      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
197         INFO = 1
198      ELSE IF( N.LT.0 ) THEN
199         INFO = 2
200      ELSE IF( K.LT.0 ) THEN
201         INFO = 3
202      ELSE IF( LDA.LT.( K+1 ) ) THEN
203         INFO = 6
204      ELSE IF( INCX.EQ.0 ) THEN
205         INFO = 8
206      ELSE IF( INCY.EQ.0 ) THEN
207         INFO = 11
208      END IF
209      IF( INFO.NE.0 ) THEN
210         CALL XERBLA( 'CSBMV ', INFO )
211         RETURN
212      END IF
213*
214*     Quick return if possible.
215*
216      IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) )
217     $   RETURN
218*
219*     Set up the start points in  X  and  Y.
220*
221      IF( INCX.GT.0 ) THEN
222         KX = 1
223      ELSE
224         KX = 1 - ( N-1 )*INCX
225      END IF
226      IF( INCY.GT.0 ) THEN
227         KY = 1
228      ELSE
229         KY = 1 - ( N-1 )*INCY
230      END IF
231*
232*     Start the operations. In this version the elements of the array A
233*     are accessed sequentially with one pass through A.
234*
235*     First form  y := beta*y.
236*
237      IF( BETA.NE.ONE ) THEN
238         IF( INCY.EQ.1 ) THEN
239            IF( BETA.EQ.ZERO ) THEN
240               DO 10 I = 1, N
241                  Y( I ) = ZERO
242   10          CONTINUE
243            ELSE
244               DO 20 I = 1, N
245                  Y( I ) = BETA*Y( I )
246   20          CONTINUE
247            END IF
248         ELSE
249            IY = KY
250            IF( BETA.EQ.ZERO ) THEN
251               DO 30 I = 1, N
252                  Y( IY ) = ZERO
253                  IY = IY + INCY
254   30          CONTINUE
255            ELSE
256               DO 40 I = 1, N
257                  Y( IY ) = BETA*Y( IY )
258                  IY = IY + INCY
259   40          CONTINUE
260            END IF
261         END IF
262      END IF
263      IF( ALPHA.EQ.ZERO )
264     $   RETURN
265      IF( LSAME( UPLO, 'U' ) ) THEN
266*
267*        Form  y  when upper triangle of A is stored.
268*
269         KPLUS1 = K + 1
270         IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
271            DO 60 J = 1, N
272               TEMP1 = ALPHA*X( J )
273               TEMP2 = ZERO
274               L = KPLUS1 - J
275               DO 50 I = MAX( 1, J-K ), J - 1
276                  Y( I ) = Y( I ) + TEMP1*A( L+I, J )
277                  TEMP2 = TEMP2 + A( L+I, J )*X( I )
278   50          CONTINUE
279               Y( J ) = Y( J ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2
280   60       CONTINUE
281         ELSE
282            JX = KX
283            JY = KY
284            DO 80 J = 1, N
285               TEMP1 = ALPHA*X( JX )
286               TEMP2 = ZERO
287               IX = KX
288               IY = KY
289               L = KPLUS1 - J
290               DO 70 I = MAX( 1, J-K ), J - 1
291                  Y( IY ) = Y( IY ) + TEMP1*A( L+I, J )
292                  TEMP2 = TEMP2 + A( L+I, J )*X( IX )
293                  IX = IX + INCX
294                  IY = IY + INCY
295   70          CONTINUE
296               Y( JY ) = Y( JY ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2
297               JX = JX + INCX
298               JY = JY + INCY
299               IF( J.GT.K ) THEN
300                  KX = KX + INCX
301                  KY = KY + INCY
302               END IF
303   80       CONTINUE
304         END IF
305      ELSE
306*
307*        Form  y  when lower triangle of A is stored.
308*
309         IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
310            DO 100 J = 1, N
311               TEMP1 = ALPHA*X( J )
312               TEMP2 = ZERO
313               Y( J ) = Y( J ) + TEMP1*A( 1, J )
314               L = 1 - J
315               DO 90 I = J + 1, MIN( N, J+K )
316                  Y( I ) = Y( I ) + TEMP1*A( L+I, J )
317                  TEMP2 = TEMP2 + A( L+I, J )*X( I )
318   90          CONTINUE
319               Y( J ) = Y( J ) + ALPHA*TEMP2
320  100       CONTINUE
321         ELSE
322            JX = KX
323            JY = KY
324            DO 120 J = 1, N
325               TEMP1 = ALPHA*X( JX )
326               TEMP2 = ZERO
327               Y( JY ) = Y( JY ) + TEMP1*A( 1, J )
328               L = 1 - J
329               IX = JX
330               IY = JY
331               DO 110 I = J + 1, MIN( N, J+K )
332                  IX = IX + INCX
333                  IY = IY + INCY
334                  Y( IY ) = Y( IY ) + TEMP1*A( L+I, J )
335                  TEMP2 = TEMP2 + A( L+I, J )*X( IX )
336  110          CONTINUE
337               Y( JY ) = Y( JY ) + ALPHA*TEMP2
338               JX = JX + INCX
339               JY = JY + INCY
340  120       CONTINUE
341         END IF
342      END IF
343*
344      RETURN
345*
346*     End of CSBMV
347*
348      END
349