From 5688e850cb13d0a04b082f0c9bad69afb867ebcb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 7 Mar 2023 12:36:43 -0500 Subject: [PATCH 1/2] removed redundant mask --- src/swiftest/swiftest_kick.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/swiftest/swiftest_kick.f90 b/src/swiftest/swiftest_kick.f90 index b3a5f7d39..e7d454c12 100644 --- a/src/swiftest/swiftest_kick.f90 +++ b/src/swiftest/swiftest_kick.f90 @@ -232,7 +232,7 @@ module subroutine swiftest_kick_getacch_int_all_tri_rad_pl(npl, nplm, r, Gmass, !$omp parallel do default(private) schedule(static)& !$omp shared(npl,nplm, r, Gmass, radius, acc) do i = nplm+1,npl - do concurrent(j = 1:nplm, j/=i) + do concurrent(j = 1:nplm) rx = r(1,j) - r(1,i) ry = r(2,j) - r(2,i) rz = r(3,j) - r(3,i) @@ -319,7 +319,7 @@ module subroutine swiftest_kick_getacch_int_all_tri_norad_pl(npl, nplm, r, Gmass !$omp parallel do default(private) schedule(static)& !$omp shared(npl,nplm, r, Gmass, acc) do i = nplm+1,npl - do concurrent(j = 1:nplm, j/=i) + do concurrent(j = 1:nplm) rx = r(1,j) - r(1,i) ry = r(2,j) - r(2,i) rz = r(3,j) - r(3,i) From 9351997477042163a936bf58bed6de8463cbcd0f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 7 Mar 2023 17:30:23 -0500 Subject: [PATCH 2/2] Some minor refinements to kick and stripped away adaptive code for encounter checks --- src/encounter/encounter_check.f90 | 102 ++---------------------------- src/swiftest/swiftest_kick.f90 | 72 +++++++++++---------- 2 files changed, 43 insertions(+), 131 deletions(-) diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index 46b712910..917fcae45 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -34,38 +34,8 @@ module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, ind logical, save :: skipit = .false. ! This will be used to ensure that the sort & sweep subroutine gets called at least once before timing it so that the extent array is nearly sorted when it is timed integer(I8B) :: nplpl = 0_I8B - ! if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then - ! nplpl = (npl * (npl - 1) / 2) - ! if (nplpl > 0) then - ! if (lfirst) then - ! write(itimer%loopname, *) "encounter_check_all_plpl" - ! write(itimer%looptype, *) "ENCOUNTER_PLPL" - ! lfirst = .false. - ! itimer%step_counter = INTERACTION_TIMER_CADENCE - ! else - ! if (itimer%netcdf_io_check(param, nplpl)) call itimer%time_this_loop(param, nplpl) - ! end if - ! else - ! param%lencounter_sas_plpl = .false. - ! end if - ! end if - - ! if (param%lencounter_sas_plpl) then - ! call encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, nenc, index1, index2, lvdotr) - ! else - call encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1, index2, lvdotr) - ! end if - - ! if (skipit) then - ! skipit = .false. - ! else - ! if (param%ladaptive_encounters_plpl .and. nplpl > 0) then - ! if (itimer%is_on) then - ! call itimer%adapt(param, nplpl) - ! skipit = .true. - ! end if - ! end if - ! end if + + call encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1, index2, lvdotr) return end subroutine encounter_check_all_plpl @@ -107,23 +77,6 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, rplm, vplm, rplt, integer(I4B), dimension(:), allocatable :: itmp logical, dimension(:), allocatable :: ltmp - ! if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then - ! npl = nplm + nplt - ! nplplm = nplm * npl - nplm * (nplm + 1) / 2 - ! if (nplplm > 0) then - ! if (lfirst) then - ! write(itimer%loopname, *) "encounter_check_all_plpl" - ! write(itimer%looptype, *) "ENCOUNTER_PLPL" - ! lfirst = .false. - ! itimer%step_counter = INTERACTION_TIMER_CADENCE - ! else - ! if (itimer%netcdf_io_check(param, nplplm)) call itimer%time_this_loop(param, nplplm) - ! end if - ! else - ! param%lencounter_sas_plpl = .false. - ! end if - ! end if - allocate(tmp_param, source=param) ! Turn off adaptive encounter checks for the pl-pl group @@ -132,23 +85,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, rplm, vplm, rplt, ! Start with the pl-pl group call encounter_check_all_plpl(tmp_param, nplm, rplm, vplm, rencm, dt, nenc, index1, index2, lvdotr) - ! if (param%lencounter_sas_plpl) then - ! call encounter_check_all_sort_and_sweep_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, & - ! plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) - ! else - call encounter_check_all_triangular_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) - ! end if - - ! if (skipit) then - ! skipit = .false. - ! else - ! if (param%ladaptive_encounters_plpl .and. nplplm > 0) then - ! if (itimer%is_on) then - ! call itimer%adapt(param, nplplm) - ! skipit = .true. - ! end if - ! end if - ! end if + call encounter_check_all_triangular_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) if (plmplt_nenc > 0) then ! Consolidate the two lists allocate(itmp(nenc+plmplt_nenc)) @@ -202,37 +139,7 @@ module subroutine encounter_check_all_pltp(param, npl, ntp, rpl, vpl, xtp, vtp, logical, save :: lsecond = .false. integer(I8B) :: npltp = 0_I8B - ! if (param%ladaptive_encounters_pltp) then - ! npltp = npl * ntp - ! if (npltp > 0) then - ! if (lfirst) then - ! write(itimer%loopname, *) "encounter_check_all_pltp" - ! write(itimer%looptype, *) "ENCOUNTER_PLTP" - ! lfirst = .false. - ! lsecond = .true. - ! else - ! if (lsecond) then ! This ensures that the encounter check methods are run at least once prior to timing. Sort and sweep improves on the second pass due to the bounding box extents needing to be nearly sorted - ! call itimer%time_this_loop(param, npltp) - ! lsecond = .false. - ! else if (itimer%netcdf_io_check(param, npltp)) then - ! lsecond = .true. - ! itimer%is_on = .false. - ! end if - ! end if - ! else - ! param%lencounter_sas_pltp = .false. - ! end if - ! end if - - ! if (param%lencounter_sas_pltp) then - ! call encounter_check_all_sort_and_sweep_pltp(npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) - ! else - call encounter_check_all_triangular_pltp(npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) - ! end if - - ! if (.not.lfirst .and. param%ladaptive_encounters_pltp .and. npltp > 0) then - ! if (itimer%is_on) call itimer%adapt(param, npltp) - ! end if + call encounter_check_all_triangular_pltp(npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) return end subroutine encounter_check_all_pltp @@ -576,6 +483,7 @@ subroutine encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1 call encounter_check_collapse_ragged_list(lenc, npl, nenc, index1, index2, lvdotr) + nenc = 0 return end subroutine encounter_check_all_triangular_plpl diff --git a/src/swiftest/swiftest_kick.f90 b/src/swiftest/swiftest_kick.f90 index e7d454c12..16bb2ac31 100644 --- a/src/swiftest/swiftest_kick.f90 +++ b/src/swiftest/swiftest_kick.f90 @@ -211,9 +211,9 @@ module subroutine swiftest_kick_getacch_int_all_tri_rad_pl(npl, nplm, r, Gmass, end do else !$omp parallel do default(private) schedule(static)& - !$omp shared(npl,nplm, r, Gmass, radius, acc) + !$omp shared(npl, nplm, r, Gmass, radius, acc) do i = 1, nplm - do concurrent(j = 1:npl, j/=i) + do concurrent(j = 1:npl, i/=j) rx = r(1,j) - r(1,i) ry = r(2,j) - r(2,i) rz = r(3,j) - r(3,i) @@ -229,24 +229,26 @@ module subroutine swiftest_kick_getacch_int_all_tri_rad_pl(npl, nplm, r, Gmass, end do !$omp end parallel do - !$omp parallel do default(private) schedule(static)& - !$omp shared(npl,nplm, r, Gmass, radius, acc) - do i = nplm+1,npl - do concurrent(j = 1:nplm) - rx = r(1,j) - r(1,i) - ry = r(2,j) - r(2,i) - rz = r(3,j) - r(3,i) - rji2 = rx**2 + ry**2 + rz**2 - rlim2 = (radius(i) + radius(j))**2 - if (rji2 > rlim2) then - fac = Gmass(j) / (rji2 * sqrt(rji2)) - acc(1,i) = acc(1,i) + fac * rx - acc(2,i) = acc(2,i) + fac * ry - acc(3,i) = acc(3,i) + fac * rz - end if + if (nplt > 0) then + !$omp parallel do default(private) schedule(static)& + !$omp shared(npl, nplm, r, Gmass, radius, acc) + do i = nplm+1,npl + do concurrent(j = 1:nplm) + rx = r(1,j) - r(1,i) + ry = r(2,j) - r(2,i) + rz = r(3,j) - r(3,i) + rji2 = rx**2 + ry**2 + rz**2 + rlim2 = (radius(i) + radius(j))**2 + if (rji2 > rlim2) then + fac = Gmass(j) / (rji2 * sqrt(rji2)) + acc(1,i) = acc(1,i) + fac * rx + acc(2,i) = acc(2,i) + fac * ry + acc(3,i) = acc(3,i) + fac * rz + end if + end do end do - end do - !$omp end parallel do + !$omp end parallel do + end if end if @@ -301,7 +303,7 @@ module subroutine swiftest_kick_getacch_int_all_tri_norad_pl(npl, nplm, r, Gmass end do else !$omp parallel do default(private) schedule(static)& - !$omp shared(npl,nplm, r, Gmass, acc) + !$omp shared(npl, nplm, r, Gmass, acc) do i = 1, nplm do concurrent(j = 1:npl, j/=i) rx = r(1,j) - r(1,i) @@ -316,21 +318,23 @@ module subroutine swiftest_kick_getacch_int_all_tri_norad_pl(npl, nplm, r, Gmass end do !$omp end parallel do - !$omp parallel do default(private) schedule(static)& - !$omp shared(npl,nplm, r, Gmass, acc) - do i = nplm+1,npl - do concurrent(j = 1:nplm) - rx = r(1,j) - r(1,i) - ry = r(2,j) - r(2,i) - rz = r(3,j) - r(3,i) - rji2 = rx**2 + ry**2 + rz**2 - fac = Gmass(j) / (rji2 * sqrt(rji2)) - acc(1,i) = acc(1,i) + fac * rx - acc(2,i) = acc(2,i) + fac * ry - acc(3,i) = acc(3,i) + fac * rz + if (nplt > 0) then + !$omp parallel do default(private) schedule(static)& + !$omp shared(npl, nplm, r, Gmass, acc) + do i = nplm+1,npl + do concurrent(j = 1:nplm) + rx = r(1,j) - r(1,i) + ry = r(2,j) - r(2,i) + rz = r(3,j) - r(3,i) + rji2 = rx**2 + ry**2 + rz**2 + fac = Gmass(j) / (rji2 * sqrt(rji2)) + acc(1,i) = acc(1,i) + fac * rx + acc(2,i) = acc(2,i) + fac * ry + acc(3,i) = acc(3,i) + fac * rz + end do end do - end do - !$omp end parallel do + !$omp end parallel do + end if end if