From 7b4857841ddbbd587554f3661d1def8678f27850 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 4 Apr 2023 17:11:14 -0400 Subject: [PATCH] Created coarray infrastructure that is the basis for being able to broadcast particle data between coarray images --- src/CMakeLists.txt | 10 +- src/base/base_module.f90 | 116 ++++++++++- src/coarray/coarray_module.f90 | 336 +++++++++++++++++++++++++++++++ src/rmvs/rmvs_util.f90 | 10 +- src/swiftest/swiftest_driver.f90 | 35 ++-- src/swiftest/swiftest_io.f90 | 27 ++- src/swiftest/swiftest_module.f90 | 19 +- src/swiftest/swiftest_util.f90 | 87 +++++--- 8 files changed, 561 insertions(+), 79 deletions(-) create mode 100644 src/coarray/coarray_module.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 0ad615170..0def91f34 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -83,7 +83,15 @@ SET(FAST_MATH_FILES ${SRC}/swiftest/swiftest_driver.f90 ) -set(SWIFTEST_src ${FAST_MATH_FILES} ${STRICT_MATH_FILES}) +SET(COARRAY_FILES + ${SRC}/coarray/coarray_module.f90 +) + +IF(USE_COARRAY) + set(SWIFTEST_src ${COARRAY_FILES} ${FAST_MATH_FILES} ${STRICT_MATH_FILES}) +ELSE() + set(SWIFTEST_src ${FAST_MATH_FILES} ${STRICT_MATH_FILES}) +ENDIF(USE_COARRAY) # Define the executable in terms of the source files ADD_EXECUTABLE(${SWIFTEST_DRIVER} ${SWIFTEST_src}) diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index 042c53909..99b0cd145 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -13,15 +13,17 @@ module base !! Base type definitions. This allows the collision and encounter modules to be defined before the swiftest module. !! use globals +#ifdef COARRAY + use coarray +#endif implicit none public - !> User defined parameters that are read in from the parameters input file. !> Each paramter is initialized to a default values. type, abstract :: base_parameters - character(len=:), allocatable :: integrator !! Name of the nbody integrator used - character(len=:), allocatable :: param_file_name !! The name of the parameter file + character(STRMAX) :: integrator !! Name of the nbody integrator used + character(STRMAX) :: param_file_name !! The name of the parameter file real(DP) :: t0 = 0.0_DP !! Integration reference time real(DP) :: tstart = -1.0_DP !! Integration start time real(DP) :: tstop = -1.0_DP !! Integration stop time @@ -97,9 +99,9 @@ module base logical :: lfirstkick = .true. !! Initiate the first kick in a symplectic step logical :: lrestart = .false. !! Indicates whether or not this is a restarted run - character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" - integer(I4B) :: display_unit !! File unit number for display (either to stdout or to a log file) - logical :: log_output = .false. !! Logs the output to file instead of displaying it on the terminal + character(NAMELEN) :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + integer(I4B) :: display_unit !! File unit number for display (either to stdout or to a log file) + logical :: log_output = .false. !! Logs the output to file instead of displaying it on the terminal ! Future features not implemented or in development logical :: lgr = .false. !! Turn on GR @@ -111,6 +113,9 @@ module base procedure(abstract_io_param_reader), deferred :: reader procedure(abstract_io_param_writer), deferred :: writer procedure(abstract_io_read_in_param), deferred :: read_in +#ifdef COARRAY + procedure :: cobroadcast => base_cobroadcast_param +#endif end type base_parameters abstract interface @@ -240,9 +245,6 @@ subroutine base_util_dealloc_param(self) ! Arguments class(base_parameters),intent(inout) :: self !! Collection of parameters - if (allocated(self%integrator)) deallocate(self%integrator) - if (allocated(self%param_file_name)) deallocate(self%param_file_name) - if (allocated(self%display_style)) deallocate(self%display_style) if (allocated(self%seed)) deallocate(self%seed) return @@ -430,5 +432,101 @@ subroutine base_final_storage_frame(self) return end subroutine base_final_storage_frame +#ifdef COARRAY + subroutine base_cobroadcast_param(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 parameter to all other images in a parameter coarray + implicit none + ! Arguments + class(base_parameters),intent(inout),codimension[*] :: self !! Collection of parameters + ! Internals + integer(I4B) :: i + + call cocopy(self%integrator) + call cocopy(self%param_file_name) + call cocopy(self%t0) + call cocopy(self%tstart) + call cocopy(self%tstop) + call cocopy(self%dt) + call cocopy(self%iloop) + call cocopy(self%nloops) + call cocopy(self%incbfile) + call cocopy(self%inplfile) + call cocopy(self%intpfile) + call cocopy(self%nc_in) + call cocopy(self%in_type) + call cocopy(self%in_form) + call cocopy(self%istep_out) + call cocopy(self%nstep_out) + call cocopy(self%fstep_out) + call cocopy(self%ltstretch) + call cocopy(self%outfile) + call cocopy(self%out_type) + call cocopy(self%out_form) + call cocopy(self%out_stat) + call cocopy(self%dump_cadence) + call cocopy(self%rmin) + call cocopy(self%rmax) + call cocopy(self%rmaxu) + call cocopy(self%qmin) + call cocopy(self%qmin_coord) + call cocopy(self%qmin_alo) + call cocopy(self%qmin_ahi) + call cocopy(self%MU2KG) + call cocopy(self%TU2S) + call cocopy(self%DU2M) + call cocopy(self%GU) + call cocopy(self%inv_c2) + call cocopy(self%GMTINY) + call cocopy(self%min_GMfrag) + call cocopy(self%nfrag_reduction) + call cocopy(self%lmtiny_pl) + call cocopy(self%collision_model) + call cocopy(self%encounter_save) + call cocopy(self%lenc_save_trajectory) + call cocopy(self%lenc_save_closest ) + call cocopy(self%interaction_loops ) + call cocopy(self%encounter_check_plpl) + call cocopy(self%encounter_check_pltp) + call cocopy(self%lflatten_interactions) + call cocopy(self%lencounter_sas_plpl) + call cocopy(self%lencounter_sas_pltp ) + call cocopy(self%lrhill_present) + call cocopy(self%lextra_force ) + call cocopy(self%lbig_discard ) + call cocopy(self%lclose ) + call cocopy(self%lenergy ) + call cocopy(self%loblatecb ) + call cocopy(self%lrotation ) + call cocopy(self%ltides ) + call cocopy(self%E_orbit_orig ) + call cocopy(self%GMtot_orig ) + do i = 1, NDIM + call cocopy(self%L_total_orig(i)) + call cocopy(self%L_orbit_orig(i)) + call cocopy(self%L_spin_orig(i)) + call cocopy(self%L_escape(i)) + end do + call cocopy(self%GMescape ) + call cocopy(self%E_collisions ) + call cocopy(self%E_untracked ) + call cocopy(self%lfirstenergy) + call cocopy(self%lfirstkick ) + call cocopy(self%lrestart ) + call cocopy(self%display_style) + call cocopy(self%display_unit ) + call cocopy(self%log_output ) + call cocopy(self%lgr ) + call cocopy(self%lyarkovsky) + call cocopy(self%lyorp ) + call cocopy(self%seed) + + return + end subroutine base_cobroadcast_param + +#endif + + end module base diff --git a/src/coarray/coarray_module.f90 b/src/coarray/coarray_module.f90 new file mode 100644 index 000000000..e9905b9df --- /dev/null +++ b/src/coarray/coarray_module.f90 @@ -0,0 +1,336 @@ +!! 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. + +module coarray + !! author: David A. Minton + !! + !! Utilities that are used for coarray test particles + !! + use globals + implicit none + public + + interface cocopy + module procedure coarray_component_copy_char + module procedure coarray_component_copy_DP + module procedure coarray_component_copy_DP_arr1D + 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_QP + end interface + + contains + + subroutine coarray_component_copy_char(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 + !! character scalar version + implicit none + ! Arguments + character(len=*), intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + character(len=STRMAX),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 coarray_component_copy_char + + + subroutine coarray_component_copy_DP(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) scalar version + implicit none + ! Arguments + real(DP), intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + real(DP),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 coarray_component_copy_DP + + + 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 + implicit none + ! Arguments + real(DP), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + real(DP), 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 (this_image() /= si) then + if (allocated(var)) deallocate(var) + allocate(var, source=tmp) + end if + + return + end subroutine coarray_component_copy_DP_arr1D + + + subroutine coarray_component_copy_DP_arr2D(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) 2D allocatable array version + implicit none + ! Arguments + real(DP), dimension(:,:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + real(DP), dimension(:,:), codimension[:], allocatable :: tmp + integer(I4B) :: img, si + integer(I4B), save :: n1[*], n2[*] + + if (present(src_img)) then + si = src_img + else + si = 1 + end if + + n1 = size(var,dim=1) + n2 = size(var,dim=2) + sync all + allocate(tmp(n1[si],n2[si])[*]) + if (this_image() == si) then + do img = 1, num_images() + tmp(:,:)[img] = var(:,:) + end do + end if + sync all + if (this_image() /= si) then + if (allocated(var)) deallocate(var) + allocate(var, source=tmp) + end if + + return + end subroutine coarray_component_copy_DP_arr2D + + + subroutine coarray_component_copy_I4B(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) scalar version + implicit none + ! Arguments + integer(I4B), intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + integer(I4B),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 coarray_component_copy_I4B + + + 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 + implicit none + ! Arguments + integer(I4B), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + integer(I4B), 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_I4B_arr1D + + + subroutine coarray_component_copy_I8B(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) scalar version + implicit none + ! Arguments + integer(I8B), intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + integer(I8B),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 coarray_component_copy_I8B + + + subroutine coarray_component_copy_lgt(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 scalar version + implicit none + ! Arguments + logical, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + logical,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 coarray_component_copy_lgt + + + subroutine coarray_component_copy_QP(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) scalar version + implicit none + ! Arguments + real(QP), intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + real(QP),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 coarray_component_copy_QP + +end module coarray \ No newline at end of file diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index b9462840b..c0f987aa9 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -413,11 +413,13 @@ module subroutine rmvs_util_setup_tp(self, n, param) call self%whm_tp%setup(n, param) if (n <= 0) return - allocate(self%lperi(n)) - allocate(self%plperP(n)) - allocate(self%plencP(n)) + if (allocated(self%lperi)) deallocate(self%lperi); allocate(self%lperi(n)) + if (allocated(self%plperP)) deallocate(self%plperP); allocate(self%plperP(n)) + if (allocated(self%plencP)) deallocate(self%plencP); allocate(self%plencP(n)) - if (self%lplanetocentric) allocate(self%rheliocentric(NDIM, n)) + if (self%lplanetocentric) then + if (allocated(self%rheliocentric)) deallocate(self%rheliocentric); allocate(self%rheliocentric(NDIM, n)) + end if self%lperi(:) = .false. diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 index bcc4d3fa1..31eccbdf9 100644 --- a/src/swiftest/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -20,7 +20,7 @@ program swiftest_driver implicit none #ifdef COARRAY - class(swiftest_nbody_system), allocatable :: nbody_system[:] !! Polymorphic object containing the nbody system to be integrated + class(swiftest_nbody_system), allocatable :: nbody_system[:] !! Polymorphic object containing the nbody system to be integrated #else class(swiftest_nbody_system), allocatable :: nbody_system !! Polymorphic object containing the nbody system to be integrated #endif @@ -77,21 +77,25 @@ program swiftest_driver !> Define the maximum number of threads nthreads = 1 ! In the *serial* case !$ nthreads = omp_get_max_threads() ! In the *parallel* case - !$ write(param%display_unit,'(a)') ' OpenMP parameters:' - !$ write(param%display_unit,'(a)') ' ------------------' - !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads - !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads -#ifdef COARRAY - ! Only execute file file I/O and reporting on image 1 +#ifdef COARRAY if (this_image() == 1) then - write(param%display_unit,'(a)') ' Coarray parameters:' - write(param%display_unit,'(a)') ' -------------------' - write(param%display_unit,'(a,i3)') ' Number of images = ', num_images() +#endif + !$ write(param%display_unit,'(a)') ' OpenMP parameters:' + !$ write(param%display_unit,'(a)') ' ------------------' + !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads + !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads +#ifdef COARRAY + write(param%display_unit,*) ' Coarray parameters:' + write(param%display_unit,*) ' -------------------' + write(param%display_unit,*) ' Number of images = ', num_images() if (param%log_output) write(*,'(a,i3)') ' Coarray: Number of images = ',num_images() + end if #endif +#ifdef COARRAY + if (this_image() == 1) then +#endif call nbody_system%initialize(param) - ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. call nbody_system%display_run_information(param, integration_timer, phase="first") if (param%lenergy) then @@ -107,8 +111,8 @@ program swiftest_driver #ifdef COARRAY ! Distribute test particles to the various images - call nbody_system%coarray_distribute() end if ! this_image() == 1 + call nbody_system%coarray_distribute() #endif do iloop = istart, nloops !> Step the nbody_system forward in time @@ -132,8 +136,8 @@ program swiftest_driver istep = floor(istep_out * fstep_out**nout, kind=I4B) end if #ifdef COARRAY + call nbody_system%coarray_collect() if (this_image() == 1) then - call nbody_system%coarray_collect() #endif call nbody_system%system_history%take_snapshot(param,nbody_system) @@ -147,9 +151,8 @@ program swiftest_driver call integration_timer%reset() if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) #ifdef COARRAY - call nbody_system%coarray_distribute() end if - sync all + call nbody_system%coarray_distribute() #endif end if end if @@ -157,9 +160,9 @@ program swiftest_driver end do ! Dump any remaining history if it exists #ifdef COARRAY + call nbody_system%coarray_collect() if (this_image() == 1) then #endif - call nbody_system%coarray_collect() call nbody_system%dump(param) call nbody_system%system_history%dump(param) call nbody_system%display_run_information(param, integration_timer, phase="last") diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 32f722a7b..928f6eccd 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -1882,10 +1882,16 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i logical :: seed_set = .false. !! Is the random seed set in the input file? character(len=:), allocatable :: integrator real(DP) :: tratio, y - - - ! Parse the file line by line, extracting tokens then matching them up with known parameters if possible + type(swiftest_parameters), codimension[*], save :: coparam + +#ifdef COARRAY + if (this_image() == 1) then + coparam = self + associate(param => coparam) +#else associate(param => self) +#endif + ! Parse the file line by line, extracting tokens then matching them up with known parameters if possible call random_seed(size = nseeds) if (allocated(param%seed)) deallocate(param%seed) allocate(param%seed(nseeds)) @@ -2309,11 +2315,22 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i iostat = 0 call param%set_display(param%display_style) - ! Print the contents of the parameter file to standard output if (.not.param%lrestart) call param%writer(unit = param%display_unit, iotype = "none", v_list = [0], iostat = iostat, iomsg = iomsg) - end associate +#ifdef COARRAY + end if ! this_image() == 1 + call coparam%cobroadcast() + select type(self) + type is (swiftest_parameters) + self = coparam + end select + + write(*,*) "Image: ", this_image(),"tstop: ",self%tstop + write(*,*) "Image: ", this_image(),"seed: ",self%seed + sync all + stop +#endif return 667 continue diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index a569e0d98..55f63ec6f 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -150,7 +150,6 @@ module swiftest procedure :: fill => swiftest_util_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: get_peri => swiftest_util_peri_body !! Determine nbody_system pericenter passages for test particles procedure :: resize => swiftest_util_resize_body !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - procedure :: set_ir3 => swiftest_util_set_ir3h !! Sets the inverse heliocentric radius term (1/rh**3) procedure :: sort => swiftest_util_sort_body !! Sorts body arrays by a sortable componen 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 @@ -394,8 +393,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 test particles from distributed images into image #1 - procedure :: coarray_distribute => swiftest_util_coarray_distribute_system !! Distributes test particles from image #1 out to all images + 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. #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 @@ -1081,7 +1080,7 @@ end subroutine swiftest_util_setup_initialize_particle_info_system module subroutine swiftest_util_setup_initialize_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_util_setup_initialize_system module subroutine swiftest_util_setup_pl(self, n, param) @@ -1189,14 +1188,14 @@ module subroutine swiftest_util_append_tp(self, source, lsource_mask) end subroutine swiftest_util_append_tp #ifdef COARRAY - module subroutine swiftest_util_coarray_collect_system(self) + module subroutine swiftest_util_coarray_collect_system(nbody_system) implicit none - class(swiftest_nbody_system), codimension[*], intent(inout) :: self + class(swiftest_nbody_system), intent(inout) :: nbody_system[*] end subroutine swiftest_util_coarray_collect_system - module subroutine swiftest_util_coarray_distribute_system(self) + module subroutine swiftest_util_coarray_distribute_system(nbody_system) implicit none - class(swiftest_nbody_system), codimension[*], intent(inout) :: self + class(swiftest_nbody_system), intent(inout) :: nbody_system[*] end subroutine swiftest_util_coarray_distribute_system #endif @@ -1677,11 +1676,7 @@ module subroutine swiftest_util_snapshot_system(self, param, nbody_system, t, ar implicit none class(swiftest_storage), intent(inout) :: self !! Swiftest storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters -#ifdef COARRAY - class(swiftest_nbody_system), intent(inout) :: nbody_system[*] !! Swiftest nbody system object to store -#else class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store -#endif real(DP), intent(in), optional :: t !! Time of snapshot if different from nbody_system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) end subroutine swiftest_util_snapshot_system diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 7661115e6..44c3bc17f 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -355,60 +355,81 @@ module subroutine swiftest_util_append_tp(self, source, lsource_mask) end subroutine swiftest_util_append_tp #ifdef COARRAY - module subroutine swiftest_util_coarray_collect_system(self) + module subroutine swiftest_util_coarray_collect_system(nbody_system) !! author: David A. Minton !! - !! Distributes test particles from image #1 out to all images. + !! Collects all the test particles from other images into the image #1 test particle system implicit none ! Arguments - class(swiftest_nbody_system), codimension[*], intent(inout) :: self + 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()) = self%tp%nbody - sync all - if (this_image() == 1) then - do i = 2, num_images() - allocate(tp_img, source=self[i]%tp) - call self%tp%append(tp_img,lsource_mask=[(.true., j = 1, ntp(i))]) - deallocate(tp_img) - end do - end if + ! 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(self) + 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), codimension[*], intent(inout) :: self + class(swiftest_nbody_system), intent(inout) :: nbody_system[*] ! Internals - integer(I4B) :: i, istart, iend, ntot, num_per_image + integer(I4B) :: i, istart, iend, ntot, num_per_image, ncopy class(swiftest_tp), allocatable :: tp_orig logical, dimension(:), allocatable :: lspill_list - - sync all - ntot = self[1]%tp%nbody - if (ntot == 0) return - allocate(lspill_list(ntot)) - allocate(tp_orig, source=self[1]%tp) - if (allocated(self%tp)) deallocate(self%tp) - 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 - lspill_list(:) = .false. - lspill_list(istart:iend) = .true. - call tp_orig%spill(self%tp,lspill_list(:), ldestructive=.false.) + 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 @@ -2895,6 +2916,7 @@ module subroutine swiftest_util_setup_initialize_system(self, param) class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals if (allocated(self%system_history)) then call self%system_history%dealloc() deallocate(self%system_history) @@ -2904,6 +2926,7 @@ module subroutine swiftest_util_setup_initialize_system(self, param) allocate(swiftest_netcdf_parameters :: self%system_history%nc) associate(nbody_system => self, cb => self%cb, pl => self%pl, tp => self%tp, nc => self%system_history%nc) + call nbody_system%read_in(param) call nbody_system%read_in(param) call nbody_system%validate_ids(param) call nbody_system%set_msys()