SUBROUTINE sswap (n, sx, incx, sy, incy)  
!     interchanges two vectors.
!     uses unrolled loops for increments equal to 1.
!     jack dongarra, linpack, 3/11/78.
!     modified 12/3/93, array(1) declarations changed to array(*)
IMPLICIT NONE

INTEGER, INTENT(IN)    :: n, incx, incy
REAL   , INTENT(IN OUT):: sx(*), sy(*)
real    :: stemp
integer :: i, ix, iy, m, mp1

if (n.le.0) return  
if (incx.eq.1.and.incy.eq.1) goto 20  
!       code for unequal increments or equal increments not equal
!         to 1
ix = 1  
iy = 1  
if (incx.lt.0) ix = ( - n + 1) * incx + 1  
if (incy.lt.0) iy = ( - n + 1) * incy + 1  
do 10 i = 1, n  
   stemp = sx (ix)  
   sx (ix) = sy (iy)  
   sy (iy) = stemp  
   ix = ix + incx  
   iy = iy + incy  
10 end do  
return  
!       code for both increments equal to 1
!       clean-up loop
   20 m = mod (n, 3)  
if (m.eq.0) goto 40  
do 30 i = 1, m  
   stemp = sx (i)  
   sx (i) = sy (i)  
   sy (i) = stemp  
30 end do  
if (n.lt.3) return  
   40 mp1 = m + 1  
do 50 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  
50 end do  

return  
END SUBROUTINE sswap
