Skip to content

Commit

Permalink
Memory-leak fix from set() calls for unique neighbors
Browse files Browse the repository at this point in the history
  • Loading branch information
@smillerc
smillerc committed Feb 9, 2021
1 parent 20baa63 commit 6968160
Show file tree
Hide file tree
Showing 2 changed files with 42 additions and 32 deletions.
64 changes: 34 additions & 30 deletions src/lib/boundary_conditions/periodic_bc.fypp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -101,12 +101,32 @@ contains
integer(ik) :: ilo, ihi, jlo, jhi
integer(ik) :: ilo_halo, ihi_halo, jlo_halo, jhi_halo
integer(ik) :: nh, ni, nj
integer(ik), dimension(:), allocatable :: unique_x_neighbors, unique_y_neighbors, unique_corner_neighbors

if(enable_debug_print) call debug_print('Running periodic_bc_t%apply_periodic_primitive_var_bc() ', __FILE__, __LINE__)
sync_stat = 0
sync_err_msg = ''
img_err_msg = ''

ilo = rho%lbounds(1)
ihi = rho%ubounds(1)
jlo = rho%lbounds(2)
jhi = rho%ubounds(2)
ilo_halo = rho%lbounds_halo(1)
ihi_halo = rho%ubounds_halo(1)
jlo_halo = rho%lbounds_halo(2)
jhi_halo = rho%ubounds_halo(2)
nh = rho%n_halo_cells
neighbors = rho%neighbors

unique_x_neighbors = set([rho%host_image_id, neighbors(ilo_neighbor), neighbors(ihi_neighbor)])
unique_y_neighbors = set([rho%host_image_id, neighbors(jlo_neighbor), neighbors(jhi_neighbor)])
unique_corner_neighbors = set([rho%host_image_id, &
neighbors(ilo_jlo_neighbor), &
neighbors(ilo_jhi_neighbor), &
neighbors(ihi_jlo_neighbor), &
neighbors(ihi_jhi_neighbor)])

! Only allocate once, b/c this will cause an implicit sync all due to the coarray index
ni = rho%domain_shape(1)
nj = rho%domain_shape(2)
Expand All @@ -132,28 +152,19 @@ contains
jhi_edge = 0.0_rk
jlo_edge = 0.0_rk

ilo = ${F}$%lbounds(1)
ihi = ${F}$%ubounds(1)
jlo = ${F}$%lbounds(2)
jhi = ${F}$%ubounds(2)
ilo_halo = ${F}$%lbounds_halo(1)
ihi_halo = ${F}$%ubounds_halo(1)
jlo_halo = ${F}$%lbounds_halo(2)
jhi_halo = ${F}$%ubounds_halo(2)
nh = ${F}$%n_halo_cells
neighbors = ${F}$%neighbors


