diff --git a/src/helio/helio_kick.f90 b/src/helio/helio_kick.f90 index b1949ac2f..fa601b7f7 100644 --- a/src/helio/helio_kick.f90 +++ b/src/helio/helio_kick.f90 @@ -14,21 +14,27 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step associate(cb => system%cb, pl => self, npl => self%nbody) call pl%accel_int() if (param%loblatecb) then - cb%aoblbeg = cb%aobl call pl%accel_obl(system) - cb%aoblend = cb%aobl + if (lbeg) then + cb%aoblbeg = cb%aobl + else + cb%aoblend = cb%aobl + end if if (param%ltides) then - cb%atidebeg = cb%atide call pl%accel_tides(system) - cb%atideend = cb%atide + if (lbeg) then + cb%atidebeg = cb%atide + else + cb%atideend = cb%atide + end if end if end if - if (param%lextra_force) call pl%accel_user(system, param, t) + if (param%lextra_force) call pl%accel_user(system, param, t, lbeg) !if (param%lgr) call pl%gr_accel(param) end associate @@ -48,17 +54,17 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step associate(tp => self, cb => system%cb, pl => system%pl, npl => system%pl%nbody) - if (present(lbeg)) system%lbeg = lbeg + system%lbeg = lbeg if (system%lbeg) then call tp%accel_int(pl%Gmass(:), pl%xbeg(:,:), npl) else call tp%accel_int(pl%Gmass(:), pl%xend(:,:), npl) end if if (param%loblatecb) call tp%accel_obl(system) - if (param%lextra_force) call tp%accel_user(system, param, t) + if (param%lextra_force) call tp%accel_user(system, param, t, lbeg) !if (param%lgr) call tp%gr_accel(param) end associate return @@ -86,7 +92,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, mask, lbeg) associate(pl => self, npl => self%nbody) if (npl ==0) return pl%ah(:,:) = 0.0_DP - call pl%accel(system, param, t) + call pl%accel(system, param, t, lbeg) if (lbeg) then call pl%set_beg_end(xbeg = pl%xh) else diff --git a/src/modules/helio_classes.f90 b/src/modules/helio_classes.f90 index c3dc0be62..2f8a52808 100644 --- a/src/modules/helio_classes.f90 +++ b/src/modules/helio_classes.f90 @@ -141,7 +141,7 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine helio_kick_getacch_pl module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) @@ -151,7 +151,7 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine helio_kick_getacch_tp module subroutine helio_kick_vb_pl(self, system, param, t, dt, mask, lbeg) diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs_classes.f90 index a459e7246..8b0ad2c2f 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs_classes.f90 @@ -143,7 +143,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structuree class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine rmvs_kick_getacch_tp module subroutine rmvs_setup_pl(self,n) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 7c160b780..417138122 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -310,7 +310,7 @@ subroutine abstract_accel(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step end subroutine abstract_accel subroutine abstract_initialize(self, param) @@ -729,7 +729,7 @@ module subroutine user_kick_getacch_body(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step end subroutine user_kick_getacch_body module subroutine util_coord_b2h_pl(self, cb) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 85c65de34..72fb06ae7 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -220,7 +220,7 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + 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_pl module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) @@ -229,7 +229,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + 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) diff --git a/src/modules/whm_classes.f90 b/src/modules/whm_classes.f90 index e30bd874f..46a4e3743 100644 --- a/src/modules/whm_classes.f90 +++ b/src/modules/whm_classes.f90 @@ -124,7 +124,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine whm_kick_getacch_pl !> Get heliocentric accelration of the test particle @@ -135,7 +135,7 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine whm_kick_getacch_tp module subroutine whm_kick_vh_pl(self, system, param, t, dt, mask, lbeg) diff --git a/src/rmvs/rmvs_kick.f90 b/src/rmvs/rmvs_kick.f90 index c68453d3d..6cba4caef 100644 --- a/src/rmvs/rmvs_kick.f90 +++ b/src/rmvs/rmvs_kick.f90 @@ -15,7 +15,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structuree class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step ! Internals type(swiftest_parameters) :: param_planetocen real(DP), dimension(:, :), allocatable :: xh_original @@ -34,7 +34,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) class is (rmvs_cb) associate(xpc => pl%xh, xpct => self%xh, apct => self%ah, system_planetocen => system) - if (present(lbeg)) system_planetocen%lbeg = lbeg + system_planetocen%lbeg = lbeg if (system_planetocen%lbeg) then allocate(xhp, source=pl%xbeg) @@ -49,7 +49,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) param_planetocen%lextra_force = .false. param_planetocen%lgr = .false. ! Now compute the planetocentric values of acceleration - call whm_kick_getacch_tp(tp, system_planetocen, param_planetocen, t) + call whm_kick_getacch_tp(tp, system_planetocen, param_planetocen, t, lbeg) ! Now compute any heliocentric values of acceleration if (tp%lfirst) then @@ -66,7 +66,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) GMcb_original = cb%Gmass cb%Gmass = tp%cb_heliocentric%Gmass if (param%loblatecb) call tp%accel_obl(system_planetocen) - if (param%lextra_force) call tp%accel_user(system_planetocen, param, t) + if (param%lextra_force) call tp%accel_user(system_planetocen, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) tp%xh(:,:) = xh_original(:,:) cb%Gmass = GMcb_original diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 611ca99be..4da46f5a6 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -15,7 +15,7 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step ! Internals integer(I4B) :: k real(DP) :: irij3, rji2, rlim2, faci, facj @@ -59,7 +59,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step ! Internals integer(I4B) :: k real(DP) :: rji2, fac, rlim2 diff --git a/src/user/user_getacch.f90 b/src/user/user_getacch.f90 index ccad7ea7d..2775de3dd 100644 --- a/src/user/user_getacch.f90 +++ b/src/user/user_getacch.f90 @@ -13,7 +13,7 @@ module subroutine user_kick_getacch_body(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters user parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the ste + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the ste return end subroutine user_kick_getacch_body diff --git a/src/whm/whm_kick.f90 b/src/whm/whm_kick.f90 index c5a60452a..4a8b68330 100644 --- a/src/whm/whm_kick.f90 +++ b/src/whm/whm_kick.f90 @@ -14,7 +14,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structure class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step ! Internals integer(I4B) :: i real(DP), dimension(NDIM) :: ah0 @@ -33,9 +33,12 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) call pl%accel_int() if (param%loblatecb) then - cb%aoblbeg = cb%aobl call pl%accel_obl(system) - cb%aoblend = cb%aobl + if (lbeg) then + cb%aoblbeg = cb%aobl + else + cb%aoblend = cb%aobl + end if if (param%ltides) then cb%atidebeg = cb%aobl call pl%accel_tides(system) @@ -45,7 +48,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) if (param%lgr) call pl%accel_gr(param) - if (param%lextra_force) call pl%accel_user(system, param, t) + if (param%lextra_force) call pl%accel_user(system, param, t, lbeg) end associate return end subroutine whm_kick_getacch_pl @@ -63,16 +66,16 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structure class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time - logical, optional, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step ! Internals integer(I4B) :: i real(DP), dimension(NDIM) :: ah0 associate(tp => self, ntp => self%nbody, pl => system%pl, cb => system%cb, npl => system%pl%nbody) if (ntp == 0 .or. npl == 0) return - if (present(lbeg)) system%lbeg = lbeg + system%lbeg = lbeg - if (system%lbeg) then + if (lbeg) then ah0(:) = whm_kick_getacch_ah0(pl%Gmass(:), pl%xbeg(:,:), npl) do i = 1, ntp tp%ah(:, i) = tp%ah(:, i) + ah0(:) @@ -87,7 +90,7 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) end if if (param%loblatecb) call tp%accel_obl(system) - if (param%lextra_force) call tp%accel_user(system, param, t) + if (param%lextra_force) call tp%accel_user(system, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) end associate return @@ -204,13 +207,13 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, mask, lbeg) if (pl%lfirst) then call pl%h2j(cb) pl%ah(:,:) = 0.0_DP - call pl%accel(system, param, t) + call pl%accel(system, param, t, lbeg) pl%lfirst = .false. end if call pl%set_beg_end(xbeg = pl%xh) else pl%ah(:,:) = 0.0_DP - call pl%accel(system, param, t) + call pl%accel(system, param, t, lbeg) call pl%set_beg_end(xend = pl%xh) end if do concurrent(i = 1:npl, mask(i))