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

Annotation of /trunk/blas/dgemv.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations) (download)
Fri Oct 29 20:54:12 2004 UTC (17 years, 11 months ago) by aw0a
File size: 8994 byte(s)
Setting up web subdirectory in repository
1 aw0a 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