Statistiques
| Révision :

root / src / blas / cgbmv.f @ 11

Historique | Voir | Annoter | Télécharger (9,5 ko)

1 1 pfleura2 
      SUBROUTINE CGBMV(TRANS,M,N,KL,KU,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,KL,KU,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 
*  CGBMV  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 band matrix, with kl sub-diagonals and ku super-diagonals.
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 
*  KL     - INTEGER.
49 1 pfleura2 
*           On entry, KL specifies the number of sub-diagonals of the
50 1 pfleura2 
*           matrix A. KL must satisfy  0 .le. KL.
51 1 pfleura2 
*           Unchanged on exit.
52 1 pfleura2 
*
53 1 pfleura2 
*  KU     - INTEGER.
54 1 pfleura2 
*           On entry, KU specifies the number of super-diagonals of the
55 1 pfleura2 
*           matrix A. KU must satisfy  0 .le. KU.
56 1 pfleura2 
*           Unchanged on exit.
57 1 pfleura2 
*
58 1 pfleura2 
*  ALPHA  - COMPLEX         .
59 1 pfleura2 
*           On entry, ALPHA specifies the scalar alpha.
60 1 pfleura2 
*           Unchanged on exit.
61 1 pfleura2 
*
62 1 pfleura2 
*  A      - COMPLEX          array of DIMENSION ( LDA, n ).
63 1 pfleura2 
*           Before entry, the leading ( kl + ku + 1 ) by n part of the
64 1 pfleura2 
*           array A must contain the matrix of coefficients, supplied
65 1 pfleura2 
*           column by column, with the leading diagonal of the matrix in
66 1 pfleura2 
*           row ( ku + 1 ) of the array, the first super-diagonal
67 1 pfleura2 
*           starting at position 2 in row ku, the first sub-diagonal
68 1 pfleura2 
*           starting at position 1 in row ( ku + 2 ), and so on.
69 1 pfleura2 
*           Elements in the array A that do not correspond to elements
70 1 pfleura2 
*           in the band matrix (such as the top left ku by ku triangle)
71 1 pfleura2 
*           are not referenced.
72 1 pfleura2 
*           The following program segment will transfer a band matrix
73 1 pfleura2 
*           from conventional full matrix storage to band storage:
74 1 pfleura2 
*
75 1 pfleura2 
*                 DO 20, J = 1, N
76 1 pfleura2 
*                    K = KU + 1 - J
77 1 pfleura2 
*                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
78 1 pfleura2 
*                       A( K + I, J ) = matrix( I, J )
79 1 pfleura2 
*              10    CONTINUE
80 1 pfleura2 
*              20 CONTINUE
81 1 pfleura2 
*
82 1 pfleura2 
*           Unchanged on exit.
83 1 pfleura2 
*
84 1 pfleura2 
*  LDA    - INTEGER.
85 1 pfleura2 
*           On entry, LDA specifies the first dimension of A as declared
86 1 pfleura2 
*           in the calling (sub) program. LDA must be at least
87 1 pfleura2 
*           ( kl + ku + 1 ).
88 1 pfleura2 
*           Unchanged on exit.
89 1 pfleura2 
*
90 1 pfleura2 
*  X      - COMPLEX          array of DIMENSION at least
91 1 pfleura2 
*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
92 1 pfleura2 
*           and at least
93 1 pfleura2 
*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
94 1 pfleura2 
*           Before entry, the incremented array X must contain the
95 1 pfleura2 
*           vector x.
96 1 pfleura2 
*           Unchanged on exit.
97 1 pfleura2 
*
98 1 pfleura2 
*  INCX   - INTEGER.
99 1 pfleura2 
*           On entry, INCX specifies the increment for the elements of
100 1 pfleura2 
*           X. INCX must not be zero.
101 1 pfleura2 
*           Unchanged on exit.
102 1 pfleura2 
*
103 1 pfleura2 
*  BETA   - COMPLEX         .
104 1 pfleura2 
*           On entry, BETA specifies the scalar beta. When BETA is
105 1 pfleura2 
*           supplied as zero then Y need not be set on input.
106 1 pfleura2 
*           Unchanged on exit.
107 1 pfleura2 
*
108 1 pfleura2 
*  Y      - COMPLEX          array of DIMENSION at least
109 1 pfleura2 
*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
110 1 pfleura2 
*           and at least
111 1 pfleura2 
*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
112 1 pfleura2 
*           Before entry, the incremented array Y must contain the
113 1 pfleura2 
*           vector y. On exit, Y is overwritten by the updated vector y.
114 1 pfleura2 
*
115 1 pfleura2 
*
116 1 pfleura2 
*  INCY   - INTEGER.
117 1 pfleura2 
*           On entry, INCY specifies the increment for the elements of
118 1 pfleura2 
*           Y. INCY must not be zero.
119 1 pfleura2 
*           Unchanged on exit.
120 1 pfleura2 
*
121 1 pfleura2 
*
122 1 pfleura2 
*  Level 2 Blas routine.
123 1 pfleura2 
*
124 1 pfleura2 
*  -- Written on 22-October-1986.
125 1 pfleura2 
*     Jack Dongarra, Argonne National Lab.
126 1 pfleura2 
*     Jeremy Du Croz, Nag Central Office.
127 1 pfleura2 
*     Sven Hammarling, Nag Central Office.
128 1 pfleura2 
*     Richard Hanson, Sandia National Labs.
129 1 pfleura2 
*
130 1 pfleura2 
*
131 1 pfleura2 
*     .. Parameters ..
132 1 pfleura2 
      COMPLEX ONE
133 1 pfleura2 
      PARAMETER (ONE= (1.0E+0,0.0E+0))
134 1 pfleura2 
      COMPLEX ZERO
135 1 pfleura2 
      PARAMETER (ZERO= (0.0E+0,0.0E+0))
136 1 pfleura2 
*     ..
137 1 pfleura2 
*     .. Local Scalars ..
138 1 pfleura2 
      COMPLEX TEMP
139 1 pfleura2 
      INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
140 1 pfleura2 
      LOGICAL NOCONJ
141 1 pfleura2 
*     ..
142 1 pfleura2 
*     .. External Functions ..
143 1 pfleura2 
      LOGICAL LSAME
144 1 pfleura2 
      EXTERNAL LSAME
145 1 pfleura2 
*     ..
146 1 pfleura2 
*     .. External Subroutines ..
147 1 pfleura2 
      EXTERNAL XERBLA
148 1 pfleura2 
*     ..
149 1 pfleura2 
*     .. Intrinsic Functions ..
150 1 pfleura2 
      INTRINSIC CONJG,MAX,MIN
151 1 pfleura2 
*     ..
152 1 pfleura2 
*
153 1 pfleura2 
*     Test the input parameters.
154 1 pfleura2 
*
155 1 pfleura2 
      INFO = 0
156 1 pfleura2 
      IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
157 1 pfleura2 
     +    .NOT.LSAME(TRANS,'C')) THEN
