Skip to content
This repository was archived by the owner on Aug 28, 2024. It is now read-only.

Commit

Permalink
Fixed a bunch of issues with coarray file i/o
Browse files Browse the repository at this point in the history
  • Loading branch information
daminton committed May 6, 2023
1 parent 22cf767 commit 9281683
Show file tree
Hide file tree
Showing 7 changed files with 241 additions and 75 deletions.
6 changes: 3 additions & 3 deletions cmake/Modules/SetFortranFlags.cmake
Original file line number Diff line number Diff line change
Expand Up @@ -320,9 +320,9 @@ SET_COMPILE_FLAG(FASTMATH_FLAGS "${FASTMATH_FLAGS}"
#####################
# Enables the optimization reports to be generated
SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_PROFILE "${CMAKE_Fortran_FLAGS_RELEASE}"
Fortran "-pg -qopt-report=5 -traceback -p -g3" # Intel
"/Qopt-report:5 /traceback -g3" # Windows Intel
"-pg -fbacktrace"
Fortran "-O2 -pg -qopt-report=5 -traceback -p -g3" # Intel
"/O2 /Qopt-report:5 /traceback -g3" # Windows Intel
"-O2 -pg -fbacktrace"
)

# Sanitize
Expand Down
34 changes: 25 additions & 9 deletions src/coarray/coarray_collect.f90
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@
module subroutine coarray_component_collect_DP_arr1D(var,dest_img)
!! author: David A. Minton
!!
!! Collects components of a coarray derived type from all images and combines them into destination image component . The default destination image is 1
!! Collects components of a coarray derived type from all images and combines them into destination image component. The default destination image is 1
!! real(DP) 1D allocatable array version
implicit none
! Arguments
Expand Down Expand Up @@ -55,10 +55,14 @@ 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(1:n[img])[img])
n = n + n[img]
call util_append(var, tmp(1:n[img])[img])
n = n + n[img]
end if
end do
sync images(*)
else
sync images(di)
if (allocated(var)) deallocate(var)
end if

deallocate(isalloc,n,tmp)
Expand Down Expand Up @@ -112,11 +116,15 @@ module subroutine coarray_component_collect_DP_arr2D(var,dest_img)

if (this_image() == di) then
do img = 1, num_images()
if (img /= di) then
call util_append(var, tmp(:,:)[img])
n2 = n2 + n2[img]
end if
if (img /= di) then
call util_append(var, tmp(:,:)[img])
n2 = n2 + n2[img]
end if
end do
sync images(*)
else
sync images(di)
if (allocated(var)) deallocate(var)
end if

deallocate(isalloc,n1,n2,tmp)
Expand Down Expand Up @@ -149,7 +157,7 @@ module subroutine coarray_component_collect_I4B(var,dest_img)
if (this_image() == di) then
var = 0
do img = 1, num_images()
var = var + tmp[img]
var = var + tmp[img]
end do
else
var = 0
Expand Down Expand Up @@ -185,7 +193,7 @@ module subroutine coarray_component_collect_I8B(var,dest_img)
if (this_image() == di) then
var = 0
do img = 1, num_images()
var = var + tmp[img]
var = var + tmp[img]
end do
else
var = 0
Expand Down Expand Up @@ -243,6 +251,10 @@ module subroutine coarray_component_collect_I4B_arr1D(var,dest_img)
n = n + n[img]
end if
end do
sync images(*)
else
sync images(di)
if (allocated(var)) deallocate(var)
end if

deallocate(isalloc,n,tmp)
Expand Down Expand Up @@ -297,6 +309,10 @@ module subroutine coarray_component_collect_lgt_arr1D(var,dest_img)
n = n + n[img]
end if
end do
sync images(*)
else
sync images(di)
if (allocated(var)) deallocate(var)
end if

deallocate(isalloc,n,tmp)
Expand Down
25 changes: 16 additions & 9 deletions src/netcdf_io/netcdf_io_implementations.f90
Original file line number Diff line number Diff line change
Expand Up @@ -37,9 +37,12 @@ module subroutine netcdf_io_close(self)
implicit none
! Arguments
class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset
character(namelen) :: message

if (self%lfile_is_open) then
call netcdf_io_check( nf90_close(self%id), "netcdf_io_close" )
write(message,*) this_image()
message = "netcdf_io_close on image " // trim(adjustl(message))
call netcdf_io_check( nf90_close(self%id), message)
self%lfile_is_open = .false.
end if

