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