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

Commit

Permalink
Updated coarray branch with modification that will help make coarrays…
Browse files Browse the repository at this point in the history 
… work (eventually)
  • Loading branch information
@daminton
daminton committed Mar 20, 2023
1 parent 3841cd3 commit 5df51a6
Show file tree
Hide file tree
Showing 9 changed files with 257 additions and 256 deletions.
2 changes: 1 addition & 1 deletion CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ ENDIF(NOT CMAKE_Fortran_COMPILER_SUPPORTS_F90)

# Set some options the user may choose
# Uncomment the below if you want the user to choose a parallelization library
OPTION(USE_MPI "Use the MPI library for parallelization" ON)
OPTION(USE_CAF "Use Coarray Fortran for parallelization" ON)
OPTION(USE_OPENMP "Use OpenMP for parallelization" ON)


Expand Down
24 changes: 7 additions & 17 deletions cmake/Modules/SetParallelizationLibrary.cmake
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,11 +7,6 @@
# You should have received a copy of the GNU General Public License along with Swiftest.
# If not, see: https://www.gnu.org/licenses.

# Turns on either OpenMP or MPI
# If both are requested, the other is disabled
# When one is turned on, the other is turned off
# If both are off, we explicitly disable them just in case

IF (USE_OPENMP)
# Find OpenMP
IF (NOT OpenMP_Fortran_FLAGS)
Expand All @@ -20,28 +15,23 @@ IF (USE_OPENMP)
MESSAGE (FATAL_ERROR "Fortran compiler does not support OpenMP")
ENDIF (NOT OpenMP_Fortran_FLAGS)
ENDIF (NOT OpenMP_Fortran_FLAGS)
# Turn of MPI
ENDIF (USE_OPENMP)

IF (USE_MPI)
IF (USE_CAF)
# Find MPI
IF (NOT MPI_Fortran_FOUND)
FIND_PACKAGE (MPI REQUIRED)
IF (NOT Coarray_Fortran_FLAGS)
FIND_PACKAGE (Coarray_Fortran)
IF (NOT Coarray_Fortran_FLAGS)
MESSAGE (FATAL_ERROR "Fortran compiler does not support Coarrays")
ENDIF (NOT Coarray_Fortran_FLAGS)
ENDIF (NOT MPI_Fortran_FOUND)
ENDIF (USE_MPI)
ENDIF (NOT Coarray_Fortran_FLAGS)
ENDIF (USE_CAF)

IF (NOT USE_OPENMP AND NOT USE_MPI)
# Turn off both OpenMP and MPI
IF (NOT USE_OPENMP AND NOT USE_CAF)
# Turn off both OpenMP and CAF
SET (OMP_NUM_PROCS 0 CACHE
STRING "Number of processors OpenMP may use" FORCE)
UNSET (OpenMP_Fortran_FLAGS CACHE)
UNSET (Coarray_Fortran_FLAGS CACHE)
UNSET (GOMP_Fortran_LINK_FLAGS CACHE)
UNSET (MPI_FOUND CACHE)
UNSET (MPI_COMPILER CACHE)
UNSET (MPI_LIBRARY CACHE)
ENDIF (NOT USE_OPENMP AND NOT USE_MPI)
ENDIF (NOT USE_OPENMP AND NOT USE_CAF)
10 changes: 4 additions & 6 deletions src/CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -101,13 +101,11 @@ IF(USE_OPENMP)
LINK_FLAGS "${OpenMP_Fortran_FLAGS}")
ENDIF(USE_OPENMP)

IF(USE_MPI)
IF(USE_CAF)
SET_TARGET_PROPERTIES(${SWIFTEST_DRIVER} PROPERTIES
COMPILE_FLAGS "${MPI_Fortran_COMPILE_FLAGS} ${Coarray_Fortran_FLAGS}"
LINK_FLAGS "${MPI_Fortran_LINK_FLAGS} ${Coarray_Fortran_FLAGS}")
INCLUDE_DIRECTORIES(${MPI_Fortran_INCLUDE_PATH})
TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} ${MPI_Fortran_LIBRARIES})
ENDIF(USE_MPI)
COMPILE_FLAGS "${Coarray_Fortran_FLAGS}"
LINK_FLAGS "${Coarray_Fortran_FLAGS}")
ENDIF(USE_CAF)


