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

Commit

Permalink
Restructured discard system to make method calls cleaner
Browse files Browse the repository at this point in the history
  • Loading branch information
@daminton
daminton committed Jul 7, 2021
1 parent a72c919 commit 62ba8c7
Show file tree
Hide file tree
Showing 6 changed files with 116 additions and 104 deletions.
95 changes: 58 additions & 37 deletions src/discard/discard.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,44 +4,65 @@
module subroutine discard_system(self, param)
!! author: David A. Minton
!!
!! Check to see if particles should be discarded based on their positions relative to the massive bodies
!! Calls the discard methods for each body class and then the write method if any discards were detected
!!
!! Adapted from David E. Kaufmann's Swifter routine: discard.f90
!! Adapted from Hal Levison's Swift routine discard.f
implicit none
class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object
class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object
class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters

associate(tp => self%tp)
call tp%discard(self, param)
if (any(tp%ldiscard(1:ntp))) then
! Spill the discards to the spill list
call tp%spill(system%tp_discards, tp%ldiscard)
call self%write_discard(param, system%tp_discards)
end if
associate(system => self, tp => self%tp, pl => self%pl)
call tp%discard(system, param)
call pl%discard(system, param)
if (any(tp%ldiscard(:) .or. any(pl%ldiscard(:)))) call system%write_discard(param)
end associate
return
end subroutine discard_system

!if (self%tp%nbody == 0) return
!select type(system => self)
!class is (whm_nbody_system)
! associate(cb => system%cb, pl => system%pl, npl => system%pl%nbody, tp => system%tp, ntp => system%tp%nbody)
! if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. &
! (param%rmaxu >= 0.0_DP) .or. ((param%qmin >= 0.0_DP) .and. (param%qmin_coord == "BARY"))) then
! if (npl > 0) call pl%h2b(cb)
! if (ntp > 0) call tp%h2b(cb)
! end if
! if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) then
! if (ntp > 0) call tp%discard_sun(system, param)
! end if
! if (param%qmin >= 0.0_DP .and. ntp > 0) call tp%discard_peri(system, param)
! if (param%lclose .and. ntp > 0) call tp%discard_pl(system, param)

module subroutine discard_pl(self, system, param)
!! author: David A. Minton
!!
!! Placeholder method for discarding massive bodies. This method does nothing except to ensure that the discard flag is set to false.
!! This method is intended to be overridden by more advanced integrators.
implicit none
! Arguments
class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object
class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object
class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter
self%ldiscard(:) = .false.
return
end subroutine discard_pl

end associate
module subroutine discard_tp(self, system, param)
!! author: David A. Minton
!!
!! Check to see if particles should be discarded based on their positions relative to the massive bodies
!!
!! Adapted from David E. Kaufmann's Swifter routine: discard.f90
!! Adapted from Hal Levison's Swift routine discard.
implicit none
! Arguments
class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object
class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object
class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter

associate(tp => self, ntp => self%nbody, cb => system%cb, pl => system%pl, npl => system%pl%nbody)
if (ntp == 0) return
if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. &
(param%rmaxu >= 0.0_DP) .or. ((param%qmin >= 0.0_DP) .and. (param%qmin_coord == "BARY"))) then
if (npl > 0) call pl%h2b(cb)
if (ntp > 0) call tp%h2b(cb)
end if
if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) then
if (ntp > 0) call discard_sun_tp(tp, system, param)
end if
if (param%qmin >= 0.0_DP .and. ntp > 0) call discard_peri_tp(tp, system, param)
if (param%lclose .and. ntp > 0) call discard_pl_tp(tp, system, param)
if (any(tp%ldiscard)) call tp%spill(system%tp_discards, tp%ldiscard)
end associate
return
end subroutine discard_system
end subroutine discard_tp

module subroutine discard_sun_tp(self, system, param)
subroutine discard_sun_tp(tp, system, param)
!! author: David A. Minton
!!
!! Check to see if test particles should be discarded based on their positions relative to the Sun
Expand All @@ -51,14 +72,14 @@ module subroutine discard_sun_tp(self, system, param)
!! Adapted from Hal Levison's Swift routine discard_sun.f
implicit none
! Arguments
class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object
class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object
class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object
class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters
! Internals
integer(I4B) :: i
real(DP) :: energy, vb2, rb2, rh2, rmin2, rmax2, rmaxu2

associate(tp => self, ntp => self%nbody, cb => system%cb, t => param%t, msys => system%msys)
associate(ntp => tp%nbody, cb => system%cb, t => param%t, msys => system%msys)
rmin2 = max(param%rmin * param%rmin, cb%radius * cb%radius)
rmax2 = param%rmax**2
rmaxu2 = param%rmaxu**2
Expand Down Expand Up @@ -90,7 +111,7 @@ module subroutine discard_sun_tp(self, system, param)
return
end subroutine discard_sun_tp

