From 3861157bbf959e58c6c134a4f921c818f8225efd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 12 Aug 2021 12:02:25 -0400 Subject: [PATCH] Restructured the collision check to return a logical flag. Refactored the SyMBA encounter list classes so that pltp and plpl are each descended from a common symba_encounter class, to clarify the polymorphic subroutines --- src/modules/symba_classes.f90 | 71 ++++++++++++++++------------- src/symba/symba_collision.f90 | 23 ++++++---- src/symba/symba_encounter_check.f90 | 6 +-- src/symba/symba_kick.f90 | 12 ++--- src/symba/symba_setup.f90 | 6 +-- src/symba/symba_step.f90 | 6 +-- src/symba/symba_util.f90 | 10 ++-- 7 files changed, 75 insertions(+), 59 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 6a69adcc7..1e0b1b3b0 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -129,29 +129,37 @@ module symba_classes procedure :: spill => symba_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) end type symba_tp + !******************************************************************************************************************************** + ! symba_encounter class definitions and method interfaces + !******************************************************************************************************************************* + !> SyMBA class for tracking close encounters in a step + type, extends(swiftest_encounter) :: symba_encounter + integer(I4B), dimension(:), allocatable :: level !! encounter recursion level + contains + procedure :: collision_check => symba_collision_check_encounter !! Checks if a test particle is going to collide with a massive body + procedure :: encounter_check => symba_encounter_check !! Checks if massive bodies are going through close encounters with each other + procedure :: kick => symba_kick_encounter !! Kick barycentric velocities of active test particles within SyMBA recursion + procedure :: setup => symba_setup_encounter !! A constructor that sets the number of encounters and allocates and initializes all arrays + procedure :: spill => symba_util_spill_encounter !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + end type symba_encounter + !******************************************************************************************************************************** ! symba_pltpenc class definitions and method interfaces !******************************************************************************************************************************* !> SyMBA class for tracking pl-tp close encounters in a step - type, extends(swiftest_encounter) :: symba_pltpenc - integer(I4B), dimension(:), allocatable :: level !! encounter recursion level + type, extends(symba_encounter) :: symba_pltpenc contains - procedure :: collision_check => symba_collision_check_pltpenc !! Checks if a test particle is going to collide with a massive body - procedure :: encounter_check => symba_encounter_check_pltpenc !! Checks if massive bodies are going through close encounters with each other - procedure :: kick => symba_kick_pltpenc !! Kick barycentric velocities of active test particles within SyMBA recursion - procedure :: setup => symba_setup_pltpenc !! A constructor that sets the number of encounters and allocates and initializes all arrays - procedure :: spill => symba_util_spill_pltpenc !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) end type symba_pltpenc !******************************************************************************************************************************** ! symba_plplenc class definitions and method interfaces !******************************************************************************************************************************* !> SyMBA class for tracking pl-pl close encounters in a step - type, extends(symba_pltpenc) :: symba_plplenc + type, extends(symba_encounter) :: symba_plplenc contains - procedure :: extract_collisions => symba_collision_encounter_extract_collisions !! Processes the pl-pl encounter list remove only those encounters that led to a collision - procedure :: resolve_fragmentations => symba_collision_resolve_fragmentations !! Process list of collisions, determine the collisional regime, and then create fragments - procedure :: resolve_mergers => symba_collision_resolve_mergers !! Process list of collisions and merge colliding bodies together + procedure :: extract_collisions => symba_collision_encounter_extract_collisions !! Processes the pl-pl encounter list remove only those encounters that led to a collision + procedure :: resolve_fragmentations => symba_collision_resolve_fragmentations !! Process list of collisions, determine the collisional regime, and then create fragments + procedure :: resolve_mergers => symba_collision_resolve_mergers !! Process list of collisions and merge colliding bodies together end type symba_plplenc !******************************************************************************************************************************** @@ -174,16 +182,17 @@ module symba_classes end type symba_nbody_system interface - module subroutine symba_collision_check_pltpenc(self, system, param, t, dt, irec) + module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) use swiftest_classes, only : swiftest_parameters implicit none - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - end subroutine symba_collision_check_pltpenc + class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_collision !! Returns true if cany pair of encounters resulted in a collision n + end function symba_collision_check_encounter module subroutine symba_collision_encounter_extract_collisions(self, system, param) implicit none @@ -255,14 +264,14 @@ module function symba_encounter_check_pl(self, system, dt, irec) result(lany_enc logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_pl - module function symba_encounter_check_pltpenc(self, system, dt, irec) result(lany_encounter) + module function symba_encounter_check(self, system, dt, irec) result(lany_encounter) implicit none - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-pl encounter list object + class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter - end function symba_encounter_check_pltpenc + end function symba_encounter_check module function symba_encounter_check_tp(self, system, dt, irec) result(lany_encounter) implicit none @@ -383,14 +392,14 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine symba_kick_getacch_tp - module subroutine symba_kick_pltpenc(self, system, dt, irec, sgn) + module subroutine symba_kick_encounter(self, system, dt, irec, sgn) implicit none - class(symba_pltpenc), intent(in) :: self !! SyMBA pl-tp encounter list object + class(symba_encounter), intent(in) :: self !! SyMBA pl-tp encounter list object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration - end subroutine symba_kick_pltpenc + end subroutine symba_kick_encounter module subroutine symba_setup_initialize_particle_info(system, param) implicit none @@ -421,11 +430,11 @@ module subroutine symba_setup_pl(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine symba_setup_pl - module subroutine symba_setup_pltpenc(self,n) + module subroutine symba_setup_encounter(self,n) implicit none - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter structure + class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter structure integer(I4B), intent(in) :: n !! Number of encounters to allocate space for - end subroutine symba_setup_pltpenc + end subroutine symba_setup_encounter module subroutine symba_setup_tp(self, n, param) use swiftest_classes, only : swiftest_parameters @@ -655,14 +664,14 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine symba_util_spill_pl - module subroutine symba_util_spill_pltpenc(self, discards, lspill_list, ldestructive) + module subroutine symba_util_spill_encounter(self, discards, lspill_list, ldestructive) use swiftest_classes, only : swiftest_encounter implicit none - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list + class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list class(swiftest_encounter), intent(inout) :: discards !! Discarded object logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list - end subroutine symba_util_spill_pltpenc + end subroutine symba_util_spill_encounter module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) use swiftest_classes, only : swiftest_body diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index b0e588300..0cb903fcf 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -2,7 +2,7 @@ use swiftest contains - module subroutine symba_collision_check_pltpenc(self, system, param, t, dt, irec) + module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) !! author: David A. Minton !! !! Check for merger between massive bodies and test particles in SyMBA @@ -12,12 +12,14 @@ module subroutine symba_collision_check_pltpenc(self, system, param, t, dt, irec !! Adapted from Hal Levison's Swift routine symba5_merge.f implicit none ! Arguments - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level + class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + ! Result + logical :: lany_collision !! Returns true if cany pair of encounters resulted in a collision ! Internals logical, dimension(:), allocatable :: lcollision, lmask real(DP), dimension(NDIM) :: xr, vr @@ -25,7 +27,9 @@ module subroutine symba_collision_check_pltpenc(self, system, param, t, dt, irec real(DP) :: rlim, Gmtot logical :: isplpl + lany_collision = .false. if (self%nenc == 0) return + select type(self) class is (symba_plplenc) isplpl = .true. @@ -66,6 +70,7 @@ module subroutine symba_collision_check_pltpenc(self, system, param, t, dt, irec end do end if + do k = 1, nenc if (lcollision(k)) self%status(k) = COLLISION self%t(k) = t @@ -97,8 +102,10 @@ module subroutine symba_collision_check_pltpenc(self, system, param, t, dt, irec end select end select + lany_collision = any(lcollision(:)) + return - end subroutine symba_collision_check_pltpenc + end function symba_collision_check_encounter pure elemental function symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr) result(lcollision) diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 808ee2347..326f5d257 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -56,7 +56,7 @@ module function symba_encounter_check_pl(self, system, dt, irec) result(lany_enc end function symba_encounter_check_pl - module function symba_encounter_check_pltpenc(self, system, dt, irec) result(lany_encounter) + module function symba_encounter_check(self, system, dt, irec) result(lany_encounter) !! author: David A. Minton !! !! Check for an encounter between test particles and massive bodies in the pltpenc list. @@ -65,7 +65,7 @@ module function symba_encounter_check_pltpenc(self, system, dt, irec) result(lan !! Adapted from portions of David E. Kaufmann's Swifter routine: symba_step_recur.f90 implicit none ! Arguments - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-pl encounter list object + class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level @@ -132,7 +132,7 @@ module function symba_encounter_check_pltpenc(self, system, dt, irec) result(lan end select return - end function symba_encounter_check_pltpenc + end function symba_encounter_check module function symba_encounter_check_tp(self, system, dt, irec) result(lany_encounter) diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 7a98c2f69..c1de5a077 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -90,7 +90,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) end subroutine symba_kick_getacch_tp - module subroutine symba_kick_pltpenc(self, system, dt, irec, sgn) + module subroutine symba_kick_encounter(self, system, dt, irec, sgn) !! author: David A. Minton !! !! Kick barycentric velocities of massive bodies and ACTIVE test particles within SyMBA recursion. @@ -100,11 +100,11 @@ module subroutine symba_kick_pltpenc(self, system, dt, irec, sgn) !! Adapted from Hal Levison's Swift routine symba5_kick.f implicit none ! Arguments - class(symba_pltpenc), intent(in) :: self !! SyMBA pl-tp encounter list object + class(symba_encounter), intent(in) :: self !! SyMBA pl-tp encounter list object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration ! Internals integer(I4B) :: k, irm1, irecl real(DP) :: r, rr, ri, ris, rim1, r2, ir3, fac, faci, facj @@ -198,6 +198,6 @@ module subroutine symba_kick_pltpenc(self, system, dt, irec, sgn) end select return - end subroutine symba_kick_pltpenc + end subroutine symba_kick_encounter end submodule s_symba_kick \ No newline at end of file diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index 3fe7c21c5..d3f44f8a1 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -183,14 +183,14 @@ module subroutine symba_setup_pl(self, n, param) end subroutine symba_setup_pl - module subroutine symba_setup_pltpenc(self, n) + module subroutine symba_setup_encounter(self, n) !! author: David A. Minton !! !! A constructor that sets the number of encounters and allocates and initializes all arrays !! implicit none ! Arguments - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter structure + class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter structure integer(I4B), intent(in) :: n !! Number of encounters to allocate space for call setup_encounter(self, n) @@ -202,7 +202,7 @@ module subroutine symba_setup_pltpenc(self, n) self%level(:) = -1 return - end subroutine symba_setup_pltpenc + end subroutine symba_setup_encounter module subroutine symba_setup_tp(self, n, param) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 847d6e4ee..3bc542c1d 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -163,7 +163,7 @@ module recursive subroutine symba_step_recur_system(self, param, t, ireci) integer(I4B) :: i, j, irecp, nloops real(DP) :: dtl, dth real(DP), dimension(NDIM) :: xr, vr - logical :: lencounter + logical :: lencounter, lplpl_collision, lpltp_collision associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list) select type(pl => self%pl) @@ -209,8 +209,8 @@ module recursive subroutine symba_step_recur_system(self, param, t, ireci) end if if (param%lclose) then - call plplenc_list%collision_check(system, param, t+dtl, dtl, ireci) - call pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci) + lplpl_collision = plplenc_list%collision_check(system, param, t+dtl, dtl, ireci) + lpltp_collision = pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci) end if call self%set_recur_levels(ireci) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index d55e7a0c7..05ee19f5e 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -826,14 +826,14 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_pl - module subroutine symba_util_spill_pltpenc(self, discards, lspill_list, ldestructive) + module subroutine symba_util_spill_encounter(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! !! Move spilled (discarded) SyMBA encounter structure from active list to discard list !! Note: Because the symba_plplenc currently does not contain any additional variable components, this method can recieve it as an input as well. implicit none ! Arguments - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list + class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list class(swiftest_encounter), intent(inout) :: discards !! Discarded object logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list @@ -842,17 +842,17 @@ module subroutine symba_util_spill_pltpenc(self, discards, lspill_list, ldestruc associate(keeps => self, nenc => self%nenc) select type(discards) - class is (symba_pltpenc) + class is (symba_encounter) call util_spill(keeps%level, discards%level, lspill_list, ldestructive) call util_spill_encounter(keeps, discards, lspill_list, ldestructive) class default - write(*,*) "Invalid object passed to the spill method. Source must be of class symba_pltpenc or its descendents!" + write(*,*) "Invalid object passed to the spill method. Source must be of class symba_encounter or its descendents!" call util_exit(FAILURE) end select end associate return - end subroutine symba_util_spill_pltpenc + end subroutine symba_util_spill_encounter module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive)