From c01b21ab7aa060139fb6f9d197b4501088d60c9a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 22 Oct 2021 22:37:17 -0400 Subject: [PATCH 1/4] Added sort with better documentation --- src/util/util_sort.f90 | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 index a662eb52c..1b09b84f7 100644 --- a/src/util/util_sort.f90 +++ b/src/util/util_sort.f90 @@ -118,9 +118,12 @@ recursive pure subroutine qsort_index_DP(arr, ind) !! author: David A. Minton !! !! Sort input DP precision array by index in ascending numerical order using quicksort sort. + !! implicit none + ! Arguments real(DP), dimension(:), intent(inout) :: arr integer(I4B),dimension(:),intent(out) :: ind + !! Internals integer :: iq if (size(arr) > 1) then @@ -137,16 +140,24 @@ pure subroutine partition_DP(arr, marker, ind) !! author: David A. Minton !! !! Partition function for quicksort on DP type - real(DP), intent(inout), dimension(:) :: arr + !! + implicit none + ! Arguments + real(DP), intent(inout), dimension(:) :: arr integer(I4B), intent(inout), dimension(:), optional :: ind - integer(I4B), intent(out) :: marker - integer(I4B) :: i, j, itmp + integer(I4B), intent(out) :: marker + ! Internals + integer(I4B) :: i, j, itmp, narr, ipiv real(DP) :: temp - real(DP) :: x ! pivot point + real(DP) :: x ! pivot point + + narr = size(arr) - x = arr(1) + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2 + x = arr(ipiv) i = 0 - j = size(arr) + 1 + j = narr + 1 do j = j - 1 @@ -164,9 +175,11 @@ pure subroutine partition_DP(arr, marker, ind) temp = arr(i) arr(i) = arr(j) arr(j) = temp - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if else if (i == j) then marker = i + 1 return From 477e6bdd7864ad5e4e2b96e92a54e89c4651784c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 25 Oct 2021 09:28:02 -0400 Subject: [PATCH 2/4] Removed cruft --- src/fraggle/fraggle_io.f90 | 45 -------------------------------------- 1 file changed, 45 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 410592782..6eb1b5ee2 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -61,26 +61,6 @@ module subroutine fraggle_io_log_generate(frag) end subroutine fraggle_io_log_generate - ! module subroutine io_log_one_message(FRAGGLE_LOG_OUT, message) - ! !! author: David A. Minton - ! !! - ! !! Writes a single message to the fraggle log file - ! implicit none - ! ! Arguments - ! character(len=*), intent(in) :: message - ! ! Internals - ! character(STRMAX) :: errmsg - - ! open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - ! write(LUN, *) trim(adjustl(message)) - ! close(LUN) - - ! return - ! 667 continue - ! write(*,*) "Error writing Fraggle message to log file: " // trim(adjustl(errmsg)) - ! end subroutine fraggle_io_log_one_message - - module subroutine fraggle_io_log_pl(pl, param) !! author: David A. Minton !! @@ -227,29 +207,4 @@ module subroutine fraggle_io_log_regime(colliders, frag) write(*,*) "Error writing Fraggle regime information to log file: " // trim(adjustl(errmsg)) end subroutine fraggle_io_log_regime - - ! module subroutine fraggle_io_log_start(param) - ! !! author: David A. Minton - ! !! - ! !! Checks to see if the Fraggle log file needs to be replaced if this is a new run, or appended if this is a restarted run - ! implicit none - ! ! Arguments - ! class(swiftest_parameters), intent(in) :: param - ! ! Internals - ! character(STRMAX) :: errmsg - ! logical :: fileExists - - ! inquire(file=FRAGGLE_LOG_OUT, exist=fileExists) - ! if (.not.param%lrestart .or. .not.fileExists) then - ! open(unit=LUN, file=FRAGGLE_LOG_OUT, status="REPLACE", err = 667, iomsg = errmsg) - ! write(LUN, *, err = 667, iomsg = errmsg) "Fraggle logfile" - ! end if - ! close(LUN) - - ! return - - ! 667 continue - ! write(*,*) "Error writing Fraggle log file: " // trim(adjustl(errmsg)) - ! end subroutine fraggle_io_log_start - end submodule s_fraggle_io \ No newline at end of file From a9189680557360555da06eca459fbc0caccf8cc6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 25 Oct 2021 10:05:17 -0400 Subject: [PATCH 3/4] Removed cruft --- src/fraggle/fraggle_set.f90 | 33 --------------------------------- 1 file changed, 33 deletions(-) diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 04ab32386..4012eda34 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -198,39 +198,6 @@ module subroutine fraggle_set_coordinate_system(self, colliders) end subroutine fraggle_set_coordinate_system - ! module subroutine symba_set_collresolve_colliders(self, cb, pl, idx) - ! !! author: David A. Minton - ! !! - ! !! Calculate the two-body equivalent values given a set of input collider indices - ! use swiftest_classes, only : swiftest_nbody_system - ! implicit none - ! ! Arguments - ! class(fraggle_colliders), intent(inout) :: self !! Fraggle collider object - ! class(symba_cb), intent(in) :: cb !! Swiftest central body object system object - ! class(symba_pl), intent(in) :: pl !! Swiftest central body object system object - ! integer(I4B), dimension(:), intent(in) :: idx !! Index array of bodies from the pl object to use to calculate a "two-body equivalent" collisional pair - ! ! Internals - ! real(DP), dimension(NDIM, 2) :: mxc, vc - ! real(DP), dimension(NDIM) :: vcom, xcom - - ! associate(colliders => self) - - ! ! Compute orbital angular momentum of pre-impact system - ! xcom(:) = (colliders%mass(1) * colliders%xb(:, 1) + colliders%mass(2) * colliders%xb(:, 2)) / sum(colliders%mass(:)) - ! vcom(:) = (colliders%mass(1) * colliders%vb(:, 1) + colliders%mass(2) * colliders%vb(:, 2)) / sum(colliders%mass(:)) - ! mxc(:, 1) = colliders%mass(1) * (colliders%xb(:, 1) - xcom(:)) - ! mxc(:, 2) = colliders%mass(2) * (colliders%xb(:, 2) - xcom(:)) - ! vc(:, 1) = colliders%vb(:, 1) - vcom(:) - ! vc(:, 2) = colliders%vb(:, 2) - vcom(:) - - ! colliders%L_orbit(:,:) = mxc(:,:) .cross. vc(:,:) - - ! end associate - - ! return - ! end subroutine symbe_set_collresolve_colliders - - module subroutine fraggle_set_natural_scale_factors(self, colliders) !! author: David A. Minton !! From a3b8b0dfb65db250b2dbaa462dc42e887b42442d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 25 Oct 2021 10:05:58 -0400 Subject: [PATCH 4/4] Fixed array shape problem that was causing the wrong bodies to be considered for encounters in the sweep phase --- src/encounter/encounter_check.f90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index 298bf7d4f..b6dae95fb 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -981,9 +981,11 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, nenc, index1, call util_index_array(ind_arr, n) allocate(ibeg(SWEEPDIM * n)) allocate(iend(SWEEPDIM * n)) - do dim = 1, SWEEPDIM - ibeg((dim - 1) * n + 1:dim * n) = self%aabb(dim)%ibeg(:) - iend((dim - 1) * n + 1:dim * n) = self%aabb(dim)%iend(:) + do i = 1, n + do dim = 1, SWEEPDIM + ibeg((i - 1) * SWEEPDIM + dim) = self%aabb(dim)%ibeg(i) + iend((i - 1) * SWEEPDIM + dim) = self%aabb(dim)%iend(i) + end do end do ! Sweep the intervals for each of the massive bodies along one dimension