You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

sscalf.f 1.0 kB

12345678910111213141516171819202122232425262728293031323334353637383940414243
  1. subroutine sscalf(n,sa,sx,incx)
  2. c
  3. c scales a vector by a constant.
  4. c uses unrolled loops for increment equal to 1.
  5. c jack dongarra, linpack, 3/11/78.
  6. c modified 3/93 to return if incx .le. 0.
  7. c modified 12/3/93, array(1) declarations changed to array(*)
  8. c
  9. real sa,sx(*)
  10. integer i,incx,m,mp1,n,nincx
  11. c
  12. if( n.le.0 .or. incx.le.0 )return
  13. if(incx.eq.1)go to 20
  14. c
  15. c code for increment not equal to 1
  16. c
  17. nincx = n*incx
  18. do 10 i = 1,nincx,incx
  19. sx(i) = sa*sx(i)
  20. 10 continue
  21. return
  22. c
  23. c code for increment equal to 1
  24. c
  25. c
  26. c clean-up loop
  27. c
  28. 20 m = mod(n,5)
  29. if( m .eq. 0 ) go to 40
  30. do 30 i = 1,m
  31. sx(i) = sa*sx(i)
  32. 30 continue
  33. if( n .lt. 5 ) return
  34. 40 mp1 = m + 1
  35. do 50 i = mp1,n,5
  36. sx(i) = sa*sx(i)
  37. sx(i + 1) = sa*sx(i + 1)
  38. sx(i + 2) = sa*sx(i + 2)
  39. sx(i + 3) = sa*sx(i + 3)
  40. sx(i + 4) = sa*sx(i + 4)
  41. 50 continue
  42. return
  43. end