← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/dgemv.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
deps/openlibm/slatec/dgemv.f
 
1
*DECK DGEMV
 
2
      SUBROUTINE DGEMV (TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y,
 
3
     $   INCY)
 
4
C***BEGIN PROLOGUE  DGEMV
 
5
C***PURPOSE  Perform one of the matrix-vector operations.
 
6
C***LIBRARY   SLATEC (BLAS)
 
7
C***CATEGORY  D1B4
 
8
C***TYPE      DOUBLE PRECISION (SGEMV-S, DGEMV-D, CGEMV-C)
 
9
C***KEYWORDS  LEVEL 2 BLAS, LINEAR ALGEBRA
 
10
C***AUTHOR  Dongarra, J. J., (ANL)
 
11
C           Du Croz, J., (NAG)
 
12
C           Hammarling, S., (NAG)
 
13
C           Hanson, R. J., (SNLA)
 
14
C***DESCRIPTION
 
15
C
 
16
C  DGEMV  performs one of the matrix-vector operations
 
17
C
 
18
C     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,
 
19
C
 
20
C  where alpha and beta are scalars, x and y are vectors and A is an
 
21
C  m by n matrix.
 
22
C
 
23
C  Parameters
 
24
C  ==========
 
25
C
 
26
C  TRANS  - CHARACTER*1.
 
27
C           On entry, TRANS specifies the operation to be performed as
 
28
C           follows:
 
29
C
 
30
C              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
 
31
C
 
32
C              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
 
33
C
 
34
C              TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y.
 
35
C
 
36
C           Unchanged on exit.
 
37
C
 
38
C  M      - INTEGER.
 
39
C           On entry, M specifies the number of rows of the matrix A.
 
40
C           M must be at least zero.
 
41
C           Unchanged on exit.
 
42
C
 
43
C  N      - INTEGER.
 
44
C           On entry, N specifies the number of columns of the matrix A.
 
45
C           N must be at least zero.
 
46
C           Unchanged on exit.
 
47
C
 
48
C  ALPHA  - DOUBLE PRECISION.
 
49
C           On entry, ALPHA specifies the scalar alpha.
 
50
C           Unchanged on exit.
 
51
C
 
52
C  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
 
53
C           Before entry, the leading m by n part of the array A must
 
54
C           contain the matrix of coefficients.
 
55
C           Unchanged on exit.
 
56
C
 
57
C  LDA    - INTEGER.
 
58
C           On entry, LDA specifies the first dimension of A as declared
 
59
C           in the calling (sub) program. LDA must be at least
 
60
C           max( 1, m ).
 
61
C           Unchanged on exit.
 
62
C
 
63
C  X      - DOUBLE PRECISION array of DIMENSION at least
 
64
C           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
 
65
C           and at least
 
66
C           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
 
67
C           Before entry, the incremented array X must contain the
 
68
C           vector x.
 
69
C           Unchanged on exit.
 
70
C
 
71
C  INCX   - INTEGER.
 
72
C           On entry, INCX specifies the increment for the elements of
 
73
C           X. INCX must not be zero.
 
74
C           Unchanged on exit.
 
75
C
 
76
C  BETA   - DOUBLE PRECISION.
 
77
C           On entry, BETA specifies the scalar beta. When BETA is
 
78
C           supplied as zero then Y need not be set on input.
 
79
C           Unchanged on exit.
 
80
C
 
81
C  Y      - DOUBLE PRECISION array of DIMENSION at least
 
82
C           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
 
83
C           and at least
 
84
C           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
 
85
C           Before entry with BETA non-zero, the incremented array Y
 
86
C           must contain the vector y. On exit, Y is overwritten by the
 
87
C           updated vector y.
 
88
C
 
89
C  INCY   - INTEGER.
 
90
C           On entry, INCY specifies the increment for the elements of
 
91
C           Y. INCY must not be zero.
 
92
C           Unchanged on exit.
 
93
C
 
94
C***REFERENCES  Dongarra, J. J., Du Croz, J., Hammarling, S., and
 
95
C                 Hanson, R. J.  An extended set of Fortran basic linear
 
96
C                 algebra subprograms.  ACM TOMS, Vol. 14, No. 1,
 
97
C                 pp. 1-17, March 1988.
 
98
C***ROUTINES CALLED  LSAME, XERBLA
 
99
C***REVISION HISTORY  (YYMMDD)
 
100
C   861022  DATE WRITTEN
 
101
C   910605  Modified to meet SLATEC prologue standards.  Only comment
 
102
C           lines were modified.  (BKS)
 
103
C***END PROLOGUE  DGEMV
 
104
C     .. Scalar Arguments ..
 
105
      DOUBLE PRECISION   ALPHA, BETA
 
106
      INTEGER            INCX, INCY, LDA, M, N
 
107
      CHARACTER*1        TRANS
 
108
C     .. Array Arguments ..
 
109
      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
 
110
C     .. Parameters ..
 
111
      DOUBLE PRECISION   ONE         , ZERO
 
112
      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 
113
C     .. Local Scalars ..
 
114
      DOUBLE PRECISION   TEMP
 
115
      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
 
116
C     .. External Functions ..
 
117
      LOGICAL            LSAME
 
118
      EXTERNAL           LSAME
 
119
C     .. External Subroutines ..
 
120
      EXTERNAL           XERBLA
 
121
C     .. Intrinsic Functions ..
 
122
      INTRINSIC          MAX
 
123
C***FIRST EXECUTABLE STATEMENT  DGEMV
 
124
C
 
125
C     Test the input parameters.
 
126
C
 