158 1 pfleura2 
          INFO = 1
159 1 pfleura2 
      ELSE IF (M.LT.0) THEN
160 1 pfleura2 
          INFO = 2
161 1 pfleura2 
      ELSE IF (N.LT.0) THEN
162 1 pfleura2 
          INFO = 3
163 1 pfleura2 
      ELSE IF (KL.LT.0) THEN
164 1 pfleura2 
          INFO = 4
165 1 pfleura2 
      ELSE IF (KU.LT.0) THEN
166 1 pfleura2 
          INFO = 5
167 1 pfleura2 
      ELSE IF (LDA.LT. (KL+KU+1)) THEN
168 1 pfleura2 
          INFO = 8
169 1 pfleura2 
      ELSE IF (INCX.EQ.0) THEN
170 1 pfleura2 
          INFO = 10
171 1 pfleura2 
      ELSE IF (INCY.EQ.0) THEN
172 1 pfleura2 
          INFO = 13
173 1 pfleura2 
      END IF
174 1 pfleura2 
      IF (INFO.NE.0) THEN
175 1 pfleura2 
          CALL XERBLA('CGBMV ',INFO)
176 1 pfleura2 
          RETURN
177 1 pfleura2 
      END IF
178 1 pfleura2 
*
179 1 pfleura2 
*     Quick return if possible.
180 1 pfleura2 
*
181 1 pfleura2 
      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
