Skip to content
This repository was archived by the owner on Aug 28, 2024. It is now read-only.

Commit

Permalink
Merge branch 'newkick' into debug
Browse files Browse the repository at this point in the history
  • Loading branch information
@daminton
daminton committed Mar 7, 2023
2 parents d8a14a0 + 9351997 commit a3d8914
Show file tree
Hide file tree
Showing 2 changed files with 43 additions and 131 deletions.
102 changes: 5 additions & 97 deletions src/encounter/encounter_check.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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))
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
72 changes: 38 additions & 34 deletions src/swiftest/swiftest_kick.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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, j/=i)
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

Expand Down Expand Up @@ -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)
Expand All @@ -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, j/=i)
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

Expand Down

0 comments on commit a3d8914

Please sign in to comment.