#####################################
Expand Down
2 changes: 1 addition & 1 deletion src/rmvs/rmvs_module.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,7 @@ module rmvs
integer(I4B), dimension(:), allocatable :: plind !! Connects the planetocentric indices back to the heliocentric planet list
type(rmvs_interp), dimension(:), allocatable :: outer !! interpolated heliocentric central body position for outer encounters
type(rmvs_interp), dimension(:), allocatable :: inner !! interpolated heliocentric central body position for inner encounters
class(swiftest_nbody_system), dimension(:), allocatable :: planetocentric !! Planetocentric version of the massive body objects (one for each massive body)
class(base_nbody_system), dimension(:), allocatable :: planetocentric !! Planetocentric version of the massive body objects (one for each massive body)
logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations
contains
procedure :: setup => rmvs_util_setup_pl !! Constructor method - Allocates space for the input number of bodiess
Expand Down
186 changes: 96 additions & 90 deletions src/rmvs/rmvs_step.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -451,64 +451,67 @@ subroutine rmvs_make_planetocentric(param, cb, pl, tp)
if (allocated(encmask)) deallocate(encmask)
allocate(encmask(ntp))
encmask(1:ntp) = tp%plencP(1:ntp) == i
allocate(rmvs_tp :: pl%planetocentric(i)%tp)
! Create encountering test particle structure
select type(cbenci => pl%planetocentric(i)%cb)
class is (rmvs_cb)
select type(plenci => pl%planetocentric(i)%pl)
class is (rmvs_pl)
select type(tpenci => pl%planetocentric(i)%tp)
class is (rmvs_tp)
tpenci%lplanetocentric = .true.
associate(nenci => pl%nenc(i))
call tpenci%setup(nenci, param)
tpenci%cb_heliocentric = cb
tpenci%ipleP = i
tpenci%lmask(1:nenci) = .true.
tpenci%status(1:nenci) = ACTIVE
! Grab all the encountering test particles and convert them to a planetocentric frame
tpenci%id(1:nenci) = pack(tp%id(1:ntp), encmask(1:ntp))
do j = 1, NDIM
tpenci%rheliocentric(j, 1:nenci) = pack(tp%rh(j,1:ntp), encmask(:))
tpenci%rh(j, 1:nenci) = tpenci%rheliocentric(j, 1:nenci) - pl%inner(0)%x(j, i)
tpenci%vh(j, 1:nenci) = pack(tp%vh(j, 1:ntp), encmask(1:ntp)) - pl%inner(0)%v(j, i)
end do
tpenci%lperi(1:nenci) = pack(tp%lperi(1:ntp), encmask(1:ntp))
tpenci%plperP(1:nenci) = pack(tp%plperP(1:ntp), encmask(1:ntp))
! Make sure that the test particles get the planetocentric value of mu
allocate(cbenci%inner(0:NTPHENC))
do inner_index = 0, NTPHENC
allocate(plenci%inner(inner_index)%x, mold=pl%inner(inner_index)%x)
allocate(plenci%inner(inner_index)%v, mold=pl%inner(inner_index)%x)
allocate(cbenci%inner(inner_index)%x(NDIM,1))
allocate(cbenci%inner(inner_index)%v(NDIM,1))
cbenci%inner(inner_index)%x(:,1) = pl%inner(inner_index)%x(:, i)
cbenci%inner(inner_index)%v(:,1) = pl%inner(inner_index)%v(:, i)
plenci%inner(inner_index)%x(:,1) = -cbenci%inner(inner_index)%x(:,1)
plenci%inner(inner_index)%v(:,1) = -cbenci%inner(inner_index)%v(:,1)

if (param%loblatecb) then
allocate(plenci%inner(inner_index)%aobl, mold=pl%inner(inner_index)%aobl)
allocate(cbenci%inner(inner_index)%aobl(NDIM,1))
cbenci%inner(inner_index)%aobl(:,1) = pl%inner(inner_index)%aobl(:, i)
end if

if (param%ltides) then
allocate(plenci%inner(inner_index)%atide, mold=pl%inner(inner_index)%atide)
allocate(cbenci%inner(inner_index)%atide(NDIM,1))
cbenci%inner(inner_index)%atide(:,1) = pl%inner(inner_index)%atide(:, i)
end if

