From 4f1593a18b7409fa0423614d14ebfd62286034c8 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 21 Apr 2023 08:34:04 -0400 Subject: [PATCH] Fixed bugs in append method and now coarrays appears to work --- src/base/base_module.f90 | 32 +++++++++++++++---------------- src/coarray/coarray_collect.f90 | 11 +++-------- src/swiftest/swiftest_coarray.f90 | 25 ------------------------ src/swiftest/swiftest_driver.f90 | 1 - src/swiftest/swiftest_util.f90 | 4 ++-- 5 files changed, 21 insertions(+), 52 deletions(-) diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index 84e5a1f2e..70ba3fbbb 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -316,9 +316,9 @@ subroutine base_util_append_arr_char_string(arr, source, nold, lsource_mask) nnew = nend_orig + nsrc if (present(lsource_mask)) then - arr(nold + 1:nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + arr(nend_orig + 1:nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) else - arr(nold + 1:nnew) = source(1:nsrc) + arr(nend_orig + 1:nnew) = source(1:nsrc) end if return @@ -359,9 +359,9 @@ subroutine base_util_append_arr_DP(arr, source, nold, lsource_mask) nnew = nend_orig + nsrc if (present(lsource_mask)) then - arr(nold + 1:nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + arr(nend_orig + 1:nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) else - arr(nold + 1:nnew) = source(1:nsrc) + arr(nend_orig + 1:nnew) = source(1:nsrc) end if return @@ -402,11 +402,11 @@ subroutine base_util_append_arr_DPvec(arr, source, nold, lsource_mask) nnew = nend_orig + nsrc if (present(lsource_mask)) then - arr(1, nold + 1:nnew) = pack(source(1,1:nsrc), lsource_mask(1:nsrc)) - arr(2, nold + 1:nnew) = pack(source(2,1:nsrc), lsource_mask(1:nsrc)) - arr(3, nold + 1:nnew) = pack(source(3,1:nsrc), lsource_mask(1:nsrc)) + arr(1, nend_orig + 1:nnew) = pack(source(1,1:nsrc), lsource_mask(1:nsrc)) + arr(2, nend_orig + 1:nnew) = pack(source(2,1:nsrc), lsource_mask(1:nsrc)) + arr(3, nend_orig + 1:nnew) = pack(source(3,1:nsrc), lsource_mask(1:nsrc)) else - arr(:,nold + 1:nnew) = source(:,1:nsrc) + arr(:,nend_orig + 1:nnew) = source(:,1:nsrc) end if return @@ -447,9 +447,9 @@ subroutine base_util_append_arr_I4B(arr, source, nold, lsource_mask) nnew = nend_orig + nsrc if (present(lsource_mask)) then - arr(nold + 1:nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + arr(nend_orig + 1:nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) else - arr(nold + 1:nnew) = source(1:nsrc) + arr(nend_orig + 1:nnew) = source(1:nsrc) end if return @@ -488,11 +488,11 @@ subroutine base_util_append_arr_logical(arr, source, nold, lsource_mask) call util_resize(arr, nend_orig + nsrc) end if nnew = nend_orig + nsrc - + if (present(lsource_mask)) then - arr(nold + 1:nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + arr(nend_orig + 1:nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) else - arr(nold + 1:nnew) = source(1:nsrc) + arr(nend_orig + 1:nnew) = source(:) end if return @@ -909,7 +909,7 @@ subroutine base_util_resize_arr_logical(arr, nnew) logical, dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated integer(I4B) :: nold !! Old size logical, parameter :: init_val = .false. - + if (nnew < 0) return if (nnew == 0) then @@ -934,7 +934,7 @@ subroutine base_util_resize_arr_logical(arr, nnew) tmp(1:nnew) = arr(1:nnew) end if else - tmp(1:nnew) = init_val + tmp = init_val end if call move_alloc(tmp, arr) @@ -1885,7 +1885,7 @@ pure subroutine base_util_sort_partition_SP(arr, marker, ind) return end subroutine base_util_sort_partition_SP - + pure subroutine base_util_sort_rearrange_arr_char_string(arr, ind, n) !! author: David A. Minton !! diff --git a/src/coarray/coarray_collect.f90 b/src/coarray/coarray_collect.f90 index f9a65dad1..35808d88f 100644 --- a/src/coarray/coarray_collect.f90 +++ b/src/coarray/coarray_collect.f90 @@ -50,9 +50,8 @@ module subroutine coarray_component_collect_DP_arr1D(var,dest_img) end do allocate(tmp(nmax)[*]) - tmp(1:n) = var(1:n) + if (isalloc) tmp(1:n) = var(1:n) - !sync all if (this_image() == di) then do img = 1, num_images() if (img /= di) then @@ -107,9 +106,8 @@ module subroutine coarray_component_collect_DP_arr2D(var,dest_img) end do allocate(tmp(NDIM,nmax)[*]) - tmp(:,1:n2) = var(:,1:n2) + if (isalloc) tmp(:,1:n2) = var(:,1:n2) - !sync all if (this_image() == di) then do img = 1, num_images() if (img /= di) then @@ -144,7 +142,6 @@ module subroutine coarray_component_collect_I4B(var,dest_img) allocate(tmp[*], source=var) - !sync all if (this_image() == di) then var = 0 do img = 1, num_images() @@ -179,7 +176,6 @@ module subroutine coarray_component_collect_I8B(var,dest_img) allocate(tmp[*], source=var) - !sync all if (this_image() == di) then var = 0 do img = 1, num_images() @@ -230,9 +226,8 @@ module subroutine coarray_component_collect_I4B_arr1D(var,dest_img) end do allocate(tmp(nmax)[*]) - tmp(1:n) = var(1:n) + if (isalloc) tmp(1:n) = var(1:n) - !sync all if (this_image() == di) then do img = 1, num_images() if (img /= di) then diff --git a/src/swiftest/swiftest_coarray.f90 b/src/swiftest/swiftest_coarray.f90 index 2b04d0697..f3643f42a 100644 --- a/src/swiftest/swiftest_coarray.f90 +++ b/src/swiftest/swiftest_coarray.f90 @@ -410,9 +410,6 @@ module subroutine swiftest_coarray_cocollect_body(self) class(swiftest_body),intent(inout), codimension[*] :: self !! Swiftest body object integer(I4B) :: i - if (this_image() == 1) write(*,*) "Before collect " - sync all - if (allocated(self%id)) write(*,*) "Image: ",this_image(), "id: ",self%id call cocollect(self%nbody) call cocollect(self%id) call cocollect(self%info) @@ -441,10 +438,6 @@ module subroutine swiftest_coarray_cocollect_body(self) call cocollect(self%omega) call cocollect(self%capm) - if (this_image() == 1) write(*,*) "after collect " - sync all - if (allocated(self%id)) write(*,*) "Image: ",this_image(), "id: ",self%id - return end subroutine swiftest_coarray_cocollect_body @@ -492,10 +485,6 @@ module subroutine swiftest_coarray_collect_system(nbody_system, param) deallocate(cotp) - if (this_image() == 1) then - write(param%display_unit,*) " Done collecting" - end if - return end subroutine swiftest_coarray_collect_system @@ -523,10 +512,6 @@ module subroutine swiftest_coarray_distribute_system(nbody_system, param) write(param%display_unit,*) " Distributing test particles across " // trim(adjustl(image_num_char)) // " images." end if - if (this_image() == 1) write(*,*) "Before distribute " - sync all - if (allocated(nbody_system%tp%id)) write(*,*) "Image: ",this_image(), "id: ",nbody_system%tp%id - ntp = nbody_system%tp%nbody sync all ntot = ntp[1] @@ -555,16 +540,6 @@ module subroutine swiftest_coarray_distribute_system(nbody_system, param) deallocate(tmp, cotp) - - if (this_image() == 1) write(*,*) "After distribute " - sync all - if (allocated(nbody_system%tp%id)) write(*,*) "Image: ",this_image(), "id: ",nbody_system%tp%id - - - if (this_image() == 1) then - write(param%display_unit,*) " Done distributing" - end if - return end subroutine swiftest_coarray_distribute_system diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 index 4a34347f2..461979caa 100644 --- a/src/swiftest/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -129,7 +129,6 @@ program swiftest_driver #endif do iloop = istart, nloops !> Step the nbody_system forward in time - if (this_image() == 1) write(*,*) "Image: ", this_image(), "ntp: ",nbody_system%tp%nbody call integration_timer%start() call nbody_system%step(param, nbody_system%t, dt) call integration_timer%stop() diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index fe46cc9e3..8e6ad35e6 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -97,9 +97,9 @@ module subroutine swiftest_util_append_arr_kin(arr, source, nold, lsource_mask) nnew = nend_orig + nsrc if (present(lsource_mask)) then - arr(nold + 1:nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + arr(nend_orig + 1:nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) else - arr(nold + 1:nnew) = source(1:nsrc) + arr(nend_orig + 1:nnew) = source(1:nsrc) end if return