root / synthbench / euroben-dm / mod2b / swap.f @ 0:839f52ef7657
History | View | Annotate | Download (1.3 kB)
| 1 |
Subroutine swap( n, x, incx, y, incy ) |
|---|---|
| 2 |
! ----------------------------------------------------------------------- |
| 3 |
Use numerics |
| 4 |
Implicit None |
| 5 |
|
| 6 |
Real(l_) :: x(*), y(*), temp |
| 7 |
Integer :: i, incx, incy, ix, iy, m, mp1, n |
| 8 |
! ----------------------------------------------------------------------- |
| 9 |
If ( n <= 0 ) Return |
| 10 |
If ( ( incx /= 1 ) .OR. ( incy /= 1 ) ) Then |
| 11 |
ix = 1 |
| 12 |
iy = 1 |
| 13 |
If ( incx < 0 ) ix = (-n+1)*incx + 1 |
| 14 |
If ( incy < 0 ) iy = (-n+1)*incy + 1 |
| 15 |
Do i = 1, n |
| 16 |
temp = x(ix) |
| 17 |
x(ix) = y(iy) |
| 18 |
y(iy) = temp |
| 19 |
ix = ix + incx |
| 20 |
iy = iy + incy |
| 21 |
End Do |
| 22 |
Return |
| 23 |
End If |
| 24 |
m = Mod( n, 3 ) |
| 25 |
If ( m /= 0 ) Then |
| 26 |
Do i = 1, m |
| 27 |
temp = x(i) |
| 28 |
x(i) = y(i) |
| 29 |
y(i) = temp |
| 30 |
End Do |
| 31 |
If ( n < 3 ) Return |
| 32 |
End If |
| 33 |
mp1 = m + 1 |
| 34 |
Do i = mp1, n, 3 |
| 35 |
temp = x(i) |
| 36 |
x(i) = y(i) |
| 37 |
y(i) = temp |
| 38 |
temp = x(i+1) |
| 39 |
x(i+1) = y(i+1) |
| 40 |
y(i+1) = temp |
| 41 |
temp = x(i+2) |
| 42 |
x(i+2) = y(i+2) |
| 43 |
y(i+2) = temp |
| 44 |
End Do |
| 45 |
! ----------------------------------------------------------------------- |
| 46 |
End Subroutine swap |