select case(self%location)
case('+x', '-x')
! if(${F}$%on_ilo_bc .or. ${F}$%on_ihi_bc) then
if(num_images() > 1) then
sync images(set([${F}$%host_image_id, neighbors(ilo_neighbor), neighbors(ihi_neighbor)]), &
sync images(unique_x_neighbors, &
stat=sync_stat, errmsg=sync_err_msg)
endif

if(sync_stat /= 0) then
write(img_err_msg, '(a,10(i0, 1x), a)') "Images: [", &
set([${F}$%host_image_id, neighbors(ilo_neighbor), neighbors(ihi_neighbor)]), "]"
unique_x_neighbors, "]"
call error_msg(module_name='mod_periodic_bc', class_name='periodic_bc_t', &
procedure_name='apply_periodic_primitive_var_bc', &
message="Unable to sync "//trim(img_err_msg)//", sync_err_msg: '"//trim(sync_err_msg)//"'", &
Expand All @@ -166,11 +177,11 @@ contains
ihi_edge(:, :)[neighbors(ilo_neighbor)] = ${F}$%data(ilo:ilo + nh - 1, jlo:jhi) ! ilo -> ihi
endif

if(num_images() > 1) sync images(set([${F}$%host_image_id, neighbors(ilo_neighbor), neighbors(ihi_neighbor)]), &
if(num_images() > 1) sync images(unique_x_neighbors, &
stat=sync_stat, errmsg=sync_err_msg)
if(sync_stat /= 0) then
write(img_err_msg, '(a,10(i0, 1x), a)') "Images: [", &
set([${F}$%host_image_id, neighbors(ilo_neighbor), neighbors(ihi_neighbor)]), "]"
unique_x_neighbors, "]"
call error_msg(module_name='mod_periodic_bc', class_name='periodic_bc_t', &
procedure_name='apply_periodic_primitive_var_bc', &
message="Unable to sync "//trim(img_err_msg)//", sync_err_msg: '"//trim(sync_err_msg)//"'", &
Expand All @@ -184,11 +195,11 @@ contains

case('+y', '-y')
! if(${F}$%on_jlo_bc .or. ${F}$%on_jhi_bc) then
if(num_images() > 1) sync images(set([${F}$%host_image_id, neighbors(jlo_neighbor), neighbors(jhi_neighbor)]), &
if(num_images() > 1) sync images(unique_y_neighbors, &
stat=sync_stat, errmsg=sync_err_msg)
if(sync_stat /= 0) then
write(img_err_msg, '(a,10(i0, 1x), a)') "Images: [", &
set([${F}$%host_image_id, neighbors(jlo_neighbor), neighbors(jhi_neighbor)]), "]"
unique_y_neighbors, "]"
call error_msg(module_name='mod_periodic_bc', class_name='periodic_bc_t', &
procedure_name='apply_periodic_primitive_var_bc', &
message="Unable to sync "//trim(img_err_msg)//", sync_err_msg: '"//trim(sync_err_msg)//"'", &
Expand All @@ -201,11 +212,11 @@ contains
jhi_edge(:, :)[neighbors(jlo_neighbor)] = ${F}$%data(ilo:ihi, jlo:jlo + nh - 1) ! jlo -> jhi
endif

if(num_images() > 1) sync images(set([${F}$%host_image_id, neighbors(jlo_neighbor), neighbors(jhi_neighbor)]), &
if(num_images() > 1) sync images(unique_y_neighbors, &
stat=sync_stat, errmsg=sync_err_msg)
if(sync_stat /= 0) then
write(img_err_msg, '(a,10(i0, 1x), a)') "Images: [", &
set([${F}$%host_image_id, neighbors(jlo_neighbor), neighbors(jhi_neighbor)]), "]"
unique_y_neighbors, "]"
call error_msg(module_name='mod_periodic_bc', class_name='periodic_bc_t', &
procedure_name='apply_periodic_primitive_var_bc', &
message="Unable to sync "//trim(img_err_msg)//", sync_err_msg: '"//trim(sync_err_msg)//"'", &
Expand All @@ -224,14 +235,10 @@ contains
! (${F}$%on_ilo_bc .and. ${F}$%on_jhi_bc) .or. &
! (${F}$%on_ihi_bc .and. ${F}$%on_jhi_bc)) then

if(num_images() > 1) sync images(set([${F}$%host_image_id, &
neighbors(ilo_jlo_neighbor), neighbors(ilo_jhi_neighbor), &
neighbors(ihi_jlo_neighbor), neighbors(ihi_jhi_neighbor)]), &
if(num_images() > 1) sync images(unique_corner_neighbors, &
stat=sync_stat, errmsg=sync_err_msg)
if(sync_stat /= 0) then
write(img_err_msg, '(a,10(i0, 1x), a)') "Images: [", set([${F}$%host_image_id, &
neighbors(ilo_jlo_neighbor), neighbors(ilo_jhi_neighbor), &
neighbors(ihi_jlo_neighbor), neighbors(ihi_jhi_neighbor)]), "]"
write(img_err_msg, '(a,10(i0, 1x), a)') "Images: [", unique_corner_neighbors, "]"
call error_msg(module_name='mod_periodic_bc', class_name='periodic_bc_t', &
procedure_name='apply_periodic_primitive_var_bc', &
message="Unable to sync "//trim(img_err_msg)//", sync_err_msg: '"//trim(sync_err_msg)//"'", &
Expand All @@ -249,14 +256,10 @@ contains
ihi_jhi_corner(:, :)[neighbors(ilo_jlo_neighbor)] = ${F}$%data(ihi - nh + 1:ihi, jhi - nh + 1:jhi) ! ilo_jlo -> ihi_jhi
endif

if(num_images() > 1) sync images(set([${F}$%host_image_id, &
neighbors(ilo_jlo_neighbor), neighbors(ilo_jhi_neighbor), &
neighbors(ihi_jlo_neighbor), neighbors(ihi_jhi_neighbor)]), &
if(num_images() > 1) sync images(unique_corner_neighbors, &
stat=sync_stat, errmsg=sync_err_msg)
if(sync_stat /= 0) then
write(img_err_msg, '(a,10(i0, 1x), a)') "Images: [", set([${F}$%host_image_id, &
neighbors(ilo_jlo_neighbor), neighbors(ilo_jhi_neighbor), &
neighbors(ihi_jlo_neighbor), neighbors(ihi_jhi_neighbor)]), "]"
write(img_err_msg, '(a,10(i0, 1x), a)') "Images: [", unique_corner_neighbors, "]"
call error_msg(module_name='mod_periodic_bc', class_name='periodic_bc_t', &
procedure_name='apply_periodic_primitive_var_bc', &
message="Unable to sync "//trim(img_err_msg)//", sync_err_msg: '"//trim(sync_err_msg)//"'", &
Expand All @@ -273,6 +276,7 @@ contains
endif ! do_corners

#:endfor
deallocate(unique_x_neighbors, unique_y_neighbors, unique_corner_neighbors)
endsubroutine apply_periodic_primitive_var_bc

subroutine finalize(self)
Expand Down
10 changes: 8 additions & 2 deletions src/lib/field/field_2d.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,6 +81,7 @@ module mod_field

! Parallel neighbor information
integer(ik), dimension(8) :: neighbors = 0
integer(ik), allocatable, dimension(:) :: unique_neighbors
!< (ilo_jlo, jlo, ihi_jlo, ilo, ihi, ilo_jhi, jhi, ihi_jhi); parallel neighbor image indices

integer(ik) :: host_image_id = 0 !< what image owns this field instance?
Expand Down Expand Up @@ -483,6 +484,7 @@ type(field_2d_t) function new_field(name, long_name, descrip, units, global_dims

self%data = 0.0_rk
self%neighbors = tile_neighbors_2d(is_periodic=.true.)
self%unique_neighbors = set(self%neighbors)
endfunction new_field

function gather(self, image)
Expand Down Expand Up @@ -589,7 +591,8 @@ subroutine sync_edges(self)
! These were originally inside of an associate block, but testing shows that associate blocks
! and coarray syntax don't always give the right behabior at runtime
sync images(set(self%neighbors), stat=sync_stat, errmsg=sync_err_msg)
! sync images(set(self%neighbors), stat=sync_stat, errmsg=sync_err_msg)
sync images(self%unique_neighbors, stat=sync_stat, errmsg=sync_err_msg)
if(sync_stat /= 0) then
write(std_err, '(a, i0, a)') "Error: unable to sync images in "//__FILE__//":", &
__LINE__, " sync_err_msg: '"//trim(sync_err_msg)//"'"
Expand All @@ -612,7 +615,8 @@ subroutine sync_edges(self)
ihi_jhi_corner(:, :)[self%neighbors(ilo_jlo_neighbor)] = self%data(ilo:ilo + nh - 1, jlo:jlo + nh - 1)
ihi_jlo_corner(:, :)[self%neighbors(ilo_jhi_neighbor)] = self%data(ilo:ilo + nh - 1, jhi - nh + 1:jhi)
sync images(set(self%neighbors), stat=sync_stat, errmsg=sync_err_msg)
! sync images(set(self%neighbors), stat=sync_stat, errmsg=sync_err_msg)
sync images(self%unique_neighbors, stat=sync_stat, errmsg=sync_err_msg)
if(sync_stat /= 0) then
write(std_err, '(a, i0, a)') "Error: unable to sync images in "//__FILE__//":", &
__LINE__, " sync_err_msg: '"//trim(sync_err_msg)//"'"
Expand Down Expand Up @@ -855,6 +859,7 @@ subroutine finalize(self)
if(enable_debug_print) call debug_print('Running "'//trim(self%name)//'" field_2d_t%finalize()', __FILE__, __LINE__)

if(allocated(self%data)) deallocate(self%data)
if(allocated(self%unique_neighbors)) deallocate(self%unique_neighbors)
if(allocated(self%units)) deallocate(self%units)
if(allocated(self%name)) deallocate(self%name)
if(allocated(self%long_name)) deallocate(self%long_name)
Expand Down Expand Up @@ -900,6 +905,7 @@ pure subroutine from_field(new, old)
new%on_jlo_bc = old%on_jlo_bc
new%on_jhi_bc = old%on_jhi_bc
new%neighbors = old%neighbors
new%unique_neighbors = old%unique_neighbors
new%host_image_id = old%host_image_id
endsubroutine from_field

Expand Down

0 comments on commit 6968160

Please sign in to comment.