Statistiques
| Révision :

root / src / blas / sscal.f @ 7

Historique | Voir | Annoter | Télécharger (1,19 ko)

1 
      SUBROUTINE SSCAL(N,SA,SX,INCX)
2 
*     .. Scalar Arguments ..
3 
      REAL SA
4 
      INTEGER INCX,N
5 
*     ..
6 
*     .. Array Arguments ..
7 
      REAL SX(*)
8 
*     ..
9 
*
10 
*  Purpose
11 
*  =======
12 
*
13 
*     scales a vector by a constant.
14 
*     uses unrolled loops for increment equal to 1.
15 
*     jack dongarra, linpack, 3/11/78.
16 
*     modified 3/93 to return if incx .le. 0.
17 
*     modified 12/3/93, array(1) declarations changed to array(*)
18 
*
19 
*
20 
*     .. Local Scalars ..
21 
      INTEGER I,M,MP1,NINCX
22 
*     ..
23 
*     .. Intrinsic Functions ..
24 
      INTRINSIC MOD
25 
*     ..
26 
      IF (N.LE.0 .OR. INCX.LE.0) RETURN
27 
      IF (INCX.EQ.1) GO TO 20
28 
*
29 
*        code for increment not equal to 1
30 
*
31 
      NINCX = N*INCX
32 
      DO 10 I = 1,NINCX,INCX
33 
          SX(I) = SA*SX(I)
34 
   10 CONTINUE
35 
      RETURN
36 
*
37 
*        code for increment equal to 1
38 
*
39 
*
40 
*        clean-up loop
41 
*
42 
   20 M = MOD(N,5)
43 
      IF (M.EQ.0) GO TO 40
44 
      DO 30 I = 1,M
45 
          SX(I) = SA*SX(I)
46 
   30 CONTINUE
47 
      IF (N.LT.5) RETURN
48 
   40 MP1 = M + 1
49 
      DO 50 I = MP1,N,5
50 
          SX(I) = SA*SX(I)
51 
          SX(I+1) = SA*SX(I+1)
52 
          SX(I+2) = SA*SX(I+2)
53 
          SX(I+3) = SA*SX(I+3)
54 
          SX(I+4) = SA*SX(I+4)
55 
   50 CONTINUE
56 
      RETURN
57 
      END