/[ascend]/trunk/blas/dgemv.f
ViewVC logotype

Contents of /trunk/blas/dgemv.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download)
Fri Oct 29 20:54:12 2004 UTC (15 years, 5 months ago) by aw0a
File size: 8994 byte(s)
Setting up web subdirectory in repository
1
2 SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
3 *
4 ************************************************************************
5 *
6 * File of the DOUBLE PRECISION Level-2 BLAS.
7 * ===========================================
8 *
9 * SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
10 * $ BETA, Y, INCY )
11 *
12 * SUBROUTINE DGBMV ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX,
13 * $ BETA, Y, INCY )
14 *
15 * SUBROUTINE DSYMV ( UPLO, N, ALPHA, A, LDA, X, INCX,
16 * $ BETA, Y, INCY )
17 *
18 * SUBROUTINE DSBMV ( UPLO, N, K, ALPHA, A, LDA, X, INCX,
19 * $ BETA, Y, INCY )
20 *
21 * SUBROUTINE DSPMV ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
22 *
23 * SUBROUTINE DTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
24 *
25 * SUBROUTINE DTBMV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
26 *
27 * SUBROUTINE DTPMV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
28 *
29 * SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
30 *
31 * SUBROUTINE DTBSV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
32 *
33 * SUBROUTINE DTPSV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
34 *
35 * SUBROUTINE DGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
36 *
37 * SUBROUTINE DSYR ( UPLO, N, ALPHA, X, INCX, A, LDA )
38 *
39 * SUBROUTINE DSPR ( UPLO, N, ALPHA, X, INCX, AP )
40 *
41 * SUBROUTINE DSYR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )
42 *
43 * SUBROUTINE DSPR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP )
44 *
45 * See:
46 *
47 * Dongarra J. J., Du Croz J. J., Hammarling S. and Hanson R. J..
48 * An extended set of Fortran Basic Linear Algebra Subprograms.
49 *
50 * Technical Memoranda Nos. 41 (revision 3) and 81, Mathematics
51 * and Computer Science Division, Argonne National Laboratory,
52 * 9700 South Cass Avenue, Argonne, Illinois 60439, US.
53 *
54 * Or
55 *
56 * NAG Technical Reports TR3/87 and TR4/87, Numerical Algorithms
57 * Group Ltd., NAG Central Office, 256 Banbury Road, Oxford
58 * OX2 7DE, UK, and Numerical Algorithms Group Inc., 1101 31st
59 * Street, Suite 100, Downers Grove, Illinois 60515-1263, USA.
60 *
61 ************************************************************************
62 *
63 $ BETA, Y, INCY )
64 * .. Scalar Arguments ..
65 DOUBLE PRECISION ALPHA, BETA
66 INTEGER INCX, INCY, LDA, M, N
67 CHARACTER*1 TRANS
68 * .. Array Arguments ..
69 DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
70 * ..
71 *
72 * Purpose
73 * =======
74 *
75 * DGEMV performs one of the matrix-vector operations
76 *
77 * y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
78 *
79 * where alpha and beta are scalars, x and y are vectors and A is an
80 * m by n matrix.
81 *
82 * Parameters
83 * ==========
84 *
85 * TRANS - CHARACTER*1.
86 * On entry, TRANS specifies the operation to be performed as
87 * follows:
88 *
89 * TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
90 *
91 * TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
92 *
93 * TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
94 *
95 * Unchanged on exit.
96 *
97 * M - INTEGER.
98 * On entry, M specifies the number of rows of the matrix A.
99 * M must be at least zero.
100 * Unchanged on exit.
101 *
102 * N - INTEGER.
103 * On entry, N specifies the number of columns of the matrix A.
104 * N must be at least zero.
105 * Unchanged on exit.
106 *
107 * ALPHA - DOUBLE PRECISION.
108 * On entry, ALPHA specifies the scalar alpha.
109 * Unchanged on exit.
110 *
111 * A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
112 * Before entry, the leading m by n part of the array A must
113 * contain the matrix of coefficients.
114 * Unchanged on exit.
115 *
116 * LDA - INTEGER.
117 * On entry, LDA specifies the first dimension of A as declared
118 * in the calling (sub) program. LDA must be at least
119 * max( 1, m ).
120 * Unchanged on exit.
121 *
122 * X - DOUBLE PRECISION array of DIMENSION at least
123 * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
124 * and at least
125 * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
126 * Before entry, the incremented array X must contain the
127 * vector x.
128 * Unchanged on exit.
129 *
130 * INCX - INTEGER.
131 * On entry, INCX specifies the increment for the elements of
132 * X. INCX must not be zero.
133 * Unchanged on exit.
134 *
135 * BETA - DOUBLE PRECISION.
136 * On entry, BETA specifies the scalar beta. When BETA is
137 * supplied as zero then Y need not be set on input.
138 * Unchanged on exit.
139 *
140 * Y - DOUBLE PRECISION array of DIMENSION at least
141 * ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
142 * and at least
143 * ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
144 * Before entry with BETA non-zero, the incremented array Y
145 * must contain the vector y. On exit, Y is overwritten by the
146 * updated vector y.
147 *
148 * INCY - INTEGER.
149 * On entry, INCY specifies the increment for the elements of
150 * Y. INCY must not be zero.
151 * Unchanged on exit.
152 *
153 *
154 * Level 2 Blas routine.
155 *
156 * -- Written on 22-October-1986.
157 * Jack Dongarra, Argonne National Lab.
158 * Jeremy Du Croz, Nag Central Office.
159 * Sven Hammarling, Nag Central Office.
160 * Richard Hanson, Sandia National Labs.
161 *
162 *
163 * .. Parameters ..
164 DOUBLE PRECISION ONE , ZERO
165 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
166 * .. Local Scalars ..
167 DOUBLE PRECISION TEMP
168 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
169 * .. External Functions ..
170 LOGICAL LSAME
171 EXTERNAL LSAME
172 * .. External Subroutines ..
173 EXTERNAL XERBLA
174 * .. Intrinsic Functions ..
175 INTRINSIC MAX
176 * ..
177 * .. Executable Statements ..
178 *
179 * Test the input parameters.
180 *
181 INFO = 0
182 IF ( .NOT.LSAME( TRANS, 'N' ).AND.
183 $ .NOT.LSAME( TRANS, 'T' ).AND.
184 $ .NOT.LSAME( TRANS, 'C' ) )THEN
185 INFO = 1
186 ELSE IF( M.LT.0 )THEN
187 INFO = 2
188 ELSE IF( N.LT.0 )THEN
189 INFO = 3
190 ELSE IF( LDA.LT.MAX( 1, M ) )THEN
191 INFO = 6
192 ELSE IF( INCX.EQ.0 )THEN
193 INFO = 8
194 ELSE IF( INCY.EQ.0 )THEN
195 INFO = 11
196 END IF
197 IF( INFO.NE.0 )THEN
198 CALL XERBLA( 'DGEMV ', INFO )
199 RETURN
200 END IF
201 *
202 * Quick return if possible.
203 *
204 IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
205 $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
206 $ RETURN
207 *
208 * Set LENX and LENY, the lengths of the vectors x and y, and set
209 * up the start points in X and Y.
210 *
211 IF( LSAME( TRANS, 'N' ) )THEN
212 LENX = N
213 LENY = M
214 ELSE
215 LENX = M
216 LENY = N
217 END IF
218 IF( INCX.GT.0 )THEN
219 KX = 1
220 ELSE
221 KX = 1 - ( LENX - 1 )*INCX
222 END IF
223 IF( INCY.GT.0 )THEN
224 KY = 1
225 ELSE
226 KY = 1 - ( LENY - 1 )*INCY
227 END IF
228 *
229 * Start the operations. In this version the elements of A are
230 * accessed sequentially with one pass through A.
231 *
232 * First form y := beta*y.
233 *
234 IF( BETA.NE.ONE )THEN
235 IF( INCY.EQ.1 )THEN
236 IF( BETA.EQ.ZERO )THEN
237 DO 10, I = 1, LENY
238 Y( I ) = ZERO
239 10 CONTINUE
240 ELSE
241 DO 20, I = 1, LENY
242 Y( I ) = BETA*Y( I )
243 20 CONTINUE
244 END IF
245 ELSE
246 IY = KY
247 IF( BETA.EQ.ZERO )THEN
248 DO 30, I = 1, LENY
249 Y( IY ) = ZERO
250 IY = IY + INCY
251 30 CONTINUE
252 ELSE
253 DO 40, I = 1, LENY
254 Y( IY ) = BETA*Y( IY )
255 IY = IY + INCY
256 40 CONTINUE
257 END IF
258 END IF
259 END IF
260 IF( ALPHA.EQ.ZERO )
261 $ RETURN
262 IF( LSAME( TRANS, 'N' ) )THEN
263 *
264 * Form y := alpha*A*x + y.
265 *
266 JX = KX
267 IF( INCY.EQ.1 )THEN
268 DO 60, J = 1, N
269 IF( X( JX ).NE.ZERO )THEN
270 TEMP = ALPHA*X( JX )
271 DO 50, I = 1, M
272 Y( I ) = Y( I ) + TEMP*A( I, J )
273 50 CONTINUE
274 END IF
275 JX = JX + INCX
276 60 CONTINUE
277 ELSE
278 DO 80, J = 1, N
279 IF( X( JX ).NE.ZERO )THEN
280 TEMP = ALPHA*X( JX )
281 IY = KY
282 DO 70, I = 1, M
283 Y( IY ) = Y( IY ) + TEMP*A( I, J )
284 IY = IY + INCY
285 70 CONTINUE
286 END IF
287 JX = JX + INCX
288 80 CONTINUE
289 END IF
290 ELSE
291 *
292 * Form y := alpha*A'*x + y.
293 *
294 JY = KY
295 IF( INCX.EQ.1 )THEN
296 DO 100, J = 1, N
297 TEMP = ZERO
298 DO 90, I = 1, M
299 TEMP = TEMP + A( I, J )*X( I )
300 90 CONTINUE
301 Y( JY ) = Y( JY ) + ALPHA*TEMP
302 JY = JY + INCY
303 100 CONTINUE
304 ELSE
305 DO 120, J = 1, N
306 TEMP = ZERO
307 IX = KX
308 DO 110, I = 1, M
309 TEMP = TEMP + A( I, J )*X( IX )
310 IX = IX + INCX
311 110 CONTINUE
312 Y( JY ) = Y( JY ) + ALPHA*TEMP
313 JY = JY + INCY
314 120 CONTINUE
315 END IF
316 END IF
317 *
318 RETURN
319 *
320 * End of DGEMV .
321 *
322 END

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22