From 0acbf347815cfcc2e400497d6474612b9a8059cc Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 30 Aug 2021 16:25:06 -0400 Subject: [PATCH] Rearranged symba_encounter_check to split off the parallel loop into its own non-polymorphic subroutine to make setting the share flags easier to manage. --- src/kick/kick.f90 | 3 +- src/symba/symba_encounter_check.f90 | 71 +++++++++++++++++++---------- 2 files changed, 47 insertions(+), 27 deletions(-) diff --git a/src/kick/kick.f90 b/src/kick/kick.f90 index f2c49ad06..5c57918e2 100644 --- a/src/kick/kick.f90 +++ b/src/kick/kick.f90 @@ -98,9 +98,8 @@ module subroutine kick_getacch_int_all_pl(npl, nplpl, k_plpl, x, Gmass, radius, if (rji2 > rlim2) call kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), ahi(1,i), ahi(2,i), ahi(3,i), ahj(1,j), ahj(2,j), ahj(3,j)) end do !$omp end parallel do - !$omp parallel workshare + acc(:,1:npl) = acc(:,1:npl) + ahi(:,1:npl) + ahj(:,1:npl) - !$omp end parallel workshare return end subroutine kick_getacch_int_all_pl diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 3f5d8d00f..6f6010047 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -2,6 +2,46 @@ use swiftest contains + subroutine symba_encounter_check_all(nplplm, k_plpl, x, v, rhill, dt, irec, lencounter, loc_lvdotr) + !! author: David A. Minton + !! + !! Check for encounters between massive bodies. Split off from the main subroutine for performance + implicit none + integer(I8B), intent(in) :: nplplm + integer(I4B), dimension(:,:), intent(in) :: k_plpl + real(DP), dimension(:,:), intent(in) :: x, v + real(DP), dimension(:), intent(in) :: rhill + real(DP), intent(in) :: dt + integer(I4B), intent(in) :: irec + logical, dimension(:), intent(out) :: lencounter, loc_lvdotr + ! Internals + integer(I8B) :: k + integer(I4B) :: i, j + real(DP) :: xr, yr, zr, vxr, vyr, vzr, rhill1, rhill2 + + !$omp parallel do default(private)& + !$omp shared(nplplm, k_plpl, x, v, rhill, dt, irec, lencounter, loc_lvdotr) + do k = 1_I8B, nplplm + i = k_plpl(1, k) + j = k_plpl(2, k) + xr = x(1, j) - x(1, i) + yr = x(2, j) - x(2, i) + zr = x(3, j) - x(3, i) + vxr = v(1, j) - v(1, i) + vyr = v(2, j) - v(2, i) + vzr = v(3, j) - v(3, i) + rhill1 = rhill(i) + rhill2 = rhill(j) + lencounter(k) = .false. + loc_lvdotr(k) = .false. + call symba_encounter_check_one(xr, yr, zr, vxr, vyr, vzr, rhill1, rhill2, dt, irec, lencounter(k), loc_lvdotr(k)) + end do + !$omp end parallel do + + return + end subroutine symba_encounter_check_all + + module function symba_encounter_check_pl(self, system, dt, irec) result(lany_encounter) !! author: David A. Minton !! @@ -18,47 +58,28 @@ module function symba_encounter_check_pl(self, system, dt, irec) result(lany_enc ! Internals integer(I8B) :: k, nplplm integer(I4B) :: i, j, nenc - real(DP) :: xr, yr, zr, vxr, vyr, vzr, rhill1, rhill2 - logical, dimension(:), allocatable :: lencounter, loc_lvdotr - real(DP), dimension(:,:), pointer :: xh, vh - real(DP), dimension(:), pointer :: rhill - integer(I4B), dimension(:,:), pointer :: k_plpl + logical, dimension(:), allocatable :: lencounter, loc_lvdotr if (self%nbody == 0) return - associate(pl => self, xh => self%xh, vh => self%vh, rhill => self%rhill, npl => self%nbody, k_plpl => self%k_plpl) - nplplm = self%nplplm + associate(pl => self) + nplplm = pl%nplplm allocate(lencounter(nplplm)) allocate(loc_lvdotr(nplplm)) - lencounter(:) = .false. - loc_lvdotr(:) = .false. - !$omp parallel do default(shared)& - !$omp private(k, i, j, xr, yr, zr, vxr, vyr, vzr, rhill1, rhill2) - do k = 1_I8B, nplplm - i = k_plpl(1, k) - j = k_plpl(2, k) - xr = xh(1, j) - xh(1, i) - yr = xh(2, j) - xh(2, i) - zr = xh(3, j) - xh(3, i) - vxr = vh(1, j) - vh(1, i) - vyr = vh(2, j) - vh(2, i) - vzr = vh(3, j) - vh(3, i) - rhill1 = rhill(i) - rhill2 = rhill(j) - call symba_encounter_check_one(xr, yr, zr, vxr, vyr, vzr, rhill1, rhill2, dt, irec, lencounter(k), loc_lvdotr(k)) - end do - !$omp end parallel do + call symba_encounter_check_all(nplplm, pl%k_plpl, pl%xh, pl%vh, pl%rhill, dt, irec, lencounter, loc_lvdotr) !$omp parallel workshare nenc = count(lencounter(:)) !$omp end parallel workshare + lany_encounter = nenc > 0 if (lany_encounter) then associate(plplenc_list => system%plplenc_list) call plplenc_list%resize(nenc) plplenc_list%lvdotr(1:nenc) = pack(loc_lvdotr(1:nplplm), lencounter(1:nplplm)) plplenc_list%kidx(1:nenc) = pack([(k, k = 1_I8B, nplplm)], lencounter(1:nplplm)) + deallocate(lencounter, loc_lvdotr) plplenc_list%index1(1:nenc) = pl%k_plpl(1,plplenc_list%kidx(1:nenc)) plplenc_list%index2(1:nenc) = pl%k_plpl(2,plplenc_list%kidx(1:nenc)) plplenc_list%id1(1:nenc) = pl%id(plplenc_list%index1(1:nenc))