From e47a6f1566bdec10d51b6bebaebd2f00d972fdb9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Jul 2021 10:34:20 -0400 Subject: [PATCH] Converted the cross term in the WHM accelration to use the flattened array. Tests pass --- src/whm/whm_getacch.f90 | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/whm/whm_getacch.f90 b/src/whm/whm_getacch.f90 index f393bd60e..0aa438a5e 100644 --- a/src/whm/whm_getacch.f90 +++ b/src/whm/whm_getacch.f90 @@ -187,17 +187,16 @@ pure subroutine whm_getacch_ah3(pl) implicit none class(whm_pl), intent(inout) :: pl - integer(I4B) :: i, j + integer(I4B) :: k real(DP) :: rji2, irij3, faci, facj real(DP), dimension(NDIM) :: dx real(DP), dimension(:,:), allocatable :: ah3 - associate(npl => pl%nbody) + associate(npl => pl%nbody, nplpl => pl%nplpl) allocate(ah3, mold=pl%ah) ah3(:, :) = 0.0_DP - - do i = 1, npl - 1 - do j = i + 1, npl + do k = 1, nplpl + associate(i => pl%k_eucl(1, k), j => pl%k_eucl(2, k)) dx(:) = pl%xh(:, j) - pl%xh(:, i) rji2 = dot_product(dx(:), dx(:)) irij3 = 1.0_DP / (rji2 * sqrt(rji2)) @@ -205,10 +204,10 @@ pure subroutine whm_getacch_ah3(pl) facj = pl%Gmass(j) * irij3 ah3(:, i) = ah3(:, i) + facj * dx(:) ah3(:, j) = ah3(:, j) - faci * dx(:) - end do + end associate end do - do i = 1, NDIM - pl%ah(i, 1:npl) = pl%ah(i, 1:npl) + ah3(i, 1:npl) + do concurrent (k = 1:npl) + pl%ah(:, k) = pl%ah(:, k) + ah3(:, k) end do deallocate(ah3) end associate