subroutine sscal (n, sa, sx, incx) C***BEGIN PROLOGUE SSCAL C***PURPOSE Multiply a vector by a constant. C***CATEGORY D1A6 C***TYPE SINGLE PRECISION (SSCAL-S, DSCAL-D, CSCAL-C) C***KEYWORDS BLAS, LINEAR ALGEBRA, SCALE, VECTOR C***AUTHOR Lawson, C. L., (JPL) C Hanson, R. J., (SNLA) C Kincaid, D. R., (U. of Texas) C Krogh, F. T., (JPL) C***DESCRIPTION C C B L A S Subprogram C Description of Parameters C C --Input-- C N number of elements in input vector(s) C SA single precision scale factor C SX single precision vector with N elements C INCX storage spacing between elements of SX C C --Output-- C SX single precision result (unchanged if N .LE. 0) C C Replace single precision SX by single precision SA*SX. C For I = 0 to N-1, replace SX(IX+I*INCX) with SA * SX(IX+I*INCX), C where IX = 1 if INCX .GE. 0, else IX = 1+(1-N)*INCX. C C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T. C Krogh, Basic linear algebra subprograms for Fortran C usage, Algorithm No. 539, Transactions on Mathematical C Software 5, 3 (September 1979), pp. 308-323. C***ROUTINES CALLED (NONE) C***REVISION HISTORY (YYMMDD) C 791001 DATE WRITTEN C 890831 Modified array declarations. (WRB) C 890831 REVISION DATE from Version 3.2 C 891214 Prologue converted to Version 4.0 format. (BAB) C 900821 Modified to correct problem with a negative increment. C (WRB) C 920501 Reformatted the REFERENCES section. (WRB) C***END PROLOGUE SSCAL real sa, sx(*) integer i, incx, ix, m, mp1, n c***first executable statement sscal if (n .le. 0) return if (incx .eq. 1) goto 20 c c code for increment not equal to 1. c ix = 1 if (incx .lt. 0) ix = (-n+1)*incx + 1 do 10 i = 1,n sx(ix) = sa*sx(ix) ix = ix + incx 10 continue return c c code for increment equal to 1. c c clean-up loop so remaining vector length is a multiple of 5. c 20 m = mod(n,5) if (m .eq. 0) goto 40 do 30 i = 1,m sx(i) = sa*sx(i) 30 continue if (n .lt. 5) return 40 mp1 = m + 1 do 50 i = mp1,n,5 sx(i) = sa*sx(i) sx(i+1) = sa*sx(i+1) sx(i+2) = sa*sx(i+2) sx(i+3) = sa*sx(i+3) sx(i+4) = sa*sx(i+4) 50 continue return end