From ea1f5f87369a325278c56959b95fb7d05b6a1165 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 16 Sep 2021 14:08:13 -0400 Subject: [PATCH] Added param to argument list of encounter methods so that the choice of whether to use the flattened matrix is available --- src/modules/rmvs_classes.f90 | 11 ++++--- src/modules/symba_classes.f90 | 50 +++++++++++++---------------- src/rmvs/rmvs_encounter_check.f90 | 9 +++--- src/rmvs/rmvs_step.f90 | 4 +-- src/symba/symba_encounter_check.f90 | 37 +++++++++++---------- src/symba/symba_step.f90 | 4 +-- src/symba/symba_util.f90 | 4 +-- 7 files changed, 59 insertions(+), 60 deletions(-) diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs_classes.f90 index b29cd02c4..680612de5 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs_classes.f90 @@ -122,12 +122,13 @@ module subroutine rmvs_discard_tp(self, system, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine rmvs_discard_tp - module function rmvs_encounter_check_tp(self, system, dt) result(lencounter) + module function rmvs_encounter_check_tp(self, param, system, dt) result(lencounter) implicit none - class(rmvs_tp), intent(inout) :: self !! RMVS test particle object - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object - real(DP), intent(in) :: dt !! step size - logical :: lencounter !! Returns true if there is at least one close encounter + class(rmvs_tp), intent(inout) :: self !! RMVS test particle object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + real(DP), intent(in) :: dt !! step size + logical :: lencounter !! Returns true if there is at least one close encounter end function rmvs_encounter_check_tp module subroutine rmvs_io_write_encounter(t, id1, id2, Gmass1, Gmass2, radius1, radius2, xh1, xh2, vh1, vh2, enc_out) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index f805aa2c4..0faefc3d1 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -256,40 +256,34 @@ module subroutine symba_drift_tp(self, system, param, dt) real(DP), intent(in) :: dt !! Stepsize end subroutine symba_drift_tp - module pure subroutine symba_encounter_check_one(xr, yr, zr, vxr, vyr, vzr, rhill1, rhill2, dt, irec, lencounter, lvdotr) - !$omp declare simd(symba_encounter_check_one) - implicit none - real(DP), intent(in) :: xr, yr, zr, vxr, vyr, vzr - real(DP), intent(in) :: rhill1, rhill2, dt - integer(I4B), intent(in) :: irec - logical, intent(out) :: lencounter, lvdotr - end subroutine symba_encounter_check_one - - module function symba_encounter_check_pl(self, system, dt, irec) result(lany_encounter) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA test particle object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical :: lany_encounter !! Returns true if there is at least one close encounter + module function symba_encounter_check_pl(self, param, system, dt, irec) result(lany_encounter) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA test particle object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_pl - module function symba_encounter_check(self, system, dt, irec) result(lany_encounter) + module function symba_encounter_check(self, param, system, dt, irec) result(lany_encounter) implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical :: lany_encounter !! Returns true if there is at least one close encounter + class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check - module function symba_encounter_check_tp(self, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) implicit none - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical :: lany_encounter !! Returns true if there is at least one close encounter + class(symba_tp), intent(inout) :: self !! SyMBA test particle object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_tp module function symba_collision_casedisruption(system, param, colliders, frag) result(status) diff --git a/src/rmvs/rmvs_encounter_check.f90 b/src/rmvs/rmvs_encounter_check.f90 index 4c59f0a15..dd492032b 100644 --- a/src/rmvs/rmvs_encounter_check.f90 +++ b/src/rmvs/rmvs_encounter_check.f90 @@ -2,7 +2,7 @@ use swiftest contains - module function rmvs_encounter_check_tp(self, system, dt) result(lencounter) + module function rmvs_encounter_check_tp(self, param, system, dt) result(lencounter) !! author: David A. Minton !! !! Determine whether a test particle and planet are having or will have an encounter within the next time step @@ -11,9 +11,10 @@ module function rmvs_encounter_check_tp(self, system, dt) result(lencounter) !! Adapted from Hal Levison's Swift routine rmvs3_chk.f implicit none ! Arguments - class(rmvs_tp), intent(inout) :: self !! RMVS test particle object - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object - real(DP), intent(in) :: dt !! step size + class(rmvs_tp), intent(inout) :: self !! RMVS test particle object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + real(DP), intent(in) :: dt !! step size ! Result logical :: lencounter !! Returns true if there is at least one close encounter ! Internals diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index b8cfcd688..00b66a9f8 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -35,7 +35,7 @@ module subroutine rmvs_step_system(self, param, t, dt) call pl%set_beg_end(xbeg = xbeg, vbeg = vbeg) ! ****** Check for close encounters ***** ! system%rts = RHSCALE - lencounter = tp%encounter_check(system, dt) + lencounter = tp%encounter_check(param, system, dt) if (lencounter) then lfirstpl = pl%lfirst pl%outer(0)%x(:, 1:npl) = xbeg(:, 1:npl) @@ -178,7 +178,7 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) vbeg = pl%outer(outer_index - 1)%v(:, 1:npl), & xend = pl%outer(outer_index )%x(:, 1:npl)) system%rts = RHPSCALE - lencounter = tp%encounter_check(system, dto) + lencounter = tp%encounter_check(param, system, dto) if (lencounter) then ! Interpolate planets in inner encounter region call rmvs_interp_in(cb, pl, system, param, dto, outer_index) diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index fa5913507..82c4c1890 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -115,17 +115,18 @@ subroutine symba_encounter_check_all_triangular(npl, nplm, x, v, rhill, dt, ire end subroutine symba_encounter_check_all_triangular - module function symba_encounter_check_pl(self, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_pl(self, param, system, dt, irec) result(lany_encounter) !! author: David A. Minton !! !! Check for an encounter between massive bodies. !! implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA test particle object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level + class(symba_pl), intent(inout) :: self !! SyMBA test particle object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level ! Result logical :: lany_encounter !! Returns true if there is at least one close encounter ! Internals @@ -185,7 +186,7 @@ module function symba_encounter_check_pl(self, system, dt, irec) result(lany_enc end function symba_encounter_check_pl - module function symba_encounter_check(self, system, dt, irec) result(lany_encounter) + module function symba_encounter_check(self, param, system, dt, irec) result(lany_encounter) !! author: David A. Minton !! !! Check for an encounter between test particles and massive bodies in the pltpenc list. @@ -194,11 +195,12 @@ module function symba_encounter_check(self, system, dt, irec) result(lany_encoun !! Adapted from portions of David E. Kaufmann's Swifter routine: symba_step_recur.f90 implicit none ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical :: lany_encounter !! Returns true if there is at least one close encounter + class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter ! Internals integer(I4B) :: i, j, k, lidx, nenc_enc real(DP), dimension(NDIM) :: xr, vr @@ -271,17 +273,18 @@ module function symba_encounter_check(self, system, dt, irec) result(lany_encoun end function symba_encounter_check - module function symba_encounter_check_tp(self, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) !! author: David A. Minton !! !! Check for an encounter between test particles and massive bodies. !! implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level + class(symba_tp), intent(inout) :: self !! SyMBA test particle object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level ! Result logical :: lany_encounter !! Returns true if there is at least one close encounter ! Internals @@ -343,7 +346,7 @@ module function symba_encounter_check_tp(self, system, dt, irec) result(lany_enc end function symba_encounter_check_tp - module pure subroutine symba_encounter_check_one(xr, yr, zr, vxr, vyr, vzr, rhill1, rhill2, dt, irec, lencounter, lvdotr) + pure subroutine symba_encounter_check_one(xr, yr, zr, vxr, vyr, vzr, rhill1, rhill2, dt, irec, lencounter, lvdotr) !$omp declare simd(symba_encounter_check_one) !! author: David A. Minton !! diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 9f4508550..dc07bf561 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -26,7 +26,7 @@ module subroutine symba_step_system(self, param, t, dt) select type(param) class is (symba_parameters) call self%reset(param) - lencounter = pl%encounter_check(self, dt, 0) .or. tp%encounter_check(self, dt, 0) + lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then call self%interp(param, t, dt) param%lfirstkick = .true. @@ -173,7 +173,7 @@ module recursive subroutine symba_step_recur_system(self, param, t, ireci) nloops = NTENC end if do j = 1, nloops - lencounter = plplenc_list%encounter_check(system, dtl, irecp) .or. pltpenc_list%encounter_check(system, dtl, irecp) + lencounter = plplenc_list%encounter_check(param, system, dtl, irecp) .or. pltpenc_list%encounter_check(param, system, dtl, irecp) call plplenc_list%kick(system, dth, irecp, 1) call pltpenc_list%kick(system, dth, irecp, 1) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index a59d1f0b8..752028cf7 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -486,7 +486,7 @@ module subroutine symba_util_rearray_pl(self, system, param) allocate(levelg_orig_pl, source=pl%levelg) allocate(levelm_orig_pl, source=pl%levelm) allocate(nplenc_orig_pl, source=pl%nplenc) - lencounter = pl%encounter_check(system, param%dt, 0) + lencounter = pl%encounter_check(param, system, param%dt, 0) if (system%tp%nbody > 0) then select type(tp => system%tp) class is (symba_tp) @@ -494,7 +494,7 @@ module subroutine symba_util_rearray_pl(self, system, param) allocate(levelg_orig_tp, source=tp%levelg) allocate(levelm_orig_tp, source=tp%levelm) allocate(nplenc_orig_tp, source=tp%nplenc) - lencounter = tp%encounter_check(system, param%dt, 0) + lencounter = tp%encounter_check(param, system, param%dt, 0) call move_alloc(levelg_orig_tp, tp%levelg) call move_alloc(levelm_orig_tp, tp%levelm) call move_alloc(nplenc_orig_tp, tp%nplenc)