module subroutine discard_peri_tp(self, system, param)
subroutine discard_peri_tp(tp, system, param)
!! author: David A. Minton
!!
!! Check to see if a test particle should be discarded because its perihelion distance becomes too small
Expand All @@ -99,7 +120,7 @@ module subroutine discard_peri_tp(self, system, param)
!! Adapted from Hal Levison's Swift routine discard_peri.f
implicit none
! Arguments
class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object
class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object
class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object
class(swiftest_parameters), intent(in) :: param !! Current run configuration parameterss
! Internals
Expand All @@ -108,7 +129,7 @@ module subroutine discard_peri_tp(self, system, param)
real(DP) :: r2
real(DP), dimension(NDIM) :: dx

associate(cb => system%cb, tp => self, ntp => self%nbody, pl => system%pl, npl => system%pl%nbody, qmin_coord => param%qmin_coord, t => param%t, msys => system%msys)
associate(cb => system%cb, ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, qmin_coord => param%qmin_coord, t => param%t, msys => system%msys)
if (lfirst) then
call util_hills(npl, pl)
call util_peri(lfirst, ntp, tp, cb%Gmass, msys, param%qmin_coord)
Expand Down Expand Up @@ -142,7 +163,7 @@ module subroutine discard_peri_tp(self, system, param)

end subroutine discard_peri_tp

module subroutine discard_pl_tp(self, system, param)
subroutine discard_pl_tp(tp, system, param)
!! author: David A. Minton
!!
!! Check to see if test particles should be discarded based on their positions relative to the massive bodies
Expand All @@ -151,15 +172,15 @@ module subroutine discard_pl_tp(self, system, param)
!! Adapted from Hal Levison's Swift routine discard_pl.f
implicit none
! Arguments
class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object
class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object
class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object
class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters
! Internals
integer(I4B) :: i, j, isp
real(DP) :: r2min, radius
real(DP), dimension(NDIM) :: dx, dv

associate(tp => self, ntp => self%nbody, pl => system%pl, npl => system%pl%nbody, t => param%t, dt => param%dt)
associate(ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => param%t, dt => param%dt)
do i = 1, ntp
if (tp%status(i) == ACTIVE) then
do j = 1, npl
Expand Down
7 changes: 3 additions & 4 deletions src/io/io.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1045,7 +1045,7 @@ module subroutine io_read_initialize_system(self, param)

end subroutine io_read_initialize_system

module subroutine io_write_discard(self, param, discards)
module subroutine io_write_discard(self, param)
!! author: David A. Minton
!!
!! Write out information about discarded test particle
Expand All @@ -1056,7 +1056,6 @@ module subroutine io_write_discard(self, param, discards)
! Arguments
class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object
class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters
class(swiftest_body), intent(inout) :: discards !! Swiftest discard object
! Internals
integer(I4B), parameter :: LUN = 40
integer(I4B) :: i, ierr
Expand All @@ -1069,8 +1068,8 @@ module subroutine io_write_discard(self, param, discards)
character(*), parameter :: PLNAMEFMT = '(I8, 2(1X, E23.16))'
class(swiftest_body), allocatable :: pltemp

associate(t => param%t, param => param, nsp => discards%nbody, dxh => discards%xh, dvh => discards%vh, &
dname => discards%name, dstatus => discards%status)
associate(t => param%t, discards => self%tp_discards, nsp => self%tp_discards%nbody, dxh => self%tp_discards%xh, dvh => self%tp_discards%vh, &
dname => self%tp_discards%name, dstatus => self%tp_discards%status)

select case(param%out_stat)
case('APPEND')
Expand Down
6 changes: 3 additions & 3 deletions src/modules/rmvs_classes.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@ module rmvs_classes
integer(I4B) :: ipleP !! index value of encountering planet
logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations
contains
procedure, public :: discard_pl => rmvs_discard_pl_tp
procedure, public :: discard => rmvs_discard_tp !! Check to see if test particles should be discarded based on pericenter passage distances with respect to planets encountered
procedure, public :: encounter_check => rmvs_encounter_check_tp !! Checks if any test particles are undergoing a close encounter with a massive body
procedure, public :: fill => rmvs_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the MERGE intrinsic)
procedure, public :: getacch => rmvs_getacch_tp !! Calculates either the standard or modified version of the acceleration depending if the
Expand Down Expand Up @@ -97,13 +97,13 @@ module rmvs_classes
end type rmvs_pl

interface
module subroutine rmvs_discard_pl_tp(self, system, param)
module subroutine rmvs_discard_tp(self, system, param)
use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters
implicit none
class(rmvs_tp), intent(inout) :: self !! RMVS test particle object
class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object
class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters
end subroutine rmvs_discard_pl_tp
end subroutine rmvs_discard_tp

module function rmvs_encounter_check_tp(self, system, dt) result(lencounter)
implicit none
Expand Down
Loading

0 comments on commit 62ba8c7

Please sign in to comment.