Statistiques
| Révision :

root / src / blas / cgemv.f @ 9

Historique | Voir | Annoter | Télécharger (7,79 ko)

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