diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7dade4335..4e1caebba 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -86,6 +86,8 @@ SET(FAST_MATH_FILES SET(COARRAY_FILES ${SRC}/coarray/coarray_module.f90 ${SRC}/swiftest/swiftest_coarray.f90 + ${SRC}/whm/whm_coarray.f90 + ${SRC}/rmvs/rmvs_coarray.f90 ) IF(USE_COARRAY) diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index f40f3e67e..3c33a47c1 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -387,7 +387,7 @@ subroutine base_util_snapshot_save(self, snapshot) !! Memory usage grows by a factor of 2 each time it fills up, but no more. implicit none ! Arguments - class(base_storage), intent(inout) :: self !! Storage ncounter storage object + class(base_storage), intent(inout) :: self !! Storage encounter storage object class(*), intent(in) :: snapshot !! Object to snapshot ! Internals integer(I4B) :: nnew, nold diff --git a/src/coarray/coarray_module.f90 b/src/coarray/coarray_module.f90 index b174e1b34..597945761 100644 --- a/src/coarray/coarray_module.f90 +++ b/src/coarray/coarray_module.f90 @@ -17,21 +17,32 @@ module coarray public interface coclone - 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 + module procedure coarray_component_clone_char + module procedure coarray_component_clone_DP + module procedure coarray_component_clone_DP_arr1D + module procedure coarray_component_clone_DP_arr2D + module procedure coarray_component_clone_I4B + module procedure coarray_component_clone_I4B_arr1D + module procedure coarray_component_clone_I4B_arr2D + module procedure coarray_component_clone_I8B + module procedure coarray_component_clone_lgt + module procedure coarray_component_clone_lgt_arr1D + module procedure coarray_component_clone_QP + end interface + + interface cocollect + module procedure coarray_component_collect_DP_arr1D + module procedure coarray_component_collect_DP_arr2D + module procedure coarray_component_collect_I4B + module procedure coarray_component_collect_I4B_arr1D + module procedure coarray_component_collect_I4B_arr2D + module procedure coarray_component_collect_I8B + module procedure coarray_component_collect_lgt_arr1D end interface contains - subroutine coarray_component_copy_char(var,src_img) + subroutine coarray_component_clone_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 @@ -55,15 +66,17 @@ subroutine coarray_component_copy_char(var,src_img) do img = 1, num_images() tmp[img] = var end do + sync images(*) + else + sync images(si) + var = tmp[si] end if - sync all - var = tmp[si] return - end subroutine coarray_component_copy_char + end subroutine coarray_component_clone_char - subroutine coarray_component_copy_DP(var,src_img) + subroutine coarray_component_clone_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 @@ -87,15 +100,18 @@ subroutine coarray_component_copy_DP(var,src_img) do img = 1, num_images() tmp[img] = var end do + sync images(*) + else + sync images(si) + var = tmp[si] end if - sync all - var = tmp[si] + return - end subroutine coarray_component_copy_DP + end subroutine coarray_component_clone_DP - subroutine coarray_component_copy_DP_arr1D(var,src_img) + subroutine coarray_component_clone_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 @@ -108,32 +124,37 @@ subroutine coarray_component_copy_DP_arr1D(var,src_img) real(DP), dimension(:), codimension[:], allocatable :: tmp integer(I4B) :: img, si integer(I4B), save :: n[*] - + logical, save :: isalloc[*] + if (present(src_img)) then si = src_img else si = 1 end if - n = size(var) sync all + isalloc = allocated(var) + if (isalloc) n = size(var) + sync all + if (.not. isalloc[si]) return + allocate(tmp(n[si])[*]) if (this_image() == si) then do img = 1, num_images() - tmp(:)[img] = var(:) + tmp(:)[img] = var end do - end if - sync all - if (this_image() /= si) then + sync images(*) + else + sync images(si) if (allocated(var)) deallocate(var) allocate(var, source=tmp) end if return - end subroutine coarray_component_copy_DP_arr1D + end subroutine coarray_component_clone_DP_arr1D - subroutine coarray_component_copy_DP_arr2D(var,src_img) + subroutine coarray_component_clone_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 @@ -146,33 +167,40 @@ subroutine coarray_component_copy_DP_arr2D(var,src_img) real(DP), dimension(:,:), codimension[:], allocatable :: tmp integer(I4B) :: img, si integer(I4B), save :: n1[*], n2[*] - + logical, save :: isalloc[*] + 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 + isalloc = allocated(var) + if (isalloc) then + n1 = size(var,dim=1) + n2 = size(var,dim=2) + end if + sync all + if (.not. isalloc[si]) return + 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 + sync images(*) + else + sync images(si) if (allocated(var)) deallocate(var) allocate(var, source=tmp) end if - + return - end subroutine coarray_component_copy_DP_arr2D + end subroutine coarray_component_clone_DP_arr2D - subroutine coarray_component_copy_I4B(var,src_img) + subroutine coarray_component_clone_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 @@ -196,15 +224,17 @@ subroutine coarray_component_copy_I4B(var,src_img) do img = 1, num_images() tmp[img] = var end do + sync images(*) + else + sync images(si) + var = tmp[si] end if - sync all - var = tmp[si] return - end subroutine coarray_component_copy_I4B - + end subroutine coarray_component_clone_I4B + - subroutine coarray_component_copy_I4B_arr1D(var,src_img) + subroutine coarray_component_clone_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 @@ -217,30 +247,83 @@ subroutine coarray_component_copy_I4B_arr1D(var,src_img) integer(I4B), dimension(:), codimension[:], allocatable :: tmp integer(I4B) :: img, si integer(I4B), save :: n[*] - + logical, save :: isalloc[*] + if (present(src_img)) then si = src_img else si = 1 end if - n = size(var) sync all + isalloc = allocated(var) + if (isalloc) n = size(var) + sync all + if (.not. isalloc[si]) return + allocate(tmp(n[si])[*]) if (this_image() == si) then do img = 1, num_images() tmp(:)[img] = var end do + sync images(*) + else + sync images(si) + if (allocated(var)) deallocate(var) + allocate(var, source=tmp) end if + + return + end subroutine coarray_component_clone_I4B_arr1D + + + subroutine coarray_component_clone_I4B_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 + !! integer(I4B) 2D 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 :: n1[*], n2[*] + logical, save :: isalloc[*] + + if (present(src_img)) then + si = src_img + else + si = 1 + end if + sync all - if (allocated(var)) deallocate(var) - allocate(var, source=tmp) - + isalloc = allocated(var) + if (isalloc) then + n1 = size(var,dim=1) + n2 = size(var,dim=2) + end if + sync all + if (.not. isalloc[si]) return + + allocate(tmp(n1[si],n2[si])[*]) + if (this_image() == si) then + do img = 1, num_images() + tmp(:,:)[img] = var(:,:) + end do + sync images(*) + else + sync images(si) + if (allocated(var)) deallocate(var) + allocate(var, source=tmp) + end if + return - end subroutine coarray_component_copy_I4B_arr1D + end subroutine coarray_component_clone_I4B_arr2D - subroutine coarray_component_copy_I8B(var,src_img) + subroutine coarray_component_clone_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 @@ -264,15 +347,17 @@ subroutine coarray_component_copy_I8B(var,src_img) do img = 1, num_images() tmp[img] = var end do + sync images(*) + else + sync images(si) + var = tmp[si] end if - sync all - var = tmp[si] return - end subroutine coarray_component_copy_I8B + end subroutine coarray_component_clone_I8B - subroutine coarray_component_copy_lgt(var,src_img) + subroutine coarray_component_clone_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 @@ -296,15 +381,18 @@ subroutine coarray_component_copy_lgt(var,src_img) do img = 1, num_images() tmp[img] = var end do + sync images(*) + else + sync images(si) + var = tmp[si] end if - sync all - var = tmp[si] + return - end subroutine coarray_component_copy_lgt + end subroutine coarray_component_clone_lgt - subroutine coarray_component_copy_lgt_arr1D(var,src_img) + subroutine coarray_component_clone_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 @@ -317,31 +405,37 @@ subroutine coarray_component_copy_lgt_arr1D(var,src_img) logical, dimension(:), codimension[:], allocatable :: tmp integer(I4B) :: img, si integer(I4B), save :: n[*] - + logical, save :: isalloc[*] + if (present(src_img)) then si = src_img else si = 1 end if - n = size(var) sync all + isalloc = allocated(var) + if (isalloc) n = size(var) + sync all + if (.not. isalloc[si]) return + allocate(tmp(n[si])[*]) if (this_image() == si) then do img = 1, num_images() tmp(:)[img] = var end do + sync images(*) + else + sync images(si) + if (allocated(var)) deallocate(var) + allocate(var, source=tmp) end if - sync all - if (allocated(var)) deallocate(var) - allocate(var, source=tmp) return - end subroutine coarray_component_copy_lgt_arr1D + end subroutine coarray_component_clone_lgt_arr1D - - subroutine coarray_component_copy_QP(var,src_img) + subroutine coarray_component_clone_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 @@ -365,11 +459,420 @@ subroutine coarray_component_copy_QP(var,src_img) do img = 1, num_images() tmp[img] = var end do + sync images(*) + else + sync images(si) + var = tmp[si] end if - sync all - var = tmp[si] return - end subroutine coarray_component_copy_QP + end subroutine coarray_component_clone_QP + + + subroutine coarray_component_collect_DP_arr1D(var,dest_img) + !! author: David A. Minton + !! + !! Collects components of a coarray derived type from all images and combines them into destination image component . The default destination image is 1 + !! real(DP) 1D allocatable array version + implicit none + ! Arguments + real(DP), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: dest_img + ! Internals + real(DP), dimension(:), codimension[:], allocatable :: tmp + integer(I4B) :: img, ti, di, ntot, istart, iend + integer(I4B), save :: n[*] + logical, save :: isalloc[*] + + if (present(dest_img)) then + di = dest_img + else + di = 1 + end if + + sync all + isalloc = allocated(var) + if (isalloc) then + n = size(var) + else + n = 0 + end if + sync all + ntot = 0 + do img = 1, num_images() + ntot = ntot + n[img] + end do + + allocate(tmp(ntot)[*]) + + ti = this_image() + + istart = 1 + iend = n + do img = 1, this_image() - 1 + istart = istart + n[img] + iend = iend + n[img] + end do + + if (isalloc) then + tmp(istart:iend) = var(:) + deallocate(var) + end if + + sync all + if (this_image() == di) then + allocate(var(ntot)) + istart = 1 + iend = n + do img = 1, num_images() + var(istart:iend) = tmp[img](istart:iend) + istart = istart + n[img] + iend = iend + n[img] + end do + end if + + return + end subroutine coarray_component_collect_DP_arr1D + + + subroutine coarray_component_collect_DP_arr2D(var,dest_img) + !! author: David A. Minton + !! + !! Collects components of a coarray derived type from all images and combines them into destination image component . The default destination image is 1 + !! real(DP) 2D allocatable array version + implicit none + ! Arguments + real(DP), dimension(:,:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: dest_img + ! Internals + integer(I4B), dimension(:,:), codimension[:], allocatable :: tmp + integer(I4B) :: img, ti, di, ntot, istart, iend + integer(I4B), save :: n1[*], n2[*] + logical, save :: isalloc[*] + + if (present(dest_img)) then + di = dest_img + else + di = 1 + end if + + sync all + isalloc = allocated(var) + if (isalloc) then + n1 = size(var,dim=1) + n2 = size(var,dim=2) + else + n1 = 0 + n2 = 0 + end if + sync all + ntot = 0 + do img = 1, num_images() + ntot = ntot + n2[img] + end do + + allocate(tmp(n1,ntot)[*]) + + ti = this_image() + + istart = 1 + iend = n2 + do img = 1, this_image() - 1 + istart = istart + n2[img] + iend = iend + n2[img] + end do + + if (isalloc) then + tmp(:,istart:iend) = var(:,:) + deallocate(var) + end if + + sync all + if (this_image() == di) then + allocate(var(n1,ntot)) + + istart = 1 + iend = n2 + do img = 1, num_images() + var(:,istart:iend) = tmp[img](:,istart:iend) + istart = istart + n2[img] + iend = iend + n2[img] + end do + end if + + return + end subroutine coarray_component_collect_DP_arr2D + + + subroutine coarray_component_collect_I4B(var,dest_img) + !! author: David A. Minton + !! + !! Sums this component of a coarray derived type from all images and places the value in the destination image component. The default destination image is 1 + !! integer(I4B) version + implicit none + ! Arguments + integer(I4B), intent(inout) :: var + integer(I4B), intent(in),optional :: dest_img + ! Internals + integer(I4B), allocatable :: tmp[:] + integer(I4B) :: img, di + + if (present(dest_img)) then + di = dest_img + else + di = 1 + end if + + allocate(tmp[*], source=var) + sync all + + if (this_image() == di) then + var = 0 + do img = 1, num_images() + var = var + tmp[img] + end do + else + var = 0 + end if + + return + end subroutine coarray_component_collect_I4B + + + subroutine coarray_component_collect_I8B(var,dest_img) + !! author: David A. Minton + !! + !! Sums this component of a coarray derived type from all images and places the value in the destination image component. The default destination image is 1 + !! integer(I8B) version + implicit none + ! Arguments + integer(I8B), intent(inout) :: var + integer(I4B), intent(in),optional :: dest_img + ! Internals + integer(I8B), allocatable :: tmp[:] + integer(I4B) :: img, di + + if (present(dest_img)) then + di = dest_img + else + di = 1 + end if + + allocate(tmp[*], source=var) + sync all + + if (this_image() == di) then + var = 0 + do img = 1, num_images() + var = var + tmp[img] + end do + else + var = 0 + end if + + return + end subroutine coarray_component_collect_I8B + + + subroutine coarray_component_collect_I4B_arr1D(var,dest_img) + !! author: David A. Minton + !! + !! Collects components of a coarray derived type from all images and combines them into destination image component . The default destination image is 1 + !! integer(I4B) 1D allocatable array version + implicit none + ! Arguments + integer(I4B), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: dest_img + ! Internals + integer(I4B), dimension(:), codimension[:], allocatable :: tmp + integer(I4B) :: img, ti, di, ntot, istart, iend + integer(I4B), save :: n[*] + logical, save :: isalloc[*] + + if (present(dest_img)) then + di = dest_img + else + di = 1 + end if + + sync all + isalloc = allocated(var) + if (isalloc) then + n = size(var) + else + n = 0 + end if + sync all + ntot = 0 + do img = 1, num_images() + ntot = ntot + n[img] + end do + + allocate(tmp(ntot)[*]) + + ti = this_image() + + istart = 1 + iend = n + do img = 1, this_image() - 1 + istart = istart + n[img] + iend = iend + n[img] + end do + + if (isalloc) then + tmp(istart:iend) = var(:) + deallocate(var) + end if + + sync all + if (this_image() == di) then + allocate(var(ntot)) + istart = 1 + iend = n + do img = 1, num_images() + var(istart:iend) = tmp[img](istart:iend) + istart = istart + n[img] + iend = iend + n[img] + end do + end if + + return + end subroutine coarray_component_collect_I4B_arr1D + + + subroutine coarray_component_collect_I4B_arr2D(var,dest_img) + !! author: David A. Minton + !! + !! Collects components of a coarray derived type from all images and combines them into destination image component . The default destination image is 1 + !! integer(I4B) 2D allocatable array version + implicit none + ! Arguments + integer(I4B), dimension(:,:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: dest_img + ! Internals + integer(I4B), dimension(:,:), codimension[:], allocatable :: tmp + integer(I4B) :: img, ti, di, ntot, istart, iend + integer(I4B), save :: n1[*], n2[*] + logical, save :: isalloc[*] + + if (present(dest_img)) then + di = dest_img + else + di = 1 + end if + + sync all + isalloc = allocated(var) + if (isalloc) then + n1 = size(var,dim=1) + n2 = size(var,dim=2) + else + n1 = 0 + n2 = 0 + end if + sync all + ntot = 0 + do img = 1, num_images() + ntot = ntot + n2[img] + end do + + allocate(tmp(n1,ntot)[*]) + + ti = this_image() + + istart = 1 + iend = n2 + do img = 1, this_image() - 1 + istart = istart + n2[img] + iend = iend + n2[img] + end do + + if (isalloc) then + tmp(:,istart:iend) = var(:,:) + deallocate(var) + end if + + sync all + if (this_image() == di) then + allocate(var(n1,ntot)) + + istart = 1 + iend = n2 + do img = 1, num_images() + var(:,istart:iend) = tmp[img](:,istart:iend) + istart = istart + n2[img] + iend = iend + n2[img] + end do + end if + + return + end subroutine coarray_component_collect_I4B_arr2D + + + subroutine coarray_component_collect_lgt_arr1D(var,dest_img) + !! author: David A. Minton + !! + !! Collects components of a coarray derived type from all images and combines them into destination image component . The default destination image is 1 + !! logical 1D allocatable array version + implicit none + ! Arguments + logical, dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: dest_img + ! Internals + logical, dimension(:), codimension[:], allocatable :: tmp + integer(I4B) :: img, ti, di, ntot, istart, iend + integer(I4B), save :: n[*] + logical, save :: isalloc[*] + + if (present(dest_img)) then + di = dest_img + else + di = 1 + end if + + sync all + isalloc = allocated(var) + if (isalloc) then + n = size(var) + else + n = 0 + end if + sync all + ntot = 0 + do img = 1, num_images() + ntot = ntot + n[img] + end do + + allocate(tmp(ntot)[*]) + + ti = this_image() + + istart = 1 + iend = n + do img = 1, this_image() - 1 + istart = istart + n[img] + iend = iend + n[img] + end do + + if (isalloc) then + tmp(istart:iend) = var(:) + deallocate(var) + end if + + sync all + if (this_image() == di) then + allocate(var(ntot)) + istart = 1 + iend = n + do img = 1, num_images() + var(istart:iend) = tmp[img](istart:iend) + istart = istart + n[img] + iend = iend + n[img] + end do + end if + + return + end subroutine coarray_component_collect_lgt_arr1D + end module coarray \ No newline at end of file diff --git a/src/helio/helio_module.f90 b/src/helio/helio_module.f90 index cd5581837..182512e53 100644 --- a/src/helio/helio_module.f90 +++ b/src/helio/helio_module.f90 @@ -165,10 +165,11 @@ module subroutine helio_kick_vb_tp(self, nbody_system, param, t, dt, lbeg) logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. end subroutine helio_kick_vb_tp - module subroutine helio_util_setup_initialize_system(self, param) + module subroutine helio_util_setup_initialize_system(self, system_history, param) implicit none - class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object + class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine helio_util_setup_initialize_system module subroutine helio_step_pl(self, nbody_system, param, t, dt) diff --git a/src/helio/helio_util.f90 b/src/helio/helio_util.f90 index 94b464502..bb032defb 100644 --- a/src/helio/helio_util.f90 +++ b/src/helio/helio_util.f90 @@ -11,17 +11,18 @@ use swiftest contains - module subroutine helio_util_setup_initialize_system(self, param) + module subroutine helio_util_setup_initialize_system(self, system_history, param) !! author: David A. Minton !! !! Initialize a Helio nbody system from files, converting all heliocentric quantities to barycentric. !! implicit none ! Arguments - class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object + class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - call swiftest_util_setup_initialize_system(self, param) + call swiftest_util_setup_initialize_system(self, system_history, param) call self%pl%sort("mass", ascending=.false.) call self%pl%vh2vb(self%cb) call self%tp%h2b(self%cb) diff --git a/src/rmvs/rmvs_coarray.f90 b/src/rmvs/rmvs_coarray.f90 new file mode 100644 index 000000000..61c638c60 --- /dev/null +++ b/src/rmvs/rmvs_coarray.f90 @@ -0,0 +1,139 @@ +!! 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 (rmvs) s_rmvs_coarray +use coarray +use swiftest +use whm +contains + + module subroutine rmvs_coarray_coclone_cb(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 object to all other images in a coarray + implicit none + ! Arguments + class(rmvs_cb),intent(inout),codimension[*] :: self !! RMVS pl object + + call coclone(self%outer) + call coclone(self%inner) + call coclone(self%lplanetocentric) + + call swiftest_coarray_coclone_cb(self) + + return + end subroutine rmvs_coarray_coclone_cb + + + module subroutine rmvs_coarray_coclone_pl(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 object to all other images in a coarray + implicit none + ! Arguments + class(rmvs_pl),intent(inout),codimension[*] :: self !! RMVS pl object + + call coclone(self%nenc) + call coclone(self%tpenc1P) + call coclone(self%plind) + call coclone(self%outer) + call coclone(self%lplanetocentric) + + call whm_coarray_coclone_pl(self) + + return + end subroutine rmvs_coarray_coclone_pl + + + + module subroutine rmvs_coarray_coclone_tp(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 object to all other images in a coarray + implicit none + ! Arguments + class(rmvs_tp),intent(inout),codimension[*] :: self !! RMVS pl object + + call coclone(self%lperi) + call coclone(self%plperP) + call coclone(self%plencP) + call coclone(self%index) + call coclone(self%ipleP) + call coclone(self%lplanetocentric) + + call swiftest_coarray_coclone_tp(self) + + return + end subroutine rmvs_coarray_coclone_tp + + + module subroutine rmvs_coarray_component_clone_interp_arr1D(var,src_img) + implicit none + !! 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 + ! Arguments + type(rmvs_interp), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + type(rmvs_interp), dimension(:), codimension[:], allocatable :: tmp + integer(I4B) :: img, si + integer(I4B), save :: n[*] + logical, save :: isalloc[*] + + + if (present(src_img)) then + si = src_img + else + si = 1 + end if + + sync all + isalloc = allocated(var) + if (isalloc) n = size(var) + sync all + if (.not. isalloc[si]) return + + allocate(tmp(n[si])[*]) + if (this_image() == si) then + do img = 1, num_images() + tmp(:)[img] = var + end do + sync images(*) + else + sync images(si) + if (allocated(var)) deallocate(var) + allocate(var, source=tmp) + end if + + return + end subroutine rmvs_coarray_component_clone_interp_arr1D + + + module subroutine rmvs_coarray_cocollect_tp(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 object to all other images in a coarray + implicit none + ! Arguments + class(rmvs_tp),intent(inout),codimension[*] :: self !! RMVS pl object + + call cocollect(self%lperi) + call cocollect(self%plperP) + call cocollect(self%plencP) + call cocollect(self%index) + call cocollect(self%ipleP) + + call swiftest_coarray_cocollect_tp(self) + + return + end subroutine rmvs_coarray_cocollect_tp + +end submodule s_rmvs_coarray \ No newline at end of file diff --git a/src/rmvs/rmvs_module.f90 b/src/rmvs/rmvs_module.f90 index 733a81e60..0f4c0f4b1 100644 --- a/src/rmvs/rmvs_module.f90 +++ b/src/rmvs/rmvs_module.f90 @@ -56,6 +56,9 @@ module rmvs contains procedure :: dealloc => rmvs_util_dealloc_cb !! Deallocates all allocatable arrays final :: rmvs_final_cb !! Finalizes the RMVS central body object - deallocates all allocatables +#ifdef COARRAY + procedure :: coclone => rmvs_coarray_coclone_cb !! Clones the image 1 body object to all other images in the coarray structure. +#endif end type rmvs_cb @@ -88,6 +91,9 @@ module rmvs procedure :: rearrange => rmvs_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) final :: rmvs_final_tp !! Finalizes the RMVS test particle object - deallocates all allocatables +#ifdef COARRAY + procedure :: coclone => rmvs_coarray_coclone_tp !! Clones the image 1 body object to all other images in the coarray structure. +#endif end type rmvs_tp @@ -101,7 +107,7 @@ module rmvs class(rmvs_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 + procedure :: setup => rmvs_util_setup_pl !! Constructor method - Allocates space for the input number of bodiess procedure :: append => rmvs_util_append_pl !! Appends elements from one structure to another procedure :: dealloc => rmvs_util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => rmvs_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) @@ -109,7 +115,10 @@ module rmvs procedure :: sort => rmvs_util_sort_pl !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: rmvs_final_pl !! Finalizes the RMVS massive body object - deallocates all allocatables + final :: rmvs_final_pl !! Finalizes the RMVS massive body object - deallocates all allocatables +#ifdef COARRAY + procedure :: coclone => rmvs_coarray_coclone_pl !! Clones the image 1 body object to all other images in the coarray structure. +#endif end type rmvs_pl interface @@ -145,10 +154,11 @@ module subroutine rmvs_util_setup_pl(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine rmvs_util_setup_pl - module subroutine rmvs_util_setup_initialize_system(self, param) + module subroutine rmvs_util_setup_initialize_system(self, system_history, param) implicit none - class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object + class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine rmvs_util_setup_initialize_system module subroutine rmvs_util_setup_tp(self, n, param) @@ -275,6 +285,41 @@ end subroutine rmvs_step_system end interface + +#ifdef COARRAY + interface coclone + module subroutine rmvs_coarray_component_clone_interp_arr1D(var,src_img) + implicit none + type(rmvs_interp), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + end subroutine rmvs_coarray_component_clone_interp_arr1D + end interface + + interface cocollect + module subroutine rmvs_coarray_cocollect_tp(self) + implicit none + class(rmvs_tp),intent(inout),codimension[*] :: self !! RMVS pl object + end subroutine rmvs_coarray_cocollect_tp + end interface + + interface + module subroutine rmvs_coarray_coclone_cb(self) + implicit none + class(rmvs_cb),intent(inout),codimension[*] :: self !! RMVS tp object + end subroutine rmvs_coarray_coclone_cb + + module subroutine rmvs_coarray_coclone_pl(self) + implicit none + class(rmvs_pl),intent(inout),codimension[*] :: self !! RMVS pl object + end subroutine rmvs_coarray_coclone_pl + + module subroutine rmvs_coarray_coclone_tp(self) + implicit none + class(rmvs_tp),intent(inout),codimension[*] :: self !! RMVS tp object + end subroutine rmvs_coarray_coclone_tp + end interface +#endif + contains subroutine rmvs_final_cb(self) diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index c0f987aa9..7100f7019 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -323,7 +323,7 @@ module subroutine rmvs_util_setup_pl(self, n, param) end subroutine rmvs_util_setup_pl - module subroutine rmvs_util_setup_initialize_system(self, param) + module subroutine rmvs_util_setup_initialize_system(self, system_history, param) !! author: David A. Minton !! !! Initialize an RMVS nbody system from files and sets up the planetocentric structures. @@ -335,13 +335,14 @@ module subroutine rmvs_util_setup_initialize_system(self, param) !! to use during close encounters. implicit none ! Arguments - class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object + class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, j ! Call parent method - call whm_util_setup_initialize_system(self, param) + call whm_util_setup_initialize_system(self, system_history, param) ! Set up the pl-tp planetocentric encounter structures for pl and cb. The planetocentric tp structures are ! generated as necessary during close encounter steps. diff --git a/src/swiftest/swiftest_coarray.f90 b/src/swiftest/swiftest_coarray.f90 index c9db7077c..08590c112 100644 --- a/src/swiftest/swiftest_coarray.f90 +++ b/src/swiftest/swiftest_coarray.f90 @@ -52,7 +52,170 @@ module subroutine swiftest_coarray_coclone_body(self) end subroutine swiftest_coarray_coclone_body - module subroutine swiftest_coarray_component_copy_info(var,src_img) + module subroutine swiftest_coarray_coclone_cb(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 object to all other images in a coarray + implicit none + ! Arguments + class(swiftest_cb),intent(inout),codimension[*] :: self !! Swiftest body object + ! Internals + integer(I4B) :: i + + call coclone(self%info) + call coclone(self%id) + call coclone(self%mass) + call coclone(self%Gmass) + call coclone(self%radius) + call coclone(self%density) + call coclone(self%j2rp2) + call coclone(self%j4rp4) + call coclone(self%k2) + call coclone(self%Q) + call coclone(self%tlag) + call coclone(self%GM0) + call coclone(self%dGM) + call coclone(self%R0) + call coclone(self%dR) + + do i = 1, NDIM + call coclone(self%aobl(i)) + call coclone(self%atide(i)) + call coclone(self%aoblbeg(i)) + call coclone(self%aoblend(i)) + call coclone(self%atidebeg(i)) + call coclone(self%atideend(i)) + call coclone(self%rb(i)) + call coclone(self%vb(i)) + call coclone(self%agr(i)) + call coclone(self%Ip(i)) + call coclone(self%rot(i)) + call coclone(self%L0(i)) + call coclone(self%dL(i)) + end do + + return + end subroutine swiftest_coarray_coclone_cb + + + module subroutine swiftest_coarray_coclone_pl(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 object to all other images in a coarray + implicit none + ! Arguments + class(swiftest_pl),intent(inout),codimension[*] :: self !! Swiftest body object + + call coclone(self%mass) + call coclone(self%Gmass) + call coclone(self%rhill) + call coclone(self%renc) + call coclone(self%radius) + call coclone(self%density) + call coclone(self%rbeg) + call coclone(self%rend) + call coclone(self%vbeg) + call coclone(self%Ip) + call coclone(self%rot) + call coclone(self%k2) + call coclone(self%Q ) + call coclone(self%tlag) + call coclone(self%k_plpl) + call coclone(self%nplpl) + call coclone(self%kin) + call coclone(self%lmtiny) + call coclone(self%nplm) + call coclone(self%nplplm) + call coclone(self%nplenc) + call coclone(self%ntpenc) + + call swiftest_coarray_coclone_body(self) + + return + end subroutine swiftest_coarray_coclone_pl + + + module subroutine swiftest_coarray_coclone_tp(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 object to all other images in a coarray + implicit none + ! Arguments + class(swiftest_tp),intent(inout),codimension[*] :: self !! Swiftest body object + + call coclone(self%k_pltp) + call coclone(self%npltp) + call coclone(self%nplenc) + call swiftest_coarray_coclone_body(self) + + return + end subroutine swiftest_coarray_coclone_tp + + + module subroutine swiftest_coarray_coclone_system(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 object to all other images in a coarray + implicit none + ! Arguments + class(swiftest_nbody_system),intent(inout),codimension[*] :: self !! Swiftest body object + ! Internals + integer(I4B) :: i, img + + call self%cb%coclone() + call self%pl%coclone() + call self%tp%coclone() + + call coclone(self%maxid) + call coclone(self%t) + call coclone(self%GMtot) + call coclone(self%ke_orbit) + call coclone(self%ke_spin) + call coclone(self%pe) + call coclone(self%be) + call coclone(self%te) + call coclone(self%oblpot) + do i = 1, NDIM + call coclone(self%L_orbit(i)) + call coclone(self%L_spin(i)) + call coclone(self%L_total(i)) + call coclone(self%L_total_orig(i)) + call coclone(self%L_orbit_orig(i)) + call coclone(self%L_spin_orig(i)) + call coclone(self%L_escape(i)) + end do + call coclone(self%ke_orbit_orig) + call coclone(self%ke_spin_orig) + call coclone(self%pe_orig) + call coclone(self%be_orig) + call coclone(self%te_orig) + call coclone(self%be_cb) + call coclone(self%E_orbit_orig) + call coclone(self%GMtot_orig) + call coclone(self%GMescape) + call coclone(self%E_collisions) + call coclone(self%E_untracked) + call coclone(self%ke_orbit_error) + call coclone(self%ke_spin_error) + call coclone(self%pe_error) + call coclone(self%be_error) + call coclone(self%E_orbit_error) + call coclone(self%Ecoll_error) + call coclone(self%E_untracked_error) + call coclone(self%te_error) + call coclone(self%L_orbit_error) + call coclone(self%L_spin_error) + call coclone(self%L_escape_error) + call coclone(self%L_total_error) + call coclone(self%Mtot_error) + call coclone(self%Mescape_error) + call coclone(self%lbeg) + + return + end subroutine swiftest_coarray_coclone_system + + + module subroutine swiftest_coarray_component_clone_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 @@ -76,16 +239,17 @@ module subroutine swiftest_coarray_component_copy_info(var,src_img) do img = 1, num_images() tmp[img] = var end do + sync images(*) + else + sync images(si) + var = tmp[si] end if - sync all - var = tmp[si] - + return - - end subroutine swiftest_coarray_component_copy_info + end subroutine swiftest_coarray_component_clone_info - module subroutine swiftest_coarray_component_copy_info_arr1D(var,src_img) + module subroutine swiftest_coarray_component_clone_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 @@ -98,6 +262,7 @@ module subroutine swiftest_coarray_component_copy_info_arr1D(var,src_img) type(swiftest_particle_info), dimension(:), codimension[:], allocatable :: tmp integer(I4B) :: img, si integer(I4B), save :: n[*] + logical, save :: isalloc[*] if (present(src_img)) then si = src_img @@ -105,99 +270,321 @@ module subroutine swiftest_coarray_component_copy_info_arr1D(var,src_img) si = 1 end if - n = size(var) sync all + isalloc = allocated(var) + if (isalloc) n = size(var) + sync all + if (.not. isalloc[si]) return + allocate(tmp(n[si])[*]) if (this_image() == si) then do img = 1, num_images() tmp(:)[img] = var end do + sync images(*) + else + sync images(si) + if (allocated(var)) deallocate(var) + allocate(var, source=tmp) + end if + + return + end subroutine swiftest_coarray_component_clone_info_arr1D + + + module subroutine swiftest_coarray_component_clone_kin_arr1D(var,src_img) + implicit none + !! 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_kinship allocatable array version + ! Arguments + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + ! Internals + type(swiftest_kinship), dimension(:), codimension[:], allocatable :: tmp + integer(I4B) :: img, si + integer(I4B), save :: n[*] + logical, save :: isalloc[*] + + if (present(src_img)) then + si = src_img + else + si = 1 end if + sync all - if (allocated(var)) deallocate(var) - allocate(var, source=tmp) + isalloc = allocated(var) + if (isalloc) n = size(var) + sync all + if (.not. isalloc[si]) return + + allocate(tmp(n[si])[*]) + if (this_image() == si) then + do img = 1, num_images() + tmp(:)[img] = var + end do + sync images(*) + else + sync images(si) + if (allocated(var)) deallocate(var) + allocate(var, source=tmp) + end if 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_component_clone_kin_arr1D + + + module subroutine swiftest_coarray_component_collect_info_arr1D(var,dest_img) + !! author: David A. Minton + !! + !! Collects components of a coarray derived type from all images and combines them into destination image component . The default destination 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 :: dest_img + ! Internals + type(swiftest_particle_info), dimension(:), codimension[:], allocatable :: tmp + integer(I4B) :: img, ti, di, ntot, istart, iend + integer(I4B), save :: n[*] + logical, save :: isalloc[*] + + if (present(dest_img)) then + di = dest_img + else + di = 1 + end if + + sync all + isalloc = allocated(var) + if (isalloc) then + n = size(var) + else + n = 0 + end if + sync all + ntot = 0 + do img = 1, num_images() + ntot = ntot + n[img] + end do + + allocate(tmp(ntot)[*]) + + ti = this_image() + + istart = 1 + iend = n + do img = 1, this_image() - 1 + istart = istart + n[img] + iend = iend + n[img] + end do + + if (isalloc) then + tmp(istart:iend) = var(:) + deallocate(var) + end if + + sync all + if (this_image() == di) then + allocate(var(ntot)) + istart = 1 + iend = n + do img = 1, num_images() + var(istart:iend) = tmp[img](istart:iend) + istart = istart + n[img] + iend = iend + n[img] + end do + end if + + return + end subroutine swiftest_coarray_component_collect_info_arr1D + + + module subroutine swiftest_coarray_cocollect_body(self) + !! author: David A. Minton + !! + !! Collects all body object array components from all images and combines them into the image 1 body object + implicit none + ! Arguments + class(swiftest_body),intent(inout), codimension[*] :: self !! Swiftest body object + integer(I4B) :: i + + call cocollect(self%nbody) + call cocollect(self%id) + call cocollect(self%info) + call cocollect(self%lmask) + call cocollect(self%status) + call cocollect(self%ldiscard) + call cocollect(self%lcollision) + call cocollect(self%lencounter) + call cocollect(self%mu) + call cocollect(self%rh) + call cocollect(self%vh) + call cocollect(self%rb) + call cocollect(self%vb) + call cocollect(self%ah) + call cocollect(self%aobl) + call cocollect(self%agr) + call cocollect(self%atide) + call cocollect(self%ir3h) + call cocollect(self%isperi) + call cocollect(self%peri) + call cocollect(self%atp) + call cocollect(self%a) + call cocollect(self%e) + call cocollect(self%inc) + call cocollect(self%capom) + call cocollect(self%omega) + call cocollect(self%capm) + + return + end subroutine swiftest_coarray_cocollect_body + + + module subroutine swiftest_coarray_cocollect_tp(self) + !! author: David A. Minton + !! + !! Collects all object array components from all images and combines them into the image 1 object + implicit none + ! Arguments + class(swiftest_tp),intent(inout),codimension[*] :: self !! Swiftest body object + + call cocollect(self%k_pltp) + call cocollect(self%npltp) + call cocollect(self%nplenc) + call swiftest_coarray_cocollect_body(self) + + return + end subroutine swiftest_coarray_cocollect_tp + + + module subroutine swiftest_coarray_collect_system(nbody_system, param) + !! 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 !! Swiftest nbody system + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i,j + integer(I4B), codimension[*], save :: ntp + class(swiftest_tp), allocatable, codimension[:] :: cotp + character(len=NAMELEN) :: image_num_char + + sync all + if (this_image() == 1) then + write(image_num_char,*) num_images() + write(param%display_unit,*) " Collecting test particles from " // trim(adjustl(image_num_char)) // " images." + end if + + allocate(cotp[*], source=nbody_system%tp) + call cotp%cocollect() + deallocate(nbody_system%tp) + allocate(nbody_system%tp, source=cotp) + + deallocate(cotp) + + if (this_image() == 1) then + write(param%display_unit,*) " Done collecting" + do i = 1, nbody_system%tp%nbody + write(*,*) i,"mu ",nbody_system%tp%mu(i) + end do + 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 + module subroutine swiftest_coarray_distribute_system(nbody_system, param) + !! 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 !! Swiftest nbody system + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, istart, iend, ntot, num_per_image, ncopy + class(swiftest_tp), allocatable :: tp + logical, dimension(:), allocatable :: lspill_list + integer(I4B), codimension[*], save :: ntp + character(len=NAMELEN) :: image_num_char + class(swiftest_tp), allocatable, codimension[:] :: cotp + class(swiftest_tp), allocatable :: tmp + + sync all + if (this_image() == 1) then + write(image_num_char,*) num_images() + write(param%display_unit,*) " Distributing test particles across " // trim(adjustl(image_num_char)) // " images." + end if + + ntp = nbody_system%tp%nbody + sync all + ntot = ntp[1] + if (ntot == 0) return + + 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 + + lspill_list(:) = .true. + lspill_list(istart:iend) = .false. + + allocate(cotp[*], source=nbody_system%tp) + call cotp%coclone() + if (this_image() /= 1) then + deallocate(nbody_system%tp) + allocate(nbody_system%tp, source=cotp) + end if + allocate(tmp, mold=nbody_system%tp) + call nbody_system%tp%spill(tmp, lspill_list(:), ldestructive=.true.) + + deallocate(tmp, cotp) + + if (this_image() == 1) then + write(param%display_unit,*) " Done distributing" + do i = 1, nbody_system%tp%nbody + write(*,*) i,"mu ",nbody_system%tp%mu(i) + end do + end if + + return end subroutine swiftest_coarray_distribute_system + + module subroutine swiftest_coarray_initialize_system(nbody_system, param) + !! author: David A. Minton + !! + !! Distributes test particles from image #1 out to all images. + implicit none + ! Arguments + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody system + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + class(swiftest_nbody_system), allocatable, codimension[:] :: tmp_system + character(len=NAMELEN) :: image_num_char + + sync all + if (this_image() == 1) then + write(image_num_char,*) num_images() + write(param%display_unit,*) " Cloning nbody system to " // trim(adjustl(image_num_char)) // " images." + end if + allocate(tmp_system[*], source=nbody_system) + call tmp_system%coclone() + if (this_image() /= 1) then + if (allocated(nbody_system)) deallocate(nbody_system) + allocate(nbody_system, source=tmp_system) + end if + + return + end subroutine swiftest_coarray_initialize_system + + end submodule s_swiftest_coarray \ No newline at end of file diff --git a/src/swiftest/swiftest_discard.f90 b/src/swiftest/swiftest_discard.f90 index 6af0c9a8f..da9208f6a 100644 --- a/src/swiftest/swiftest_discard.f90 +++ b/src/swiftest/swiftest_discard.f90 @@ -25,7 +25,7 @@ module subroutine swiftest_discard_system(self, param) lpl_check = allocated(self%pl_discards) ltp_check = allocated(self%tp_discards) - associate(nbody_system => self, tp => self%tp, pl => self%pl, tp_discards => self%tp_discards, pl_discards => self%pl_discards, nc => self%system_history%nc) + associate(nbody_system => self, tp => self%tp, pl => self%pl, tp_discards => self%tp_discards, pl_discards => self%pl_discards) lpl_discards = .false. ltp_discards = .false. if (lpl_check .and. pl%nbody > 0) then diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 index 31eccbdf9..9e139c986 100644 --- a/src/swiftest/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -19,12 +19,9 @@ program swiftest_driver use swiftest implicit none -#ifdef COARRAY - 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 type(swiftest_parameters) :: param !! Run configuration parameters + class(swiftest_storage), allocatable :: system_history !! Stores the system history between output dumps character(len=:), allocatable :: integrator !! Integrator type code (see globals for symbolic names) character(len=:), allocatable :: param_file_name !! Name of the file containing user-defined parameters character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" @@ -95,24 +92,29 @@ program swiftest_driver #ifdef COARRAY if (this_image() == 1) then #endif - call nbody_system%initialize(param) + call nbody_system%initialize(system_history, param) +#ifdef COARRAY + end if ! this_image() == 1 + call swiftest_coarray_initialize_system(nbody_system, param) + if (this_image() == 1) then +#endif ! 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 if (param%lrestart) then - call nbody_system%get_t0_values(param) + call nbody_system%get_t0_values(system_history%nc, param) else call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum end if call nbody_system%conservation_report(param, lterminal=.true.) end if - call nbody_system%system_history%take_snapshot(param,nbody_system) - call nbody_system%dump(param) + call system_history%take_snapshot(param,nbody_system) + call nbody_system%dump(param, system_history) #ifdef COARRAY - ! Distribute test particles to the various images end if ! this_image() == 1 - call nbody_system%coarray_distribute() + ! Distribute test particles to the various images + call nbody_system%coarray_distribute(param) #endif do iloop = istart, nloops !> Step the nbody_system forward in time @@ -136,14 +138,14 @@ program swiftest_driver istep = floor(istep_out * fstep_out**nout, kind=I4B) end if #ifdef COARRAY - call nbody_system%coarray_collect() + call nbody_system%coarray_collect(param) if (this_image() == 1) then #endif - call nbody_system%system_history%take_snapshot(param,nbody_system) + call system_history%take_snapshot(param,nbody_system) if (idump == dump_cadence) then idump = 0 - call nbody_system%dump(param) + call nbody_system%dump(param, system_history) end if call integration_timer%report(message="Integration steps:", unit=display_unit) @@ -152,7 +154,7 @@ program swiftest_driver if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) #ifdef COARRAY end if - call nbody_system%coarray_distribute() + call nbody_system%coarray_distribute(param) #endif end if end if @@ -160,11 +162,10 @@ program swiftest_driver end do ! Dump any remaining history if it exists #ifdef COARRAY - call nbody_system%coarray_collect() + call nbody_system%coarray_collect(param) if (this_image() == 1) then #endif - call nbody_system%dump(param) - call nbody_system%system_history%dump(param) + call nbody_system%dump(param, system_history) call nbody_system%display_run_information(param, integration_timer, phase="last") #ifdef COARRAY end if ! this_image() == 1 diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 610f623d1..1cf6f93e7 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -127,7 +127,7 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) integer(I4B), parameter :: EGYIU = 72 character(len=*), parameter :: EGYTERMFMT = '(" DL/L0 = ", ES12.5, "; DE_orbit/|E0| = ", ES12.5, "; DE_total/|E0| = ", ES12.5, "; DM/M0 = ", ES12.5)' - associate(nbody_system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit, nc => self%system_history%nc) + associate(nbody_system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit) select type(self) class is (helio_nbody_system) ! Don't convert vh to vb for Helio-based integrators, because they are already have that calculated @@ -189,8 +189,6 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) if (abs(nbody_system%Mtot_error) > 100 * epsilon(nbody_system%Mtot_error)) then write(*,*) "Severe error! Mass not conserved! Halting!" ! Save the frame of data to the bin file in the slot just after the present one for diagnostics - call self%write_frame(nc, param) - call nc%close() call base_util_exit(FAILURE) end if end if @@ -239,14 +237,14 @@ module subroutine swiftest_io_display_run_information(self, param, integration_t if (phase_val == 0) then if (param%lrestart) then - write(param%display_unit, *) " *************** Swiftest restart " // param%integrator // " *************** " + write(param%display_unit, *) " *************** Swiftest restart " // trim(adjustl(param%integrator)) // " *************** " else - write(param%display_unit, *) " *************** Swiftest start " // param%integrator // " *************** " + write(param%display_unit, *) " *************** Swiftest start " // trim(adjustl(param%integrator)) // " *************** " end if if (param%display_style == "PROGRESS") then call pbar%reset(param%nloops) else if (param%display_style == "COMPACT") then - write(*,*) "SWIFTEST START " // param%integrator + write(*,*) "SWIFTEST START " // trim(adjustl(param%integrator)) end if end if @@ -264,8 +262,8 @@ module subroutine swiftest_io_display_run_information(self, param, integration_t end if if (phase_val == -1) then - write(param%display_unit, *)" *************** Swiftest stop " // param%integrator // " *************** " - if (param%display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator + write(param%display_unit, *)" *************** Swiftest stop " // trim(adjustl(param%integrator)) // " *************** " + if (param%display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // trim(adjustl(param%integrator)) end if return @@ -303,7 +301,7 @@ module subroutine swiftest_io_dump_param(self, param_file_name) end subroutine swiftest_io_dump_param - module subroutine swiftest_io_dump_system(self, param) + module subroutine swiftest_io_dump_system(self, param, system_history) !! author: David A. Minton !! !! Dumps the state of the nbody_system to files in case the simulation is interrupted. @@ -313,6 +311,7 @@ module subroutine swiftest_io_dump_system(self, param) ! Arguments class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_storage), intent(inout) :: system_history !! Stores the system history between output dumps ! Internals class(swiftest_parameters), allocatable :: param_restart !! Local parameters variable used to parameters change input file names !! to dump file-specific values without changing the user-defined values @@ -324,7 +323,7 @@ module subroutine swiftest_io_dump_system(self, param) if (allocated(self%collision_history)) call self%collision_history%dump(param) ! Dump the nbody_system history to file - call self%system_history%dump(param) + call system_history%dump(param) allocate(param_restart, source=param) param_restart%in_form = "XV" @@ -353,7 +352,7 @@ module subroutine swiftest_io_dump_storage(self, param) implicit none ! Arguments class(swiftest_storage), intent(inout) :: self !! Swiftest simulation history storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -366,7 +365,7 @@ module subroutine swiftest_io_dump_storage(self, param) if (allocated(self%frame(i)%item)) then select type(nbody_system => self%frame(i)%item) class is (swiftest_nbody_system) - call nbody_system%write_frame(param) + call nbody_system%write_frame(nc, param) end select deallocate(self%frame(i)%item) end if @@ -566,15 +565,16 @@ module subroutine swiftest_io_netcdf_flush(self, param) end subroutine swiftest_io_netcdf_flush - module subroutine swiftest_io_netcdf_get_t0_values_system(self, param) + module subroutine swiftest_io_netcdf_get_t0_values_system(self, nc, param) !! author: David A. Minton !! !! Gets the t0 values of various parameters such as energy and momentum !! implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self - class(swiftest_parameters), intent(inout) :: param + class(swiftest_nbody_system), intent(inout) :: self + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param ! Internals integer(I4B) :: itmax, idmax, tslot real(DP), dimension(:), allocatable :: vals @@ -582,7 +582,7 @@ module subroutine swiftest_io_netcdf_get_t0_values_system(self, param) real(DP), dimension(NDIM) :: rot0, Ip0, L real(DP) :: mass0 - associate (nc => self%system_history%nc, cb => self%cb) + associate (cb => self%cb) call nc%open(param, readonly=.true.) call nc%find_tslot(param%t0, tslot) call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=itmax), "netcdf_io_get_t0_values_system time_dimid" ) @@ -2318,6 +2318,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i ! 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%coclone() @@ -2325,11 +2326,6 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i 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 @@ -2751,14 +2747,15 @@ module subroutine swiftest_io_read_in_cb(self, param) end subroutine swiftest_io_read_in_cb - module subroutine swiftest_io_read_in_system(self, param) + module subroutine swiftest_io_read_in_system(self, nc, param) !! author: David A. Minton and Carlisle A. Wishard !! !! Reads in the nbody_system from input files implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self - class(swiftest_parameters), intent(inout) :: param + class(swiftest_nbody_system), intent(inout) :: self + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param ! Internals integer(I4B) :: ierr, i class(swiftest_parameters), allocatable :: tmp_param @@ -2781,13 +2778,13 @@ module subroutine swiftest_io_read_in_system(self, param) self%E_untracked = param%E_untracked else allocate(tmp_param, source=param) - self%system_history%nc%file_name = param%nc_in + nc%file_name = param%nc_in tmp_param%out_form = param%in_form if (.not. param%lrestart) then ! Turn off energy computation so we don't have to feed it into the initial conditions tmp_param%lenergy = .false. end if - ierr = self%read_frame(self%system_history%nc, tmp_param) + ierr = self%read_frame(nc, tmp_param) deallocate(tmp_param) if (ierr /=0) call base_util_exit(FAILURE) end if @@ -3003,7 +3000,7 @@ module subroutine swiftest_io_toupper(string) end subroutine swiftest_io_toupper - module subroutine swiftest_io_write_frame_system(self, param) + module subroutine swiftest_io_write_frame_system(self, nc, param) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Write a frame (header plus records for each massive body and active test particle) to output binary file @@ -3013,14 +3010,15 @@ module subroutine swiftest_io_write_frame_system(self, param) !! Adapted from Hal Levison's Swift routine io_write_frame.f implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals logical, save :: lfirst = .true. !! Flag to determine if this is the first call of this method character(len=STRMAX) :: errmsg logical :: fileExists - associate (nc => self%system_history%nc, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) + associate (pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) nc%file_name = param%outfile if (lfirst) then inquire(file=param%outfile, exist=fileExists) @@ -3045,7 +3043,7 @@ module subroutine swiftest_io_write_frame_system(self, param) lfirst = .false. end if - call self%write_frame(nc, param) + call swiftest_io_netcdf_write_frame_system(self, nc, param) end associate return diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index fc5819ac1..6388929ac 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -159,7 +159,8 @@ module swiftest 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. + procedure :: coclone => swiftest_coarray_coclone_body !! Clones the image 1 body object to all other images in the coarray structure. + procedure :: cocollect => swiftest_coarray_cocollect_body !! Collects all body object array components from all images and combines them into the image 1 body object #endif end type swiftest_body @@ -218,6 +219,10 @@ module swiftest procedure :: read_in => swiftest_io_read_in_cb !! Read in central body initial conditions from an ASCII file procedure :: write_frame => swiftest_io_netcdf_write_frame_cb !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format procedure :: write_info => swiftest_io_netcdf_write_info_cb !! Dump contents of particle information metadata to file + +#ifdef COARRAY + procedure :: coclone => swiftest_coarray_coclone_cb !! Clones the image 1 body object to all other images in the coarray structure. +#endif end type swiftest_cb @@ -277,6 +282,9 @@ module swiftest procedure :: rearrange => swiftest_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => swiftest_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) generic :: set_renc => set_renc_I4B, set_renc_DP +#ifdef COARRAY + procedure :: coclone => swiftest_coarray_coclone_pl !! Clones the image 1 body object to all other images in the coarray structure. +#endif end type swiftest_pl @@ -307,6 +315,10 @@ module swiftest procedure :: sort => swiftest_util_sort_tp !! Sorts body arrays by a sortable component procedure :: rearrange => swiftest_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => swiftest_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) +#ifdef COARRAY + procedure :: coclone => swiftest_coarray_coclone_tp !! Clones the image 1 object to all other images in the coarray structure. + procedure :: cocollect => swiftest_coarray_cocollect_tp !! Collects all object array components from all images and combines them into the image 1 object +#endif end type swiftest_tp @@ -330,7 +342,6 @@ module swiftest class(collision_basic), allocatable :: collider !! Collision system object class(encounter_storage), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file class(collision_storage), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file - class(swiftest_storage), allocatable :: system_history !! Stores the system history between output dumps integer(I4B) :: maxid = -1 !! The current maximum particle id number real(DP) :: t = -1.0_DP !! Integration current time @@ -391,17 +402,12 @@ module swiftest procedure :: dump => swiftest_io_dump_system !! Dump the state of the nbody_system to a file procedure :: get_t0_values => swiftest_io_netcdf_get_t0_values_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. procedure :: read_frame => swiftest_io_netcdf_read_frame_system !! Read in a frame of input data from file - procedure :: write_frame_netcdf => swiftest_io_netcdf_write_frame_system !! Write a frame of input data from file procedure :: read_hdr => swiftest_io_netcdf_read_hdr_system !! Read a header for an output frame in NetCDF format procedure :: write_hdr => swiftest_io_netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format procedure :: read_particle_info => swiftest_io_netcdf_read_particle_info_system !! Read in particle metadata from file procedure :: read_in => swiftest_io_read_in_system !! Reads the initial conditions for an nbody system - procedure :: write_frame_system => swiftest_io_write_frame_system !! Write a frame of input data from file + procedure :: write_frame => 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_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 procedure :: get_idvals => swiftest_util_get_idvalues_system !! Returns an array of all id values in use in the nbody_system @@ -411,7 +417,11 @@ module swiftest ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. procedure :: set_msys => swiftest_util_set_msys !! Sets the value of msys from the masses of nbody_system bodies. procedure :: validate_ids => swiftest_util_valid_id_system !! Validate the numerical ids passed to the nbody_system and save the maximum value - generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data +#ifdef COARRAY + procedure :: coclone => swiftest_coarray_coclone_system !! Clones the image 1 body object to all other images in the coarray structure. + 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 end type swiftest_nbody_system @@ -602,10 +612,11 @@ module subroutine swiftest_io_dump_param(self, param_file_name) character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) end subroutine swiftest_io_dump_param - module subroutine swiftest_io_dump_system(self, param) + module subroutine swiftest_io_dump_system(self, param, system_history) 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_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_storage), intent(inout) :: system_history !! Stores the system history between output dumps end subroutine swiftest_io_dump_system module subroutine swiftest_io_dump_storage(self, param) @@ -649,10 +660,11 @@ module subroutine swiftest_io_netcdf_flush(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_netcdf_flush - module subroutine swiftest_io_netcdf_get_t0_values_system(self, param) + module subroutine swiftest_io_netcdf_get_t0_values_system(self, nc, 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_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_netcdf_get_t0_values_system module subroutine swiftest_io_netcdf_get_valid_masks(self, plmask, tpmask) @@ -847,9 +859,10 @@ module subroutine swiftest_io_read_in_param(self, param_file_name) character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) end subroutine swiftest_io_read_in_param - module subroutine swiftest_io_read_in_system(self, param) + module subroutine swiftest_io_read_in_system(self, nc, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self + class(swiftest_nbody_system), intent(inout) :: self + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param end subroutine swiftest_io_read_in_system @@ -880,9 +893,10 @@ module subroutine swiftest_io_toupper(string) character(*), intent(inout) :: string !! String to make upper case end subroutine swiftest_io_toupper - module subroutine swiftest_io_write_frame_system(self, param) + module subroutine swiftest_io_write_frame_system(self, nc, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_write_frame_system @@ -1068,12 +1082,8 @@ end subroutine swiftest_util_setup_body module subroutine swiftest_util_setup_construct_system(nbody_system, param) implicit none -#ifdef COARRAY - class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system[:] !! Swiftest nbody_system object -#else - class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object -#endif - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_util_setup_construct_system module subroutine swiftest_util_setup_initialize_particle_info_system(self, param) @@ -1082,10 +1092,11 @@ module subroutine swiftest_util_setup_initialize_particle_info_system(self, para class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_util_setup_initialize_particle_info_system - module subroutine swiftest_util_setup_initialize_system(self, param) + module subroutine swiftest_util_setup_initialize_system(self, system_history, 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_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps + 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) @@ -1952,29 +1963,51 @@ end subroutine swiftest_util_version #ifdef COARRAY interface - module subroutine swiftest_coarray_collect_system(nbody_system) + module subroutine swiftest_coarray_collect_system(nbody_system, param) implicit none - class(swiftest_nbody_system), intent(inout) :: nbody_system[*] + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_coarray_collect_system - module subroutine swiftest_coarray_distribute_system(nbody_system) + module subroutine swiftest_coarray_distribute_system(nbody_system, param) implicit none - class(swiftest_nbody_system), intent(inout) :: nbody_system[*] + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_coarray_distribute_system + + module subroutine swiftest_coarray_initialize_system(nbody_system, param) + implicit none + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody system + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_coarray_initialize_system end interface interface coclone - module subroutine swiftest_coarray_component_copy_info(var,src_img) + module subroutine swiftest_coarray_component_clone_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 + end subroutine swiftest_coarray_component_clone_info - module subroutine swiftest_coarray_component_copy_info_arr1D(var,src_img) + module subroutine swiftest_coarray_component_clone_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 subroutine swiftest_coarray_component_clone_info_arr1D + + module subroutine swiftest_coarray_component_clone_kin_arr1D(var,src_img) + implicit none + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: src_img + end subroutine swiftest_coarray_component_clone_kin_arr1D + end interface + + interface cocollect + module subroutine swiftest_coarray_component_collect_info_arr1D(var,dest_img) + implicit none + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: var + integer(I4B), intent(in),optional :: dest_img + end subroutine end interface interface @@ -1982,7 +2015,40 @@ 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 + + module subroutine swiftest_coarray_coclone_cb(self) + implicit none + class(swiftest_cb),intent(inout),codimension[*] :: self !! Swiftest cb object + end subroutine swiftest_coarray_coclone_cb + + module subroutine swiftest_coarray_coclone_pl(self) + implicit none + class(swiftest_pl),intent(inout),codimension[*] :: self !! Swiftest pl object + end subroutine swiftest_coarray_coclone_pl + + module subroutine swiftest_coarray_coclone_tp(self) + implicit none + class(swiftest_tp),intent(inout),codimension[*] :: self !! Swiftest tp object + end subroutine swiftest_coarray_coclone_tp + + module subroutine swiftest_coarray_coclone_system(self) + implicit none + class(swiftest_nbody_system),intent(inout),codimension[*] :: self !! Swiftest nbody system object + end subroutine swiftest_coarray_coclone_system + + module subroutine swiftest_coarray_cocollect_body(self) + !! Collects all body object array components from all images and combines them into the image 1 body object + implicit none + class(swiftest_body),intent(inout), codimension[*] :: self !! Swiftest body object + end subroutine swiftest_coarray_cocollect_body + + module subroutine swiftest_coarray_cocollect_tp(self) + !! Collects all body object array components from all images and combines them into the image 1 body object + implicit none + class(swiftest_tp),intent(inout), codimension[*] :: self !! Swiftest tp object + end subroutine swiftest_coarray_cocollect_tp end interface + #endif contains diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 7e5bd548a..77747170b 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -896,7 +896,6 @@ module subroutine swiftest_util_dealloc_system(self) if (allocated(self%collider)) deallocate(self%collider) if (allocated(self%encounter_history)) deallocate(self%encounter_history) if (allocated(self%collision_history)) deallocate(self%collision_history) - if (allocated(self%system_history)) deallocate(self%system_history) self%t = -1.0_DP self%GMtot = 0.0_DP @@ -2695,28 +2694,19 @@ module subroutine swiftest_util_set_rhill_approximate(self,cb) end subroutine swiftest_util_set_rhill_approximate module subroutine swiftest_util_setup_construct_system(nbody_system, param) + !! author: David A. Minton !! !! Constructor for a Swiftest nbody system. Creates the nbody system object based on the user-input integrator !! implicit none ! Arguments -#ifdef COARRAY - class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system[:] !! Swiftest nbody_system object -#else - class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object -#endif - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters select case(param%integrator) case (INT_BS) write(*,*) 'Bulirsch-Stoer integrator not yet enabled' case (INT_HELIO) -#ifdef COARRAY - allocate(helio_nbody_system :: nbody_system[*]) -#else - allocate(helio_nbody_system :: nbody_system) -#endif select type(nbody_system) class is (helio_nbody_system) allocate(helio_cb :: nbody_system%cb) @@ -2730,11 +2720,7 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) case (INT_TU4) write(*,*) 'INT_TU4 integrator not yet enabled' case (INT_WHM) -#ifdef COARRAY - allocate(whm_nbody_system :: nbody_system[*]) -#else allocate(whm_nbody_system :: nbody_system) -#endif select type(nbody_system) class is (whm_nbody_system) allocate(whm_cb :: nbody_system%cb) @@ -2744,11 +2730,7 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) end select param%collision_model = "MERGE" case (INT_RMVS) -#ifdef COARRAY - allocate(rmvs_nbody_system :: nbody_system[*]) -#else allocate(rmvs_nbody_system :: nbody_system) -#endif select type(nbody_system) class is (rmvs_nbody_system) allocate(rmvs_cb :: nbody_system%cb) @@ -2758,11 +2740,7 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) end select param%collision_model = "MERGE" case (INT_SYMBA) -#ifdef COARRAY - allocate(symba_nbody_system :: nbody_system[*]) -#else allocate(symba_nbody_system :: nbody_system) -#endif select type(nbody_system) class is (symba_nbody_system) allocate(symba_cb :: nbody_system%cb) @@ -2826,28 +2804,28 @@ module subroutine swiftest_util_setup_initialize_particle_info_system(self, para end subroutine swiftest_util_setup_initialize_particle_info_system - module subroutine swiftest_util_setup_initialize_system(self, param) + module subroutine swiftest_util_setup_initialize_system(self, system_history, param) !! author: David A. Minton !! !! Wrapper method to initialize a basic Swiftest nbody system from files !! implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps + 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) + if (allocated(system_history)) then + call system_history%dealloc() + deallocate(system_history) end if - allocate(swiftest_storage :: self%system_history) - call self%system_history%setup(param%dump_cadence) - allocate(swiftest_netcdf_parameters :: self%system_history%nc) + allocate(swiftest_storage :: system_history) + call system_history%setup(param%dump_cadence) + allocate(swiftest_netcdf_parameters :: 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) + associate(nbody_system => self, cb => self%cb, pl => self%pl, tp => self%tp, nc => system_history%nc) + call nbody_system%read_in(nc, param) call nbody_system%validate_ids(param) call nbody_system%set_msys() call pl%set_mu(cb) @@ -2867,7 +2845,7 @@ module subroutine swiftest_util_setup_initialize_system(self, param) ! Write initial conditions to file nc%file_name = param%outfile - call nbody_system%write_frame(param) + call nbody_system%write_frame(nc, param) call nc%close() end associate @@ -3069,11 +3047,7 @@ module subroutine swiftest_util_snapshot_system(self, param, nbody_system, t, ar ! Arguments 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) ! Internals @@ -3102,9 +3076,6 @@ module subroutine swiftest_util_snapshot_system(self, param, nbody_system, t, ar allocate(snapshot%cb, source=nbody_system%cb ) allocate(snapshot%pl, source=nbody_system%pl ) allocate(snapshot%tp, source=nbody_system%tp ) - allocate(snapshot%system_history) - allocate(snapshot%system_history%nc, source=nbody_system%system_history%nc) - snapshot%system_history%nc%lfile_is_open = .true. snapshot%t = nbody_system%t snapshot%GMtot = nbody_system%GMtot diff --git a/src/symba/symba_module.f90 b/src/symba/symba_module.f90 index efa8dda8f..85e5ca3bc 100644 --- a/src/symba/symba_module.f90 +++ b/src/symba/symba_module.f90 @@ -243,10 +243,12 @@ module subroutine symba_util_dealloc_system(self) class(symba_nbody_system), intent(inout) :: self end subroutine symba_util_dealloc_system - module subroutine symba_util_setup_initialize_system(self, param) + + module subroutine symba_util_setup_initialize_system(self, system_history, param) implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object + class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_util_setup_initialize_system module subroutine symba_util_setup_pl(self, n, param) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index a30c08bac..ad1d50383 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -273,7 +273,7 @@ module subroutine symba_util_set_renc(self, scale) end subroutine symba_util_set_renc - module subroutine symba_util_setup_initialize_system(self, param) + module subroutine symba_util_setup_initialize_system(self, system_history, param) !! author: David A. Minton !! !! Initialize an SyMBA nbody system from files and sets up the planetocentric structures. @@ -281,8 +281,9 @@ module subroutine symba_util_setup_initialize_system(self, param) !! implicit none ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object + class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals type(encounter_storage) :: encounter_history type(collision_storage) :: collision_history @@ -291,7 +292,7 @@ module subroutine symba_util_setup_initialize_system(self, param) call collision_history%setup(4096) ! Call parent method associate(nbody_system => self) - call helio_util_setup_initialize_system(nbody_system, param) + call helio_util_setup_initialize_system(nbody_system, system_history, param) call nbody_system%pltp_encounter%setup(0_I8B) call nbody_system%plpl_encounter%setup(0_I8B) call nbody_system%plpl_collision%setup(0_I8B) diff --git a/src/whm/whm_coarray.f90 b/src/whm/whm_coarray.f90 new file mode 100644 index 000000000..5a8de4c32 --- /dev/null +++ b/src/whm/whm_coarray.f90 @@ -0,0 +1,34 @@ +!! 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 (whm) s_whm_coarray +use coarray +use swiftest +contains + + module subroutine whm_coarray_coclone_pl(self) + !! author: David A. Minton + !! + !! Broadcasts the image 1 object to all other images in a coarray + implicit none + ! Arguments + class(whm_pl),intent(inout),codimension[*] :: self !! WHM pl object + + call coclone(self%eta) + call coclone(self%xj) + call coclone(self%vj) + call coclone(self%muj) + call coclone(self%ir3j) + + call swiftest_coarray_coclone_pl(self) + + return + end subroutine whm_coarray_coclone_pl + +end submodule s_whm_coarray \ No newline at end of file diff --git a/src/whm/whm_module.f90 b/src/whm/whm_module.f90 index d2d10f971..38e73f190 100644 --- a/src/whm/whm_module.f90 +++ b/src/whm/whm_module.f90 @@ -48,10 +48,13 @@ module whm procedure :: set_mu => whm_util_set_mu_eta_pl !! Sets the Jacobi mass value for all massive bodies. procedure :: sort => whm_util_sort_pl !! Sort a WHM massive body object in-place. procedure :: rearrange => whm_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => whm_util_spill_pl !!"Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - procedure :: setup => whm_util_setup_pl !! Constructor method - Allocates space for the input number of bodiess + procedure :: spill => whm_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: setup => whm_util_setup_pl !! Constructor method - Allocates space for the input number of bodiess procedure :: step => whm_step_pl !! Steps the body forward one stepsize - final :: whm_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables + final :: whm_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables +#ifdef COARRAY + procedure :: coclone => whm_coarray_coclone_pl !! Clones the image 1 body object to all other images in the coarray structure. +#endif end type whm_pl @@ -180,10 +183,11 @@ module subroutine whm_util_setup_pl(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine whm_util_setup_pl - module subroutine whm_util_setup_initialize_system(self, param) + module subroutine whm_util_setup_initialize_system(self, system_history, param) implicit none - class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object + class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine whm_util_setup_initialize_system module subroutine whm_step_pl(self, nbody_system, param, t, dt) @@ -270,6 +274,15 @@ module subroutine whm_util_sort_rearrange_pl(self, ind) end subroutine whm_util_sort_rearrange_pl end interface +#ifdef COARRAY + interface + module subroutine whm_coarray_coclone_pl(self) + implicit none + class(whm_pl),intent(inout),codimension[*] :: self !! WHM pl object + end subroutine whm_coarray_coclone_pl + end interface +#endif + contains subroutine whm_final_pl(self) diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 751e97d2a..13105047e 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -200,17 +200,18 @@ module subroutine whm_util_set_mu_eta_pl(self, cb) end subroutine whm_util_set_mu_eta_pl - module subroutine whm_util_setup_initialize_system(self, param) + module subroutine whm_util_setup_initialize_system(self, system_history, param) !! author: David A. Minton !! !! Initialize a WHM nbody system from files !! implicit none ! Arguments - class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object + class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - call swiftest_util_setup_initialize_system(self, param) + call swiftest_util_setup_initialize_system(self, system_history, param) ! First we need to make sure that the massive bodies are sorted by heliocentric distance before computing jacobies call swiftest_util_set_ir3h(self%pl) call self%pl%sort("ir3h", ascending=.false.)