diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index f33535327..5331e50fd 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -827,7 +827,8 @@ def process_netcdf_input(ds, param): if "id" in ds.dims: if len(np.unique(ds['name'])) == len(ds['name']): ds = ds.swap_dims({"id" : "name"}) - ds = ds.reset_coords("id") + if "id" in ds: + ds = ds.reset_coords("id") return ds diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 8fb77ab4a..8f6a8d9dd 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2505,7 +2505,8 @@ def _combine_and_fix_dsnew(self,dsnew): if "id" not in self.data.dims: if len(np.unique(dsnew['name'])) == len(dsnew['name']): dsnew = dsnew.swap_dims({"id" : "name"}) - dsnew = dsnew.reset_coords("id") + if "id" in dsnew: + dsnew = dsnew.reset_coords("id") else: msg = "Non-unique names detected for bodies. The Dataset will be dimensioned by integer id instead of name." msg +="\nConsider using unique names instead." diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 7c3730df2..22412e97f 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -25,15 +25,14 @@ module subroutine encounter_io_dump(self, param) do i = 1, self%nframes if (allocated(self%frame(i)%item)) then + param%ioutput = self%tslot(i) + select type(snapshot => self%frame(i)%item) + class is (fraggle_encounter_snapshot) + call snapshot%write_frame(self%ncc,param) + call snapshot%encounter_snapshot%write_frame(self%nce,param) class is (encounter_snapshot) - param%ioutput = self%tslot(i) - call snapshot%write_frame(self%nc,param) - select type(snapshot) ! Be sure to call the base class method to get the regular encounter data sved - class is (fraggle_encounter_snapshot) - call snapshot%encounter_snapshot%write_frame(self%nc,param) - end select - + call snapshot%write_frame(self%nce,param) end select else exit @@ -56,12 +55,13 @@ module subroutine encounter_io_initialize(self, param) class(encounter_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, nvar, varid, vartype + integer(I4B) :: nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill logical :: fileExists character(len=STRMAX) :: errmsg - integer(I4B) :: ndims + integer(I4B) :: ndims, i + character(len=NAMELEN) :: charstring associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) @@ -75,13 +75,13 @@ module subroutine encounter_io_initialize(self, param) end select ! Check if the file exists, and if it does, delete it - inquire(file=nc%enc_file, exist=fileExists) + inquire(file=nc%file_name, exist=fileExists) if (fileExists) then - open(unit=LUN, file=nc%enc_file, status="old", err=667, iomsg=errmsg) + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) close(unit=LUN, status="delete") end if - call check( nf90_create(nc%enc_file, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" ) + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" ) ! Dimensions call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension @@ -130,8 +130,7 @@ module subroutine encounter_io_initialize(self, param) ! Add in the space dimension coordinates call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" ) - ! Pre-fill id slots with ids - + ! Pre-fill name slots with ids call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "encounter_io_initialize nf90_put_var pl id_varid" ) end associate @@ -151,20 +150,20 @@ module subroutine encounter_io_write_frame(self, nc, param) implicit none ! Arguments class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp character(len=NAMELEN) :: charstring tslot = param%ioutput + associate(pl => self%pl, tp => self%tp) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" ) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" ) - associate(pl => self%pl, tp => self%tp) npl = pl%nbody do i = 1, npl idslot = pl%id(i) @@ -198,9 +197,9 @@ module subroutine encounter_io_write_frame(self, nc, param) charstring = trim(adjustl(tp%info(i)%particle_type)) call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) end do - end associate - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end associate return end subroutine encounter_io_write_frame diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 3ec23ef99..4da30c3d8 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -151,7 +151,6 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa else call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation succeeded after " // & trim(adjustl(message)) // " tries") - call fraggle_io_log_generate(frag) end if call frag%set_original_scale(colliders) diff --git a/src/io/io.f90 b/src/io/io.f90 index f0c1cb994..74116d5b0 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -253,7 +253,7 @@ module subroutine io_dump_system(self, param) call dump_param%dump(param_file_name) dump_param%out_form = "XV" - dump_param%outfile = trim(adjustl(DUMP_NC_FILE(idx))) + dump_param%nc%file_name = trim(adjustl(DUMP_NC_FILE(idx))) dump_param%ioutput = 1 call dump_param%nc%initialize(dump_param) call self%write_frame(dump_param%nc, dump_param) @@ -1312,7 +1312,7 @@ module subroutine io_read_in_system(self, param) self%Euntracked = param%Euntracked else allocate(tmp_param, source=param) - tmp_param%outfile = param%in_netcdf + tmp_param%nc%file_name = param%in_netcdf tmp_param%out_form = param%in_form if (.not. param%lrestart) then ! Turn off energy computation so we don't have to feed it into the initial conditions @@ -1549,6 +1549,7 @@ module subroutine io_write_frame_system(self, param) param%nc%id_chunk = self%pl%nbody + self%tp%nbody param%nc%time_chunk = max(param%dump_cadence / param%istep_out, 1) + param%nc%file_name = param%outfile if (lfirst) then inquire(file=param%outfile, exist=fileExists) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index b350f1a1c..2af59b94b 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -56,7 +56,6 @@ module encounter_classes !> NetCDF dimension and variable names for the enounter save object type, extends(netcdf_parameters) :: encounter_io_parameters integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history - character(STRMAX) :: enc_file !! Encounter output file name character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter integer(I4B) :: loop_varid !! ID for the recursion level variable integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot @@ -68,7 +67,8 @@ module encounter_classes !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: encounter_storage - class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object + class(encounter_io_parameters), allocatable :: nce !! NetCDF parameter object containing the details about the encounter file attached to this storage object + class(encounter_io_parameters), allocatable :: ncc !! NetCDF parameter object containing the details about the collision file attached to this storage object contains procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file final :: encounter_util_final_storage @@ -221,7 +221,7 @@ end subroutine encounter_io_initialize module subroutine encounter_io_write_frame(self, nc, param) implicit none class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine encounter_io_write_frame diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index d09c0d159..0aa7421a3 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -10,10 +10,10 @@ module fraggle_classes !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! - !! Definition of classes and methods specific to Fraggel: The Fragment Generation Model + !! Definition of classes and methods specific to Fraggle: *Frag*ment *g*eneration that conserves angular momentum (*L*) and energy (*E*) use swiftest_globals use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_cb, swiftest_pl, swiftest_storage, netcdf_parameters - use encounter_classes, only : encounter_snapshot, encounter_io_parameters + use encounter_classes, only : encounter_snapshot, encounter_io_parameters, encounter_storage implicit none public @@ -111,7 +111,6 @@ module fraggle_classes !! NetCDF dimension and variable names for the enounter save object type, extends(encounter_io_parameters) :: fraggle_io_parameters - character(STRMAX) :: frag_file !! Encounter output file name integer(I4B) :: stage_dimid !! ID for the name variable integer(I4B) :: stage_varid !! ID for the name variable character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) @@ -155,15 +154,10 @@ end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) implicit none class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine fraggle_io_write_frame - module subroutine fraggle_io_log_generate(frag) - implicit none - class(fraggle_fragments), intent(in) :: frag - end subroutine fraggle_io_log_generate - module subroutine fraggle_io_log_pl(pl, param) implicit none class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object (only the new bodies generated in a collision) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 1bd1edef8..9c60dd884 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -20,6 +20,7 @@ module swiftest_classes !! This derived datatype stores the NetCDF ID values for each of the variables included in the NetCDF data file. This is used as the base class defined in swiftest_classes type :: netcdf_variables + character(STRMAX) :: file_name !! Name of the output file integer(I4B) :: out_type !! output type (will be assigned either NF90_DOUBLE or NF90_FLOAT, depending on the user parameter) integer(I4B) :: id !! ID for the output file integer(I4B) :: discard_body_id_varid !! ID for the id of the other body involved in the discard diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index c30762243..a896c3dc1 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -16,7 +16,7 @@ module symba_classes use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, swiftest_storage, netcdf_parameters use helio_classes, only : helio_cb, helio_pl, helio_tp, helio_nbody_system use fraggle_classes, only : fraggle_colliders, fraggle_fragments - use encounter_classes, only : encounter_list, encounter_storage, encounter_snapshot + use encounter_classes, only : encounter_list, encounter_snapshot, encounter_storage implicit none public @@ -184,13 +184,13 @@ module symba_classes ! symba_nbody_system class definitions and method interfaces !******************************************************************************************************************************** type, extends(helio_nbody_system) :: symba_nbody_system - class(symba_merger), allocatable :: pl_adds !! List of added bodies in mergers or collisions - class(symba_pltpenc), allocatable :: pltpenc_list !! List of massive body-test particle encounters in a single step - class(symba_plplenc), allocatable :: plplenc_list !! List of massive body-massive body encounters in a single step - class(symba_plplenc), allocatable :: plplcollision_list !! List of massive body-massive body collisions in a single step - integer(I4B) :: irec !! System recursion level - type(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: fragments !! Fraggle fragmentation system object + class(symba_merger), allocatable :: pl_adds !! List of added bodies in mergers or collisions + class(symba_pltpenc), allocatable :: pltpenc_list !! List of massive body-test particle encounters in a single step + class(symba_plplenc), allocatable :: plplenc_list !! List of massive body-massive body encounters in a single step + class(symba_plplenc), allocatable :: plplcollision_list !! List of massive body-massive body collisions in a single step + integer(I4B) :: irec !! System recursion level + type(fraggle_colliders) :: colliders !! Fraggle colliders object + type(fraggle_fragments) :: fragments !! Fraggle fragmentation system object type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file contains procedure :: write_discard => symba_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index ad5d7bbeb..d44cbb5a7 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -172,14 +172,14 @@ module subroutine netcdf_initialize_output(self, param) end select ! Check if the file exists, and if it does, delete it - inquire(file=param%outfile, exist=fileExists) + inquire(file=nc%file_name, exist=fileExists) if (fileExists) then - open(unit=LUN, file=param%outfile, status="old", err=667, iomsg=errmsg) + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) close(unit=LUN, status="delete") end if ! Create the file - call check( nf90_create(param%outfile, NF90_NETCDF4, nc%id), "netcdf_initialize_output nf90_create" ) + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "netcdf_initialize_output nf90_create" ) ! Dimensions call check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension @@ -324,8 +324,8 @@ module subroutine netcdf_open(self, param, readonly) associate(nc => self) - write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) - call check( nf90_open(param%outfile, mode, nc%id), errmsg) + write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(nc%file_name)) + call check( nf90_open(nc%file_name, mode, nc%id), errmsg) ! Dimensions call check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) @@ -824,6 +824,9 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma cb%id = itemp(1) pl%id(:) = pack(itemp, plmask) tp%id(:) = pack(itemp, tpmask) + cb%id = 0 + pl%id(:) = pack([(i,i=1,idmax)],plmask) + tp%id(:) = pack([(i,i=1,idmax)],tpmask) call check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar name_varid" ) call cb%info%set_value(name=ctemp(1)) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 481d35761..835d1c995 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -72,10 +72,12 @@ module subroutine setup_construct_system(system, param) select type(param) class is (symba_parameters) if (param%lencounter_save) then - if (.not. allocated(system%encounter_history)) allocate(encounter_storage :: system%encounter_history) - allocate(fraggle_io_parameters :: system%encounter_history%nc) + allocate(encounter_storage :: system%encounter_history) + allocate(encounter_io_parameters :: system%encounter_history%nce) + allocate(fraggle_io_parameters :: system%encounter_history%ncc) call system%encounter_history%reset() - system%encounter_history%nc%file_number = param%iloop / param%dump_cadence + system%encounter_history%nce%file_number = param%iloop / param%dump_cadence + system%encounter_history%ncc%file_number = param%iloop / param%dump_cadence end if end select end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 0fde607f6..6c1d53a6c 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -22,18 +22,23 @@ module subroutine symba_io_dump_encounter(self, param) class(symba_parameters), intent(inout) :: param !! Current run configuration parameters if (self%encounter_history%iframe == 0) return ! No enounters in this interval - self%encounter_history%nc%file_number = self%encounter_history%nc%file_number + 1 - ! Create and save the output file for this encounter - self%encounter_history%nc%time_dimsize = maxval(self%encounter_history%tslot(:)) - write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') self%encounter_history%nc%file_number - select type(nc => self%encounter_history%nc) - class is (fraggle_io_parameters) - write(nc%frag_file, '("fragmentation_",I0.6,".nc")') nc%file_number - end select - call self%encounter_history%nc%initialize(param) - call self%encounter_history%dump(param) - call self%encounter_history%nc%close() - call self%encounter_history%reset() + + associate(encounter_history => self%encounter_history, nce => self%encounter_history%nce, ncc => self%encounter_history%ncc, iframe => self%encounter_history%iframe) + + ! Create and save the output files for this encounter and fragmentation + nce%file_number = nce%file_number + 1 + ncc%file_number = ncc%file_number + 1 + nce%time_dimsize = maxval(encounter_history%tslot(:)) + ncc%time_dimsize = maxval(encounter_history%tslot(:)) + write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number + write(ncc%file_name, '("fragmentation_",I0.6,".nc")') ncc%file_number + call nce%initialize(param) + call ncc%initialize(param) + call encounter_history%dump(param) + call nce%close() + call ncc%close() + call encounter_history%reset() + end associate return end subroutine symba_io_dump_encounter diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index faa6bf431..5d8a4a444 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -903,7 +903,8 @@ subroutine symba_util_save_storage(system, snapshot, t) tmp%tslot(1:nold) = system%encounter_history%tslot(1:nold) tmp%tslot(nold+1:nbig) = 0 tmp%iframe = system%encounter_history%iframe - call move_alloc(system%encounter_history%nc, tmp%nc) + call move_alloc(system%encounter_history%nce, tmp%nce) + call move_alloc(system%encounter_history%ncc, tmp%ncc) do i = 1, nold if (allocated(system%encounter_history%frame(i)%item)) call move_alloc(system%encounter_history%frame(i)%item, tmp%frame(i)%item)