diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 0def91f34..7dade4335 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -85,6 +85,7 @@ SET(FAST_MATH_FILES SET(COARRAY_FILES ${SRC}/coarray/coarray_module.f90 + ${SRC}/swiftest/swiftest_coarray.f90 ) IF(USE_COARRAY) diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index d9d456958..f40f3e67e 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -114,7 +114,7 @@ module base procedure(abstract_io_param_writer), deferred :: writer procedure(abstract_io_read_in_param), deferred :: read_in #ifdef COARRAY - procedure :: cobroadcast => base_cobroadcast_param + procedure :: coclone => base_coclone_param #endif end type base_parameters @@ -433,7 +433,7 @@ subroutine base_final_storage_frame(self) end subroutine base_final_storage_frame #ifdef COARRAY - subroutine base_cobroadcast_param(self) + subroutine base_coclone_param(self) !! author: David A. Minton !! !! Broadcasts the image 1 parameter to all other images in a parameter coarray @@ -523,7 +523,7 @@ subroutine base_cobroadcast_param(self) call coclone(self%seed) return - end subroutine base_cobroadcast_param + end subroutine base_coclone_param #endif diff --git a/src/coarray/coarray_module.f90 b/src/coarray/coarray_module.f90 index a8b9f02ab..b174e1b34 100644 --- a/src/coarray/coarray_module.f90 +++ b/src/coarray/coarray_module.f90 @@ -20,10 +20,12 @@ module coarray module procedure coarray_component_copy_char module procedure coarray_component_copy_DP module procedure coarray_component_copy_DP_arr1D + module procedure coarray_component_copy_DP_arr2D module procedure coarray_component_copy_I4B module procedure coarray_component_copy_I4B_arr1D module procedure coarray_component_copy_I8B module procedure coarray_component_copy_lgt + module procedure coarray_component_copy_lgt_arr1D module procedure coarray_component_copy_QP end interface @@ -97,7 +99,7 @@ subroutine coarray_component_copy_DP_arr1D(var,src_img) !! author: David A. Minton !! !! Copies a component of a coarray derived type from the specified source image to the current local one. The default source image is 1 - !! real(DP) allocatable array version + !! real(DP) 1D allocatable array version implicit none ! Arguments real(DP), dimension(:), allocatable, intent(inout) :: var @@ -206,7 +208,7 @@ subroutine coarray_component_copy_I4B_arr1D(var,src_img) !! author: David A. Minton !! !! Copies a component of a coarray derived type from the specified source image to the current local one. The default source image is 1 - !! integer(I4B) allocatable array version + !! integer(I4B) 1D allocatable array version implicit none ! Arguments integer(I4B), dimension(:), allocatable, intent(inout) :: var @@ -302,6 +304,43 @@ subroutine coarray_component_copy_lgt(var,src_img) end subroutine coarray_component_copy_lgt + subroutine coarray_component_copy_lgt_arr1D(var,src_img) + !! author: David A. Minton + !! + !! Copies a component of a coarray derived type from the specified source image to the current local one. The default source image is 1 + !! logical 1D allocatable array version + implicit none + ! Arguments + logical, dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + logical, dimension(:), codimension[:], allocatable :: tmp + integer(I4B) :: img, si + integer(I4B), save :: n[*] + + if (present(src_img)) then + si = src_img + else + si = 1 + end if + + n = size(var) + sync all + allocate(tmp(n[si])[*]) + if (this_image() == si) then + do img = 1, num_images() + tmp(:)[img] = var + end do + end if + sync all + if (allocated(var)) deallocate(var) + allocate(var, source=tmp) + + return + end subroutine coarray_component_copy_lgt_arr1D + + + subroutine coarray_component_copy_QP(var,src_img) !! author: David A. Minton !! diff --git a/src/swiftest/swiftest_coarray.f90 b/src/swiftest/swiftest_coarray.f90 new file mode 100644 index 000000000..c9db7077c --- /dev/null +++ b/src/swiftest/swiftest_coarray.f90 @@ -0,0 +1,203 @@ +!! Copyright 2023 - David Minton +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (swiftest) s_swiftest_coarray + use coarray +contains + + module subroutine swiftest_coarray_coclone_body(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 object to all other images in a coarray + implicit none + ! Arguments + class(swiftest_body),intent(inout),codimension[*] :: self !! Swiftest body object + + call coclone(self%lfirst) + call coclone(self%nbody) + call coclone(self%id) + call coclone(self%info) + call coclone(self%lmask) + call coclone(self%status) + call coclone(self%ldiscard) + call coclone(self%lcollision) + call coclone(self%lencounter) + call coclone(self%mu) + call coclone(self%rh) + call coclone(self%vh) + call coclone(self%rb) + call coclone(self%vb) + call coclone(self%ah) + call coclone(self%aobl) + call coclone(self%agr) + call coclone(self%atide) + call coclone(self%ir3h) + call coclone(self%isperi) + call coclone(self%peri) + call coclone(self%atp) + call coclone(self%a) + call coclone(self%e) + call coclone(self%inc) + call coclone(self%capom) + call coclone(self%omega) + call coclone(self%capm) + + return + end subroutine swiftest_coarray_coclone_body + + + module subroutine swiftest_coarray_component_copy_info(var,src_img) + !! author: David A. Minton + !! + !! Copies a component of a coarray derived type from the specified source image to the current local one. The default source image is 1 + !! swiftest_particle_info scalar version + implicit none + ! Arguments + type(swiftest_particle_info), intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + type(swiftest_particle_info),save :: tmp[*] + integer(I4B) :: img, si + + if (present(src_img)) then + si = src_img + else + si = 1 + end if + + sync all + if (this_image() == si) then + do img = 1, num_images() + tmp[img] = var + end do + end if + sync all + var = tmp[si] + + return + + end subroutine swiftest_coarray_component_copy_info + + + module subroutine swiftest_coarray_component_copy_info_arr1D(var,src_img) + !! author: David A. Minton + !! + !! Copies a component of a coarray derived type from the specified source image to the current local one. The default source image is 1 + !! swiftest_particle_info 1D allocatable array version + implicit none + ! Arguments + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + type(swiftest_particle_info), dimension(:), codimension[:], allocatable :: tmp + integer(I4B) :: img, si + integer(I4B), save :: n[*] + + if (present(src_img)) then + si = src_img + else + si = 1 + end if + + n = size(var) + sync all + allocate(tmp(n[si])[*]) + if (this_image() == si) then + do img = 1, num_images() + tmp(:)[img] = var + end do + end if + sync all + if (allocated(var)) deallocate(var) + allocate(var, source=tmp) + + return + end subroutine swiftest_coarray_component_copy_info_arr1D + + + module subroutine swiftest_coarray_collect_system(nbody_system) + !! author: David A. Minton + !! + !! Collects all the test particles from other images into the image #1 test particle system + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: nbody_system[*] + ! Internals + integer(I4B) :: i,j + integer(I4B), dimension(num_images()) :: ntp + class(swiftest_tp), allocatable :: tp_img + + ! ntp(this_image()) = nbody_system%tp%nbody + ! sync all + ! if (this_image() == 1) then + ! write(*,*) "Collecting test particles" + ! write(*,*) "Image ",1," ntp: ",ntp(1) + ! do i = 2, num_images() + ! write(*,*) "Image ",i," ntp: ",ntp(i) + ! allocate(tp_img, source=nbody_system[i]%tp) + ! call nbody_system%tp%append(tp_img,lsource_mask=[(.true., j = 1, ntp(i))]) + ! deallocate(tp_img) + ! end do + ! write(*,*) "Total test particles: ",nbody_system%tp%nbody + ! end if + + return + end subroutine swiftest_coarray_collect_system + + + module subroutine swiftest_coarray_distribute_system(nbody_system) + !! author: David A. Minton + !! + !! Distributes test particles from image #1 out to all images. + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: nbody_system[*] + ! Internals + integer(I4B) :: i, istart, iend, ntot, num_per_image, ncopy + class(swiftest_tp), allocatable :: tp_orig + logical, dimension(:), allocatable :: lspill_list + integer(I4B), codimension[*],save :: ntp + class(swiftest_nbody_system), allocatable :: tmp_system + class(swiftest_tp), allocatable :: tp + + ! ntp = nbody_system%tp%nbody + ! sync all + + ! ntot = ntp[1] + ! if (ntot == 0) return + + ! allocate(tp, mold=nbody_system%tp) + + ! write(*,*) "Image ",this_image(), "Distributing ",ntot + ! allocate(lspill_list(ntot)) + ! num_per_image = ntot / num_images() + ! istart = (this_image() - 1) * num_per_image + 1 + ! if (this_image() == num_images()) then + ! iend = ntot + ! else + ! iend = this_image() * num_per_image + ! end if + + ! if (this_image() == 1) then + ! lspill_list(:) = .true. + ! lspill_list(istart:iend) = .false. + ! call nbody_system%tp%spill(tp,lspill_list(:), ldestructive=.true.) + ! else + ! lspill_list(:) = .false. + ! lspill_list(istart:iend) = .true. + ! tp%nbody = ntot + ! call nbody_system%tp%spill(tp,lspill_list(:), ldestructive=.true.) + ! end if + + ! write(*,*) "Image ",this_image(), "ntp: ",nbody_system%tp%nbody + + return + end subroutine swiftest_coarray_distribute_system + +end submodule s_swiftest_coarray \ No newline at end of file diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 928f6eccd..610f623d1 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -2320,7 +2320,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i end associate #ifdef COARRAY end if ! this_image() == 1 - call coparam%cobroadcast() + call coparam%coclone() select type(self) type is (swiftest_parameters) self = coparam diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 55f63ec6f..fc5819ac1 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -43,6 +43,9 @@ module swiftest use io_progress_bar use netcdf_io use solver +#ifdef COARRAY + use coarray +#endif !use advisor_annotate !$ use omp_lib implicit none @@ -155,6 +158,9 @@ module swiftest procedure :: rearrange => swiftest_util_sort_rearrange_body !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => swiftest_util_spill_body !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) generic :: read_frame => read_frame_bin !! Add the generic read frame for Fortran binary files +#ifdef COARRAY + procedure :: coclone => swiftest_coarray_coclone_body !! Clones the image 1 body object to all other images in the coarray structure. +#endif end type swiftest_body @@ -393,8 +399,8 @@ module swiftest procedure :: write_frame_system => swiftest_io_write_frame_system !! Write a frame of input data from file procedure :: obl_pot => swiftest_obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body #ifdef COARRAY - procedure :: coarray_collect => swiftest_util_coarray_collect_system !! Collects all the test particles from other images into the image #1 test particle system - procedure :: coarray_distribute => swiftest_util_coarray_distribute_system !! Distributes test particles from image #1 out to all images. + procedure :: coarray_collect => swiftest_coarray_collect_system !! Collects all the test particles from other images into the image #1 test particle system + procedure :: coarray_distribute => swiftest_coarray_distribute_system !! Distributes test particles from image #1 out to all images. #endif procedure :: dealloc => swiftest_util_dealloc_system !! Deallocates all allocatables and resets all values to defaults. Acts as a base for a finalizer procedure :: get_energy_and_momentum => swiftest_util_get_energy_and_momentum_system !! Calculates the total nbody_system energy and momentum @@ -447,11 +453,11 @@ end subroutine abstract_set_mu subroutine abstract_step_body(self, nbody_system, param, t, dt) import DP, swiftest_body, swiftest_nbody_system, swiftest_parameters implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(inout) :: self !! Swiftest body object class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Simulation time - real(DP), intent(in) :: dt !! Current stepsize + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Simulation time + real(DP), intent(in) :: dt !! Current stepsize end subroutine abstract_step_body subroutine abstract_step_system(self, param, t, dt) @@ -464,7 +470,6 @@ subroutine abstract_step_system(self, param, t, dt) end subroutine abstract_step_system end interface - interface module subroutine swiftest_discard_pl(self, nbody_system, param) implicit none @@ -1187,18 +1192,6 @@ module subroutine swiftest_util_append_tp(self, source, lsource_mask) logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to end subroutine swiftest_util_append_tp -#ifdef COARRAY - module subroutine swiftest_util_coarray_collect_system(nbody_system) - implicit none - class(swiftest_nbody_system), intent(inout) :: nbody_system[*] - end subroutine swiftest_util_coarray_collect_system - - module subroutine swiftest_util_coarray_distribute_system(nbody_system) - implicit none - class(swiftest_nbody_system), intent(inout) :: nbody_system[*] - end subroutine swiftest_util_coarray_distribute_system -#endif - module subroutine swiftest_util_coord_b2h_pl(self, cb) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object @@ -1957,6 +1950,41 @@ module subroutine swiftest_util_version() end subroutine swiftest_util_version end interface +#ifdef COARRAY + interface + module subroutine swiftest_coarray_collect_system(nbody_system) + implicit none + class(swiftest_nbody_system), intent(inout) :: nbody_system[*] + end subroutine swiftest_coarray_collect_system + + module subroutine swiftest_coarray_distribute_system(nbody_system) + implicit none + class(swiftest_nbody_system), intent(inout) :: nbody_system[*] + end subroutine swiftest_coarray_distribute_system + end interface + + interface coclone + module subroutine swiftest_coarray_component_copy_info(var,src_img) + implicit none + type(swiftest_particle_info), intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + end subroutine swiftest_coarray_component_copy_info + + module subroutine swiftest_coarray_component_copy_info_arr1D(var,src_img) + implicit none + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + end subroutine swiftest_coarray_component_copy_info_arr1D + end interface + + interface + module subroutine swiftest_coarray_coclone_body(self) + implicit none + class(swiftest_body),intent(inout),codimension[*] :: self !! Swiftest body object + end subroutine swiftest_coarray_coclone_body + end interface +#endif + contains subroutine swiftest_final_kin(self) !! author: David A. Minton diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 44c3bc17f..7e5bd548a 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -354,86 +354,6 @@ module subroutine swiftest_util_append_tp(self, source, lsource_mask) return end subroutine swiftest_util_append_tp -#ifdef COARRAY - module subroutine swiftest_util_coarray_collect_system(nbody_system) - !! author: David A. Minton - !! - !! Collects all the test particles from other images into the image #1 test particle system - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: nbody_system[*] - ! Internals - integer(I4B) :: i,j - integer(I4B), dimension(num_images()) :: ntp - class(swiftest_tp), allocatable :: tp_img - - ! ntp(this_image()) = nbody_system%tp%nbody - ! sync all - ! if (this_image() == 1) then - ! write(*,*) "Collecting test particles" - ! write(*,*) "Image ",1," ntp: ",ntp(1) - ! do i = 2, num_images() - ! write(*,*) "Image ",i," ntp: ",ntp(i) - ! allocate(tp_img, source=nbody_system[i]%tp) - ! call nbody_system%tp%append(tp_img,lsource_mask=[(.true., j = 1, ntp(i))]) - ! deallocate(tp_img) - ! end do - ! write(*,*) "Total test particles: ",nbody_system%tp%nbody - ! end if - - return - end subroutine swiftest_util_coarray_collect_system - - - module subroutine swiftest_util_coarray_distribute_system(nbody_system) - !! author: David A. Minton - !! - !! Distributes test particles from image #1 out to all images. - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: nbody_system[*] - ! Internals - integer(I4B) :: i, istart, iend, ntot, num_per_image, ncopy - class(swiftest_tp), allocatable :: tp_orig - logical, dimension(:), allocatable :: lspill_list - integer(I4B), codimension[*],save :: ntp - class(swiftest_nbody_system), allocatable :: tmp_system - class(swiftest_tp), allocatable :: tp - - ! ntp = nbody_system%tp%nbody - ! sync all - - ! ntot = ntp[1] - ! if (ntot == 0) return - - ! allocate(tp, mold=nbody_system%tp) - - ! write(*,*) "Image ",this_image(), "Distributing ",ntot - ! allocate(lspill_list(ntot)) - ! num_per_image = ntot / num_images() - ! istart = (this_image() - 1) * num_per_image + 1 - ! if (this_image() == num_images()) then - ! iend = ntot - ! else - ! iend = this_image() * num_per_image - ! end if - - ! if (this_image() == 1) then - ! lspill_list(:) = .true. - ! lspill_list(istart:iend) = .false. - ! call nbody_system%tp%spill(tp,lspill_list(:), ldestructive=.true.) - ! else - ! lspill_list(:) = .false. - ! lspill_list(istart:iend) = .true. - ! tp%nbody = ntot - ! call nbody_system%tp%spill(tp,lspill_list(:), ldestructive=.true.) - ! end if - - ! write(*,*) "Image ",this_image(), "ntp: ",nbody_system%tp%nbody - - return - end subroutine swiftest_util_coarray_distribute_system -#endif module subroutine swiftest_util_coord_h2b_pl(self, cb) !! author: David A. Minton