diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs_classes.f90 index 37a88993c..de4cdec4c 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs_classes.f90 @@ -66,13 +66,15 @@ module rmvs_classes integer(I4B) :: ipleP !! index value of encountering planet logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations contains - procedure :: discard => rmvs_discard_tp !! Check to see if test particles should be discarded based on pericenter passage distances with respect to planets encountered - procedure :: encounter_check => rmvs_encounter_check_tp !! Checks if any test particles are undergoing a close encounter with a massive body - procedure :: fill => rmvs_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) - procedure :: accel => rmvs_kick_getacch_tp !! Calculates either the standard or modified version of the acceleration depending if the - !! if the test particle is undergoing a close encounter or not - procedure :: setup => rmvs_setup_tp !! Constructor method - Allocates space for number of particles - procedure :: spill => rmvs_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: discard => rmvs_discard_tp !! Check to see if test particles should be discarded based on pericenter passage distances with respect to planets encountered + procedure :: encounter_check => rmvs_encounter_check_tp !! Checks if any test particles are undergoing a close encounter with a massive body + procedure :: accel => rmvs_kick_getacch_tp !! Calculates either the standard or modified version of the acceleration depending if the + !! if the test particle is undergoing a close encounter or not + procedure :: setup => rmvs_setup_tp !! Constructor method - Allocates space for number of particles + procedure :: fill => rmvs_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) + procedure :: sort => rmvs_util_sort_tp !! Sorts body arrays by a sortable componen + procedure :: rearrange => rmvs_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: spill => rmvs_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) end type rmvs_tp !******************************************************************************************************************************** @@ -89,9 +91,11 @@ module rmvs_classes class(rmvs_nbody_system), dimension(:), allocatable :: planetocentric !! Planetocentric version of the massive body objects (one for each massive body) logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations contains - procedure :: fill => rmvs_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) - procedure :: setup => rmvs_setup_pl !! Constructor method - Allocates space for number of particles - procedure :: spill => rmvs_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: setup => rmvs_setup_pl !! Constructor method - Allocates space for number of particles + procedure :: sort => rmvs_util_sort_pl !! Sorts body arrays by a sortable componen + procedure :: rearrange => rmvs_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: fill => rmvs_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) + procedure :: spill => rmvs_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) end type rmvs_pl interface @@ -117,22 +121,6 @@ module function rmvs_encounter_check_tp(self, system, dt) result(lencounter) logical :: lencounter !! Returns true if there is at least one close encounter end function rmvs_encounter_check_tp - module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body - implicit none - class(rmvs_pl), intent(inout) :: self !! RMVS massive body object - class(swiftest_body), intent(inout) :: inserts !! Inserted object - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine rmvs_util_fill_pl - - module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body - implicit none - class(rmvs_tp), intent(inout) :: self !! RMVS massive body object - class(swiftest_body), intent(inout) :: inserts !! Inserted object - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine rmvs_util_fill_tp - module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none @@ -162,10 +150,52 @@ module subroutine rmvs_setup_tp(self,n) integer, intent(in) :: n !! Number of test particles to allocate end subroutine rmvs_setup_tp + module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) + use swiftest_classes, only : swiftest_body + implicit none + class(rmvs_pl), intent(inout) :: self !! RMVS massive body object + class(swiftest_body), intent(inout) :: inserts !! Inserted object + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine rmvs_util_fill_pl + + module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) + use swiftest_classes, only : swiftest_body + implicit none + class(rmvs_tp), intent(inout) :: self !! RMVS massive body object + class(swiftest_body), intent(inout) :: inserts !! Inserted object + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine rmvs_util_fill_tp + + module subroutine rmvs_util_sort_pl(self, sortby, ascending) + implicit none + class(rmvs_pl), intent(inout) :: self !! RMVS 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 rmvs_util_sort_pl + + module subroutine rmvs_util_sort_tp(self, sortby, ascending) + implicit none + class(rmvs_tp), intent(inout) :: self !! RMVS test particle 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 rmvs_util_sort_tp + + module subroutine rmvs_util_sort_rearrange_pl(self, ind) + implicit none + class(rmvs_pl), intent(inout) :: self !! RMVS 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 rmvs_util_sort_rearrange_pl + + module subroutine rmvs_util_sort_rearrange_tp(self, ind) + implicit none + class(rmvs_tp), intent(inout) :: self !! RMVS test particle 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 rmvs_util_sort_rearrange_tp + module subroutine rmvs_util_spill_pl(self, discards, lspill_list) use swiftest_classes, only : swiftest_body implicit none - class(rmvs_pl), intent(inout) :: self !! RMVS massive body object + class(rmvs_pl), intent(inout) :: self !! RMVS massive body object class(swiftest_body), intent(inout) :: discards !! Discarded object logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards end subroutine rmvs_util_spill_pl diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 7eab9e5c7..01fb7bbf4 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -316,13 +316,13 @@ end subroutine symba_setup_pl module subroutine symba_setup_pltpenc(self,n) implicit none - class(symba_pltpenc), intent(inout) :: self !! Symba pl-tp encounter structure + class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter structure integer, intent(in) :: n !! Number of encounters to allocate space for end subroutine symba_setup_pltpenc module subroutine symba_setup_plplenc(self,n) implicit none - class(symba_plplenc), intent(inout) :: self !! Symba pl-tp encounter structure + class(symba_plplenc), intent(inout) :: self !! SyMBA pl-tp encounter structure integer, intent(in) :: n !! Number of encounters to allocate space for end subroutine symba_setup_plplenc diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 29d0b7b2a..745888a64 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -65,6 +65,136 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) return end subroutine rmvs_util_fill_tp + module subroutine rmvs_util_sort_pl(self, sortby, ascending) + !! author: David A. Minton + !! + !! Sort a RMVS massive body object in-place. + !! sortby is a string indicating which array component to sort. + implicit none + ! Arguments + class(rmvs_pl), intent(inout) :: self !! RMVS 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("nenc") + call util_sort(direction * pl%nenc(1:npl), ind(1:npl)) + case("tpenc1P") + call util_sort(direction * pl%tpenc1P(1:npl), ind(1:npl)) + case("plind") + call util_sort(direction * pl%plind(1:npl), ind(1:npl)) + case("outer", "inner", "planetocentric", "lplanetocentric") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default ! Look for components in the parent class + call whm_util_sort_pl(pl, sortby, ascending) + return + end select + + call pl%rearrange(ind) + + end associate + return + end subroutine rmvs_util_sort_pl + + module subroutine rmvs_util_sort_tp(self, sortby, ascending) + !! author: David A. Minton + !! + !! Sort a RMVS test particle object in-place. + !! sortby is a string indicating which array component to sort. + implicit none + ! Arguments + class(rmvs_tp), intent(inout) :: self !! RMVS test particle 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(tp => self, ntp => self%nbody) + select case(sortby) + case("plperP") + call util_sort(direction * tp%plperP(1:ntp), ind(1:ntp)) + case("plencP") + call util_sort(direction * tp%plencP(1:ntp), ind(1:ntp)) + case("lperi", "cb_heliocentric", "xheliocentric", "index", "ipleP", "lplanetocentric") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default ! Look for components in the parent class (*NOTE whm_tp does not need its own sort method, so we go straight to the swiftest_tp method) + call util_sort_tp(tp, sortby, ascending) + return + end select + + call tp%rearrange(ind) + + end associate + return + end subroutine rmvs_util_sort_tp + + module subroutine rmvs_util_sort_rearrange_pl(self, ind) + !! author: David A. Minton + !! + !! Rearrange RMVS 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(rmvs_pl), intent(inout) :: self !! RMVS 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(rmvs_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 rmvs_util_sort_rearrange_pl + + module subroutine rmvs_util_sort_rearrange_tp(self, ind) + !! author: David A. Minton + !! + !! Rearrange RMVS test particle object in-place from an index list. + !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. + implicit none + ! Arguments + class(rmvs_tp), intent(inout) :: self !! RMVS test particle 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(rmvs_tp), allocatable :: tp_sorted !! Temporary holder for sorted body + + associate(tp => self, ntp => self%nbody) + call util_sort_rearrange_tp(tp,ind) + allocate(tp_sorted, source=self) + tp%lperi(1:ntp) = tp_sorted%lperi(ind(1:ntp)) + tp%plperP(1:ntp) = tp_sorted%plperP(ind(1:ntp)) + tp%plencP(1:ntp) = tp_sorted%plencP(ind(1:ntp)) + tp%xheliocentric(:,1:ntp) = tp_sorted%xheliocentric(:,ind(1:ntp)) + deallocate(tp_sorted) + end associate + return + end subroutine rmvs_util_sort_rearrange_tp + module subroutine rmvs_util_spill_pl(self, discards, lspill_list) !! author: David A. Minton !! diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index 51aaf69ba..8ae223228 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -50,7 +50,7 @@ module subroutine symba_setup_pltpenc(self, n) !! implicit none ! Arguments - class(symba_pltpenc), intent(inout) :: self !! Symba pl-tp encounter structure + class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter structure integer, intent(in) :: n !! Number of encounters to allocate space for self%nenc = n @@ -80,7 +80,7 @@ module subroutine symba_setup_plplenc(self,n) ! implicit none ! Arguments - class(symba_plplenc), intent(inout) :: self !! Symba pl-tp encounter structure + class(symba_plplenc), intent(inout) :: self !! SyMBA pl-tp encounter structure integer, intent(in) :: n !! Number of encounters to allocate space for call symba_setup_pltpenc(self, n) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 397cd789e..71db85cc3 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -99,7 +99,9 @@ module subroutine symba_util_sort_pl(self, sortby, ascending) call util_sort(direction * pl%peri(1:npl), ind(1:npl)) case("atp") call util_sort(direction * pl%atp(1:npl), ind(1:npl)) - case default + case("lcollision", "lencounter", "lmtiny", "nplm", "nplplm", "kin", "info") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default ! Look for components in the parent class call util_sort_pl(pl, sortby, ascending) return end select @@ -138,7 +140,7 @@ module subroutine symba_util_sort_tp(self, sortby, ascending) call util_sort(direction * tp%levelg(1:ntp), ind(1:ntp)) case("levelm") call util_sort(direction * tp%levelm(1:ntp), ind(1:ntp)) - case default + case default ! Look for components in the parent class call util_sort_tp(tp, sortby, ascending) return end select @@ -156,7 +158,7 @@ module subroutine symba_util_sort_rearrange_pl(self, ind) !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! Symba massive body object + class(symba_pl), intent(inout) :: self !! SyMBA 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(symba_pl), allocatable :: pl_sorted !! Temporary holder for sorted body @@ -193,7 +195,7 @@ module subroutine symba_util_sort_rearrange_tp(self, ind) !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! Symba massive body object + class(symba_tp), intent(inout) :: self !! SyMBA test particle 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(symba_tp), allocatable :: tp_sorted !! Temporary holder for sorted body diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 index a3e2d37a4..c81ced32d 100644 --- a/src/util/util_sort.f90 +++ b/src/util/util_sort.f90 @@ -35,8 +35,10 @@ module subroutine util_sort_body(self, sortby, ascending) call util_sort(direction * body%capom(1:n), ind(1:n)) case("mu") call util_sort(direction * body%mu(1:n), ind(1:n)) + case("lfirst", "nbody","xh", "vh", "xb", "vb", "ah", "aobl", "atide", "agr") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default - write(*,*) 'Cannot sort structure by component ' // trim(adjustl(sortby)) + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not found!' return end select @@ -83,7 +85,9 @@ module subroutine util_sort_pl(self, sortby, ascending) call util_sort(direction * pl%Q(1:npl), ind(1:npl)) case("tlag") call util_sort(direction * pl%tlag(1:npl), ind(1:npl)) - case default + case("xbeg", "xend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default ! Look for components in the parent class call util_sort_body(pl, sortby, ascending) return end select @@ -121,7 +125,9 @@ module subroutine util_sort_tp(self, sortby, ascending) call util_sort(direction * tp%peri(1:ntp), ind(1:ntp)) case("atp") call util_sort(direction * tp%atp(1:ntp), ind(1:ntp)) - case default + case("isperi") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default ! Look for components in the parent class call util_sort_body(tp, sortby, ascending) return end select diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 9ebeb0b3f..7e1b02f50 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -140,6 +140,8 @@ module subroutine whm_util_sort_pl(self, sortby, ascending) 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("xj", "vj") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default call util_sort_pl(pl, sortby, ascending) return