diff --git a/src/coarray/coarray_collect.f90 b/src/coarray/coarray_collect.f90 index 35808d88f..bf60aa522 100644 --- a/src/coarray/coarray_collect.f90 +++ b/src/coarray/coarray_collect.f90 @@ -55,7 +55,7 @@ module subroutine coarray_component_collect_DP_arr1D(var,dest_img) if (this_image() == di) then do img = 1, num_images() if (img /= di) then - call util_append(var, tmp(:)[img]) + call util_append(var, tmp(1:n[img])[img]) n = n + n[img] end if end do @@ -231,7 +231,7 @@ module subroutine coarray_component_collect_I4B_arr1D(var,dest_img) if (this_image() == di) then do img = 1, num_images() if (img /= di) then - call util_append(var, tmp(:)[img]) + call util_append(var, tmp(1:n[img])[img]) n = n + n[img] end if end do @@ -252,7 +252,7 @@ module subroutine coarray_component_collect_lgt_arr1D(var,dest_img) integer(I4B), intent(in),optional :: dest_img ! Internals logical, dimension(:), codimension[:], allocatable :: tmp - integer(I4B) :: i,img, ti, di, ntot, istart, iend + integer(I4B) :: i,img, ti, di, ntot, istart, iend, nmax integer(I4B), allocatable :: n[:] logical, allocatable :: isalloc[:] @@ -271,13 +271,19 @@ module subroutine coarray_component_collect_lgt_arr1D(var,dest_img) else n = 0 end if - allocate(tmp[*],source=var) sync all + nmax = 0 + do img = 1, num_images() + if (n[img] > nmax) nmax = n[img] + end do + + allocate(tmp(nmax)[*]) + if (isalloc) tmp(1:n) = var(1:n) if (this_image() == di) then do img = 1, num_images() if (img /= di) then - call util_append(var, tmp(:)[img]) + call util_append(var, tmp(1:n[img])[img]) n = n + n[img] end if end do diff --git a/src/swiftest/swiftest_coarray.f90 b/src/swiftest/swiftest_coarray.f90 index f3643f42a..9b3de3b81 100644 --- a/src/swiftest/swiftest_coarray.f90 +++ b/src/swiftest/swiftest_coarray.f90 @@ -209,7 +209,6 @@ module subroutine swiftest_coarray_coclone_system(self) end subroutine swiftest_coarray_coclone_system - module subroutine swiftest_coarray_component_clone_info(var,src_img) !! author: David A. Minton !! @@ -344,63 +343,47 @@ module subroutine swiftest_coarray_component_collect_info_arr1D(var,dest_img) 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[*] - + integer(I4B) :: i,img, ti, di, ntot, istart, iend, nmax + integer(I4B), allocatable :: n[:] + logical, allocatable :: isalloc[:] + + allocate(isalloc[*]) + allocate(n[*]) + if (present(dest_img)) then - di = dest_img + di = dest_img else - di = 1 + di = 1 end if - - sync all + isalloc = allocated(var) if (isalloc) then - n = size(var) + n = size(var) else - n = 0 + n = 0 end if sync all - ntot = 0 + nmax = 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] + if (n[img] > nmax) nmax = n[img] end do - - if (isalloc) then - tmp(istart:iend) = var(:) - deallocate(var) - end if - - sync all + + allocate(tmp(nmax)[*]) + if (isalloc) tmp(1:n) = var(1:n) + 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 + do img = 1, num_images() + if (img /= di) then + call util_append(var, tmp(1:n[img])[img]) + n = n + n[img] + end if + end do end if - + return end subroutine swiftest_coarray_component_collect_info_arr1D - - module subroutine swiftest_coarray_cocollect_body(self) !! author: David A. Minton !! @@ -472,6 +455,8 @@ module subroutine swiftest_coarray_collect_system(nbody_system, param) class(swiftest_tp), allocatable, codimension[:] :: cotp character(len=NAMELEN) :: image_num_char + sync all + if (allocated(nbody_system%tp%id)) write(*,*) "Image: ",this_image(), "before collecting ids: ",nbody_system%tp%id sync all if (this_image() == 1) then write(image_num_char,*) num_images() @@ -485,6 +470,8 @@ module subroutine swiftest_coarray_collect_system(nbody_system, param) deallocate(cotp) + if (this_image() == 1) write(*,*) "Image: ",this_image(), "After collecting ids: ",nbody_system%tp%id + return end subroutine swiftest_coarray_collect_system @@ -518,7 +505,7 @@ module subroutine swiftest_coarray_distribute_system(nbody_system, param) if (ntot == 0) return allocate(lspill_list(ntot)) - num_per_image = ntot / num_images() + num_per_image = ceiling(1.0_DP * ntot / num_images()) istart = (this_image() - 1) * num_per_image + 1 if (this_image() == num_images()) then iend = ntot diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 68e60a04a..2fe0cb41a 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -183,8 +183,13 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) nbody_system%L_total_error = norm2(L_total_now(:) - nbody_system%L_total_orig(:)) / norm2(nbody_system%L_total_orig(:)) nbody_system%Mescape_error = nbody_system%GMescape / nbody_system%GMtot_orig - +#ifdef COARRAY + if (this_image() == 1) then +#endif if (lterminal) write(display_unit, EGYTERMFMT) nbody_system%L_total_error, nbody_system%E_orbit_error, nbody_system%te_error,nbody_system%Mtot_error +#ifdef COARRAY + end if ! (this_image() == 1) then +#endif if (abs(nbody_system%Mtot_error) > 100 * epsilon(nbody_system%Mtot_error)) then write(*,*) "Severe error! Mass not conserved! Halting!" diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 8e6ad35e6..a6b7566e7 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -57,7 +57,7 @@ module subroutine swiftest_util_append_arr_info(arr, source, nold, lsource_mask) idx = [(i, i = 1,nsrc)] end if - call swiftest_util_copy_particle_info_arr(source(:), arr(nold+1:nnew), idx) + call swiftest_util_copy_particle_info_arr(source(:), arr(nend_orig+1:nnew), idx) return end subroutine swiftest_util_append_arr_info