DSWAP interchanges two vectors. uses unrolled loops for increments equal to 1.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer(kind=ip) | :: | n | ||||
real(kind=wp) | :: | dx(*) | ||||
integer(kind=ip) | :: | incx | ||||
real(kind=wp) | :: | dy(*) | ||||
integer(kind=ip) | :: | incy |
subroutine dswap(n, dx, incx, dy, incy) !! DSWAP interchanges two vectors. !! uses unrolled loops for increments equal to 1. integer(ip) :: incx, incy, n real(wp) :: dx(*), dy(*) real(wp) :: dtemp integer(ip) :: i, ix, iy, m, mp1 if (n <= 0_ip) return if (incx == 1_ip .and. incy == 1_ip) then ! code for both increments equal to 1 ! clean-up loop m = mod(n, 3_ip) if (m /= 0_ip) then do i = 1_ip, m dtemp = dx(i) dx(i) = dy(i) dy(i) = dtemp end do if (n < 3_ip) return end if mp1 = m + 1_ip do i = mp1, n, 3_ip dtemp = dx(i) dx(i) = dy(i) dy(i) = dtemp dtemp = dx(i + 1_ip) dx(i + 1_ip) = dy(i + 1_ip) dy(i + 1_ip) = dtemp dtemp = dx(i + 2_ip) dx(i + 2_ip) = dy(i + 2_ip) dy(i + 2_ip) = dtemp end do else ! code for unequal increments or equal increments not equal ! to 1 ix = 1 iy = 1 if (incx < 0_ip) ix = (-n + 1_ip)*incx + 1_ip if (incy < 0_ip) iy = (-n + 1_ip)*incy + 1_ip do i = 1_ip, n dtemp = dx(ix) dx(ix) = dy(iy) dy(iy) = dtemp ix = ix + incx iy = iy + incy end do end if end subroutine dswap