Fixed bugs in append method and now coarrays appears to work

MintonGroup · Apr 21, 2023 · 4f1593a · 4f1593a
1 parent 2e2e97c
commit 4f1593a
Show file tree

Hide file tree

Showing 5 changed files with 21 additions and 52 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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