DCOPY copies a vector, x, to a vector, y. 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 dcopy(n, dx, incx, dy, incy) !! DCOPY copies a vector, x, to a vector, y. !! uses unrolled loops for increments equal to 1. integer(ip) :: incx, incy, n real(wp) :: dx(*), dy(*) 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, 7_ip) if (m /= 0_ip) then do i = 1_ip, m dy(i) = dx(i) end do if (n < 7_ip) return end if mp1 = m + 1_ip do i = mp1, n, 7_ip dy(i) = dx(i) dy(i + 1_ip) = dx(i + 1_ip) dy(i + 2_ip) = dx(i + 2_ip) dy(i + 3_ip) = dx(i + 3_ip) dy(i + 4_ip) = dx(i + 4_ip) dy(i + 5_ip) = dx(i + 5_ip) dy(i + 6_ip) = dx(i + 6_ip) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip 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 dy(iy) = dx(ix) ix = ix + incx iy = iy + incy end do end if end subroutine dcopy