182 1 pfleura2 
     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
183 1 pfleura2 
*
184 1 pfleura2 
      NOCONJ = LSAME(TRANS,'T')
185 1 pfleura2 
*
186 1 pfleura2 
*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
187 1 pfleura2 
*     up the start points in  X  and  Y.
188 1 pfleura2 
*
189 1 pfleura2 
      IF (LSAME(TRANS,'N')) THEN
190 1 pfleura2 
          LENX = N
191 1 pfleura2 
          LENY = M
192 1 pfleura2 
      ELSE
193 1 pfleura2 
          LENX = M
194 1 pfleura2 
          LENY = N
195 1 pfleura2 
      END IF
196 1 pfleura2 
      IF (INCX.GT.0) THEN
197 1 pfleura2 
          KX = 1
198 1 pfleura2 
      ELSE
199 1 pfleura2 
          KX = 1 - (LENX-1)*INCX
200 1 pfleura2 
      END IF
201 1 pfleura2 
      IF (INCY.GT.0) THEN
202 1 pfleura2 
          KY = 1
203 1 pfleura2 
      ELSE
204 1 pfleura2 
          KY = 1 - (LENY-1)*INCY
205 1 pfleura2 
      END IF
206 1 pfleura2 
*
207 1 pfleura2 
*     Start the operations. In this version the elements of A are
208 1 pfleura2 
*     accessed sequentially with one pass through the band part of A.
209 1 pfleura2 
*
210 1 pfleura2 
*     First form  y := beta*y.
211 1 pfleura2 
*
212 1 pfleura2 
      IF (BETA.NE.ONE) THEN
213 1 pfleura2 
          IF (INCY.EQ.1) THEN
214 1 pfleura2 
              IF (BETA.EQ.ZERO) THEN
215 1 pfleura2 
                  DO 10 I = 1,LENY
216 1 pfleura2 
                      Y(I) = ZERO
217 1 pfleura2 
   10             CONTINUE
218 1 pfleura2 
              ELSE
219 1 pfleura2 
                  DO 20 I = 1,LENY
220 1 pfleura2 
                      Y(I) = BETA*Y(I)
221 1 pfleura2 
   20             CONTINUE
222 1 pfleura2 
              END IF
223 1 pfleura2 
          ELSE
224 1 pfleura2 
              IY = KY
225 1 pfleura2 
              IF (BETA.EQ.ZERO) THEN
226 1 pfleura2 
                  DO 30 I = 1,LENY
227 1 pfleura2 
                      Y(IY) = ZERO
228 1 pfleura2 
                      IY = IY + INCY
229 1 pfleura2 
   30             CONTINUE
230 1 pfleura2 
              ELSE
231 1 pfleura2 
                  DO 40 I = 1,LENY
232 1 pfleura2 
                      Y(IY) = BETA*Y(IY)
233 1 pfleura2 
                      IY = IY + INCY
234 1 pfleura2 
   40             CONTINUE
235 1 pfleura2 
              END IF
236 1 pfleura2 
          END IF
237 1 pfleura2 
      END IF
238 1 pfleura2 
      IF (ALPHA.EQ.ZERO) RETURN
239 1 pfleura2 
      KUP1 = KU + 1
240 1 pfleura2 
      IF (LSAME(TRANS,'N')) THEN
241 1 pfleura2 
*
242 1 pfleura2 
*        Form  y := alpha*A*x + y.
243 1 pfleura2 
*
244 1 pfleura2 
          JX = KX
245 1 pfleura2 
          IF (INCY.EQ.1) THEN
246 1 pfleura2 
              DO 60 J = 1,N
247 1 pfleura2 
                  IF (X(JX).NE.ZERO) THEN
248 1 pfleura2 
                      TEMP = ALPHA*X(JX)
249 1 pfleura2 
                      K = KUP1 - J
250 1 pfleura2 
                      DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
251 1 pfleura2 
                          Y(I) = Y(I) + TEMP*A(K+I,J)
