← Back to branch summary

~ubuntu-branches/ubuntu/vivid/atlas/vivid

« back to all changes in this revision

Viewing changes to src/blas/f77reference/sgemv.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-06-11 15:58:16 UTC
  • mfrom: (1.1.3 upstream)
  • mto: (2.2.21 experimental)
  • mto: This revision was merged to the branch mainline in revision 26.
  • Revision ID: package-import@ubuntu.com-20130611155816-b72z8f621tuhbzn0
Tags: upstream-3.10.1
Import upstream version 3.10.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/blas/f77reference/sgemv.f
 
1
      SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
 
2
*     .. Scalar Arguments ..
 
3
      REAL ALPHA,BETA
 
4
      INTEGER INCX,INCY,LDA,M,N
 
5
      CHARACTER TRANS
 
6
*     ..
 
7
*     .. Array Arguments ..
 
8
      REAL A(LDA,*),X(*),Y(*)
 
9
*     ..
 
10
*
 
11
*  Purpose
 
12
*  =======
 
13
*
 
14
*  SGEMV  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 matrix.
 
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
*  ALPHA  - REAL            .
 
47
*           On entry, ALPHA specifies the scalar alpha.
 
48
*           Unchanged on exit.
 
49
*
 
50
*  A      - REAL             array of DIMENSION ( LDA, n ).
 
51
*           Before entry, the leading m by n part of the array A must
 
52
*           contain the matrix of coefficients.
 
53
*           Unchanged on exit.
 
54
*
 
55
*  LDA    - INTEGER.
 
56
*           On entry, LDA specifies the first dimension of A as declared
 
57
*           in the calling (sub) program. LDA must be at least
 
58
*           max( 1, m ).
 
59
*           Unchanged on exit.
 
60
*
 
61
*  X      - REAL             array of DIMENSION at least
 
62
*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
 
63
*           and at least
 
64
*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
 
65
*           Before entry, the incremented array X must contain the
 
66
*           vector x.
 
67
*           Unchanged on exit.
 
68
*
 
69
*  INCX   - INTEGER.
 
70
*           On entry, INCX specifies the increment for the elements of
 
71
*           X. INCX must not be zero.
 
72
*           Unchanged on exit.
 
73
*
 
74
*  BETA   - REAL            .
 
75
*           On entry, BETA specifies the scalar beta. When BETA is
 
76
*           supplied as zero then Y need not be set on input.
 
77
*           Unchanged on exit.
 
78
*
 
79
*  Y      - REAL             array of DIMENSION at least
 
80
*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
 
81
*           and at least
 
82
*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
 
83
*           Before entry with BETA non-zero, the incremented array Y
 
84
*           must contain the vector y. On exit, Y is overwritten by the
 
85
*           updated vector y.
 
86
*
 
87
*  INCY   - INTEGER.
 
88
*           On entry, INCY specifies the increment for the elements of
 
89
*           Y. INCY must not be zero.
 
90
*           Unchanged on exit.
 
91
*
 
92
*
 
93
*  Level 2 Blas routine.
 
94
*
 
95
*  -- Written on 22-October-1986.
 
96
*     Jack Dongarra, Argonne National Lab.
 
97
*     Jeremy Du Croz, Nag Central Office.
 
98
*     Sven Hammarling, Nag Central Office.
 
99
*     Richard Hanson, Sandia National Labs.
 
100
*
 
101
*
 
102
*     .. Parameters ..
 
103
      REAL ONE,ZERO
 
104
      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
 
105
*     ..
 
106
*     .. Local Scalars ..
 
107
      REAL TEMP
 
108
      INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
 
109
*     ..
 
110
*     .. External Functions ..
 
111
      LOGICAL LSAME
 
112
      EXTERNAL LSAME
 
113
*     ..
 
114
*     .. External Subroutines ..
 
115
      EXTERNAL XERBLA
 
116
*     ..
 
117
*     .. Intrinsic Functions ..
 
118
      INTRINSIC MAX
 
119
*     ..
 
120
*
 
121
*     Test the input parameters.
 
122
*
 
123
      INFO = 0
 
124
      IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
 
125
     +    .NOT.LSAME(TRANS,'C')) THEN
 
126
          INFO = 1
 
127
      ELSE IF (M.LT.0) THEN
 
128
          INFO = 2
 
129
      ELSE IF (N.LT.0) THEN
 
130
          INFO = 3
 
131
      ELSE IF (LDA.LT.MAX(1,M)) THEN
 
132
          INFO = 6
 
133
      ELSE IF (INCX.EQ.0) THEN
 
134
          INFO = 8
 
135
      ELSE IF (INCY.EQ.0) THEN
 
136
          INFO = 11
 
137
      END IF
 
