From fc45a69416e851f2e1065f53c49992bb5f8778e1 Mon Sep 17 00:00:00 2001 From: David Minton Date: Sat, 31 Jul 2021 16:26:52 -0400 Subject: [PATCH] Added fill method to SyMBA --- src/modules/rmvs_classes.f90 | 4 +- src/modules/swiftest_classes.f90 | 6 +-- src/modules/symba_classes.f90 | 18 +++++++ src/modules/whm_classes.f90 | 2 +- src/symba/symba_util.f90 | 93 ++++++++++++++++++++++++++++++++ src/util/util_copy.f90 | 1 - 6 files changed, 117 insertions(+), 7 deletions(-) diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs_classes.f90 index 945b96ce2..64a0a5875 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs_classes.f90 @@ -71,7 +71,7 @@ module rmvs_classes 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_copy_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) + procedure :: fill => rmvs_util_copy_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK 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_copy_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) @@ -94,7 +94,7 @@ module rmvs_classes 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_copy_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) + procedure :: fill => rmvs_util_copy_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: spill => rmvs_util_copy_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) end type rmvs_pl diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 5ec4fc7dc..3711e5295 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -166,7 +166,7 @@ module swiftest_classes procedure :: accel_user => user_kick_getacch_body !! Add user-supplied heliocentric accelerations to planets procedure :: append => util_append_body !! Appends elements from one structure to another procedure :: copy_into => util_copy_into_body !! Copies elements from one Swiftest body object to another. - procedure :: fill => util_copy_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) + procedure :: fill => util_copy_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: resize => util_resize_body !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: set_ir3 => util_set_ir3h !! Sets the inverse heliocentric radius term (1/rh**3) procedure :: sort => util_sort_body !! Sorts body arrays by a sortable componen @@ -208,7 +208,7 @@ module swiftest_classes procedure :: accel_tides => tides_kick_getacch_pl !! Compute the accelerations of bodies due to tidal interactions with the central body procedure :: h2b => util_coord_h2b_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) procedure :: b2h => util_coord_b2h_pl !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) - procedure :: fill => util_copy_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) + procedure :: fill => util_copy_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: set_beg_end => util_set_beg_end_pl !! Sets the beginning and ending positions and velocities of planets. procedure :: set_mu => util_set_mu_pl !! Method used to construct the vectorized form of the central body mass procedure :: set_rhill => util_set_rhill !! Calculates the Hill's radii for each body @@ -237,7 +237,7 @@ module swiftest_classes procedure :: setup => setup_tp !! A base constructor that sets the number of bodies and procedure :: h2b => util_coord_h2b_tp !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) procedure :: b2h => util_coord_b2h_tp !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) - procedure :: fill => util_copy_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) + procedure :: fill => util_copy_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: get_peri => util_peri_tp !! Determine system pericenter passages for test particles procedure :: set_mu => util_set_mu_tp !! Method used to construct the vectorized form of the central body mass procedure :: sort => util_sort_tp !! Sorts body arrays by a sortable component diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 2b131ef76..6a878520a 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -92,6 +92,7 @@ module symba_classes procedure :: encounter_check => symba_encounter_check_pl !! Checks if massive bodies are going through close encounters with each other procedure :: accel => symba_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies procedure :: setup => symba_setup_pl !! Constructor method - Allocates space for number of particle + procedure :: fill => symba_util_copy_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: sort => symba_util_sort_pl !! Sorts body arrays by a sortable componen procedure :: rearrange => symba_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods end type symba_pl @@ -109,6 +110,7 @@ module symba_classes procedure :: encounter_check => symba_encounter_check_tp !! Checks if any test particles are undergoing a close encounter with a massive body procedure :: accel => symba_kick_getacch_tp !! Compute heliocentric accelerations of test particles procedure :: setup => symba_setup_tp !! Constructor method - Allocates space for number of particle + procedure :: fill => symba_util_copy_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: sort => symba_util_sort_tp !! Sorts body arrays by a sortable componen procedure :: rearrange => symba_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods end type symba_tp @@ -414,6 +416,22 @@ module subroutine symba_step_reset_system(self) class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object end subroutine symba_step_reset_system + module subroutine symba_util_copy_fill_pl(self, inserts, lfill_list) + use swiftest_classes, only : swiftest_body + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + class(swiftest_body), intent(in) :: inserts !! Inserted object + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine symba_util_copy_fill_pl + + module subroutine symba_util_copy_fill_tp(self, inserts, lfill_list) + use swiftest_classes, only : swiftest_body + implicit none + class(symba_tp), intent(inout) :: self !! SyMBA test particle object + class(swiftest_body), intent(in) :: inserts !! Inserted object + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine symba_util_copy_fill_tp + module subroutine symba_util_copy_pltpenc(self, source) implicit none class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list diff --git a/src/modules/whm_classes.f90 b/src/modules/whm_classes.f90 index d64354c08..4dd7f646a 100644 --- a/src/modules/whm_classes.f90 +++ b/src/modules/whm_classes.f90 @@ -34,7 +34,7 @@ module whm_classes 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_copy_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic) + procedure :: fill => whm_util_copy_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK 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 diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 7a6f17cbf..b8dbbd49a 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -2,6 +2,99 @@ use swiftest contains + module subroutine symba_util_copy_fill_pl(self, inserts, lfill_list) + !! author: David A. Minton + !! + !! Insert new SyMBA test particle structure into an old one. + !! This is the inverse of a fill operation. + !! + implicit none + ! Arguments + class(symba_pl), intent(inout) :: self !! SyMBA masive body object + class(swiftest_body), intent(in) :: inserts !! Inserted object + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + + associate(keeps => self) + select type(inserts) + class is (symba_pl) + keeps%lcollision(:) = unpack(keeps%lcollision(:), .not.lfill_list(:), keeps%lcollision(:)) + keeps%lcollision(:) = unpack(inserts%lcollision(:), lfill_list(:), keeps%lcollision(:)) + + keeps%lencounter(:) = unpack(keeps%lencounter(:), .not.lfill_list(:), keeps%lencounter(:)) + keeps%lencounter(:) = unpack(inserts%lencounter(:), lfill_list(:), keeps%lencounter(:)) + + keeps%lmtiny(:) = unpack(keeps%lmtiny(:), .not.lfill_list(:), keeps%lmtiny(:)) + keeps%lmtiny(:) = unpack(inserts%lmtiny(:), lfill_list(:), keeps%lmtiny(:)) + + keeps%nplenc(:) = unpack(keeps%nplenc(:), .not.lfill_list(:), keeps%nplenc(:)) + keeps%nplenc(:) = unpack(inserts%nplenc(:), lfill_list(:), keeps%nplenc(:)) + + keeps%nplenc(:) = unpack(keeps%nplenc(:), .not.lfill_list(:), keeps%nplenc(:)) + keeps%ntpenc(:) = unpack(inserts%ntpenc(:), lfill_list(:), keeps%ntpenc(:)) + + keeps%levelg(:) = unpack(keeps%levelg(:), .not.lfill_list(:), keeps%levelg(:)) + keeps%levelg(:) = unpack(inserts%levelg(:), lfill_list(:), keeps%levelg(:)) + + keeps%levelm(:) = unpack(keeps%levelm(:), .not.lfill_list(:), keeps%levelm(:)) + keeps%levelm(:) = unpack(inserts%levelm(:), lfill_list(:), keeps%levelm(:)) + + keeps%isperi(:) = unpack(keeps%isperi(:), .not.lfill_list(:), keeps%isperi(:)) + keeps%isperi(:) = unpack(inserts%isperi(:), lfill_list(:), keeps%isperi(:)) + + keeps%peri(:) = unpack(keeps%peri(:), .not.lfill_list(:), keeps%peri(:)) + keeps%peri(:) = unpack(inserts%peri(:), lfill_list(:), keeps%peri(:)) + + keeps%atp(:) = unpack(keeps%atp(:), .not.lfill_list(:), keeps%atp(:)) + keeps%atp(:) = unpack(inserts%atp(:), lfill_list(:), keeps%atp(:)) + + keeps%kin(:) = unpack(keeps%kin(:), .not.lfill_list(:), keeps%kin(:)) + keeps%kin(:) = unpack(inserts%kin(:), lfill_list(:), keeps%kin(:)) + + keeps%info(:) = unpack(keeps%info(:), .not.lfill_list(:), keeps%info(:)) + keeps%info(:) = unpack(inserts%info(:), lfill_list(:), keeps%info(:)) + + call util_copy_fill_pl(keeps, inserts, lfill_list) + class default + write(*,*) 'Error! fill method called for incompatible return type on symba_pl' + end select + end associate + + return + end subroutine symba_util_copy_fill_pl + + module subroutine symba_util_copy_fill_tp(self, inserts, lfill_list) + !! author: David A. Minton + !! + !! Insert new SyMBA test particle structure into an old one. + !! This is the inverse of a fill operation. + !! + implicit none + ! Arguments + class(symba_tp), intent(inout) :: self !! SyMBA test particle object + class(swiftest_body), intent(in) :: inserts !! Inserted object + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + + associate(keeps => self) + select type(inserts) + class is (symba_tp) + keeps%nplenc(:) = unpack(keeps%nplenc(:), .not.lfill_list(:), keeps%nplenc(:)) + keeps%nplenc(:) = unpack(inserts%nplenc(:), lfill_list(:), keeps%nplenc(:)) + + keeps%levelg(:) = unpack(keeps%levelg(:), .not.lfill_list(:), keeps%levelg(:)) + keeps%levelg(:) = unpack(inserts%levelg(:), lfill_list(:), keeps%levelg(:)) + + keeps%levelm(:) = unpack(keeps%levelm(:), .not.lfill_list(:), keeps%levelm(:)) + keeps%levelm(:) = unpack(inserts%levelm(:), lfill_list(:), keeps%levelm(:)) + + call util_copy_fill_tp(keeps, inserts, lfill_list) + class default + write(*,*) 'Error! fill method called for incompatible return type on symba_tp' + end select + end associate + + return + end subroutine symba_util_copy_fill_tp + module subroutine symba_util_copy_pltpenc(self, source) !! author: David A. Minton !! diff --git a/src/util/util_copy.f90 b/src/util/util_copy.f90 index ad3c111c4..3a4b1e9f6 100644 --- a/src/util/util_copy.f90 +++ b/src/util/util_copy.f90 @@ -311,7 +311,6 @@ module subroutine util_copy_spill_body(self, discards, lspill_list) if (allocated(keeps%omega)) discards%omega(:) = pack(keeps%omega(:), lspill_list(:)) if (allocated(keeps%capm)) discards%capm(:) = pack(keeps%capm(:), lspill_list(:)) - if (allocated(keeps%aobl)) then do i = 1, NDIM discards%aobl(i, :) = pack(keeps%aobl(i, :), lspill_list(:))