Expand Down Expand Up @@ -68,13 +71,17 @@ module subroutine netcdf_io_find_tslot(self, t, tslot)
if (self%max_tslot > 0) then
allocate(tvals(self%max_tslot))
call netcdf_io_check( nf90_get_var(self%id, self%time_varid, tvals(:), start=[1]), "netcdf_io_find_tslot get_var" )
where(tvals(:) /= tvals(:)) tvals(:) = huge(1.0_DP)
else
allocate(tvals(1))
tvals(1) = -huge(1.0_DP)
tvals(1) = huge(1.0_DP)
end if

tslot = findloc(tvals, t, dim=1)
if (tslot == 0) tslot = self%max_tslot + 1
tslot = 1
do
if ((t <= tvals(tslot)) .or. (tslot > self%max_tslot)) exit
tslot = tslot + 1
end do
self%max_tslot = max(self%max_tslot, tslot)
self%tslot = tslot

Expand All @@ -99,16 +106,16 @@ module subroutine netcdf_io_find_idslot(self, id, idslot)

if (.not.allocated(self%idvals)) call self%get_idvals()
self%max_idslot = size(self%idvals)
idslot = findloc(self%idvals, id, dim=1)
if (idslot == 0) then
self%max_idslot = self%max_idslot + 1
idslot = self%max_idslot
idslot = id + 1
if (idslot > self%max_idslot) then

! Update the idvals array
allocate(idvals(idslot))
idvals(1:idslot-1) = self%idvals(1:idslot-1)
idvals(:) = NF90_FILL_INT
idvals(1:self%max_idslot) = self%idvals(1:self%max_idslot)
idvals(idslot) = id
call move_alloc(idvals, self%idvals)
self%max_idslot = idslot
end if

self%idslot = idslot
Expand Down
141 changes: 136 additions & 5 deletions src/swiftest/swiftest_coarray.f90
Original file line number Diff line number Diff line change
Expand Up @@ -81,6 +81,134 @@ module subroutine swiftest_coarray_coclone_body(self)
return
end subroutine swiftest_coarray_coclone_body

module subroutine swiftest_coarray_coclone_nc(self)
!! author: David A. Minton
!!
!! Broadcasts the image 1 object to all other images in a coarray
implicit none
! Arguments
class(swiftest_netcdf_parameters),intent(inout),codimension[*] :: self !! Swiftest body object

