source: PSPA/parmelaPSPA/trunk/sscal.f @ 402

Last change on this file since 402 was 12, checked in by lemeur, 12 years ago

parmela pspa initial

File size: 2.2 KB
Line 
1      subroutine sscal (n, sa, sx, incx)
2c***begin prologue  sscal
3c***purpose  mULTIPLY A VECTOR BY A CONSTANT.
4c***library   slatec (blas)
5c***category  d1a6
6c***type      single precision (sscal-s, dscal-d, cscal-c)
7c***keywords  blas, linear algebra, scale, vector
8c***AUTHOR  Lawson, C. L., (JPL)
9c           Hanson, R. J., (SNLA)
10c           Kincaid, D. R., (U. of Texas)
11c           Krogh, F. T., (JPL)
12c***description
13c
14c                B L A S  Subprogram
15C    Description of Parameters
16C
17C     --Input--
18C        N  number of elements in input vector(s)
19C       SA  single precision scale factor
20C       SX  single precision vector with N elements
21C     INCX  storage spacing between elements of SX
22C
23C     --Output--
24C       SX  single precision result (unchanged if N .LE. 0)
25C
26C     Replace single precision SX by single precision SA*SX.
27C     For I = 0 to N-1, replace SX(1+I*INCX) with  SA * SX(1+I*INCX)
28C
29c***references  lawson c.l., hanson r.j., kincaid d.r., krogh f.t.,
30c                 *basic linear algebra subprograms for fortran usage*,
31c                 algorithm no. 539, transactions on mathematical
32c                 software, volume 5, number 3, september 1979, 308-323
33c***routines called  (none)
34c***revision history  (yymmdd)
35C   791001  Date written
36C   890831  Modified array declarations.  (WRB)
37C   890831  REVISION DATE from Version 3.2
38C   891214  Prologue converted to Version 4.0 format.  (BAB)
39c***end prologue  sscal
40c
41      real sa,sx(*)
42c***first executable statement  sscal
43      if(n.le.0)return
44      if(incx.eq.1)goto 20
45c
46c        code for increments not equal to 1.
47c
48      ns = n*incx
49          do 10 i = 1,ns,incx
50          sx(i) = sa*sx(i)
51   10     continue
52      return
53c
54c        code for increments equal to 1.
55c
56c
57c        clean-up loop so remaining vector length is a multiple of 5.
58c
59   20 m = mod(n,5)
60      if( m .eq. 0 ) go to 40
61      do 30 i = 1,m
62        sx(i) = sa*sx(i)
63   30 continue
64      if( n .lt. 5 ) return
65   40 mp1 = m + 1
66      do 50 i = mp1,n,5
67        sx(i) = sa*sx(i)
68        sx(i + 1) = sa*sx(i + 1)
69        sx(i + 2) = sa*sx(i + 2)
70        sx(i + 3) = sa*sx(i + 3)
71        sx(i + 4) = sa*sx(i + 4)
72   50 continue
73      return
74      end
75c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
Note: See TracBrowser for help on using the repository browser.