do j = 2, npl
ipc2hc = plenci%plind(j)
plenci%inner(inner_index)%x(:,j) = pl%inner(inner_index)%x(:, ipc2hc) &
- cbenci%inner(inner_index)%x(:,1)
plenci%inner(inner_index)%v(:,j) = pl%inner(inner_index)%v(:, ipc2hc) &
- cbenci%inner(inner_index)%v(:,1)
select type (planetocentric => pl%planetocentric)
class is(rmvs_nbody_system)
allocate(rmvs_tp :: planetocentric(i)%tp)
! Create encountering test particle structure
select type(cbenci => planetocentric(i)%cb)
class is (rmvs_cb)
select type(plenci => planetocentric(i)%pl)
class is (rmvs_pl)
select type(tpenci => planetocentric(i)%tp)
class is (rmvs_tp)
tpenci%lplanetocentric = .true.
associate(nenci => pl%nenc(i))
call tpenci%setup(nenci, param)
tpenci%cb_heliocentric = cb
tpenci%ipleP = i
tpenci%lmask(1:nenci) = .true.
tpenci%status(1:nenci) = ACTIVE
! Grab all the encountering test particles and convert them to a planetocentric frame
tpenci%id(1:nenci) = pack(tp%id(1:ntp), encmask(1:ntp))
do j = 1, NDIM
tpenci%rheliocentric(j, 1:nenci) = pack(tp%rh(j,1:ntp), encmask(:))
tpenci%rh(j, 1:nenci) = tpenci%rheliocentric(j, 1:nenci) - pl%inner(0)%x(j, i)
tpenci%vh(j, 1:nenci) = pack(tp%vh(j, 1:ntp), encmask(1:ntp)) - pl%inner(0)%v(j, i)
end do
tpenci%lperi(1:nenci) = pack(tp%lperi(1:ntp), encmask(1:ntp))
tpenci%plperP(1:nenci) = pack(tp%plperP(1:ntp), encmask(1:ntp))
! Make sure that the test particles get the planetocentric value of mu
allocate(cbenci%inner(0:NTPHENC))
do inner_index = 0, NTPHENC
allocate(plenci%inner(inner_index)%x, mold=pl%inner(inner_index)%x)
allocate(plenci%inner(inner_index)%v, mold=pl%inner(inner_index)%x)
allocate(cbenci%inner(inner_index)%x(NDIM,1))
allocate(cbenci%inner(inner_index)%v(NDIM,1))
cbenci%inner(inner_index)%x(:,1) = pl%inner(inner_index)%x(:, i)
cbenci%inner(inner_index)%v(:,1) = pl%inner(inner_index)%v(:, i)
plenci%inner(inner_index)%x(:,1) = -cbenci%inner(inner_index)%x(:,1)
plenci%inner(inner_index)%v(:,1) = -cbenci%inner(inner_index)%v(:,1)

if (param%loblatecb) then
allocate(plenci%inner(inner_index)%aobl, mold=pl%inner(inner_index)%aobl)
allocate(cbenci%inner(inner_index)%aobl(NDIM,1))
cbenci%inner(inner_index)%aobl(:,1) = pl%inner(inner_index)%aobl(:, i)
end if

if (param%ltides) then
allocate(plenci%inner(inner_index)%atide, mold=pl%inner(inner_index)%atide)
allocate(cbenci%inner(inner_index)%atide(NDIM,1))
cbenci%inner(inner_index)%atide(:,1) = pl%inner(inner_index)%atide(:, i)
end if