call coclone(self%file_name)
call coclone(self%lfile_is_open)
call coclone(self%out_type)
call coclone(self%id)
call coclone(self%tslot)
call coclone(self%max_tslot)
call coclone(self%idvals)
call coclone(self%idslot)
call coclone(self%max_idslot)
call coclone(self%str_dimname)
call coclone(self%str_dimid)
call coclone(self%time_dimname)
call coclone(self%time_dimid)
call coclone(self%time_varid)
call coclone(self%name_dimname)
call coclone(self%name_dimid)
call coclone(self%name_varid)
call coclone(self%space_dimname)
call coclone(self%space_dimid)
call coclone(self%space_varid)
call coclone(self%id_varname)
call coclone(self%id_varid)
call coclone(self%status_varname)
call coclone(self%status_varid)
call coclone(self%ptype_varname)
call coclone(self%ptype_varid)
call coclone(self%npl_varname)
call coclone(self%npl_varid)
call coclone(self%ntp_varname)
call coclone(self%ntp_varid)
call coclone(self%nplm_varname)
call coclone(self%nplm_varid)
call coclone(self%a_varname)
call coclone(self%a_varid)
call coclone(self%e_varname)
call coclone(self%e_varid)
call coclone(self%inc_varname)
call coclone(self%inc_varid)
call coclone(self%capom_varname)
call coclone(self%capom_varid)
call coclone(self%omega_varname)
call coclone(self%omega_varid)
call coclone(self%capm_varname)
call coclone(self%capm_varid)
call coclone(self%varpi_varname)
call coclone(self%varpi_varid)
call coclone(self%lam_varname)
call coclone(self%lam_varid)
call coclone(self%f_varname)
call coclone(self%f_varid)
call coclone(self%cape_varname)
call coclone(self%cape_varid)
call coclone(self%rh_varname)
call coclone(self%rh_varid)
call coclone(self%vh_varname)
call coclone(self%vh_varid)
call coclone(self%gr_pseudo_vh_varname)
call coclone(self%gr_pseudo_vh_varid)
call coclone(self%Gmass_varname)
call coclone(self%Gmass_varid)
call coclone(self%mass_varname)
call coclone(self%mass_varid)
call coclone(self%rhill_varname)
call coclone(self%rhill_varid)
call coclone(self%radius_varname)
call coclone(self%radius_varid)
call coclone(self%Ip_varname)
call coclone(self%Ip_varid)
call coclone(self%rot_varname)
call coclone(self%rot_varid)
call coclone(self%j2rp2_varname)
call coclone(self%j2rp2_varid)
call coclone(self%j4rp4_varname)
call coclone(self%j4rp4_varid)
call coclone(self%k2_varname)
call coclone(self%k2_varid)
call coclone(self%q_varname)
call coclone(self%Q_varid)
call coclone(self%ke_orb_varname)
call coclone(self%KE_orb_varid)
call coclone(self%ke_spin_varname)
call coclone(self%KE_spin_varid)
call coclone(self%pe_varname)
call coclone(self%PE_varid)
call coclone(self%be_varname)
call coclone(self%BE_varid)
call coclone(self%te_varname)
call coclone(self%TE_varid)
call coclone(self%L_orbit_varname)
call coclone(self%L_orbit_varid)
call coclone(self%L_spin_varname)
call coclone(self%L_spin_varid)
call coclone(self%L_escape_varname)
call coclone(self%L_escape_varid)
call coclone(self%E_collisions_varname)
call coclone(self%E_collisions_varid)
call coclone(self%E_untracked_varname)
call coclone(self%E_untracked_varid)
call coclone(self%GMescape_varname)
call coclone(self%GMescape_varid)
call coclone(self%origin_type_varname)
call coclone(self%origin_type_varid)
call coclone(self%origin_time_varname)
call coclone(self%origin_time_varid)
call coclone(self%collision_id_varname)
call coclone(self%collision_id_varid)
call coclone(self%origin_rh_varname)
call coclone(self%origin_rh_varid)
call coclone(self%origin_vh_varname)
call coclone(self%origin_vh_varid)
call coclone(self%discard_time_varname)
call coclone(self%discard_time_varid)
call coclone(self%discard_rh_varname)
call coclone(self%discard_rh_varid)
call coclone(self%discard_vh_varname)
call coclone(self%discard_vh_varid)
call coclone(self%discard_body_id_varname)
call coclone(self%lpseudo_vel_exists)
return
end subroutine swiftest_coarray_coclone_nc

module subroutine swiftest_coarray_coclone_cb(self)
!! author: David A. Minton
Expand Down Expand Up @@ -178,13 +306,13 @@ end subroutine swiftest_coarray_coclone_tp

module subroutine swiftest_coarray_coclone_system(self)
!! author: David A. Minton
!!
!! Broadcasts the image 1 object to all other images in a coarray
!!
!! Broadcasts the image 1 object to all other images in a coarray
implicit none
! Arguments
class(swiftest_nbody_system),intent(inout),codimension[*] :: self !! Swiftest body object
! Internals
integer(I4B) :: i, img
integer(I4B) :: i

call self%cb%coclone()
call self%pl%coclone()
Expand Down Expand Up @@ -414,6 +542,10 @@ module subroutine swiftest_coarray_component_collect_info_arr1D(var,dest_img)
n = n + n[img]
end if
end do
sync images(*)
else
sync images(di)
if (allocated(var)) deallocate(var)
end if

deallocate(isalloc,n,tmp)
Expand Down Expand Up @@ -520,8 +652,7 @@ module subroutine swiftest_coarray_distribute_system(nbody_system, param)
class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system
class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters
! Internals
integer(I4B) :: i, istart, iend, ntot, num_per_image, ncopy
class(swiftest_tp), allocatable :: tp
integer(I4B) :: istart, iend, ntot, num_per_image, ncopy
logical, dimension(:), allocatable :: lspill_list
integer(I4B), codimension[:], allocatable :: ntp
character(len=NAMELEN) :: image_num_char, ntp_num_char
Expand Down
Loading

0 comments on commit 9281683

Please sign in to comment.