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

@@ -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
 

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))