Skip to content
This repository was archived by the owner on Aug 28, 2024. It is now read-only.

Commit

Permalink
Improved memory management of rearrange subroutines with generic prog…
Browse files Browse the repository at this point in the history 
…ramming
  • Loading branch information
@daminton
daminton committed Aug 12, 2021
1 parent f818e66 commit a8c874a
Show file tree
Hide file tree
Showing 9 changed files with 622 additions and 288 deletions.
49 changes: 47 additions & 2 deletions src/modules/swiftest_classes.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -324,6 +324,7 @@ module swiftest_classes
real(DP), dimension(:), allocatable :: t !! Time of encounter
contains
procedure :: setup => setup_encounter !! A constructor that sets the number of encounters and allocates and initializes all arrays
procedure :: append => util_append_encounter !! Appends elements from one structure to another
procedure :: copy => util_copy_encounter !! Copies elements from the source encounter list into self.
procedure :: spill => util_spill_encounter !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic)
procedure :: resize => util_resize_encounter !! Checks the current size of the encounter list against the required size and extends it by a factor of 2 more than requested if it is too small.
Expand Down Expand Up @@ -883,11 +884,18 @@ end subroutine util_append_arr_logical
interface
module subroutine util_append_body(self, source, lsource_mask)
implicit none
class(swiftest_body), intent(inout) :: self !! Swiftest body object
class(swiftest_body), intent(in) :: source !! Source object to append
class(swiftest_body), intent(inout) :: self !! Swiftest body object
class(swiftest_body), intent(in) :: source !! Source object to append
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
end subroutine util_append_body

module subroutine util_append_encounter(self, source, lsource_mask)
implicit none
class(swiftest_encounter), intent(inout) :: self !! Swiftest encounter list object
class(swiftest_encounter), intent(in) :: source !! Source object to append
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
end subroutine util_append_encounter

module subroutine util_append_pl(self, source, lsource_mask)
implicit none
class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object
Expand Down Expand Up @@ -1198,6 +1206,43 @@ module subroutine util_sort_index_dp(arr,ind)
end subroutine util_sort_index_dp
end interface util_sort

interface util_sort_rearrange
module subroutine util_sort_rearrange_arr_char_string(arr, ind, n)
implicit none
character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array
integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against
integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange
end subroutine util_sort_rearrange_arr_char_string

module subroutine util_sort_rearrange_arr_DP(arr, ind, n)
implicit none
real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array
integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against
integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange
end subroutine util_sort_rearrange_arr_DP

module subroutine util_sort_rearrange_arr_DPvec(arr, ind, n)
implicit none
real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array
integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against
integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange
end subroutine util_sort_rearrange_arr_DPvec

module subroutine util_sort_rearrange_arr_I4B(arr, ind, n)
implicit none
integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array
integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against
integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange
end subroutine util_sort_rearrange_arr_I4B

module subroutine util_sort_rearrange_arr_logical(arr, ind, n)
implicit none
logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array
integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against
integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange
end subroutine util_sort_rearrange_arr_logical
end interface util_sort_rearrange

interface
module subroutine util_sort_rearrange_body(self, ind)
implicit none
Expand Down
46 changes: 45 additions & 1 deletion src/modules/symba_classes.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -137,10 +137,11 @@ module symba_classes
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 :: 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)
procedure :: append => symba_util_append_encounter !! Appends elements from one structure to another
end type symba_encounter

!********************************************************************************************************************************
Expand All @@ -149,6 +150,7 @@ module symba_classes
!> SyMBA class for tracking pl-tp close encounters in a step
type, extends(symba_encounter) :: symba_pltpenc
contains
procedure :: resolve_collision => symba_collision_resolve_pltpenc !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the c
end type symba_pltpenc

!********************************************************************************************************************************
Expand All @@ -160,6 +162,7 @@ module symba_classes
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 :: resolve_collision => symba_collision_resolve_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c
end type symba_plplenc

