001:       SUBROUTINE SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
002: *     .. Scalar Arguments ..
003:       REAL ALPHA,BETA
004:       INTEGER INCX,INCY,KL,KU,LDA,M,N
005:       CHARACTER TRANS
006: *     ..
007: *     .. Array Arguments ..
008:       REAL A(LDA,*),X(*),Y(*)
009: *     ..
010: *
011: *  Purpose
012: *  =======
013: *
014: *  SGBMV  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  - REAL            .
057: *           On entry, ALPHA specifies the scalar alpha.
058: *           Unchanged on exit.
059: *
060: *  A      - REAL             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      - REAL             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   - REAL            .
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      - REAL             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: *  Further Details
119: *  ===============
120: *
121: *  Level 2 Blas routine.
122: *
123: *  -- Written on 22-October-1986.
124: *     Jack Dongarra, Argonne National Lab.
125: *     Jeremy Du Croz, Nag Central Office.
126: *     Sven Hammarling, Nag Central Office.
127: *     Richard Hanson, Sandia National Labs.
128: *
129: *  =====================================================================
130: *
131: *     .. Parameters ..
132:       REAL ONE,ZERO
133:       PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
134: *     ..
135: *     .. Local Scalars ..
136:       REAL TEMP
137:       INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
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: *
150: *     Test the input parameters.
151: *
152:       INFO = 0
153:       IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
154:      +    .NOT.LSAME(TRANS,'C')) THEN
155:           INFO = 1
156:       ELSE IF (M.LT.0) THEN
157:           INFO = 2
158:       ELSE IF (N.LT.0) THEN
159:           INFO = 3
160:       ELSE IF (KL.LT.0) THEN
161:           INFO = 4
162:       ELSE IF (KU.LT.0) THEN
163:           INFO = 5
164:       ELSE IF (LDA.LT. (KL+KU+1)) THEN
165:           INFO = 8
166:       ELSE IF (INCX.EQ.0) THEN
167:           INFO = 10
168:       ELSE IF (INCY.EQ.0) THEN
169:           INFO = 13
170:       END IF
171:       IF (INFO.NE.0) THEN
172:           CALL XERBLA('SGBMV ',INFO)
173:           RETURN
174:       END IF
175: *
176: *     Quick return if possible.
177: *
178:       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
179:      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
180: *
181: *     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
182: *     up the start points in  X  and  Y.
183: *
184:       IF (LSAME(TRANS,'N')) THEN
185:           LENX = N
186:           LENY = M
187:       ELSE
188:           LENX = M
189:           LENY = N
190:       END IF
191:       IF (INCX.GT.0) THEN
192:           KX = 1
193:       ELSE
194:           KX = 1 - (LENX-1)*INCX
195:       END IF
196:       IF (INCY.GT.0) THEN
197:           KY = 1
198:       ELSE
199:           KY = 1 - (LENY-1)*INCY
200:       END IF
201: *
202: *     Start the operations. In this version the elements of A are
203: *     accessed sequentially with one pass through the band part of A.
204: *
205: *     First form  y := beta*y.
206: *
207:       IF (BETA.NE.ONE) THEN
208:           IF (INCY.EQ.1) THEN
209:               IF (BETA.EQ.ZERO) THEN
210:                   DO 10 I = 1,LENY
211:                       Y(I) = ZERO
212:    10             CONTINUE
213:               ELSE
214:                   DO 20 I = 1,LENY
215:                       Y(I) = BETA*Y(I)
216:    20             CONTINUE
217:               END IF
218:           ELSE
219:               IY = KY
220:               IF (BETA.EQ.ZERO) THEN
221:                   DO 30 I = 1,LENY
222:                       Y(IY) = ZERO
223:                       IY = IY + INCY
224:    30             CONTINUE
225:               ELSE
226:                   DO 40 I = 1,LENY
227:                       Y(IY) = BETA*Y(IY)
228:                       IY = IY + INCY
229:    40             CONTINUE
230:               END IF
231:           END IF
232:       END IF
233:       IF (ALPHA.EQ.ZERO) RETURN
234:       KUP1 = KU + 1
235:       IF (LSAME(TRANS,'N')) THEN
236: *
237: *        Form  y := alpha*A*x + y.
238: *
239:           JX = KX
240:           IF (INCY.EQ.1) THEN
241:               DO 60 J = 1,N
242:                   IF (X(JX).NE.ZERO) THEN
243:                       TEMP = ALPHA*X(JX)
244:                       K = KUP1 - J
245:                       DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
246:                           Y(I) = Y(I) + TEMP*A(K+I,J)
247:    50                 CONTINUE
248:                   END IF
249:                   JX = JX + INCX
250:    60         CONTINUE
251:           ELSE
252:               DO 80 J = 1,N
253:                   IF (X(JX).NE.ZERO) THEN
254:                       TEMP = ALPHA*X(JX)
255:                       IY = KY
256:                       K = KUP1 - J
257:                       DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
258:                           Y(IY) = Y(IY) + TEMP*A(K+I,J)
259:                           IY = IY + INCY
260:    70                 CONTINUE
261:                   END IF
262:                   JX = JX + INCX
263:                   IF (J.GT.KU) KY = KY + INCY
264:    80         CONTINUE
265:           END IF
266:       ELSE
267: *
268: *        Form  y := alpha*A'*x + y.
269: *
270:           JY = KY
271:           IF (INCX.EQ.1) THEN
272:               DO 100 J = 1,N
273:                   TEMP = ZERO
274:                   K = KUP1 - J
275:                   DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
276:                       TEMP = TEMP + A(K+I,J)*X(I)
277:    90             CONTINUE
278:                   Y(JY) = Y(JY) + ALPHA*TEMP
279:                   JY = JY + INCY
280:   100         CONTINUE
281:           ELSE
282:               DO 120 J = 1,N
283:                   TEMP = ZERO
284:                   IX = KX
285:                   K = KUP1 - J
286:                   DO 110 I = MAX(1,J-KU),MIN(M,J+KL)
287:                       TEMP = TEMP + A(K+I,J)*X(IX)
288:                       IX = IX + INCX
289:   110             CONTINUE
290:                   Y(JY) = Y(JY) + ALPHA*TEMP
291:                   JY = JY + INCY
292:                   IF (J.GT.KU) KX = KX + INCX
293:   120         CONTINUE
294:           END IF
295:       END IF
296: *
297:       RETURN
298: *
299: *     End of SGBMV .
300: *
301:       END
302: