1: SUBROUTINE DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
2: * .. Scalar Arguments ..
3: DOUBLE PRECISION ALPHA,BETA
4: INTEGER INCX,INCY,KL,KU,LDA,M,N
5: CHARACTER TRANS
6: * ..
7: * .. Array Arguments ..
8: DOUBLE PRECISION A(LDA,*),X(*),Y(*)
9: * ..
10: *
11: * Purpose
12: * =======
13: *
14: * DGBMV performs one of the matrix-vector operations
15: *
16: * y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
17: *
18: * where alpha and beta are scalars, x and y are vectors and A is an
19: * m by n band matrix, with kl sub-diagonals and ku super-diagonals.
20: *
21: * Arguments
22: * ==========
23: *
24: * TRANS - CHARACTER*1.
25: * On entry, TRANS specifies the operation to be performed as
26: * follows:
27: *
28: * TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
29: *
30: * TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
31: *
32: * TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
33: *
34: * Unchanged on exit.
35: *
36: * M - INTEGER.
37: * On entry, M specifies the number of rows of the matrix A.
38: * M must be at least zero.
39: * Unchanged on exit.
40: *
41: * N - INTEGER.
42: * On entry, N specifies the number of columns of the matrix A.
43: * N must be at least zero.
44: * Unchanged on exit.
45: *
46: * KL - INTEGER.
47: * On entry, KL specifies the number of sub-diagonals of the
48: * matrix A. KL must satisfy 0 .le. KL.
49: * Unchanged on exit.
50: *
51: * KU - INTEGER.
52: * On entry, KU specifies the number of super-diagonals of the
53: * matrix A. KU must satisfy 0 .le. KU.
54: * Unchanged on exit.
55: *
56: * ALPHA - DOUBLE PRECISION.
57: * On entry, ALPHA specifies the scalar alpha.
58: * Unchanged on exit.
59: *
60: * A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
61: * Before entry, the leading ( kl + ku + 1 ) by n part of the
62: * array A must contain the matrix of coefficients, supplied
63: * column by column, with the leading diagonal of the matrix in
64: * row ( ku + 1 ) of the array, the first super-diagonal
65: * starting at position 2 in row ku, the first sub-diagonal
66: * starting at position 1 in row ( ku + 2 ), and so on.
67: * Elements in the array A that do not correspond to elements
68: * in the band matrix (such as the top left ku by ku triangle)
69: * are not referenced.
70: * The following program segment will transfer a band matrix
71: * from conventional full matrix storage to band storage:
72: *
73: * DO 20, J = 1, N
74: * K = KU + 1 - J
75: * DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
76: * A( K + I, J ) = matrix( I, J )
77: * 10 CONTINUE
78: * 20 CONTINUE
79: *
80: * Unchanged on exit.
81: *
82: * LDA - INTEGER.
83: * On entry, LDA specifies the first dimension of A as declared
84: * in the calling (sub) program. LDA must be at least
85: * ( kl + ku + 1 ).
86: * Unchanged on exit.
87: *
88: * X - DOUBLE PRECISION array of DIMENSION at least
89: * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
90: * and at least
91: * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
92: * Before entry, the incremented array X must contain the
93: * vector x.
94: * Unchanged on exit.
95: *
96: * INCX - INTEGER.
97: * On entry, INCX specifies the increment for the elements of
98: * X. INCX must not be zero.
99: * 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: * 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: DOUBLE PRECISION ONE,ZERO
133: PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
134: * ..
135: * .. Local Scalars ..
136: DOUBLE PRECISION 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('DGBMV ',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 DGBMV .
300: *
301: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dgbmv.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / blas