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