Routine to interchange two vectors author: Jack Dongarra, Linpack author: P J Knight, CCFE, Culham Science Centre n : input integer : order of the matrices sx, sy sx(nincx) : input/output real array : first vector incx : input integer : interval in storage between sx array elements sy(nincy) : input/output real array : second vector incy : input integer : interval in storage between sy array elements This routine swaps the contents of two vectors, using unrolled loops for increments equal to 1. !
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | n | |||
real(kind=dp), | intent(inout), | dimension(n*incx) | :: | sx | ||
integer, | intent(in) | :: | incx | |||
real(kind=dp), | intent(inout), | dimension(n*incy) | :: | sy | ||
integer, | intent(in) | :: | incy |
subroutine sswap(n,sx,incx,sy,incy)
!! Routine to interchange two vectors
!! author: Jack Dongarra, Linpack
!! author: P J Knight, CCFE, Culham Science Centre
!! n : input integer : order of the matrices sx, sy
!! sx(n*incx) : input/output real array : first vector
!! incx : input integer : interval in storage between sx array elements
!! sy(n*incy) : input/output real array : second vector
!! incy : input integer : interval in storage between sy array elements
!! This routine swaps the contents of two vectors,
!! using unrolled loops for increments equal to 1.
!! !
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
implicit none
! Arguments
integer, intent(in) :: n, incx, incy
real(dp), dimension(n*incx), intent(inout) :: sx
real(dp), dimension(n*incy), intent(inout) :: sy
! Local variables
integer :: i,ix,iy,m,mp1
real(dp) :: stemp
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if (n <= 0) return
if ((incx /= 1).or.(incy /= 1)) then
ix = 1 ; iy = 1
if (incx < 0) ix = (-n+1)*incx + 1
if (incy < 0) iy = (-n+1)*incy + 1
do i = 1,n
stemp = sx(ix)
sx(ix) = sy(iy)
sy(iy) = stemp
ix = ix + incx
iy = iy + incy
end do
else
m = mod(n,3)
if (m /= 0) then
do i = 1,m
stemp = sx(i)
sx(i) = sy(i)
sy(i) = stemp
end do
if (n < 3) return
end if
mp1 = m + 1
do i = mp1,n,3
stemp = sx(i)
sx(i) = sy(i)
sy(i) = stemp
stemp = sx(i + 1)
sx(i + 1) = sy(i + 1)
sy(i + 1) = stemp
stemp = sx(i + 2)
sx(i + 2) = sy(i + 2)
sy(i + 2) = stemp
end do
end if
end subroutine sswap