diff --git a/cmake/Modules/SetFortranFlags.cmake b/cmake/Modules/SetFortranFlags.cmake index fd2ea1aee..403bc6ed0 100644 --- a/cmake/Modules/SetFortranFlags.cmake +++ b/cmake/Modules/SetFortranFlags.cmake @@ -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 diff --git a/src/coarray/coarray_collect.f90 b/src/coarray/coarray_collect.f90 index 0f85bf41a..566113a07 100644 --- a/src/coarray/coarray_collect.f90 +++ b/src/coarray/coarray_collect.f90 @@ -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 @@ -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) @@ -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) @@ -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 @@ -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 @@ -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) @@ -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) diff --git a/src/netcdf_io/netcdf_io_implementations.f90 b/src/netcdf_io/netcdf_io_implementations.f90 index c59acd0fc..7b1de6b34 100644 --- a/src/netcdf_io/netcdf_io_implementations.f90 +++ b/src/netcdf_io/netcdf_io_implementations.f90 @@ -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 @@ -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 @@ -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 diff --git a/src/swiftest/swiftest_coarray.f90 b/src/swiftest/swiftest_coarray.f90 index a95f8adc8..e35d3d838 100644 --- a/src/swiftest/swiftest_coarray.f90 +++ b/src/swiftest/swiftest_coarray.f90 @@ -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 @@ -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() @@ -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) @@ -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 diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 6eeb64e2b..69453e214 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -414,53 +414,45 @@ module subroutine swiftest_io_dump_storage(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i -#ifdef COARRAY - integer(I4B) :: img, tslot - integer(I4B), dimension(self%iframe) :: ntp_tot - integer(I4B), codimension[*], save :: ntp -#endif if (self%iframe == 0) return call self%make_index_map() associate(nc => self%nc) #ifdef COARRAY - ! Get the sum of all test particles across snapshots from all images - ntp_tot(:) = 0 - do i = 1, self%iframe - if (allocated(self%frame(i)%item)) then - select type(nbody_system => self%frame(i)%item) - class is (swiftest_nbody_system) - ntp = nbody_system%tp%nbody - sync all - do img = 1, num_images() - ntp_tot(i) = ntp_tot(i) + ntp[img] - end do - end select - end if - end do - - critical + critical #endif call nc%open(param) +#ifdef COARRAY + end critical +#endif do i = 1, self%iframe + ! Writing files is more efficient if we write out the common frames from each image before going to the next frame +#ifdef COARRAY + if (param%lcoarray .and. (this_image() /= 1)) sync images(this_image() - 1) +#endif if (allocated(self%frame(i)%item)) then select type(nbody_system => self%frame(i)%item) class is (swiftest_nbody_system) call nbody_system%write_frame(nc, param) -#ifdef COARRAY - ! Record the correct number of test particles from all images - call nc%find_tslot(nbody_system%t, tslot) - call netcdf_io_check( nf90_put_var(nc%id, nc%ntp_varid, ntp_tot(i), start=[tslot]), "swiftest_io_dump_storage nf90_put_var ntp_varid" ) -#endif COARRAY end select deallocate(self%frame(i)%item) end if +#ifdef COARRAY + if (param%lcoarray .and. (this_image() < num_images())) sync images(this_image() + 1) +#endif end do - call nc%close() #ifdef COARRAY - end critical + sync all + if (this_image() == 1) then +#endif + call nc%close() +#ifdef COARRAY + else + nc%lfile_is_open = .false. + end if #endif end associate + call self%reset() return end subroutine swiftest_io_dump_storage @@ -938,7 +930,6 @@ module subroutine swiftest_io_netcdf_open(self, param, readonly) end if associate(nc => self) - write(errmsg,*) "swiftest_io_netcdf_open nf90_open ",trim(adjustl(nc%file_name)) call netcdf_io_check( nf90_open(nc%file_name, mode, nc%id), errmsg) self%lfile_is_open = .true. @@ -1061,7 +1052,7 @@ module subroutine swiftest_io_netcdf_get_valid_masks(self, plmask, tpmask) real(DP), dimension(:,:), allocatable :: rh integer(I4B), dimension(:), allocatable :: body_status logical, dimension(:), allocatable :: lvalid - integer(I4B) :: idmax, status + integer(I4B) :: idmax, status,i call netcdf_io_check( nf90_inquire_dimension(self%id, self%name_dimid, len=idmax), "swiftest_io_netcdf_get_valid_masks nf90_inquire_dimension name_dimid" ) @@ -1069,7 +1060,6 @@ module subroutine swiftest_io_netcdf_get_valid_masks(self, plmask, tpmask) allocate(tpmask(idmax)) allocate(plmask(idmax)) allocate(lvalid(idmax)) - associate(tslot => self%tslot) call netcdf_io_check( nf90_get_var(self%id, self%Gmass_varid, Gmass, start=[1,tslot], count=[idmax,1]), "swiftest_io_netcdf_get_valid_masks nf90_getvar Gmass_varid" ) @@ -1097,7 +1087,8 @@ module subroutine swiftest_io_netcdf_get_valid_masks(self, plmask, tpmask) end if end if - plmask(:) = Gmass(:) == Gmass(:) + plmask(:) = (Gmass(:) == Gmass(:)) + where(plmask(:)) plmask(:) = Gmass(:) > 0.0_DP tpmask(:) = .not. plmask(:) plmask(1) = .false. ! This is the central body @@ -1634,10 +1625,11 @@ module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, j, idslot, old_mode + integer(I4B) :: i, j, idslot, old_mode, ntp integer(I4B), dimension(:), allocatable :: ind real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs real(DP) :: a, e, inc, omega, capom, capm, varpi, lam, f, cape, capf + logical, dimension(:), allocatable :: tpmask, plmask call self%write_info(nc, param) @@ -1721,12 +1713,20 @@ module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, [0.0_DP,0.0_DP,0.0_DP], start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var body Ip_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, [0.0_DP,0.0_DP,0.0_DP], start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var body rotx_varid" ) end if - end select end do end associate end select end select +#ifdef COARRAY + select type(self) + class is (swiftest_tp) + call nc%get_valid_masks(plmask, tpmask) + ntp = count(tpmask(:)) + call netcdf_io_check( nf90_put_var(nc%id, nc%ntp_varid, ntp, start=[nc%tslot]), "netcdf_io_write_frame_body nf90_put_var ntp_varid" ) + end select +#endif + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode), "netcdf_io_write_frame_body nf90_set_fill old_mode" ) return @@ -1782,8 +1782,14 @@ module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters call self%write_hdr(nc, param) - call self%cb%write_frame(nc, param) - call self%pl%write_frame(nc, param) +#ifdef COARRAY + if (this_image() == 1) then +#endif + call self%cb%write_frame(nc, param) + call self%pl%write_frame(nc, param) +#ifdef COARRAY + end if ! this_image() == 1 +#endif call self%tp%write_frame(nc, param) return @@ -1802,13 +1808,15 @@ module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i,tslot, idmax - integer(I4B), dimension(:), allocatable :: body_status + logical, dimension(:), allocatable :: tpmask, plmask + integer(I4B) :: tslot call nc%find_tslot(self%t, tslot) call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var time_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var npl_varid" ) +#ifndef COARRAY call netcdf_io_check( nf90_put_var(nc%id, nc%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var ntp_varid" ) +#endif if (param%lmtiny_pl) call netcdf_io_check( nf90_put_var(nc%id, nc%nplm_varid, self%pl%nplm, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var nplm_varid" ) if (param%lenergy) then @@ -1825,10 +1833,6 @@ module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) call netcdf_io_check( nf90_put_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var GMescape_varid" ) end if - ! Set the status flag to INACTIVE by default - call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_io_get_t0_values_system name_dimid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%status_varid, [(INACTIVE, i=1,idmax)], start=[1,tslot], count=[idmax,1]), "netcdf_io_write_info_body nf90_put_var status_varid" ) - return end subroutine swiftest_io_netcdf_write_hdr_system @@ -3148,7 +3152,7 @@ module subroutine swiftest_io_toupper(string) end subroutine swiftest_io_toupper - module subroutine swiftest_io_write_frame_system(self, nc, param) + module subroutine swiftest_io_initialize_output_file_system(self, nc, param) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Write a frame (header plus records for each massive body and active test particle) to output binary file @@ -3194,7 +3198,6 @@ module subroutine swiftest_io_write_frame_system(self, nc, param) lfirst = .false. end if - call swiftest_io_netcdf_write_frame_system(self, nc, param) end associate return @@ -3202,6 +3205,6 @@ module subroutine swiftest_io_write_frame_system(self, nc, param) 667 continue write(*,*) "Error writing nbody_system frame: " // trim(adjustl(errmsg)) call base_util_exit(FAILURE) - end subroutine swiftest_io_write_frame_system + end subroutine swiftest_io_initialize_output_file_system end submodule s_swiftest_io diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 50cb16e23..6555617bb 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -57,6 +57,9 @@ module swiftest procedure :: get_valid_masks => swiftest_io_netcdf_get_valid_masks !! Gets logical masks indicating which bodies are valid pl and tp type at the current time procedure :: open => swiftest_io_netcdf_open !! Opens a NetCDF file and does the variable inquiries to activate variable ids procedure :: flush => swiftest_io_netcdf_flush !! Flushes a NetCDF file by closing it then opening it again +#ifdef COARRAY + procedure :: coclone => swiftest_coarray_coclone_nc +#endif end type swiftest_netcdf_parameters @@ -406,12 +409,13 @@ module swiftest procedure :: write_hdr => swiftest_io_netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format procedure :: read_particle_info => swiftest_io_netcdf_read_particle_info_system !! Read in particle metadata from file procedure :: read_in => swiftest_io_read_in_system !! Reads the initial conditions for an nbody system - procedure :: write_frame => swiftest_io_write_frame_system !! Write a frame of input data from file + procedure :: write_frame => swiftest_io_netcdf_write_frame_system !! Write a frame of input data from file procedure :: obl_pot => swiftest_obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body procedure :: dealloc => swiftest_util_dealloc_system !! Deallocates all allocatables and resets all values to defaults. Acts as a base for a finalizer procedure :: get_energy_and_momentum => swiftest_util_get_energy_and_momentum_system !! Calculates the total nbody_system energy and momentum procedure :: get_idvals => swiftest_util_get_idvalues_system !! Returns an array of all id values in use in the nbody_system procedure :: rescale => swiftest_util_rescale_system !! Rescales the nbody_system into a new set of units + procedure :: initialize_output_file => swiftest_io_initialize_output_file_system !! Write a frame of input data from file procedure :: initialize => swiftest_util_setup_initialize_system !! Initialize the nbody_system from input files procedure :: init_particle_info => swiftest_util_setup_initialize_particle_info_system !! Initialize the nbody_system from input files ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. @@ -894,12 +898,12 @@ module subroutine swiftest_io_toupper(string) character(*), intent(inout) :: string !! String to make upper case end subroutine swiftest_io_toupper - module subroutine swiftest_io_write_frame_system(self, nc, param) + module subroutine swiftest_io_initialize_output_file_system(self, nc, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_io_write_frame_system + end subroutine swiftest_io_initialize_output_file_system module subroutine swiftest_kick_getacch_int_pl(self, param) implicit none @@ -1764,6 +1768,11 @@ module subroutine swiftest_coarray_coclone_cb(self) class(swiftest_cb),intent(inout),codimension[*] :: self !! Swiftest cb object end subroutine swiftest_coarray_coclone_cb + module subroutine swiftest_coarray_coclone_nc(self) + implicit none + class(swiftest_netcdf_parameters),intent(inout),codimension[*] :: self !! Swiftest body object + end subroutine swiftest_coarray_coclone_nc + module subroutine swiftest_coarray_coclone_pl(self) implicit none class(swiftest_pl),intent(inout),codimension[*] :: self !! Swiftest pl object diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 0737aab77..879f6c8f3 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -2379,7 +2379,7 @@ module subroutine swiftest_util_setup_initialize_system(self, system_history, pa ! Write initial conditions to file nc%file_name = param%outfile - call nbody_system%write_frame(nc, param) + call nbody_system%initialize_output_file(nc, param) call nc%close() end associate