Merge remote-tracking branch 'origin/release-v4.6.1'
[WRF.git] / var / external / blas / dscal.inc
blob7d107d283a5550c7fd8a0c9bdd2291cfd911a086
1       subroutine  dscal(n,da,dx,incx)
3 !     scales a vector by a constant.
4 !     uses unrolled loops for increment equal to one.
5 !     jack dongarra, linpack, 3/11/78.
6 !     modified 3/93 to return if incx .le. 0.
7 !     modified 12/3/93, array(1) declarations changed to array(*)
9       double precision da,dx(*)
10       integer i,incx,m,mp1,n,nincx
12       if( n.le.0 .or. incx.le.0 )return
13       if(incx.eq.1)go to 20
15 !        code for increment not equal to 1
17       nincx = n*incx
18       do 10 i = 1,nincx,incx
19         dx(i) = da*dx(i)
20    10 continue
21       return
23 !        code for increment equal to 1
26 !        clean-up loop
28    20 m = mod(n,5)
29       if( m .eq. 0 ) go to 40
30       do 30 i = 1,m
31         dx(i) = da*dx(i)
32    30 continue
33       if( n .lt. 5 ) return
34    40 mp1 = m + 1
35       do 50 i = mp1,n,5
36         dx(i) = da*dx(i)
37         dx(i + 1) = da*dx(i + 1)
38         dx(i + 2) = da*dx(i + 2)
39         dx(i + 3) = da*dx(i + 3)
40         dx(i + 4) = da*dx(i + 4)
41    50 continue
42       return
43       end subroutine  dscal