More coarray broadcasting infrastructure

src/CMakeLists.txt

@@ -85,6 +85,7 @@ SET(FAST_MATH_FILES
 
 SET(COARRAY_FILES
             ${SRC}/coarray/coarray_module.f90
+            ${SRC}/swiftest/swiftest_coarray.f90
 )
 
 IF(USE_COARRAY)

src/base/base_module.f90

@@ -114,7 +114,7 @@ module base
       procedure(abstract_io_param_writer),    deferred :: writer    
       procedure(abstract_io_read_in_param),   deferred :: read_in 
 #ifdef COARRAY
-      procedure :: cobroadcast => base_cobroadcast_param
+      procedure :: coclone => base_coclone_param
 #endif
    end type base_parameters
 
@@ -433,7 +433,7 @@ subroutine base_final_storage_frame(self)
       end subroutine base_final_storage_frame
 
 #ifdef COARRAY
-      subroutine base_cobroadcast_param(self)
+      subroutine base_coclone_param(self)
          !! author: David A. Minton
          !!
          !! Broadcasts the image 1 parameter to all other images in a parameter coarray
@@ -523,7 +523,7 @@ subroutine base_cobroadcast_param(self)
          call coclone(self%seed)
 
          return
-      end subroutine base_cobroadcast_param 
+      end subroutine base_coclone_param 
 
 #endif
 

src/coarray/coarray_module.f90

@@ -20,10 +20,12 @@ module coarray
         module procedure coarray_component_copy_char
         module procedure coarray_component_copy_DP
         module procedure coarray_component_copy_DP_arr1D
+        module procedure coarray_component_copy_DP_arr2D
         module procedure coarray_component_copy_I4B
         module procedure coarray_component_copy_I4B_arr1D
         module procedure coarray_component_copy_I8B
         module procedure coarray_component_copy_lgt
+        module procedure coarray_component_copy_lgt_arr1D
         module procedure coarray_component_copy_QP
     end interface
 
@@ -97,7 +99,7 @@ subroutine coarray_component_copy_DP_arr1D(var,src_img)
         !! author: David A. Minton
         !!
         !! Copies a component of a coarray derived type from the specified source image to the current local one. The default source image is 1
-        !! real(DP) allocatable array version
+        !! real(DP) 1D allocatable array version
         implicit none
         ! Arguments
         real(DP), dimension(:), allocatable, intent(inout) :: var
@@ -206,7 +208,7 @@ subroutine coarray_component_copy_I4B_arr1D(var,src_img)
         !! author: David A. Minton
         !!
         !! Copies a component of a coarray derived type from the specified source image to the current local one. The default source image is 1
-        !! integer(I4B) allocatable array version
+        !! integer(I4B) 1D allocatable array version
         implicit none
         ! Arguments
         integer(I4B), dimension(:), allocatable, intent(inout) :: var
@@ -302,6 +304,43 @@ subroutine coarray_component_copy_lgt(var,src_img)
      end subroutine coarray_component_copy_lgt
 
 
+     subroutine coarray_component_copy_lgt_arr1D(var,src_img)
+        !! author: David A. Minton
+        !!
+        !! Copies a component of a coarray derived type from the specified source image to the current local one. The default source image is 1
+        !! logical 1D allocatable array version
+        implicit none
+        ! Arguments
+        logical, dimension(:), allocatable, intent(inout) :: var
+        integer(I4B), intent(in),optional :: src_img
+        ! Internals
+        logical, dimension(:), codimension[:], allocatable :: tmp
+        integer(I4B) :: img, si
+        integer(I4B), save :: n[*]
+
+        if (present(src_img)) then
+            si = src_img
+        else
+            si = 1
+        end if
+
+        n = size(var)
+        sync all
+        allocate(tmp(n[si])[*])
+        if (this_image() == si) then
+            do img = 1, num_images()
+                tmp(:)[img] = var 
+            end do
+        end if
+        sync all
+        if (allocated(var)) deallocate(var)
+        allocate(var, source=tmp)
+
+        return
+     end subroutine coarray_component_copy_lgt_arr1D
+
+
+
      subroutine coarray_component_copy_QP(var,src_img)
         !! author: David A. Minton
         !!

src/swiftest/swiftest_coarray.f90

@@ -0,0 +1,203 @@
+!! Copyright 2023 - David Minton
+!! This file is part of Swiftest.
+!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License 
+!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty 
+!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+!! You should have received a copy of the GNU General Public License along with Swiftest. 
+!! If not, see: https://www.gnu.org/licenses. 
+
+submodule (swiftest) s_swiftest_coarray
+    use coarray
+contains
+
+    module subroutine swiftest_coarray_coclone_body(self)
+        !! author: David A. Minton
+         !!
+         !! Broadcasts the image 1 object to all other images in a coarray 
+        implicit none
+        ! Arguments
+        class(swiftest_body),intent(inout),codimension[*]  :: self  !! Swiftest body object
+
+        call coclone(self%lfirst)
+        call coclone(self%nbody)
+        call coclone(self%id)
+        call coclone(self%info)
+        call coclone(self%lmask)
+        call coclone(self%status)
+        call coclone(self%ldiscard)
+        call coclone(self%lcollision)
+        call coclone(self%lencounter)
+        call coclone(self%mu)
+        call coclone(self%rh)
+        call coclone(self%vh)
+        call coclone(self%rb)
+        call coclone(self%vb)
+        call coclone(self%ah)
+        call coclone(self%aobl)
+        call coclone(self%agr)
+        call coclone(self%atide)
+        call coclone(self%ir3h)
+        call coclone(self%isperi)
+        call coclone(self%peri)
+        call coclone(self%atp)
+        call coclone(self%a)
+        call coclone(self%e)
+        call coclone(self%inc)
+        call coclone(self%capom)
+        call coclone(self%omega)
+        call coclone(self%capm)
+
+        return
+    end subroutine swiftest_coarray_coclone_body
+
+
+    module subroutine swiftest_coarray_component_copy_info(var,src_img)
+        !! author: David A. Minton
+        !!
+        !! Copies a component of a coarray derived type from the specified source image to the current local one. The default source image is 1
+        !! swiftest_particle_info scalar version
+        implicit none
+        ! Arguments
+        type(swiftest_particle_info), intent(inout) :: var
+        integer(I4B), intent(in),optional :: src_img
+        ! Internals
+        type(swiftest_particle_info),save :: tmp[*]
+        integer(I4B) :: img, si
+
+        if (present(src_img)) then
+            si = src_img
+        else
+            si = 1
+        end if
+
+        sync all
+        if (this_image() == si) then
+            do img = 1, num_images()
+                tmp[img] = var 
+            end do
+        end if
+        sync all
+        var = tmp[si]
+
+        return
+
+    end subroutine swiftest_coarray_component_copy_info
+
+
+    module subroutine swiftest_coarray_component_copy_info_arr1D(var,src_img)
+        !! author: David A. Minton
+        !!
+        !! Copies a component of a coarray derived type from the specified source image to the current local one. The default source image is 1
+        !! swiftest_particle_info 1D allocatable array version
+        implicit none
+        ! Arguments
+        type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: var
+        integer(I4B), intent(in),optional :: src_img
+        ! Internals
+        type(swiftest_particle_info), dimension(:), codimension[:], allocatable :: tmp
+        integer(I4B) :: img, si
+        integer(I4B), save :: n[*]
+
+        if (present(src_img)) then
+            si = src_img
+        else
+            si = 1
+        end if
+
+        n = size(var)
+        sync all
+        allocate(tmp(n[si])[*])
+        if (this_image() == si) then
+            do img = 1, num_images()
+                tmp(:)[img] = var 
+            end do
+        end if
+        sync all
+        if (allocated(var)) deallocate(var)
+        allocate(var, source=tmp)
+
+        return
+     end subroutine swiftest_coarray_component_copy_info_arr1D
+
+
+    module subroutine swiftest_coarray_collect_system(nbody_system)
+       !! author: David A. Minton
+       !!
+       !! Collects all the test particles from other images into the image #1 test particle system
+       implicit none
+       ! Arguments
+       class(swiftest_nbody_system), intent(inout) :: nbody_system[*]
+       ! Internals
+       integer(I4B) :: i,j
+       integer(I4B), dimension(num_images()) :: ntp
+       class(swiftest_tp), allocatable :: tp_img
+
+       ! ntp(this_image()) = nbody_system%tp%nbody
+       ! sync all
+       ! if (this_image() == 1) then
+       !    write(*,*) "Collecting test particles"
+       !    write(*,*) "Image ",1," ntp: ",ntp(1)
+       !    do i = 2, num_images()
+       !       write(*,*) "Image ",i," ntp: ",ntp(i)
+       !       allocate(tp_img, source=nbody_system[i]%tp)
+       !       call nbody_system%tp%append(tp_img,lsource_mask=[(.true., j = 1, ntp(i))])
+       !       deallocate(tp_img)
+       !    end do
+       !    write(*,*) "Total test particles: ",nbody_system%tp%nbody
+       ! end if
+
+       return
+    end subroutine swiftest_coarray_collect_system
+
+
+    module subroutine swiftest_coarray_distribute_system(nbody_system)
+       !! author: David A. Minton
+       !!
+       !! Distributes test particles from image #1 out to all images.
+       implicit none
+       ! Arguments
+       class(swiftest_nbody_system), intent(inout) :: nbody_system[*]
+       ! Internals
+       integer(I4B) :: i, istart, iend, ntot, num_per_image, ncopy
+       class(swiftest_tp), allocatable :: tp_orig
+       logical, dimension(:), allocatable :: lspill_list
+       integer(I4B), codimension[*],save :: ntp
+       class(swiftest_nbody_system), allocatable :: tmp_system
+       class(swiftest_tp), allocatable :: tp
+
+       ! ntp = nbody_system%tp%nbody
+       ! sync all
+
+       ! ntot = ntp[1]
+       ! if (ntot == 0) return
+
+       ! allocate(tp, mold=nbody_system%tp)
+
+       ! write(*,*) "Image ",this_image(), "Distributing ",ntot
+       ! allocate(lspill_list(ntot))
+       ! num_per_image = ntot / num_images()
+       ! istart = (this_image() - 1) * num_per_image + 1
+       ! if (this_image() == num_images()) then
+       !    iend = ntot
+       ! else
+       !    iend = this_image() * num_per_image
+       ! end if
+
+       ! if (this_image() == 1) then
+       !    lspill_list(:) = .true.
+       !    lspill_list(istart:iend) = .false.
+       !    call nbody_system%tp%spill(tp,lspill_list(:), ldestructive=.true.)
+       ! else
+       !    lspill_list(:) = .false.
+       !    lspill_list(istart:iend) = .true.
+       !    tp%nbody = ntot
+       !    call nbody_system%tp%spill(tp,lspill_list(:), ldestructive=.true.)
+       ! end if
+
+       ! write(*,*) "Image ",this_image(), "ntp: ",nbody_system%tp%nbody
+
+       return
+    end subroutine swiftest_coarray_distribute_system
+
+end submodule s_swiftest_coarray

src/swiftest/swiftest_io.f90

@@ -2320,7 +2320,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i
       end associate
 #ifdef COARRAY
    end if ! this_image() == 1
-      call coparam%cobroadcast()
+      call coparam%coclone()
       select type(self)
       type is (swiftest_parameters)
          self = coparam