From 567af34171ea253cfb4b5e6a5e599072177b5522 Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 14 Apr 2021 10:30:14 -0400 Subject: [PATCH] Corrected bugs that prevented SIM --- src/rmvs/rmvs_encounter_check.f90 | 2 +- src/whm/whm_getacch.f90 | 7 +++++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/rmvs/rmvs_encounter_check.f90 b/src/rmvs/rmvs_encounter_check.f90 index 3a0efc8d1..3eb1f406e 100644 --- a/src/rmvs/rmvs_encounter_check.f90 +++ b/src/rmvs/rmvs_encounter_check.f90 @@ -24,7 +24,7 @@ module function rmvs_encounter_check_tp(self, cb, pl, dt, rts) result(lencounter logical :: lflag associate(tp => self, ntp => self%nbody, npl => pl%nbody, rhill => pl%rhill, xht => self%xh, vht => self%vh, & - xbeg => self%xbeg, vbeg => self%vbeg, status => tp%status, plencP => tp%plencP, nenc => pl%nenc) + xbeg => self%xbeg, vbeg => self%vbeg, status => self%status, plencP => self%plencP, nenc => pl%nenc) r2crit(:) = (rts * rhill(:))**2 plencP(:) = 0 do j = 1, npl diff --git a/src/whm/whm_getacch.f90 b/src/whm/whm_getacch.f90 index a3aed14f7..2fcbad910 100644 --- a/src/whm/whm_getacch.f90 +++ b/src/whm/whm_getacch.f90 @@ -216,10 +216,12 @@ pure subroutine whm_getacch_ah3_tp(cb, pl, tp, xh) integer(I4B) :: i, j real(DP) :: rji2, irij3, fac real(DP), dimension(NDIM) :: dx + real(DP), dimension(:,:), allocatable :: aht associate(ntp => tp%nbody, npl => pl%nbody, msun => cb%Gmass, Gmpl => pl%Gmass, & - xht => tp%xh, aht => tp%ah) - + xht => tp%xh) + + allocate(aht, source=tp%ah) if (ntp == 0) return do j = 1, npl !$omp simd private(dx,rji2,irij3,fac) reduction(-:aht) @@ -231,6 +233,7 @@ pure subroutine whm_getacch_ah3_tp(cb, pl, tp, xh) aht(:, i) = aht(:, i) - fac * dx(:) end do end do + call move_alloc(aht, tp%ah) end associate return end subroutine whm_getacch_ah3_tp