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

Commit

Permalink
Browse files Browse the repository at this point in the history 
Added spill methods to SyMBA
  • Loading branch information
@daminton
daminton committed Jul 31, 2021
1 parent fc45a69 commit d48cc78
Show file tree
Hide file tree
Showing 3 changed files with 113 additions and 1 deletion.
18 changes: 18 additions & 0 deletions src/modules/symba_classes.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -95,6 +95,7 @@ module symba_classes
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
procedure :: spill => symba_util_copy_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic)
end type symba_pl

!********************************************************************************************************************************
Expand All @@ -113,6 +114,7 @@ module symba_classes
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
procedure :: spill => symba_util_copy_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic)
end type symba_tp

!********************************************************************************************************************************
Expand Down Expand Up @@ -450,6 +452,22 @@ module subroutine symba_util_resize_pltpenc(self, nrequested)
integer(I4B), intent(in) :: nrequested !! New size of list needed
end subroutine symba_util_resize_pltpenc

module subroutine symba_util_copy_spill_pl(self, discards, lspill_list)
use swiftest_classes, only : swiftest_body
implicit none
class(symba_pl), intent(inout) :: self !! SyMBA 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 symba_util_copy_spill_pl

module subroutine symba_util_copy_spill_tp(self, discards, lspill_list)
use swiftest_classes, only : swiftest_body
implicit none
class(symba_tp), intent(inout) :: self !! SyMBA test particle 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 symba_util_copy_spill_tp

module subroutine symba_util_sort_pl(self, sortby, ascending)
implicit none
class(symba_pl), intent(inout) :: self !! SyMBA massive body object
Expand Down
95 changes: 95 additions & 0 deletions src/symba/symba_util.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -140,6 +140,7 @@ module subroutine symba_util_copy_plplenc(self, source)
return
end subroutine symba_util_copy_plplenc


module subroutine symba_util_resize_pltpenc(self, nrequested)
!! author: David A. Minton
!!
Expand Down Expand Up @@ -332,4 +333,98 @@ module subroutine symba_util_sort_rearrange_tp(self, ind)
return
end subroutine symba_util_sort_rearrange_tp


module subroutine symba_util_copy_spill_pl(self, discards, lspill_list)
!! author: David A. Minton
!!
!! Move spilled (discarded) SyMBA massive body particle structure from active list to discard list
!! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90
implicit none
! Arguments
class(symba_pl), intent(inout) :: self !! SyMBA 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
! Internals
integer(I4B) :: i

! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps
!> Spill all the common components
associate(keeps => self)
select type(discards)
class is (symba_pl)
discards%lcollision(:) = pack(keeps%lcollision(:), lspill_list(:))
discards%lencounter(:) = pack(keeps%lencounter(:), lspill_list(:))
discards%lmtiny(:) = pack(keeps%lmtiny(:), lspill_list(:))
discards%nplenc(:) = pack(keeps%nplenc(:), lspill_list(:))
discards%ntpenc(:) = pack(keeps%ntpenc(:), lspill_list(:))
discards%levelg(:) = pack(keeps%levelg(:), lspill_list(:))
discards%levelm(:) = pack(keeps%levelm(:), lspill_list(:))
discards%isperi(:) = pack(keeps%isperi(:), lspill_list(:))
discards%peri(:) = pack(keeps%peri(:), lspill_list(:))
discards%atp(:) = pack(keeps%atp(:), lspill_list(:))
discards%info(:) = pack(keeps%info(:), lspill_list(:))
discards%kin(:) = pack(keeps%kin(:), lspill_list(:))

if (count(.not.lspill_list(:)) > 0) then
keeps%lcollision(:) = pack(keeps%lcollision(:), .not. lspill_list(:))
keeps%lencounter(:) = pack(keeps%lencounter(:), .not. lspill_list(:))
keeps%lmtiny(:) = pack(keeps%lmtiny(:), .not. lspill_list(:))
keeps%nplenc(:) = pack(keeps%nplenc(:), .not. lspill_list(:))
keeps%ntpenc(:) = pack(keeps%ntpenc(:), .not. lspill_list(:))
keeps%levelg(:) = pack(keeps%levelg(:), .not. lspill_list(:))
keeps%levelm(:) = pack(keeps%levelm(:), .not. lspill_list(:))
keeps%isperi(:) = pack(keeps%isperi(:), .not. lspill_list(:))
keeps%peri(:) = pack(keeps%peri(:), .not. lspill_list(:))
keeps%atp(:) = pack(keeps%atp(:), .not. lspill_list(:))
keeps%info(:) = pack(keeps%info(:), .not. lspill_list(:))
keeps%kin(:) = pack(keeps%kin(:), .not. lspill_list(:))
end if

call util_copy_spill_pl(keeps, discards, lspill_list)
class default
write(*,*) 'Error! spill method called for incompatible return type on symba_pl'
end select
end associate

return
end subroutine symba_util_copy_spill_pl


module subroutine symba_util_copy_spill_tp(self, discards, lspill_list)
!! author: David A. Minton
!!
!! Move spilled (discarded) SyMBA test particle structure from active list to discard list
!! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90
implicit none
! Arguments
class(symba_tp), intent(inout) :: self !! SyMBA test particle object
class(swiftest_body), intent(inout) :: discards !! Discarded object
logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards
! Internals
integer(I4B) :: i

! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps
!> Spill all the common components
associate(keeps => self)
select type(discards)
class is (symba_pl)
discards%nplenc(:) = pack(keeps%nplenc(:), lspill_list(:))
discards%levelg(:) = pack(keeps%levelg(:), lspill_list(:))
discards%levelm(:) = pack(keeps%levelm(:), lspill_list(:))

if (count(.not.lspill_list(:)) > 0) then
keeps%nplenc(:) = pack(keeps%nplenc(:), .not. lspill_list(:))
keeps%levelg(:) = pack(keeps%levelg(:), .not. lspill_list(:))
keeps%levelm(:) = pack(keeps%levelm(:), .not. lspill_list(:))
end if

call util_copy_spill_tp(keeps, discards, lspill_list)
class default
write(*,*) 'Error! spill method called for incompatible return type on symba_pl'
end select
end associate

return
end subroutine symba_util_copy_spill_tp

end submodule s_symba_util
1 change: 0 additions & 1 deletion src/util/util_copy.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -378,7 +378,6 @@ module subroutine util_copy_spill_body(self, discards, lspill_list)
allocate(discards%ldiscard(discards%nbody))
keeps%ldiscard = .false.
discards%ldiscard = .true.

end associate

return
Expand Down

0 comments on commit d48cc78

Please sign in to comment.