127
      INFO = 0
 
128
      IF     ( .NOT.LSAME( TRANS, 'N' ).AND.
 
129
     $         .NOT.LSAME( TRANS, 'T' ).AND.
 
130
     $         .NOT.LSAME( TRANS, 'C' )      )THEN
 
131
         INFO = 1
 
132
      ELSE IF( M.LT.0 )THEN
 
133
         INFO = 2
 
134
      ELSE IF( N.LT.0 )THEN
 
135
         INFO = 3
 
136
      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
 
137
         INFO = 6
 
138
      ELSE IF( INCX.EQ.0 )THEN
 
139
         INFO = 8
 
140
      ELSE IF( INCY.EQ.0 )THEN
 
141
         INFO = 11
 
142
      END IF
 
143
      IF( INFO.NE.0 )THEN
 
144
         CALL XERBLA( 'DGEMV ', INFO )
 
145
         RETURN
 
146
      END IF
 
147
C
 
148
C     Quick return if possible.
 
149
C
 
150
      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
 
151
     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
 
152
     $   RETURN
 
153
C
 
154
C     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
 
155
C     up the start points in  X  and  Y.
 
156
C
 
157
      IF( LSAME( TRANS, 'N' ) )THEN
 
158
         LENX = N
 
159
         LENY = M
 
160
      ELSE
 
161
         LENX = M
 
162
         LENY = N
 
163
      END IF
 
164
      IF( INCX.GT.0 )THEN
 
165
         KX = 1
 
166
      ELSE
 
167
         KX = 1 - ( LENX - 1 )*INCX
 
168
      END IF
 
169
      IF( INCY.GT.0 )THEN
 
170
         KY = 1
 
171
      ELSE
 
172
         KY = 1 - ( LENY - 1 )*INCY
 
173
      END IF
 
174
C
 
175
C     Start the operations. In this version the elements of A are
 
176
C     accessed sequentially with one pass through A.
 
177
C
 
178
C     First form  y := beta*y.
 
179
C
 
180
      IF( BETA.NE.ONE )THEN
 
181
         IF( INCY.EQ.1 )THEN
 
182
            IF( BETA.EQ.ZERO )THEN
 
183
               DO 10, I = 1, LENY
 
184
                  Y( I ) = ZERO
 
185
   10          CONTINUE
 
186
            ELSE
 
187
               DO 20, I = 1, LENY
 
188
                  Y( I ) = BETA*Y( I )
 
189
   20          CONTINUE
 
190
            END IF
 
191
         ELSE
 
192
            IY = KY
 
193
            IF( BETA.EQ.ZERO )THEN
 
194
               DO 30, I = 1, LENY
 
195
                  Y( IY ) = ZERO
 
196
                  IY      = IY   + INCY
 
197
   30          CONTINUE
 
198
            ELSE
 
199
               DO 40, I = 1, LENY
 
200
                  Y( IY ) = BETA*Y( IY )
 
201
                  IY      = IY           + INCY
 
202
   40          CONTINUE
 
203
            END IF
 
204
         END IF
 
205
      END IF
 
206
      IF( ALPHA.EQ.ZERO )
 
207
     $   RETURN
 
208
      IF( LSAME( TRANS, 'N' ) )THEN
 
209
C
 
210
C        Form  y := alpha*A*x + y.
 
211
C
 
212
         JX = KX
 
213
         IF( INCY.EQ.1 )THEN
 
214
            DO 60, J = 1, N
 
215
               IF( X( JX ).NE.ZERO )THEN
 
216
                  TEMP = ALPHA*X( JX )
 
217
                  DO 50, I = 1, M
 
218
                     Y( I ) = Y( I ) + TEMP*A( I, J )
 
219
   50             CONTINUE
 
220
               END IF
 
221
               JX = JX + INCX
 
222
   60       CONTINUE
 
223
         ELSE
 
224
            DO 80, J = 1, N
 
225
               IF( X( JX ).NE.ZERO )THEN
 
226
                  TEMP = ALPHA*X( JX )
 
227
                  IY   = KY
 
228
                  DO 70, I = 1, M
 
229
                     Y( IY ) = Y( IY ) + TEMP*A( I, J )
 
230
                     IY      = IY      + INCY
 
231
   70             CONTINUE
 
232
               END IF
 
233
               JX = JX + INCX
 
234
   80       CONTINUE
 
235
         END IF
 
236
      ELSE
 
237
C
 
238
C        Form  y := alpha*A'*x + y.
 
239
C
 
240
         JY = KY
 
241
         IF( INCX.EQ.1 )THEN
 
242
            DO 100, J = 1, N
 
243
               TEMP = ZERO
 
244
               DO 90, I = 1, M
 
245
                  TEMP = TEMP + A( I, J )*X( I )
 
246
   90          CONTINUE
 
247
               Y( JY ) = Y( JY ) + ALPHA*TEMP
 
248
               JY      = JY      + INCY
 
249
  100       CONTINUE
 
250
         ELSE
 
251
            DO 120, J = 1, N
 
252
               TEMP = ZERO
 
253
               IX   = KX
 
254
               DO 110, I = 1, M
 
255
                  TEMP = TEMP + A( I, J )*X( IX )
 
256
                  IX   = IX   + INCX
 
257
  110          CONTINUE
 
258
               Y( JY ) = Y( JY ) + ALPHA*TEMP
 
259
               JY      = JY      + INCY
 
260
  120       CONTINUE
 
261
         END IF
 
262
      END IF
 
263
C
 
264
      RETURN
 
265
C
 
266
C     End of DGEMV .
 
267
C
 
268
      END