001:       SUBROUTINE CGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
002: *     .. Scalar Arguments ..
003:       COMPLEX ALPHA,BETA
004:       INTEGER INCX,INCY,KL,KU,LDA,M,N
005:       CHARACTER TRANS
006: *     ..
007: *     .. Array Arguments ..
008:       COMPLEX A(LDA,*),X(*),Y(*)
009: *     ..
010: *
011: *  Purpose
012: *  =======
013: *
014: *  CGBMV  performs one of the matrix-vector operations
015: *
016: *     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   or
017: *
018: *     y := alpha*conjg( A' )*x + beta*y,
019: *
020: *  where alpha and beta are scalars, x and y are vectors and A is an
021: *  m by n band matrix, with kl sub-diagonals and ku super-diagonals.
022: *
023: *  Arguments
024: *  ==========
025: *
026: *  TRANS  - CHARACTER*1.
027: *           On entry, TRANS specifies the operation to be performed as
028: *           follows:
029: *
030: *              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
031: *
032: *              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
033: *
034: *              TRANS = 'C' or 'c'   y := alpha*conjg( A' )*x + beta*y.
035: *
036: *           Unchanged on exit.
037: *
038: *  M      - INTEGER.
039: *           On entry, M specifies the number of rows of the matrix A.
040: *           M must be at least zero.
041: *           Unchanged on exit.
042: *
043: *  N      - INTEGER.
044: *           On entry, N specifies the number of columns of the matrix A.
045: *           N must be at least zero.
046: *           Unchanged on exit.
047: *
048: *  KL     - INTEGER.
049: *           On entry, KL specifies the number of sub-diagonals of the
050: *           matrix A. KL must satisfy  0 .le. KL.
051: *           Unchanged on exit.
052: *
053: *  KU     - INTEGER.
054: *           On entry, KU specifies the number of super-diagonals of the
055: *           matrix A. KU must satisfy  0 .le. KU.
056: *           Unchanged on exit.
057: *
058: *  ALPHA  - COMPLEX         .
059: *           On entry, ALPHA specifies the scalar alpha.
060: *           Unchanged on exit.
061: *
062: *  A      - COMPLEX          array of DIMENSION ( LDA, n ).
063: *           Before entry, the leading ( kl + ku + 1 ) by n part of the
064: *           array A must contain the matrix of coefficients, supplied
065: *           column by column, with the leading diagonal of the matrix in
066: *           row ( ku + 1 ) of the array, the first super-diagonal
067: *           starting at position 2 in row ku, the first sub-diagonal
068: *           starting at position 1 in row ( ku + 2 ), and so on.
069: *           Elements in the array A that do not correspond to elements
070: *           in the band matrix (such as the top left ku by ku triangle)
071: *           are not referenced.
072: *           The following program segment will transfer a band matrix
073: *           from conventional full matrix storage to band storage:
074: *
075: *                 DO 20, J = 1, N
076: *                    K = KU + 1 - J
077: *                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
078: *                       A( K + I, J ) = matrix( I, J )
079: *              10    CONTINUE
080: *              20 CONTINUE
081: *
082: *           Unchanged on exit.
083: *
084: *  LDA    - INTEGER.
085: *           On entry, LDA specifies the first dimension of A as declared
086: *           in the calling (sub) program. LDA must be at least
087: *           ( kl + ku + 1 ).
088: *           Unchanged on exit.
089: *
090: *  X      - COMPLEX          array of DIMENSION at least
091: *           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
092: *           and at least
093: *           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
094: *           Before entry, the incremented array X must contain the
095: *           vector x.
096: *           Unchanged on exit.
097: *
098: *  INCX   - INTEGER.
099: *           On entry, INCX specifies the increment for the elements of
100: *           X. INCX must not be zero.
101: *           Unchanged on exit.
102: *
103: *  BETA   - COMPLEX         .
104: *           On entry, BETA specifies the scalar beta. When BETA is
105: *           supplied as zero then Y need not be set on input.
106: *           Unchanged on exit.
107: *
108: *  Y      - COMPLEX          array of DIMENSION at least
109: *           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
110: *           and at least
111: *           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
112: *           Before entry, the incremented array Y must contain the
113: *           vector y. On exit, Y is overwritten by the updated vector y.
114: *
115: *
116: *  INCY   - INTEGER.
117: *           On entry, INCY specifies the increment for the elements of
118: *           Y. INCY must not be zero.
119: *           Unchanged on exit.
120: *
121: *
122: *  Level 2 Blas routine.
123: *
124: *  -- Written on 22-October-1986.
125: *     Jack Dongarra, Argonne National Lab.
126: *     Jeremy Du Croz, Nag Central Office.
127: *     Sven Hammarling, Nag Central Office.
128: *     Richard Hanson, Sandia National Labs.
129: *
130: *
131: *     .. Parameters ..
132:       COMPLEX ONE
133:       PARAMETER (ONE= (1.0E+0,0.0E+0))
134:       COMPLEX ZERO
135:       PARAMETER (ZERO= (0.0E+0,0.0E+0))
136: *     ..
137: *     .. Local Scalars ..
138:       COMPLEX TEMP
139:       INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
140:       LOGICAL NOCONJ
141: *     ..
142: *     .. External Functions ..
143:       LOGICAL LSAME
144:       EXTERNAL LSAME
145: *     ..
146: *     .. External Subroutines ..
147:       EXTERNAL XERBLA
148: *     ..
149: *     .. Intrinsic Functions ..
150:       INTRINSIC CONJG,MAX,MIN
151: *     ..
152: *
153: *     Test the input parameters.
154: *
155:       INFO = 0
156:       IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
157:      +    .NOT.LSAME(TRANS,'C')) THEN
158:           INFO = 1
159:       ELSE IF (M.LT.0) THEN
160:           INFO = 2
161:       ELSE IF (N.LT.0) THEN
162:           INFO = 3
163:       ELSE IF (KL.LT.0) THEN
164:           INFO = 4
165:       ELSE IF (KU.LT.0) THEN
166:           INFO = 5
167:       ELSE IF (LDA.LT. (KL+KU+1)) THEN
168:           INFO = 8
169:       ELSE IF (INCX.EQ.0) THEN
170:           INFO = 10
171:       ELSE IF (INCY.EQ.0) THEN
172:           INFO = 13
173:       END IF
174:       IF (INFO.NE.0) THEN
175:           CALL XERBLA('CGBMV ',INFO)
176:           RETURN
177:       END IF
178: *
179: *     Quick return if possible.
180: *
181:       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
182:      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
183: *
184:       NOCONJ = LSAME(TRANS,'T')
185: *
186: *     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
187: *     up the start points in  X  and  Y.
188: *
189:       IF (LSAME(TRANS,'N')) THEN
190:           LENX = N
191:           LENY = M
192:       ELSE
193:           LENX = M
194:           LENY = N
195:       END IF
196:       IF (INCX.GT.0) THEN
197:           KX = 1
198:       ELSE
199:           KX = 1 - (LENX-1)*INCX
200:       END IF
201:       IF (INCY.GT.0) THEN
202:           KY = 1
203:       ELSE
204:           KY = 1 - (LENY-1)*INCY
205:       END IF
206: *
207: *     Start the operations. In this version the elements of A are
208: *     accessed sequentially with one pass through the band part of A.
209: *
210: *     First form  y := beta*y.
211: *
212:       IF (BETA.NE.ONE) THEN
213:           IF (INCY.EQ.1) THEN
214:               IF (BETA.EQ.ZERO) THEN
215:                   DO 10 I = 1,LENY
216:                       Y(I) = ZERO
217:    10             CONTINUE
218:               ELSE
219:                   DO 20 I = 1,LENY
220:                       Y(I) = BETA*Y(I)
221:    20             CONTINUE
222:               END IF
223:           ELSE
224:               IY = KY
225:               IF (BETA.EQ.ZERO) THEN
226:                   DO 30 I = 1,LENY
227:                       Y(IY) = ZERO
228:                       IY = IY + INCY
229:    30             CONTINUE
230:               ELSE
231:                   DO 40 I = 1,LENY
232:                       Y(IY) = BETA*Y(IY)
233:                       IY = IY + INCY
234:    40             CONTINUE
235:               END IF
236:           END IF
237:       END IF
238:       IF (ALPHA.EQ.ZERO) RETURN
239:       KUP1 = KU + 1
240:       IF (LSAME(TRANS,'N')) THEN
241: *
242: *        Form  y := alpha*A*x + y.
243: *
244:           JX = KX
245:           IF (INCY.EQ.1) THEN
246:               DO 60 J = 1,N
247:                   IF (X(JX).NE.ZERO) THEN
248:                       TEMP = ALPHA*X(JX)
249:                       K = KUP1 - J
250:                       DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
251:                           Y(I) = Y(I) + TEMP*A(K+I,J)
252:    50                 CONTINUE
253:                   END IF
254:                   JX = JX + INCX
255:    60         CONTINUE
256:           ELSE
257:               DO 80 J = 1,N
258:                   IF (X(JX).NE.ZERO) THEN
259:                       TEMP = ALPHA*X(JX)
260:                       IY = KY
261:                       K = KUP1 - J
262:                       DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
263:                           Y(IY) = Y(IY) + TEMP*A(K+I,J)
264:                           IY = IY + INCY
265:    70                 CONTINUE
266:                   END IF
267:                   JX = JX + INCX
268:                   IF (J.GT.KU) KY = KY + INCY
269:    80         CONTINUE
270:           END IF
271:       ELSE
272: *
273: *        Form  y := alpha*A'*x + y  or  y := alpha*conjg( A' )*x + y.
274: *
275:           JY = KY
276:           IF (INCX.EQ.1) THEN
277:               DO 110 J = 1,N
278:                   TEMP = ZERO
279:                   K = KUP1 - J
280:                   IF (NOCONJ) THEN
281:                       DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
282:                           TEMP = TEMP + A(K+I,J)*X(I)
283:    90                 CONTINUE
284:                   ELSE
285:                       DO 100 I = MAX(1,J-KU),MIN(M,J+KL)
286:                           TEMP = TEMP + CONJG(A(K+I,J))*X(I)
287:   100                 CONTINUE
288:                   END IF
289:                   Y(JY) = Y(JY) + ALPHA*TEMP
290:                   JY = JY + INCY
291:   110         CONTINUE
292:           ELSE
293:               DO 140 J = 1,N
294:                   TEMP = ZERO
295:                   IX = KX
296:                   K = KUP1 - J
297:                   IF (NOCONJ) THEN
298:                       DO 120 I = MAX(1,J-KU),MIN(M,J+KL)
299:                           TEMP = TEMP + A(K+I,J)*X(IX)
300:                           IX = IX + INCX
301:   120                 CONTINUE
302:                   ELSE
303:                       DO 130 I = MAX(1,J-KU),MIN(M,J+KL)
304:                           TEMP = TEMP + CONJG(A(K+I,J))*X(IX)
305:                           IX = IX + INCX
306:   130                 CONTINUE
307:                   END IF
308:                   Y(JY) = Y(JY) + ALPHA*TEMP
309:                   JY = JY + INCY
310:                   IF (J.GT.KU) KX = KX + INCX
311:   140         CONTINUE
312:           END IF
313:       END IF
314: *
315:       RETURN
316: *
317: *     End of CGBMV .
318: *
319:       END
320: