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 info and kinship types to the fill and spill interfaces
  • Loading branch information
@daminton
daminton committed Aug 2, 2021
1 parent 0d2b22d commit be00555
Show file tree
Hide file tree
Showing 2 changed files with 214 additions and 91 deletions.
97 changes: 67 additions & 30 deletions src/modules/symba_classes.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -418,6 +418,36 @@ 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_pltpenc(self, source)
implicit none
class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list
class(symba_pltpenc), intent(in) :: source !! Source object to copy into
end subroutine symba_util_copy_pltpenc

module subroutine symba_util_copy_plplenc(self, source)
implicit none
class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list
class(symba_pltpenc), intent(in) :: source !! Source object to copy into
end subroutine symba_util_copy_plplenc
end interface

interface util_fill
module subroutine symba_util_fill_arr_char_info(keeps, inserts, lfill_list)
implicit none
type(symba_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
type(symba_particle_info), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps
end subroutine symba_util_fill_arr_char_info

module subroutine symba_util_fill_arr_char_kin(keeps, inserts, lfill_list)
implicit none
type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
type(symba_kinship), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps
end subroutine symba_util_fill_arr_char_kin
end interface

interface
module subroutine symba_util_fill_pl(self, inserts, lfill_list)
use swiftest_classes, only : swiftest_body
implicit none
Expand All @@ -434,42 +464,12 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list)
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps
end subroutine symba_util_fill_tp

module subroutine symba_util_copy_pltpenc(self, source)
implicit none
class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list
class(symba_pltpenc), intent(in) :: source !! Source object to copy into
end subroutine symba_util_copy_pltpenc

module subroutine symba_util_copy_plplenc(self, source)
implicit none
class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list
class(symba_pltpenc), intent(in) :: source !! Source object to copy into
end subroutine symba_util_copy_plplenc

module subroutine symba_util_resize_pltpenc(self, nrequested)
implicit none
class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list
integer(I4B), intent(in) :: nrequested !! New size of list needed
end subroutine symba_util_resize_pltpenc

module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive)
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
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_tp(self, discards, lspill_list, ldestructive)
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
logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not
end subroutine symba_util_spill_tp

module subroutine symba_util_sort_pl(self, sortby, ascending)
implicit none
class(symba_pl), intent(inout) :: self !! SyMBA massive body object
Expand All @@ -495,7 +495,44 @@ module subroutine symba_util_sort_rearrange_tp(self, ind)
class(symba_tp), 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)
end subroutine symba_util_sort_rearrange_tp
end interface

interface util_spill
module subroutine symba_util_spill_arr_info(keeps, discards, lspill_list, ldestructive)
implicit none
type(symba_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
type(symba_particle_info), dimension(:), allocatable, intent(inout) :: discards !! Array of discards
logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss
logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not
end subroutine symba_util_spill_arr_info

module subroutine symba_util_spill_arr_kin(keeps, discards, lspill_list, ldestructive)
implicit none
type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
type(symba_kinship), dimension(:), allocatable, intent(inout) :: discards !! Array of discards
logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss
logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not
end subroutine symba_util_spill_arr_kin
end interface

interface
module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive)
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
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_tp(self, discards, lspill_list, ldestructive)
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
logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not
end subroutine symba_util_spill_tp
end interface

end module symba_classes
208 changes: 147 additions & 61 deletions src/symba/symba_util.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,92 @@
use swiftest
contains

module subroutine symba_util_copy_pltpenc(self, source)
!! author: David A. Minton
!!
!! Copies elements from the source encounter list into self.
implicit none
! Arguments
class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list
class(symba_pltpenc), intent(in) :: source !! Source object to copy into

associate(n => source%nenc)
self%nenc = n
self%lvdotr(1:n) = source%lvdotr(1:n)
self%status(1:n) = source%status(1:n)
self%level(1:n) = source%level(1:n)
self%index1(1:n) = source%index1(1:n)
self%index2(1:n) = source%index2(1:n)
end associate

return
end subroutine symba_util_copy_pltpenc


module subroutine symba_util_copy_plplenc(self, source)
!! author: David A. Minton
!!
!! Copies elements from the source encounter list into self.
implicit none
! Arguments
class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list
class(symba_pltpenc), intent(in) :: source !! Source object to copy into

call symba_util_copy_pltpenc(self, source)
associate(n => source%nenc)
select type(source)
class is (symba_plplenc)
self%xh1(:,1:n) = source%xh1(:,1:n)
self%xh2(:,1:n) = source%xh2(:,1:n)
self%vb1(:,1:n) = source%vb1(:,1:n)
self%vb2(:,1:n) = source%vb2(:,1:n)
end select
end associate

return
end subroutine symba_util_copy_plplenc


module subroutine symba_util_fill_arr_char_info(keeps, inserts, lfill_list)
!! author: David A. Minton
!!
!! Performs a fill operation on a single array of particle origin information types
!! This is the inverse of a spill operation
implicit none
! Arguments
type(symba_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
type(symba_particle_info), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps

if (.not.allocated(keeps) .or. .not.allocated(inserts)) return

keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:))
keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:))

return
end subroutine symba_util_fill_arr_char_info


module subroutine symba_util_fill_arr_char_kin(keeps, inserts, lfill_list)
!! author: David A. Minton
!!
!! Performs a fill operation on a single array of particle kinship types
!! This is the inverse of a spill operation
implicit none
! Arguments
type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
type(symba_kinship), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep
logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps

if (.not.allocated(keeps) .or. .not.allocated(inserts)) return

keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:))
keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:))

return
end subroutine symba_util_fill_arr_char_kin


