source: trunk/SOURCES/BLAS/saxpy.f @ 23

Last change on this file since 23 was 22, checked in by roche, 9 years ago

Petites adaptations diverses du code pour compilation en gfortran. Ajout d un Makefile flexible a option pour choisir ifort ou gfortran.
File size: 1.6 KB
Line 
1      SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY)
2*     .. Scalar Arguments ..
3      REAL SA
4      INTEGER INCX,INCY,N
5*     ..
6*     .. Array Arguments ..
7      REAL SX(*),SY(*)
8*     ..
9*
10*  Purpose
11*  =======
12*
13*     SAXPY constant times a vector plus a vector.
14*     uses unrolled loops for increments equal to one.
15*
16*  Further Details
17*  ===============
18*
19*     jack dongarra, linpack, 3/11/78.
20*     modified 12/3/93, array(1) declarations changed to array(*)
21*
22*  =====================================================================
23*
24*     .. Local Scalars ..
25      INTEGER I,IX,IY,M,MP1
26*     ..
27*     .. Intrinsic Functions ..
28      INTRINSIC MOD
29*     ..
30      IF (N.LE.0) RETURN
31      IF (SA.EQ.0.0) RETURN
32      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
33*
34*        code for both increments equal to 1
35*
36*
37*        clean-up loop
38*
39         M = MOD(N,4)
40         IF (M.NE.0) THEN
41            DO I = 1,M
42               SY(I) = SY(I) + SA*SX(I)
43            END DO
44         END IF
45         IF (N.LT.4) RETURN
46         MP1 = M + 1
47         DO I = MP1,N,4
48            SY(I) = SY(I) + SA*SX(I)
49            SY(I+1) = SY(I+1) + SA*SX(I+1)
50            SY(I+2) = SY(I+2) + SA*SX(I+2)
51            SY(I+3) = SY(I+3) + SA*SX(I+3)
52         END DO
53      ELSE
54*
55*        code for unequal increments or equal increments
56*          not equal to 1
57*
58         IX = 1
59         IY = 1
60         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
61         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
62         DO I = 1,N
63          SY(IY) = SY(IY) + SA*SX(IX)
64          IX = IX + INCX
65          IY = IY + INCY
66         END DO
67      END IF
68      RETURN
69      END
Note: See TracBrowser for help on using the repository browser.