252 1 pfleura2 
   50                 CONTINUE
253 1 pfleura2 
                  END IF
254 1 pfleura2 
                  JX = JX + INCX
255 1 pfleura2 
   60         CONTINUE
256 1 pfleura2 
          ELSE
257 1 pfleura2 
              DO 80 J = 1,N
258 1 pfleura2 
                  IF (X(JX).NE.ZERO) THEN
259 1 pfleura2 
                      TEMP = ALPHA*X(JX)
260 1 pfleura2 
                      IY = KY
261 1 pfleura2 
                      K = KUP1 - J
262 1 pfleura2 
                      DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
263 1 pfleura2 
                          Y(IY) = Y(IY) + TEMP*A(K+I,J)
264 1 pfleura2 
                          IY = IY + INCY
265 1 pfleura2 
   70                 CONTINUE
266 1 pfleura2 
                  END IF
267 1 pfleura2 
                  JX = JX + INCX
268 1 pfleura2 
                  IF (J.GT.KU) KY = KY + INCY
269 1 pfleura2 
   80         CONTINUE
270 1 pfleura2 
          END IF
271 1 pfleura2 
      ELSE
272 1 pfleura2 
*
273 1 pfleura2 
*        Form  y := alpha*A'*x + y  or  y := alpha*conjg( A' )*x + y.
274 1 pfleura2 
*
275 1 pfleura2 
          JY = KY
276 1 pfleura2 
          IF (INCX.EQ.1) THEN
277 1 pfleura2 
              DO 110 J = 1,N
278 1 pfleura2 
                  TEMP = ZERO
279 1 pfleura2 
                  K = KUP1 - J
280 1 pfleura2 
                  IF (NOCONJ) THEN
281 1 pfleura2 
                      DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
282 1 pfleura2 
                          TEMP = TEMP + A(K+I,J)*X(I)
283 1 pfleura2 
   90                 CONTINUE
284 1 pfleura2 
                  ELSE
285 1 pfleura2 
                      DO 100 I = MAX(1,J-KU),MIN(M,J+KL)
286 1 pfleura2 
                          TEMP = TEMP + CONJG(A(K+I,J))*X(I)
287 1 pfleura2 
  100                 CONTINUE
288 1 pfleura2 
                  END IF
289 1 pfleura2 
                  Y(JY) = Y(JY) + ALPHA*TEMP
290 1 pfleura2 
                  JY = JY + INCY
291 1 pfleura2 
  110         CONTINUE
292 1 pfleura2 
          ELSE
293 1 pfleura2 
              DO 140 J = 1,N
294 1 pfleura2 
                  TEMP = ZERO
295 1 pfleura2 
                  IX = KX
296 1 pfleura2 
                  K = KUP1 - J
297 1 pfleura2 
                  IF (NOCONJ) THEN
298 1 pfleura2 
                      DO 120 I = MAX(1,J-KU),MIN(M,J+KL)
299 1 pfleura2 
                          TEMP = TEMP + A(K+I,J)*X(IX)
300 1 pfleura2 
                          IX = IX + INCX
301 1 pfleura2 
  120                 CONTINUE
302 1 pfleura2 
                  ELSE
303 1 pfleura2 
                      DO 130 I = MAX(1,J-KU),MIN(M,J+KL)
304 1 pfleura2 
                          TEMP = TEMP + CONJG(A(K+I,J))*X(IX)
305 1 pfleura2 
                          IX = IX + INCX
306 1 pfleura2 
  130                 CONTINUE
307 1 pfleura2 
                  END IF
308 1 pfleura2 
                  Y(JY) = Y(JY) + ALPHA*TEMP
309 1 pfleura2 
                  JY = JY + INCY
310 1 pfleura2 
                  IF (J.GT.KU) KX = KX + INCX
311 1 pfleura2 
  140         CONTINUE
312 1 pfleura2 
          END IF
313 1 pfleura2 
      END IF
314 1 pfleura2 
*
315 1 pfleura2 
      RETURN
316 1 pfleura2 
*
317 1 pfleura2 
*     End of CGBMV .
318 1 pfleura2 
*
319 1 pfleura2 
      END