do j = 2, npl
ipc2hc = plenci%plind(j)
plenci%inner(inner_index)%x(:,j) = pl%inner(inner_index)%x(:, ipc2hc) &
- cbenci%inner(inner_index)%x(:,1)
plenci%inner(inner_index)%v(:,j) = pl%inner(inner_index)%v(:, ipc2hc) &
- cbenci%inner(inner_index)%v(:,1)
end do
end do
end do
call tpenci%set_mu(cbenci)
end associate
call tpenci%set_mu(cbenci)
end associate
end select
end select
end select
end select
Expand Down Expand Up @@ -611,39 +614,42 @@ subroutine rmvs_end_planetocentric(pl, tp)
associate (npl => pl%nbody, ntp => tp%nbody)
do i = 1, npl
if (pl%nenc(i) == 0) cycle
select type(cbenci => pl%planetocentric(i)%cb)
class is (rmvs_cb)
select type(plenci => pl%planetocentric(i)%pl)
class is (rmvs_pl)
select type(tpenci => pl%planetocentric(i)%tp)
class is (rmvs_tp)
associate(nenci => pl%nenc(i))
if (allocated(tpind)) deallocate(tpind)
allocate(tpind(nenci))
! Index array of encountering test particles
if (allocated(encmask)) deallocate(encmask)
allocate(encmask(ntp))
encmask(1:ntp) = tp%plencP(1:ntp) == i
tpind(1:nenci) = pack([(j,j=1,ntp)], encmask(1:ntp))

! Copy the results of the integration back over and shift back to heliocentric reference
tp%status(tpind(1:nenci)) = tpenci%status(1:nenci)
tp%lmask(tpind(1:nenci)) = tpenci%lmask(1:nenci)
do j = 1, NDIM
tp%rh(j, tpind(1:nenci)) = tpenci%rh(j,1:nenci) + pl%inner(NTPHENC)%x(j, i)
tp%vh(j, tpind(1:nenci)) = tpenci%vh(j,1:nenci) + pl%inner(NTPHENC)%v(j, i)
end do
tp%lperi(tpind(1:nenci)) = tpenci%lperi(1:nenci)
tp%plperP(tpind(1:nenci)) = tpenci%plperP(1:nenci)
deallocate(pl%planetocentric(i)%tp)
deallocate(cbenci%inner)
do inner_index = 0, NTPHENC
deallocate(plenci%inner(inner_index)%x)
deallocate(plenci%inner(inner_index)%v)
if (allocated(plenci%inner(inner_index)%aobl)) deallocate(plenci%inner(inner_index)%aobl)
if (allocated(plenci%inner(inner_index)%atide)) deallocate(plenci%inner(inner_index)%atide)
end do
end associate
select type(planetocentric => pl%planetocentric)
class is(rmvs_nbody_system)
select type(cbenci => planetocentric(i)%cb)
class is (rmvs_cb)
select type(plenci => planetocentric(i)%pl)
class is (rmvs_pl)
select type(tpenci => planetocentric(i)%tp)
class is (rmvs_tp)
associate(nenci => pl%nenc(i))
if (allocated(tpind)) deallocate(tpind)
allocate(tpind(nenci))
! Index array of encountering test particles
if (allocated(encmask)) deallocate(encmask)
allocate(encmask(ntp))
encmask(1:ntp) = tp%plencP(1:ntp) == i
tpind(1:nenci) = pack([(j,j=1,ntp)], encmask(1:ntp))

! Copy the results of the integration back over and shift back to heliocentric reference
tp%status(tpind(1:nenci)) = tpenci%status(1:nenci)
tp%lmask(tpind(1:nenci)) = tpenci%lmask(1:nenci)
do j = 1, NDIM
tp%rh(j, tpind(1:nenci)) = tpenci%rh(j,1:nenci) + pl%inner(NTPHENC)%x(j, i)
tp%vh(j, tpind(1:nenci)) = tpenci%vh(j,1:nenci) + pl%inner(NTPHENC)%v(j, i)
end do
tp%lperi(tpind(1:nenci)) = tpenci%lperi(1:nenci)
tp%plperP(tpind(1:nenci)) = tpenci%plperP(1:nenci)
deallocate(planetocentric(i)%tp)
deallocate(cbenci%inner)
do inner_index = 0, NTPHENC
deallocate(plenci%inner(inner_index)%x)
deallocate(plenci%inner(inner_index)%v)
if (allocated(plenci%inner(inner_index)%aobl)) deallocate(plenci%inner(inner_index)%aobl)
if (allocated(plenci%inner(inner_index)%atide)) deallocate(plenci%inner(inner_index)%atide)
end do
end associate
end select
end select
end select
end select
Expand Down
Loading

0 comments on commit 5df51a6

Please sign in to comment.