From 49b18b06cf87595e6ecea0a0a68cde31cdda4a54 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 27 Jul 2021 17:39:14 -0400 Subject: [PATCH] Replaced NR quicksort with simple insertion sort, as it performs better for partially sorted lists, and nearly every time we need to sort in SyMBA it's a nearly sorted list --- .../swiftest_symba_vs_swifter_symba.ipynb | 4 +- src/setup/setup.f90 | 2 +- src/util/util_sort.f90 | 279 +++--------------- src/util/util_valid.f90 | 1 - 4 files changed, 50 insertions(+), 236 deletions(-) diff --git a/examples/symba_swifter_comparison/9pl_18tp_encounters/swiftest_symba_vs_swifter_symba.ipynb b/examples/symba_swifter_comparison/9pl_18tp_encounters/swiftest_symba_vs_swifter_symba.ipynb index 500096a76..b3b31d703 100644 --- a/examples/symba_swifter_comparison/9pl_18tp_encounters/swiftest_symba_vs_swifter_symba.ipynb +++ b/examples/symba_swifter_comparison/9pl_18tp_encounters/swiftest_symba_vs_swifter_symba.ipynb @@ -622,7 +622,7 @@ " 1.25413096e+00])\n", "Coordinates:\n", " id int64 2\n", - " * time (d) (time (d)) float64 0.0 11.0 22.0 ... 3.63e+03 3.641e+03 3.652e+03
    • id
      ()
      int64
      2
      array(2)
    • time (d)
      (time (d))
      float64
      0.0 11.0 ... 3.641e+03 3.652e+03
      array([   0.,   11.,   22., ..., 3630., 3641., 3652.])
    • " ], "text/plain": [ "\n", diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index ceed089fe..cbd7aabfe 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -69,7 +69,6 @@ module subroutine setup_construct_system(system, param) return end subroutine setup_construct_system - module subroutine setup_initialize_system(self, param) !! author: David A. Minton !! @@ -83,6 +82,7 @@ module subroutine setup_initialize_system(self, param) call self%cb%initialize(param) call self%pl%initialize(param) call self%tp%initialize(param) + call util_valid(self%pl, self%tp) call self%set_msys() call self%pl%set_mu(self%cb) call self%tp%set_mu(self%cb) diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 index 126f4f12d..108e7941d 100644 --- a/src/util/util_sort.f90 +++ b/src/util/util_sort.f90 @@ -4,260 +4,75 @@ module subroutine util_sort_dp(arr) !! author: David A. Minton !! - !! Sort input double precision array into ascending numerical order using Quicksort algorithm + !! Sort input double precision array into ascending numerical order using insertion sort. + !! This algorithm works well for partially sorted arrays (which is usually the case here) !! - !! Adapted from David E. Kaufmann's Swifter routine: util_sort_dp.f90 - !! Adapted from Numerical Recipes in Fortran 90: The Art of Parallel Scientific Computing, by Press, Teukolsky, - !! Vetterling, and Flannery, 2nd ed., pp. 1169-70 implicit none ! Arguments real(DP), dimension(:), intent(inout) :: arr ! Internals - integer(I4B), parameter :: NN = 15, NSTACK = 50 - real(DP) :: a, dum - integer(I4B) :: n, k, i, j, jstack, l, r - integer(I4B), dimension(NSTACK) :: istack + real(DP) :: tmp + integer(I4B) :: n, i, j - ! executable code n = size(arr) - jstack = 0 - l = 1 - r = n - do - if ((r - l) < NN) then - do j = l + 1, r - a = arr(j) - do i = j - 1, l, -1 - if (arr(i) <= a) exit - arr(i+1) = arr(i) - end do - arr(i+1) = a - end do - if (jstack == 0) return - r = istack(jstack) - l = istack(jstack-1) - jstack = jstack - 2 - else - k = (l + r)/2 - dum = arr(k); arr(k) = arr(l+1); arr(l+1) = dum - if (arr(l) > arr(r)) then - dum = arr(l); arr(l) = arr(r); arr(r) = dum - end if - if (arr(l+1) > arr(r)) then - dum = arr(l+1); arr(l+1) = arr(r); arr(r) = dum - end if - if (arr(l) > arr(l+1)) then - dum = arr(l); arr(l) = arr(l+1); arr(l+1) = dum - end if - i = l + 1 - j = r - a = arr(l+1) - do - do - i = i + 1 - if (arr(i) >= a) exit - end do - do - j = j - 1 - if (arr(j) <= a) exit - end do - if (j < i) exit - dum = arr(i); arr(i) = arr(j); arr(j) = dum - end do - arr(l+1) = arr(j) - arr(j) = a - jstack = jstack + 2 - if (jstack > NSTACK) then - write(*, *) "Swiftest Error:" - write(*, *) " NSTACK too small in util_sort_I4B" - call util_exit(FAILURE) - end if - if ((r - i + 1) >= (j - l)) then - istack(jstack) = r - istack(jstack-1) = i - r = j - 1 - else - istack(jstack) = j - 1 - istack(jstack-1) = l - l = i - end if - end if + do i = 2, n + tmp = arr(i) + do j = i - 1, 1, -1 + if (arr(j) <= tmp) exit + arr(j + 1) = arr(j) + end do + arr(j + 1) = tmp end do - return - end subroutine util_sort_dp module subroutine util_sort_i4b(arr) !! author: David A. Minton !! - !! Sort input double precision array into ascending numerical order using Quicksort algorithm + !! Sort input integer array into ascending numerical order using insertion sort. + !! This algorithm works well for partially sorted arrays (which is usually the case here) !! - !! Adapted from David E. Kaufmann's Swifter routine: util_sort_i4b.f90 - !! Adapted from Numerical Recipes in Fortran 90: The Art of Parallel Scientific Computing, by Press, Teukolsky, - !! Vetterling, and Flannery, 2nd ed., pp. 1169-70 implicit none ! Arguments integer(I4B), dimension(:), intent(inout) :: arr ! Internals - integer(I4B), parameter :: NN = 15, NSTACK = 50 - integer(I4B) :: a, n, k, i, j, jstack, l, r, dum - integer(I4B), dimension(NSTACK) :: istack - - ! executable code + integer(I4B) :: tmp + integer(I4B) :: n, i, j + n = size(arr) - jstack = 0 - l = 1 - r = n - do - if ((r - l) < NN) then - do j = l + 1, r - a = arr(j) - do i = j - 1, l, -1 - if (arr(i) <= a) exit - arr(i+1) = arr(i) - end do - arr(i+1) = a - end do - if (jstack == 0) return - r = istack(jstack) - l = istack(jstack-1) - jstack = jstack - 2 - else - k = (l + r)/2 - dum = arr(k); arr(k) = arr(l+1); arr(l+1) = dum - if (arr(l) > arr(r)) then - dum = arr(l); arr(l) = arr(r); arr(r) = dum - end if - if (arr(l+1) > arr(r)) then - dum = arr(l+1); arr(l+1) = arr(r); arr(r) = dum - end if - if (arr(l) > arr(l+1)) then - dum = arr(l); arr(l) = arr(l+1); arr(l+1) = dum - end if - i = l + 1 - j = r - a = arr(l+1) - do - do - i = i + 1 - if (arr(i) >= a) exit - end do - do - j = j - 1 - if (arr(j) <= a) exit - end do - if (j < i) exit - dum = arr(i); arr(i) = arr(j); arr(j) = dum - end do - arr(l+1) = arr(j) - arr(j) = a - jstack = jstack + 2 - if (jstack > NSTACK) then - write(*, *) "Swiftest Error:" - write(*, *) " NSTACK too small in util_sort_i4b" - call util_exit(FAILURE) - end if - if ((r - i + 1) >= (j - l)) then - istack(jstack) = r - istack(jstack-1) = i - r = j - 1 - else - istack(jstack) = j - 1 - istack(jstack-1) = l - l = i - end if - end if + do i = 2, n + tmp = arr(i) + do j = i - 1, 1, -1 + if (arr(j) <= tmp) exit + arr(j + 1) = arr(j) + end do + arr(j + 1) = tmp end do - return - - end subroutine util_sort_i4b + end subroutine util_sort_i4b + + module subroutine util_sort_sp(arr) + !! author: David A. Minton + !! + !! Sort input single precision array into ascending numerical order using insertion sort. + !! This algorithm works well for partially sorted arrays (which is usually the case here) + ! + implicit none + ! Arguments + real(SP), dimension(:), intent(inout) :: arr + ! Internals + real(SP) :: tmp + integer(I4B) :: n, i, j - module subroutine util_sort_sp(arr) - !! author: David A. Minton - !! - !! Sort input single precision array into ascending numerical order using Quicksort algorithm - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_sort_DP.f90 - !! Adapted from Numerical Recipes in Fortran 90: The Art of Parallel Scientific Computing, by Press, Teukolsky, - !! Vetterling, and Flannery, 2nd ed., pp. 1169-70 - implicit none - ! Arguments - real(SP), dimension(:), intent(inout) :: arr - ! Internals - integer(I4B), parameter :: NN = 15, NSTACK = 50 - real(SP) :: a, dum - integer(I4B) :: n, k, i, j, jstack, l, r - integer(I4B), dimension(NSTACK) :: istack - - ! executable code - n = size(arr) - jstack = 0 - l = 1 - r = n - do - if ((r - l) < NN) then - do j = l + 1, r - a = arr(j) - do i = j - 1, l, -1 - if (arr(i) <= a) exit - arr(i+1) = arr(i) - end do - arr(i+1) = a - end do - if (jstack == 0) return - r = istack(jstack) - l = istack(jstack-1) - jstack = jstack - 2 - else - k = (l + r)/2 - dum = arr(k); arr(k) = arr(l+1); arr(l+1) = dum - if (arr(l) > arr(r)) then - dum = arr(l); arr(l) = arr(r); arr(r) = dum - end if - if (arr(l+1) > arr(r)) then - dum = arr(l+1); arr(l+1) = arr(r); arr(r) = dum - end if - if (arr(l) > arr(l+1)) then - dum = arr(l); arr(l) = arr(l+1); arr(l+1) = dum - end if - i = l + 1 - j = r - a = arr(l+1) - do - do - i = i + 1 - if (arr(i) >= a) exit - end do - do - j = j - 1 - if (arr(j) <= a) exit - end do - if (j < i) exit - dum = arr(i); arr(i) = arr(j); arr(j) = dum - end do - arr(l+1) = arr(j) - arr(j) = a - jstack = jstack + 2 - if (jstack > NSTACK) then - write(*, *) "Swiftest Error:" - write(*, *) " NSTACK too small in util_sort_I4B" - call util_exit(FAILURE) - end if - if ((r - i + 1) >= (j - l)) then - istack(jstack) = r - istack(jstack-1) = i - r = j - 1 - else - istack(jstack) = j - 1 - istack(jstack-1) = l - l = i - end if - end if + n = size(arr) + do i = 2, n + tmp = arr(i) + do j = i - 1, 1, -1 + if (arr(j) <= tmp) exit + arr(j + 1) = arr(j) end do - - return - - end subroutine util_sort_sp + arr(j + 1) = tmp + end do + return + end subroutine util_sort_sp end submodule s_util_sort diff --git a/src/util/util_valid.f90 b/src/util/util_valid.f90 index ac81673ca..ac9cc2fad 100644 --- a/src/util/util_valid.f90 +++ b/src/util/util_valid.f90 @@ -32,7 +32,6 @@ module subroutine util_valid(pl, tp) call util_exit(FAILURE) end if end do - deallocate(idarr) end associate return