!********************************************************************************************************************************
Expand Down Expand Up @@ -221,6 +224,22 @@ module subroutine symba_collision_resolve_mergers(self, system, param)
class(symba_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions
end subroutine symba_collision_resolve_mergers

module subroutine symba_collision_resolve_plplenc(self, system, param, t)
implicit none
class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
real(DP), intent(in) :: t !! Current simulation time
end subroutine symba_collision_resolve_plplenc

module subroutine symba_collision_resolve_pltpenc(self, system, param, t)
implicit none
class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
real(DP), intent(in) :: t !! Current simulation time
end subroutine symba_collision_resolve_pltpenc

module subroutine symba_discard_pl(self, system, param)
use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters
implicit none
Expand Down Expand Up @@ -502,6 +521,13 @@ end subroutine symba_util_append_arr_kin
end interface

interface
module subroutine symba_util_append_encounter(self, source, lsource_mask)
implicit none
class(symba_encounter), intent(inout) :: self !! SyMBA encounter list object
class(swiftest_encounter), intent(in) :: source !! Source object to append
logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to
end subroutine symba_util_append_encounter

module subroutine symba_util_append_merger(self, source, lsource_mask)
use swiftest_classes, only : swiftest_body
implicit none
Expand Down Expand Up @@ -622,7 +648,25 @@ module subroutine symba_util_sort_tp(self, sortby, ascending)
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 symba_util_sort_tp
end interface

interface util_sort_rearrange
module subroutine symba_util_sort_rearrange_arr_info(arr, ind, n)
implicit none
type(symba_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array
integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against
integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange
end subroutine symba_util_sort_rearrange_arr_info

module subroutine symba_util_sort_rearrange_arr_kin(arr, ind, n)
implicit none
type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array
integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against
integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange
end subroutine symba_util_sort_rearrange_arr_kin
end interface util_sort_rearrange

interface
module subroutine symba_util_sort_rearrange_pl(self, ind)
implicit none
class(symba_pl), intent(inout) :: self !! SyMBA massive body object
Expand Down
101 changes: 95 additions & 6 deletions src/symba/symba_collision.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -333,7 +333,7 @@ module function symba_collision_casesupercatastrophic(system, param, family, x,
allocate(Ip_frag(NDIM, nfrag))

mtot = sum(mass(:))
xcom(:) = (mass(1) * x(:,1) + mass(2) * x(:,2)) / mtot
xcom(:) = (mass(1) * x(:,1) + mass(2) * x(:,2)) / mtot
vcom(:) = (mass(1) * v(:,1) + mass(2) * v(:,2)) / mtot

! Get mass weighted mean of Ip and average density
Expand Down Expand Up @@ -393,7 +393,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec
!! Adapted from Hal Levison's Swift routine symba5_merge.f
implicit none
! Arguments
class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object
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
Expand Down Expand Up @@ -451,7 +451,6 @@ module function symba_collision_check_encounter(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
Expand Down Expand Up @@ -485,6 +484,14 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec

lany_collision = any(lcollision(:))

! Extract the pl-pl encounter list and return the plplcollision_list
if (lany_collision) then
select type(plplenc_list => self)
class is (symba_plplenc)
call plplenc_list%extract_collisions(system, param)
end select
end if

return
end function symba_collision_check_encounter

Expand Down Expand Up @@ -604,7 +611,7 @@ function symba_collision_consolidate_familes(pl, param, idx_parent, family, x, v

! Find the barycenter of each body along with its children, if it has any
do j = 1, 2
x(:, j) = pl%xb(:, idx_parent(j))
x(:, j) = pl%xh(:, idx_parent(j))
v(:, j) = pl%vb(:, idx_parent(j))
! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip)
if (param%lrotation) then
Expand All @@ -617,7 +624,7 @@ function symba_collision_consolidate_familes(pl, param, idx_parent, family, x, v
idx_child = parent_child_index_array(j)%idx(i + 1)
if (.not. pl%lcollision(idx_child)) cycle
mchild = pl%mass(idx_child)
xchild(:) = pl%xb(:, idx_child)
xchild(:) = pl%xh(:, idx_child)
vchild(:) = pl%vb(:, idx_child)
volchild = (4.0_DP / 3.0_DP) * PI * pl%radius(idx_child)**3
volume(j) = volume(j) + volchild
Expand Down Expand Up @@ -947,6 +954,10 @@ module subroutine symba_collision_resolve_fragmentations(self, system, param)
if (.not. lgoodcollision) cycle
if (any(pl%status(idx_parent(:)) /= COLLISION)) cycle ! One of these two bodies has already been resolved

! Convert from DH to barycentric
x(:,1) = x(:,1) + cb%xb(:)
x(:,2) = x(:,2) + cb%xb(:)

! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them
! to symba_regime
if (mass(1) > mass(2)) then
Expand Down Expand Up @@ -1020,7 +1031,7 @@ module subroutine symba_collision_resolve_mergers(self, system, param)
logical :: lgoodcollision
integer(I4B) :: i, status

associate(plpl_collisions => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2)
associate(plpl_collisions => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, cb => system%cb)
select type(pl => system%pl)
class is (symba_pl)
do i = 1, ncollisions
Expand All @@ -1029,6 +1040,11 @@ module subroutine symba_collision_resolve_mergers(self, system, param)
lgoodcollision = symba_collision_consolidate_familes(pl, param, idx_parent, family, x, v, mass, radius, L_spin, Ip)
if (.not. lgoodcollision) cycle
if (any(pl%status(idx_parent(:)) /= COLLISION)) cycle ! One of these two bodies has already been resolved

! Convert from DH to barycentric
x(:,1) = x(:,1) + cb%xb(:)
x(:,2) = x(:,2) + cb%xb(:)

status = symba_collision_casemerge(system, param, family, x, v, mass, radius, L_spin, Ip)
end do
end select
Expand All @@ -1037,4 +1053,77 @@ module subroutine symba_collision_resolve_mergers(self, system, param)
return
end subroutine symba_collision_resolve_mergers


module subroutine symba_collision_resolve_plplenc(self, system, param, t)
!! author: David A. Minton
!!
!! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision
!!
implicit none
! Arguments
class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
real(DP), intent(in) :: t !! Current simulation time
! Internals
real(DP) :: Eorbit_before, Eorbit_after

associate(plplenc_list => self, plplcollision_list => system%plplcollision_list)
select type(pl => system%pl)
class is (symba_pl)
select type(param)
class is (symba_parameters)
if (plplcollision_list%nenc == 0) return ! No collisions to resolve

write(*, *) "Collision between massive bodies detected at time t = ", t
if (param%lfragmentation) then
call plplcollision_list%resolve_fragmentations(system, param)
else
call plplcollision_list%resolve_mergers(system, param)
end if

! Destroy the collision list now that the collisions are resolved
call plplcollision_list%setup(0)

! Get the energy before the collision is resolved
if (param%lenergy) then
call system%get_energy_and_momentum(param)
Eorbit_before = system%te
end if

call pl%rearray(system, param)

if (param%lenergy) then
call system%get_energy_and_momentum(param)
Eorbit_after = system%te
system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before)
end if

end select
end select
end associate

return
end subroutine symba_collision_resolve_plplenc


module subroutine symba_collision_resolve_pltpenc(self, system, param, t)
!! author: David A. Minton
!!
!! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision
!!
implicit none
! Arguments
class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-pl encounter list
class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object
class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions
real(DP), intent(in) :: t !! Current simulation tim

call system%tp%discard(system, param)

return
end subroutine symba_collision_resolve_pltpenc



end submodule s_symba_collision
Loading

0 comments on commit a8c874a

Please sign in to comment.