module subroutine symba_util_fill_pl(self, inserts, lfill_list)
!! author: David A. Minton
!!
Expand All @@ -27,12 +113,8 @@ module subroutine symba_util_fill_pl(self, inserts, lfill_list)
call util_fill(keeps%isperi, inserts%isperi, lfill_list)
call util_fill(keeps%peri, inserts%peri, lfill_list)
call util_fill(keeps%atp, inserts%atp, lfill_list)

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_fill(keeps%kin, inserts%kin, lfill_list)
call util_fill(keeps%info, inserts%info, lfill_list)

call util_fill_pl(keeps, inserts, lfill_list)
class default
Expand All @@ -43,6 +125,7 @@ module subroutine symba_util_fill_pl(self, inserts, lfill_list)
return
end subroutine symba_util_fill_pl


module subroutine symba_util_fill_tp(self, inserts, lfill_list)
!! author: David A. Minton
!!
Expand Down Expand Up @@ -71,51 +154,6 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list)
return
end subroutine symba_util_fill_tp

module subroutine symba_util_copy_pltpenc(self, source)
!! author: David A. Minton
!!
!! Copies elements from the source encounter list into self.
implicit none
! Arguments
class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list
class(symba_pltpenc), intent(in) :: source !! Source object to copy into

associate(n => source%nenc)
self%nenc = n
self%lvdotr(1:n) = source%lvdotr(1:n)
self%status(1:n) = source%status(1:n)
self%level(1:n) = source%level(1:n)
self%index1(1:n) = source%index1(1:n)
self%index2(1:n) = source%index2(1:n)
end associate

return
end subroutine symba_util_copy_pltpenc


module subroutine symba_util_copy_plplenc(self, source)
!! author: David A. Minton
!!
!! Copies elements from the source encounter list into self.
implicit none
! Arguments
class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list
class(symba_pltpenc), intent(in) :: source !! Source object to copy into

call symba_util_copy_pltpenc(self, source)
associate(n => source%nenc)
select type(source)
class is (symba_plplenc)
self%xh1(:,1:n) = source%xh1(:,1:n)
self%xh2(:,1:n) = source%xh2(:,1:n)
self%vb1(:,1:n) = source%vb1(:,1:n)
self%vb2(:,1:n) = source%vb2(:,1:n)
end select
end associate

return
end subroutine symba_util_copy_plplenc


module subroutine symba_util_resize_pltpenc(self, nrequested)
!! author: David A. Minton
Expand Down Expand Up @@ -310,6 +348,62 @@ module subroutine symba_util_sort_rearrange_tp(self, ind)
end subroutine symba_util_sort_rearrange_tp


module subroutine symba_util_spill_arr_info(keeps, discards, lspill_list, ldestructive)
!! author: David A. Minton
!!
!! Performs a spill operation on a single array of particle origin information types
!! This is the inverse of a spill operation
implicit none
! Arguments
type(symba_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
type(symba_particle_info), dimension(:), allocatable, intent(inout) :: discards !! Array of discards
logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss
logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not

if (.not.allocated(keeps) .or. count(lspill_list(:)) == 0) return
if (.not.allocated(discards)) allocate(discards(count(lspill_list(:))))

discards(:) = pack(keeps(:), lspill_list(:))
if (ldestructive) then
if (count(.not.lspill_list(:)) > 0) then
keeps(:) = pack(keeps(:), .not. lspill_list(:))
else
deallocate(keeps)
end if
end if

return
end subroutine symba_util_spill_arr_info


module subroutine symba_util_spill_arr_kin(keeps, discards, lspill_list, ldestructive)
!! author: David A. Minton
!!
!! Performs a spill operation on a single array of particle kinships
!! This is the inverse of a spill operation
implicit none
! Arguments
type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep
type(symba_kinship), dimension(:), allocatable, intent(inout) :: discards !! Array of discards
logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss
logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not

if (.not.allocated(keeps) .or. count(lspill_list(:)) == 0) return
if (.not.allocated(discards)) allocate(discards(count(lspill_list(:))))

discards(:) = pack(keeps(:), lspill_list(:))
if (ldestructive) then
if (count(.not.lspill_list(:)) > 0) then
keeps(:) = pack(keeps(:), .not. lspill_list(:))
else
deallocate(keeps)
end if
end if

return
end subroutine symba_util_spill_arr_kin


module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive)
!! author: David A. Minton
!!
Expand All @@ -329,7 +423,6 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive)
associate(keeps => self)
select type(discards)
class is (symba_pl)

call util_spill(keeps%lcollision, discards%lcollision, lspill_list, ldestructive)
call util_spill(keeps%lencounter, discards%lencounter, lspill_list, ldestructive)
call util_spill(keeps%lmtiny, discards%lmtiny, lspill_list, ldestructive)
Expand All @@ -340,15 +433,8 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive)
call util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive)
call util_spill(keeps%peri, discards%peri, lspill_list, ldestructive)
call util_spill(keeps%atp, discards%atp, lspill_list, ldestructive)
discards%info(:) = pack(keeps%info(:), lspill_list(:))
discards%kin(:) = pack(keeps%kin(:), lspill_list(:))

if (ldestructive) then
if (count(.not.lspill_list(:)) > 0) then
keeps%info(:) = pack(keeps%info(:), .not. lspill_list(:))
keeps%kin(:) = pack(keeps%kin(:), .not. lspill_list(:))
end if
end if
call util_spill(keeps%info, discards%info, lspill_list, ldestructive)
call util_spill(keeps%kin, discards%kin, lspill_list, ldestructive)

call util_spill_pl(keeps, discards, lspill_list, ldestructive)
class default
Expand Down

0 comments on commit be00555

Please sign in to comment.