sswap Subroutine

public 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(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. !

Arguments

Type IntentOptional AttributesName
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

Contents

Source Code


Source Code

  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