From d6c6369a10b867e9bea0d09ad32ca7a800c483d4 Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 14 Apr 2021 13:34:25 -0400 Subject: [PATCH] Changing back to ntp on outer loop and npl on inner loop --- src/whm/whm_getacch.f90 | 39 +++++++++++---------------------------- 1 file changed, 11 insertions(+), 28 deletions(-) diff --git a/src/whm/whm_getacch.f90 b/src/whm/whm_getacch.f90 index 6da84bfd1..65497c402 100644 --- a/src/whm/whm_getacch.f90 +++ b/src/whm/whm_getacch.f90 @@ -216,38 +216,21 @@ pure subroutine whm_getacch_ah3_tp(cb, pl, tp, xh) integer(I4B) :: i, j real(DP) :: rji2, irij3, fac real(DP), dimension(NDIM) :: dx, acc - real(DP), dimension(:,:), allocatable :: aht - associate(ntp => tp%nbody, npl => pl%nbody, msun => cb%Gmass, GMpl => pl%Gmass, xht => tp%xh) - + associate(ntp => tp%nbody, npl => pl%nbody, msun => cb%Gmass, GMpl => pl%Gmass, xht => tp%xh, aht => tp%ah) if (ntp == 0) return - if (ntp > npl) then - allocate(aht, source=tp%ah) + do i = 1, ntp + acc(:) = 0.0_DP + !$omp simd private(dx,rji2,irij3,fac) reduction(-:acc) do j = 1, npl - !$omp simd private(dx,rji2,irij3,fac) reduction(-:aht) - do i = 1, ntp - dx(:) = xht(:, i) - xh(:, j) - rji2 = dot_product(dx(:), dx(:)) - irij3 = 1.0_DP / (rji2 * sqrt(rji2)) - fac = GMpl(j) * irij3 - aht(:, i) = aht(:, i) - fac * dx(:) - end do - end do - call move_alloc(aht, tp%ah) - else - do i = 1, ntp - acc(:) = 0.0_DP - !$omp simd private(dx,rji2,irij3,fac) reduction(-:acc) - do j = 1, npl - dx(:) = xht(:, i) - xh(:, j) - rji2 = dot_product(dx(:), dx(:)) - irij3 = 1.0_DP / (rji2 * sqrt(rji2)) - fac = GMpl(j) * irij3 - acc(:) = acc(:) - fac * dx(:) - end do - tp%ah(:, i) = tp%ah(:, i) + acc(:) + dx(:) = xht(:, i) - xh(:, j) + rji2 = dot_product(dx(:), dx(:)) + irij3 = 1.0_DP / (rji2 * sqrt(rji2)) + fac = GMpl(j) * irij3 + acc(:) = acc(:) - fac * dx(:) end do - end if + aht(:, i) = aht(:, i) + acc(:) + end do end associate return end subroutine whm_getacch_ah3_tp