138
      IF (INFO.NE.0) THEN
 
139
          CALL XERBLA('SGEMV ',INFO)
 
140
          RETURN
 
141
      END IF
 
142
*
 
143
*     Quick return if possible.
 
144
*
 
145
      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
 
146
     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
 
147
*
 
148
*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
 
149
*     up the start points in  X  and  Y.
 
150
*
 
151
      IF (LSAME(TRANS,'N')) THEN
 
152
          LENX = N
 
153
          LENY = M
 
154
      ELSE
 
155
          LENX = M
 
156
          LENY = N
 
157
      END IF
 
158
      IF (INCX.GT.0) THEN
 
159
          KX = 1
 
160
      ELSE
 
161
          KX = 1 - (LENX-1)*INCX
 
162
      END IF
 
163
      IF (INCY.GT.0) THEN
 
164
          KY = 1
 
165
      ELSE
 
166
          KY = 1 - (LENY-1)*INCY
 
167
      END IF
 
168
*
 
169
*     Start the operations. In this version the elements of A are
 
170
*     accessed sequentially with one pass through A.
 
171
*
 
172
*     First form  y := beta*y.
 
173
*
 
174
      IF (BETA.NE.ONE) THEN
 
175
          IF (INCY.EQ.1) THEN
 
176
              IF (BETA.EQ.ZERO) THEN
 
177
                  DO 10 I = 1,LENY
 
178
                      Y(I) = ZERO
 
179
   10             CONTINUE
 
180
              ELSE
 
181
                  DO 20 I = 1,LENY
 
182
                      Y(I) = BETA*Y(I)
 
183
   20             CONTINUE
 
184
              END IF
 
185
          ELSE
 
186
              IY = KY
 
187
              IF (BETA.EQ.ZERO) THEN
 
188
                  DO 30 I = 1,LENY
 
189
                      Y(IY) = ZERO
 
190
                      IY = IY + INCY
 
191
   30             CONTINUE
 
192
              ELSE
 
193
                  DO 40 I = 1,LENY
 
194
                      Y(IY) = BETA*Y(IY)
 
195
                      IY = IY + INCY
 
196
   40             CONTINUE
 
197
              END IF
 
198
          END IF
 
199
      END IF
 
200
      IF (ALPHA.EQ.ZERO) RETURN
 
201
      IF (LSAME(TRANS,'N')) THEN
 
202
*
 
203
*        Form  y := alpha*A*x + y.
 
204
*
 
205
          JX = KX
 
206
          IF (INCY.EQ.1) THEN
 
207
              DO 60 J = 1,N
 
208
                  IF (X(JX).NE.ZERO) THEN
 
209
                      TEMP = ALPHA*X(JX)
 
210
                      DO 50 I = 1,M
 
211
                          Y(I) = Y(I) + TEMP*A(I,J)
 
212
   50                 CONTINUE
 
213
                  END IF
 
214
                  JX = JX + INCX
 
215
   60         CONTINUE
 
216
          ELSE
 
217
              DO 80 J = 1,N
 
218
                  IF (X(JX).NE.ZERO) THEN
 
219
                      TEMP = ALPHA*X(JX)
 
220
                      IY = KY
 
221
                      DO 70 I = 1,M
 
222
                          Y(IY) = Y(IY) + TEMP*A(I,J)
 
223
                          IY = IY + INCY
 
224
   70                 CONTINUE
 
225
                  END IF
 
226
                  JX = JX + INCX
 
227
   80         CONTINUE
 
228
          END IF
 
229
      ELSE
 
230
*
 
231
*        Form  y := alpha*A'*x + y.
 
232
*
 
233
          JY = KY
 
234
          IF (INCX.EQ.1) THEN
 
235
              DO 100 J = 1,N
 
236
                  TEMP = ZERO
 
237
                  DO 90 I = 1,M
 
238
                      TEMP = TEMP + A(I,J)*X(I)
 
239
   90             CONTINUE
 
240
                  Y(JY) = Y(JY) + ALPHA*TEMP
 
241
                  JY = JY + INCY
 
242
  100         CONTINUE
 
243
          ELSE
 
244
              DO 120 J = 1,N
 
245
                  TEMP = ZERO
 
246
                  IX = KX
 
247
                  DO 110 I = 1,M
 
248
                      TEMP = TEMP + A(I,J)*X(IX)
 
249
                      IX = IX + INCX
 
250
  110             CONTINUE
 
251
                  Y(JY) = Y(JY) + ALPHA*TEMP
 
252
                  JY = JY + INCY
 
253
  120         CONTINUE
 
254
          END IF
 
255
      END IF
 
256
*
 
257
      RETURN
 
258
*
 
259
*     End of SGEMV .
 
260
*
 
261
      END