From 570717efc6a58047d98b25880e6ac4b597d2da54 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 28 Jul 2021 10:39:09 -0400 Subject: [PATCH] Added sort and rearrange methods to WHM --- src/modules/whm_classes.f90 | 43 ++++++++++++++++--------- src/whm/whm_util.f90 | 62 +++++++++++++++++++++++++++++++++++++ 2 files changed, 91 insertions(+), 14 deletions(-) diff --git a/src/modules/whm_classes.f90 b/src/modules/whm_classes.f90 index a6ab59958..c242d2521 100644 --- a/src/modules/whm_classes.f90 +++ b/src/modules/whm_classes.f90 @@ -30,20 +30,22 @@ module whm_classes !! Note to developers: If you add componenets to this class, be sure to update methods and subroutines that traverse the !! component list, such as whm_setup_pl and whm_util_spill_pl contains - procedure :: h2j => whm_coord_h2j_pl !! Convert position and velcoity vectors from heliocentric to Jacobi coordinates - procedure :: j2h => whm_coord_j2h_pl !! Convert position and velcoity vectors from Jacobi to helliocentric coordinates - procedure :: vh2vj => whm_coord_vh2vj_pl !! Convert velocity vectors from heliocentric to Jacobi coordinates - procedure :: drift => whm_drift_pl !! Loop through massive bodies and call Danby drift routine to jacobi coordinates - procedure :: fill => whm_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) - procedure :: accel => whm_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies - procedure :: kick => whm_kick_vh_pl !! Kick heliocentric velocities of massive bodies - procedure :: accel_gr => whm_gr_kick_getacch_pl !! Acceleration term arising from the post-Newtonian correction - procedure :: gr_pos_kick => whm_gr_p4_pl !! Position kick due to p**4 term in the post-Newtonian correction - procedure :: setup => whm_setup_pl !! Constructor method - Allocates space for number of particles - procedure :: set_mu => whm_util_set_mu_eta_pl !! Sets the Jacobi mass value for all massive bodies. - procedure :: set_ir3 => whm_util_set_ir3j !! Sets both the heliocentric and jacobi inverse radius terms (1/rj**3 and 1/rh**3) - procedure :: step => whm_step_pl !! Steps the body forward one stepsize - procedure :: spill => whm_util_spill_pl !!"Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: h2j => whm_coord_h2j_pl !! Convert position and velcoity vectors from heliocentric to Jacobi coordinates + procedure :: j2h => whm_coord_j2h_pl !! Convert position and velcoity vectors from Jacobi to helliocentric coordinates + procedure :: vh2vj => whm_coord_vh2vj_pl !! Convert velocity vectors from heliocentric to Jacobi coordinates + procedure :: drift => whm_drift_pl !! Loop through massive bodies and call Danby drift routine to jacobi coordinates + procedure :: fill => whm_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) + procedure :: accel => whm_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies + procedure :: kick => whm_kick_vh_pl !! Kick heliocentric velocities of massive bodies + procedure :: accel_gr => whm_gr_kick_getacch_pl !! Acceleration term arising from the post-Newtonian correction + procedure :: gr_pos_kick => whm_gr_p4_pl !! Position kick due to p**4 term in the post-Newtonian correction + procedure :: setup => whm_setup_pl !! Constructor method - Allocates space for number of particles + procedure :: set_mu => whm_util_set_mu_eta_pl !! Sets the Jacobi mass value for all massive bodies. + procedure :: set_ir3 => whm_util_set_ir3j !! Sets both the heliocentric and jacobi inverse radius terms (1/rj**3 and 1/rh**3) + procedure :: sort => whm_util_sort_pl !! Sort a WHM massive body object in-place. + procedure :: rearrange => whm_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: step => whm_step_pl !! Steps the body forward one stepsize + procedure :: spill => whm_util_spill_pl !!"Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) end type whm_pl !******************************************************************************************************************************** @@ -209,6 +211,19 @@ module subroutine whm_util_set_mu_eta_pl(self, cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object end subroutine whm_util_set_mu_eta_pl + module subroutine whm_util_sort_pl(self, sortby, ascending) + implicit none + class(whm_pl), intent(inout) :: self !! WHM massive body object + character(*), intent(in) :: sortby !! Sorting attribute + logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + end subroutine whm_util_sort_pl + + module subroutine whm_util_sort_rearrange_pl(self, ind) + implicit none + class(whm_pl), intent(inout) :: self !! WHM massive body object + integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + end subroutine whm_util_sort_rearrange_pl + module subroutine whm_setup_initialize_system(self, param) use swiftest_classes, only : swiftest_parameters implicit none diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 67c7ef4a1..791b5d651 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -112,4 +112,66 @@ module subroutine whm_util_set_ir3j(self) end if end subroutine whm_util_set_ir3j + module subroutine whm_util_sort_pl(self, sortby, ascending) + !! author: David A. Minton + !! + !! Sort a WHM massive body object in-place. + !! sortby is a string indicating which array component to sort. + implicit none + ! Arguments + class(whm_pl), intent(inout) :: self !! WHM massive body object + character(*), intent(in) :: sortby !! Sorting attribute + logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + ! Internals + integer(I4B), dimension(self%nbody) :: ind + integer(I4B) :: direction + + if (ascending) then + direction = 1 + else + direction = -1 + end if + associate(pl => self, npl => self%nbody) + select case(sortby) + case("eta") + call util_sort(direction * pl%eta(1:npl), ind(1:npl)) + case("muj") + call util_sort(direction * pl%muj(1:npl), ind(1:npl)) + case("ir3j") + call util_sort(direction * pl%ir3j(1:npl), ind(1:npl)) + case default + call util_sort_pl(pl, sortby, ascending) + return + end select + call pl%rearrange(ind) + end associate + return + end subroutine whm_util_sort_pl + + module subroutine whm_util_sort_rearrange_pl(self, ind) + !! author: David A. Minton + !! + !! Rearrange WHM massive body structure in-place from an index list. + !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. + implicit none + ! Arguments + class(whm_pl), intent(inout) :: self !! WHM massive body object + integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + ! Internals + class(whm_pl), allocatable :: pl_sorted !! Temporary holder for sorted body + integer(I4B) :: i + + associate(pl => self, npl => self%nbody) + call util_sort_rearrange_pl(pl,ind) + allocate(pl_sorted, source=self) + pl%eta(1:npl) = pl_sorted%eta(ind(1:npl)) + pl%xj(:,1:npl) = pl_sorted%xj(:,ind(1:npl)) + pl%vj(:,1:npl) = pl_sorted%vj(:,ind(1:npl)) + pl%muj(1:npl) = pl_sorted%muj(ind(1:npl)) + pl%ir3j(1:npl) = pl_sorted%ir3j(ind(1:npl)) + deallocate(pl_sorted) + end associate + return + end subroutine whm_util_sort_rearrange_pl + end submodule s_whm_util