From 0f412239001189a7f98799ba75b46724e06833af Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 16:52:31 -0500 Subject: [PATCH 01/63] Fixed the code so that it only outputs encounter data on the dump steps --- python/swiftest/swiftest/io.py | 6 +- python/swiftest/swiftest/simulation_class.py | 5 ++ src/encounter/encounter_io.f90 | 17 ++--- src/io/io.f90 | 11 +++ src/main/swiftest_driver.f90 | 4 +- src/modules/encounter_classes.f90 | 21 +++--- src/modules/symba_classes.f90 | 15 +--- src/setup/setup.f90 | 8 +++ src/symba/symba_io.f90 | 73 +++++++------------- src/symba/symba_step.f90 | 4 +- src/symba/symba_util.f90 | 1 + 11 files changed, 79 insertions(+), 86 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index a4f370773..f33535327 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -64,7 +64,7 @@ # handles strings differently than Python's Xarray. string_varnames = ["name", "particle_type", "status", "origin_type"] char_varnames = ["space"] -int_varnames = ["id", "ntp", "npl", "nplm", "discard_body_id", "collision_id"] +int_varnames = ["id", "ntp", "npl", "nplm", "discard_body_id", "collision_id", "loopnum"] def bool2yesno(boolval): """ @@ -816,8 +816,8 @@ def process_netcdf_input(ds, param): ------- ds : xarray dataset """ - - ds = ds.where(~np.isnan(ds.id) ,drop=True) + # + ds = ds.where(ds.id >=0,drop=True) if param['OUT_TYPE'] == "NETCDF_DOUBLE": ds = fix_types(ds,ftype=np.float64) elif param['OUT_TYPE'] == "NETCDF_FLOAT": diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9b9bd02dc..8fb77ab4a 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2780,6 +2780,11 @@ def _preprocess(ds, param): tgood,tid = np.unique(self.enc.time,return_index=True) self.enc = self.enc.isel(time=tid) + # Reduce the dimensionality of variables that got expanded in the combine process + self.enc['loopnum'] = self.enc['loopnum'].max(dim="name") + self.enc['id'] = self.enc['id'].max(dim="time") + self.enc['particle_type'] = self.enc['particle_type'].max(dim="time") + return diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 0cc07b009..67020fb13 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -53,7 +53,7 @@ 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) :: nvar, varid, vartype + integer(I4B) :: i, nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill logical :: fileExists @@ -97,7 +97,7 @@ module subroutine encounter_io_initialize(self, param) call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%level_varname, NF90_INT, [nc%id_dimid, nc%time_dimid], nc%level_varid), "encounter_io_initialize nf90_def_var level_varid" ) + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) if (param%lclose) then call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) end if @@ -126,6 +126,10 @@ 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 + + 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 return @@ -145,7 +149,7 @@ module subroutine encounter_io_write_frame(self, nc, param) ! 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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp character(len=NAMELEN) :: charstring @@ -155,19 +159,16 @@ module subroutine encounter_io_write_frame(self, nc, param) 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) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) - select type(pl) - class is (symba_pl) - call check( nf90_put_var(nc%id, nc%level_varid, pl%levelg(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl level_varid" ) - end select if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) diff --git a/src/io/io.f90 b/src/io/io.f90 index d14f0a694..f0c1cb994 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -264,6 +264,17 @@ module subroutine io_dump_system(self, param) idx = idx + 1 if (idx > NDUMPFILES) idx = 1 + ! Dump the encounter history if necessary + select type(param) + class is (symba_parameters) + if (param%lencounter_save) then + select type(self) + class is (symba_nbody_system) + call self%dump_encounter(param) + end select + end if + end select + return end subroutine io_dump_system diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 6d5abce79..56ceafd9f 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -51,6 +51,8 @@ program swiftest_driver end select param%integrator = trim(adjustl(integrator)) call param%set_display(display_style) + call param%read_in(param_file_name) + call setup_construct_system(nbody_system, param) !> Define the maximum number of threads nthreads = 1 ! In the *serial* case @@ -60,8 +62,6 @@ program swiftest_driver !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads - call setup_construct_system(nbody_system, param) - call param%read_in(param_file_name) associate(t => nbody_system%t, & t0 => param%t0, & diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index c7edc5e8a..ad73dc4ad 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -43,9 +43,10 @@ module encounter_classes type :: encounter_snapshot !! A simplified version of a SyMBA nbody system object for storing minimal snapshots of the system state during encounters - class(swiftest_pl), allocatable :: pl !! Massive body data structure - class(swiftest_tp), allocatable :: tp !! Test particle data structure - real(DP) :: t !! Simulation time when snapshot was taken + class(swiftest_pl), allocatable :: pl !! Massive body data structure + class(swiftest_tp), allocatable :: tp !! Test particle data structure + real(DP) :: t !! Simulation time when snapshot was taken + integer(I8B) :: iloop !! Loop number at time of snapshot contains procedure :: write_frame => encounter_io_write_frame !! Writes a frame of encounter data to file final :: encounter_util_final_snapshot @@ -53,19 +54,19 @@ 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) :: level_varname = "level" !! Recursion depth - integer(I4B) :: level_varid !! ID for the recursion level variable - integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot - integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot + 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 + integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot contains procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object end type encounter_io_parameters !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: encounter_storage - type(encounter_io_parameters) :: nc !! NetCDF parameter object containing the details about the file attached to this storage object + type(encounter_io_parameters) :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file final :: encounter_util_final_storage diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index faa1e2e80..4c56ff6f7 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -199,8 +199,7 @@ module symba_classes procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step procedure :: snapshot => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter - procedure :: start_encounter => symba_io_start_encounter !! Initializes the new encounter history - procedure :: stop_encounter => symba_io_stop_encounter !! Saves the encounter and/or fragmentation data to file(s) + procedure :: dump_encounter => symba_io_dump_encounter !! Saves the encounter and/or fragmentation data to file(s) final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system @@ -409,19 +408,11 @@ module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, ioms character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 end subroutine symba_io_param_writer - module subroutine symba_io_start_encounter(self, param, t) + module subroutine symba_io_dump_encounter(self, param) implicit none class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - end subroutine symba_io_start_encounter - - module subroutine symba_io_stop_encounter(self, param, t) - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - end subroutine symba_io_stop_encounter + end subroutine symba_io_dump_encounter module subroutine symba_io_write_discard(self, param) use swiftest_classes, only : swiftest_parameters diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index e95505b9b..4cd5d130a 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -68,6 +68,14 @@ module subroutine setup_construct_system(system, param) allocate(symba_pltpenc :: system%pltpenc_list) allocate(symba_plplenc :: system%plplenc_list) allocate(symba_plplenc :: system%plplcollision_list) + + select type(param) + class is (symba_parameters) + if (param%lencounter_save) then + if (.not. allocated(system%encounter_history)) allocate(encounter_storage :: system%encounter_history) + call system%encounter_history%reset() + end if + end select end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index e790e1685..3dbf4ebbd 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -11,6 +11,30 @@ use swiftest contains + + module subroutine symba_io_dump_encounter(self, param) + !! author: David A. Minton + !! + !! Saves the encounter and/or fragmentation data to file with the name of the current output interval number attached + implicit none + ! Arguments + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters + + if (self%encounter_history%iframe == 0) return ! No enounters in this interval + + ! 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")') param%iloop / param%dump_cadence + call self%encounter_history%nc%initialize(param) + call self%encounter_history%dump(param) + call self%encounter_history%nc%close() + call self%encounter_history%reset() + + return + end subroutine symba_io_dump_encounter + + module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! @@ -188,55 +212,6 @@ module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, ioms end subroutine symba_io_param_writer - module subroutine symba_io_start_encounter(self, param, t) - !! author: David A. Minton - !! - !! Initializes the new encounter and/or fragmentation history - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - - if (.not. allocated(self%encounter_history)) then - allocate(encounter_storage :: self%encounter_history) - end if - call self%encounter_history%reset() - - ! Take the snapshot at the start of the encounter - call self%snapshot(param, t) - - return - end subroutine symba_io_start_encounter - - - module subroutine symba_io_stop_encounter(self, param, t) - !! author: David A. Minton - !! - !! Saves the encounter and/or fragmentation data to file(s) - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - ! Internals - integer(I4B) :: i - - ! 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")') param%iloop - - call self%encounter_history%nc%initialize(param) - call self%encounter_history%dump(param) - call self%encounter_history%nc%close() - call self%encounter_history%reset() - - return - end subroutine symba_io_stop_encounter - - module subroutine symba_io_write_discard(self, param) !! author: David A. Minton !! diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index e727ed9f3..0b8879464 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -37,9 +37,9 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then - if (param%lencounter_save) call self%start_encounter(param, t) + if (param%lencounter_save) call self%snapshot(param, t) call self%interp(param, t, dt) - if (param%lencounter_save) call self%stop_encounter(param, t+dt) + if (param%lencounter_save) call self%snapshot(param, t+dt) else self%irec = -1 call helio_step_system(self, param, t, dt) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index d53bd442b..c2a837599 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1302,6 +1302,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) associate(npl => self%pl%nbody, ntp => self%tp%nbody) snapshot%t = t + snapshot%iloop = param%iloop if (npl + ntp == 0) return npl_snap = npl From d002ece8be89f616170c8e55aa3486c87d6c31c4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 17:13:28 -0500 Subject: [PATCH 02/63] Fixed file numbering issue for encounter files --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/encounter/encounter_io.f90 | 1 - src/main/swiftest_driver.f90 | 90 ++++++++++--------- src/modules/encounter_classes.f90 | 1 + src/setup/setup.f90 | 1 + src/symba/symba_io.f90 | 4 +- 6 files changed, 52 insertions(+), 47 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index a664ef49e..914f8ed11 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -203,7 +203,7 @@ def data_stream(self, frame=0): minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades sim.set_parameter(fragmentation=True, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=0) + sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=4) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 67020fb13..86a0c60ad 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -23,7 +23,6 @@ module subroutine encounter_io_dump(self, param) ! Internals integer(I4B) :: i - ! Most of this is just temporary test code just to get something working. Eventually this should get cleaned up. do i = 1, self%nframes if (allocated(self%frame(i)%item)) then diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 56ceafd9f..bfc0b38c6 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -18,7 +18,7 @@ program swiftest_driver use swiftest implicit none - class(swiftest_nbody_system), allocatable :: nbody_system !! Polymorphic object containing the nbody system to be integrated + class(swiftest_nbody_system), allocatable :: system !! Polymorphic object containing the nbody system to be integrated class(swiftest_parameters), allocatable :: param !! Run configuration parameters character(len=:), allocatable :: integrator !! Integrator type code (see swiftest_globals for symbolic names) character(len=:),allocatable :: param_file_name !! Name of the file containing user-defined parameters @@ -52,33 +52,21 @@ program swiftest_driver param%integrator = trim(adjustl(integrator)) call param%set_display(display_style) call param%read_in(param_file_name) - call setup_construct_system(nbody_system, param) - - !> Define the maximum number of threads - nthreads = 1 ! In the *serial* case - !$ nthreads = omp_get_max_threads() ! In the *parallel* case - !$ write(param%display_unit,'(a)') ' OpenMP parameters:' - !$ write(param%display_unit,'(a)') ' ------------------' - !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads - !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads - - - associate(t => nbody_system%t, & - t0 => param%t0, & - tstart => param%tstart, & - dt => param%dt, & - tstop => param%tstop, & - iloop => param%iloop, & - istep_out => param%istep_out, & - dump_cadence => param%dump_cadence, & - ioutput => param%ioutput, & - display_style => param%display_style, & - display_unit => param%display_unit) - - call nbody_system%initialize(param) + + + associate(t0 => param%t0, & + tstart => param%tstart, & + dt => param%dt, & + tstop => param%tstop, & + iloop => param%iloop, & + istep_out => param%istep_out, & + dump_cadence => param%dump_cadence, & + ioutput => param%ioutput, & + display_style => param%display_style, & + display_unit => param%display_unit) + ! Set up loop and output cadence variables - t = tstart nloops = ceiling((tstop - t0) / dt, kind=I8B) istart = ceiling((tstart - t0) / dt + 1.0_DP, kind=I8B) ioutput = max(int(istart / istep_out, kind=I4B),1) @@ -87,13 +75,27 @@ program swiftest_driver if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) allocate(swiftest_storage(dump_cadence) :: system_history) + ! Construct the main n-body system using the user-input integrator to choose the type of system + call setup_construct_system(system, param) + + !> Define the maximum number of threads + nthreads = 1 ! In the *serial* case + !$ nthreads = omp_get_max_threads() ! In the *parallel* case + !$ write(param%display_unit,'(a)') ' OpenMP parameters:' + !$ write(param%display_unit,'(a)') ' ------------------' + !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads + !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads + + call system%initialize(param) + + ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. if (param%lrestart) then - if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) + if (param%lenergy) call system%conservation_report(param, lterminal=.true.) else - if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum - call nbody_system%write_frame(param) - call nbody_system%dump(param) + if (param%lenergy) call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum + call system%write_frame(param) + call system%dump(param) end if write(display_unit, *) " *************** Main Loop *************** " @@ -104,21 +106,22 @@ program swiftest_driver call pbar%update(1,message=pbarmessage) else if (display_style == "COMPACT") then write(*,*) "SWIFTEST START " // param%integrator - call nbody_system%compact_output(param,integration_timer) + call system%compact_output(param,integration_timer) end if iout = 0 idump = 0 + system%t = tstart do iloop = istart, nloops !> Step the system forward in time call integration_timer%start() - call nbody_system%step(param, t, dt) + call system%step(param, system%t, dt) call integration_timer%stop() - t = t0 + iloop * dt + system%t = t0 + iloop * dt !> Evaluate any discards or collisional outcomes - call nbody_system%discard(param) + call system%discard(param) if (display_style == "PROGRESS") call pbar%update(iloop) !> If the loop counter is at the output cadence value, append the data file with a single frame @@ -127,30 +130,30 @@ program swiftest_driver if (iout == istep_out) then iout = 0 idump = idump + 1 - system_history%frame(idump) = nbody_system ! Store a snapshot of the system for posterity + system_history%frame(idump) = system ! Store a snapshot of the system for posterity if (idump == dump_cadence) then idump = 0 - call nbody_system%dump(param) + call system%dump(param) call system_history%dump(param) end if - tfrac = (t - t0) / (tstop - t0) + tfrac = (system%t - t0) / (tstop - t0) - select type(pl => nbody_system%pl) + select type(pl => system%pl) class is (symba_pl) - write(display_unit, symbastatfmt) t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody + write(display_unit, symbastatfmt) system%t, tfrac, pl%nplm, pl%nbody, system%tp%nbody class default - write(display_unit, statusfmt) t, tfrac, pl%nbody, nbody_system%tp%nbody + write(display_unit, statusfmt) system%t, tfrac, pl%nbody, system%tp%nbody end select - if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) + if (param%lenergy) call system%conservation_report(param, lterminal=.true.) call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) if (display_style == "PROGRESS") then - write(pbarmessage,fmt=pbarfmt) t, tstop + write(pbarmessage,fmt=pbarfmt) system%t, tstop call pbar%update(1,message=pbarmessage) else if (display_style == "COMPACT") then - call nbody_system%compact_output(param,integration_timer) + call system%compact_output(param,integration_timer) end if call integration_timer%reset() @@ -160,6 +163,7 @@ program swiftest_driver end do ! Dump any remaining history if it exists + call system%dump(param) call system_history%dump(param) if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator end associate diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index ad73dc4ad..3329fde02 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -60,6 +60,7 @@ module encounter_classes integer(I4B) :: loop_varid !! ID for the recursion level variable integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot + integer(I4B) :: file_number = 1 !! The number to append on the output file contains procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object end type encounter_io_parameters diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 4cd5d130a..13e3ec9a1 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -74,6 +74,7 @@ module subroutine setup_construct_system(system, param) if (param%lencounter_save) then if (.not. allocated(system%encounter_history)) allocate(encounter_storage :: system%encounter_history) call system%encounter_history%reset() + system%encounter_history%nc%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 3dbf4ebbd..606d359cf 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -22,10 +22,10 @@ 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")') param%iloop / param%dump_cadence + write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') self%encounter_history%nc%file_number call self%encounter_history%nc%initialize(param) call self%encounter_history%dump(param) call self%encounter_history%nc%close() From 34a8f623fb2fe3ac90791576282c35bff3fe576a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 17:20:40 -0500 Subject: [PATCH 03/63] Put the dump_cadence back to 0 after testing --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 914f8ed11..a664ef49e 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -203,7 +203,7 @@ def data_stream(self, frame=0): minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades sim.set_parameter(fragmentation=True, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=4) + sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file From 36dc282a7eacea53f9e203cdbc7af4dbc65e0f16 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 17:26:53 -0500 Subject: [PATCH 04/63] Refactored --- src/modules/fraggle_classes.f90 | 2 ++ src/modules/symba_classes.f90 | 24 ++++++++++++------------ src/symba/symba_collision.f90 | 16 ++++++++-------- 3 files changed, 22 insertions(+), 20 deletions(-) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index e4a458a3b..a45ceb873 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -123,6 +123,8 @@ module fraggle_classes end type fraggle_storage type, extends(encounter_snapshot) :: fraggle_encounter_snapshot + class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot + class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot contains procedure :: write_frame => fraggle_io_encounter_write_frame !! Writes a frame of encounter data to file final :: fraggle_util_final_snapshot diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 4c56ff6f7..66c84cc0b 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -164,7 +164,7 @@ module symba_classes !> SyMBA class for tracking pl-tp close encounters in a step type, extends(symba_encounter) :: symba_pltpenc contains - procedure :: resolve_collision => symba_collision_resolve_pltpenc !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the c + procedure :: resolve_collision => symba_resolve_collision_pltpenc !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the c end type symba_pltpenc !******************************************************************************************************************************** @@ -174,9 +174,9 @@ module symba_classes type, extends(symba_encounter) :: symba_plplenc contains procedure :: extract_collisions => symba_collision_encounter_extract_collisions !! Processes the pl-pl encounter list remove only those encounters that led to a collision - procedure :: resolve_fragmentations => symba_collision_resolve_fragmentations !! Process list of collisions, determine the collisional regime, and then create fragments - procedure :: resolve_mergers => symba_collision_resolve_mergers !! Process list of collisions and merge colliding bodies together - procedure :: resolve_collision => symba_collision_resolve_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c + procedure :: resolve_fragmentations => symba_resolve_collision_fragmentations !! Process list of collisions, determine the collisional regime, and then create fragments + procedure :: resolve_mergers => symba_resolve_collision_mergers !! Process list of collisions and merge colliding bodies together + procedure :: resolve_collision => symba_resolve_collision_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c end type symba_plplenc @@ -231,21 +231,21 @@ module subroutine symba_collision_make_colliders_pl(self,idx) integer(I4B), dimension(2), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision end subroutine symba_collision_make_colliders_pl - module subroutine symba_collision_resolve_fragmentations(self, system, param) + module subroutine symba_resolve_collision_fragmentations(self, system, param) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - end subroutine symba_collision_resolve_fragmentations + end subroutine symba_resolve_collision_fragmentations - module subroutine symba_collision_resolve_mergers(self, system, param) + module subroutine symba_resolve_collision_mergers(self, system, param) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - end subroutine symba_collision_resolve_mergers + end subroutine symba_resolve_collision_mergers - module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, irec) + module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object @@ -253,9 +253,9 @@ module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, ir real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size integer(I4B), intent(in) :: irec !! Current recursion level - end subroutine symba_collision_resolve_plplenc + end subroutine symba_resolve_collision_plplenc - module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, irec) + module subroutine symba_resolve_collision_pltpenc(self, system, param, t, dt, irec) implicit none class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object @@ -263,7 +263,7 @@ module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, ir real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size integer(I4B), intent(in) :: irec !! Current recursion level - end subroutine symba_collision_resolve_pltpenc + end subroutine symba_resolve_collision_pltpenc module subroutine symba_discard_pl(self, system, param) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index eb891eb23..d69beea1b 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -870,7 +870,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) end subroutine symba_collision_mergeaddsub - module subroutine symba_collision_resolve_fragmentations(self, system, param) + module subroutine symba_resolve_collision_fragmentations(self, system, param) !! author: David A. Minton !! !! Process list of collisions, determine the collisional regime, and then create fragments. @@ -918,10 +918,10 @@ module subroutine symba_collision_resolve_fragmentations(self, system, param) end associate return - end subroutine symba_collision_resolve_fragmentations + end subroutine symba_resolve_collision_fragmentations - module subroutine symba_collision_resolve_mergers(self, system, param) + module subroutine symba_resolve_collision_mergers(self, system, param) !! author: David A. Minton !! !! Process list of collisions and merge colliding bodies together. @@ -964,10 +964,10 @@ module subroutine symba_collision_resolve_mergers(self, system, param) end associate return - end subroutine symba_collision_resolve_mergers + end subroutine symba_resolve_collision_mergers - module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, irec) + module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec) !! author: David A. Minton !! !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision @@ -1051,10 +1051,10 @@ module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, ir end associate return - end subroutine symba_collision_resolve_plplenc + end subroutine symba_resolve_collision_plplenc - module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, irec) + module subroutine symba_resolve_collision_pltpenc(self, system, param, t, dt, irec) !! author: David A. Minton !! !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision @@ -1078,6 +1078,6 @@ module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, ir call system%tp%discard(system, param) return - end subroutine symba_collision_resolve_pltpenc + end subroutine symba_resolve_collision_pltpenc end submodule s_symba_collision \ No newline at end of file From 691acb1716e519f0ee92e594cb9227be88ed2aab Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 17:38:13 -0500 Subject: [PATCH 05/63] Refactoring to prepare to consolidate fraggle stuff into the symba nbody object --- src/modules/symba_classes.f90 | 14 ++-- src/symba/symba_collision.f90 | 128 ++++++++++++++++------------------ 2 files changed, 70 insertions(+), 72 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 66c84cc0b..b61b2079e 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -189,6 +189,8 @@ module symba_classes 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 @@ -342,33 +344,33 @@ pure module subroutine symba_gr_p4_tp(self, system, param, dt) real(DP), intent(in) :: dt !! Step size end subroutine symba_gr_p4_tp - module function symba_collision_casedisruption(system, param, colliders, frag) result(status) + module function symba_collision_casedisruption(system, param, colliders, fragments) result(status) use fraggle_classes, only : fraggle_colliders, fraggle_fragments implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casedisruption - module function symba_collision_casehitandrun(system, param, colliders, frag) result(status) + module function symba_collision_casehitandrun(system, param, colliders, fragments) result(status) use fraggle_classes, only : fraggle_colliders, fraggle_fragments implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casehitandrun - module function symba_collision_casemerge(system, param, colliders, frag) result(status) + module function symba_collision_casemerge(system, param, colliders, fragments) result(status) use fraggle_classes, only : fraggle_colliders, fraggle_fragments implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casemerge diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index d69beea1b..45c4fe854 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -12,7 +12,7 @@ contains - module function symba_collision_casedisruption(system, param, colliders, frag) result(status) + module function symba_collision_casedisruption(system, param, colliders, fragments) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic disruption collision @@ -22,7 +22,7 @@ module function symba_collision_casedisruption(system, param, colliders, frag) class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -30,7 +30,7 @@ module function symba_collision_casedisruption(system, param, colliders, frag) logical :: lfailure character(len=STRMAX) :: message - select case(frag%regime) + select case(fragments%regime) case(COLLRESOLVE_REGIME_DISRUPTION) message = "Disruption between" case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) @@ -40,10 +40,10 @@ module function symba_collision_casedisruption(system, param, colliders, frag) call io_log_one_message(FRAGGLE_LOG_OUT, message) ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call frag%set_mass_dist(colliders, param) + call fragments%set_mass_dist(colliders, param) ! Generate the position and velocity distributions of the fragments - call frag%generate_fragments(colliders, system, param, lfailure) + call fragments%generate_fragments(colliders, system, param, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") @@ -57,30 +57,30 @@ module function symba_collision_casedisruption(system, param, colliders, frag) end select else ! Populate the list of new bodies - nfrag = frag%nbody + nfrag = fragments%nbody write(message, *) nfrag call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(frag%regime) + select case(fragments%regime) case(COLLRESOLVE_REGIME_DISRUPTION) status = DISRUPTION ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) - frag%id(1) = system%pl%id(ibiggest) - frag%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = frag%id(nfrag) + fragments%id(1) = system%pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) status = SUPERCATASTROPHIC - frag%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = frag%id(nfrag) + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) end select - call symba_collision_mergeaddsub(system, param, colliders, frag, status) + call symba_collision_mergeaddsub(system, param, colliders, fragments, status) end if return end function symba_collision_casedisruption - module function symba_collision_casehitandrun(system, param, colliders, frag) result(status) + module function symba_collision_casehitandrun(system, param, colliders, fragments) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic hit-and-run collision @@ -90,7 +90,7 @@ module function symba_collision_casehitandrun(system, param, colliders, frag) r class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcom ! Internals @@ -110,22 +110,22 @@ module function symba_collision_casehitandrun(system, param, colliders, frag) r jproj = 1 end if - if (frag%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + if (fragments%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") nfrag = 0 lpure = .true. else ! Imperfect hit and run, so we'll keep the largest body and destroy the other lpure = .false. - call frag%set_mass_dist(colliders, param) + call fragments%set_mass_dist(colliders, param) ! Generate the position and velocity distributions of the fragments - call frag%generate_fragments(colliders, system, param, lpure) + call fragments%generate_fragments(colliders, system, param, lpure) if (lpure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") nfrag = 0 else - nfrag = frag%nbody + nfrag = fragments%nbody write(message, *) nfrag call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") end if @@ -140,18 +140,18 @@ module function symba_collision_casehitandrun(system, param, colliders, frag) r end select else ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) - frag%id(1) = system%pl%id(ibiggest) - frag%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = frag%id(nfrag) + fragments%id(1) = system%pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) status = HIT_AND_RUN_DISRUPT - call symba_collision_mergeaddsub(system, param, colliders, frag, status) + call symba_collision_mergeaddsub(system, param, colliders, fragments, status) end if return end function symba_collision_casehitandrun - module function symba_collision_casemerge(system, param, colliders, frag) result(status) + module function symba_collision_casemerge(system, param, colliders, fragments) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Merge massive bodies. @@ -164,7 +164,7 @@ module function symba_collision_casemerge(system, param, colliders, frag) resul class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -180,18 +180,18 @@ module function symba_collision_casemerge(system, param, colliders, frag) resul select type(pl => system%pl) class is (symba_pl) - call frag%set_mass_dist(colliders, param) + call fragments%set_mass_dist(colliders, param) ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) - frag%id(1) = pl%id(ibiggest) - frag%xb(:,1) = frag%xbcom(:) - frag%vb(:,1) = frag%vbcom(:) + fragments%id(1) = pl%id(ibiggest) + fragments%xb(:,1) = fragments%xbcom(:) + fragments%vb(:,1) = fragments%vbcom(:) if (param%lrotation) then ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body L_spin_new(:) = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) ! Assume prinicpal axis rotation on 3rd Ip axis - frag%rot(:,1) = L_spin_new(:) / (frag%Ip(3,1) * frag%mass(1) * frag%radius(1)**2) + fragments%rot(:,1) = L_spin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable param%Lescape(:) = param%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) end if @@ -225,7 +225,7 @@ module function symba_collision_casemerge(system, param, colliders, frag) resul status = MERGED - call symba_collision_mergeaddsub(system, param, colliders, frag, status) + call symba_collision_mergeaddsub(system, param, colliders, fragments, status) end select @@ -708,7 +708,7 @@ module subroutine symba_collision_make_colliders_pl(self, idx) end subroutine symba_collision_make_colliders_pl - subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) + subroutine symba_collision_mergeaddsub(system, param, colliders, fragments, status) !! author: David A. Minton !! !! Fills the pl_discards and pl_adds with removed and added bodies @@ -718,7 +718,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B), intent(in) :: status !! Status flag to assign to adds ! Internals integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, ncolliders, nfrag @@ -734,7 +734,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody) ! Add the colliders%idx bodies to the subtraction list ncolliders = colliders%ncoll - nfrag = frag%nbody + nfrag = fragments%nbody param%maxid_collision = max(param%maxid_collision, maxval(system%pl%info(:)%collision_id)) param%maxid_collision = param%maxid_collision + 1 @@ -746,26 +746,26 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) ismallest = colliders%idx(minloc(pl%Gmass(colliders%idx(:)), dim=1)) ! Copy over identification, information, and physical properties of the new bodies from the fragment list - plnew%id(1:nfrag) = frag%id(1:nfrag) - plnew%xb(:, 1:nfrag) = frag%xb(:, 1:nfrag) - plnew%vb(:, 1:nfrag) = frag%vb(:, 1:nfrag) + plnew%id(1:nfrag) = fragments%id(1:nfrag) + plnew%xb(:, 1:nfrag) = fragments%xb(:, 1:nfrag) + plnew%vb(:, 1:nfrag) = fragments%vb(:, 1:nfrag) call pl%vb2vh(cb) call pl%xh2xb(cb) do i = 1, nfrag - plnew%rh(:,i) = frag%xb(:, i) - cb%xb(:) - plnew%vh(:,i) = frag%vb(:, i) - cb%vb(:) + plnew%rh(:,i) = fragments%xb(:, i) - cb%xb(:) + plnew%vh(:,i) = fragments%vb(:, i) - cb%vb(:) end do - plnew%mass(1:nfrag) = frag%mass(1:nfrag) - plnew%Gmass(1:nfrag) = param%GU * frag%mass(1:nfrag) - plnew%radius(1:nfrag) = frag%radius(1:nfrag) - plnew%density(1:nfrag) = frag%mass(1:nfrag) / frag%radius(1:nfrag) + plnew%mass(1:nfrag) = fragments%mass(1:nfrag) + plnew%Gmass(1:nfrag) = param%GU * fragments%mass(1:nfrag) + plnew%radius(1:nfrag) = fragments%radius(1:nfrag) + plnew%density(1:nfrag) = fragments%mass(1:nfrag) / fragments%radius(1:nfrag) call plnew%set_rhill(cb) select case(status) case(SUPERCATASTROPHIC) plnew%status(1:nfrag) = NEW_PARTICLE do i = 1, nfrag - write(newname, FRAGFMT) frag%id(i) + write(newname, FRAGFMT) fragments%id(i) call plnew%info(i)%set_value(origin_type="Supercatastrophic", origin_time=system%t, name=newname, & origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & collision_id=param%maxid_collision) @@ -789,7 +789,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) call plnew%info(1)%copy(pl%info(ibiggest)) plnew%status(1) = OLD_PARTICLE do i = 2, nfrag - write(newname, FRAGFMT) frag%id(i) + write(newname, FRAGFMT) fragments%id(i) call plnew%info(i)%set_value(origin_type=origin_type, origin_time=system%t, name=newname, & origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & collision_id=param%maxid_collision) @@ -814,8 +814,8 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) end select if (param%lrotation) then - plnew%Ip(:, 1:nfrag) = frag%Ip(:, 1:nfrag) - plnew%rot(:, 1:nfrag) = frag%rot(:, 1:nfrag) + plnew%Ip(:, 1:nfrag) = fragments%Ip(:, 1:nfrag) + plnew%rot(:, 1:nfrag) = fragments%rot(:, 1:nfrag) end if ! if (param%ltides) then @@ -885,10 +885,8 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision logical :: lgoodcollision integer(I4B) :: i - type(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: frag !! Fraggle fragmentation system object - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, colliders => system%colliders, fragments => system%fragments) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) @@ -899,15 +897,15 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle - call colliders%regime(frag, system, param) + call colliders%regime(fragments, system, param) - select case (frag%regime) + select case (fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plplcollision_list%status(i) = symba_collision_casedisruption(system, param, colliders, frag) + plplcollision_list%status(i) = symba_collision_casedisruption(system, param, colliders, fragments) case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, colliders, frag) + plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, colliders, fragments) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, frag) + plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, fragments) case default write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) @@ -935,10 +933,8 @@ module subroutine symba_resolve_collision_mergers(self, system, param) integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision logical :: lgoodcollision integer(I4B) :: i - type(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: frag !! Fraggle fragmentation system object - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, fragments => system%fragments, colliders => system%colliders) select type(pl => system%pl) class is (symba_pl) select type(cb => system%cb) @@ -950,14 +946,14 @@ module subroutine symba_resolve_collision_mergers(self, system, param) if (.not. lgoodcollision) cycle if (any(pl%status(idx_parent(:)) /= COLLISION)) cycle ! One of these two bodies has already been resolved - frag%regime = COLLRESOLVE_REGIME_MERGE - frag%mtot = sum(colliders%mass(:)) - frag%mass_dist(1) = frag%mtot - frag%mass_dist(2) = 0.0_DP - frag%mass_dist(3) = 0.0_DP - frag%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / frag%mtot - frag%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / frag%mtot - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, frag) + fragments%regime = COLLRESOLVE_REGIME_MERGE + fragments%mtot = sum(colliders%mass(:)) + fragments%mass_dist(1) = fragments%mtot + fragments%mass_dist(2) = 0.0_DP + fragments%mass_dist(3) = 0.0_DP + fragments%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / fragments%mtot + fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot + plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, fragments) end do end select end select From fb2a95ec3bc4d398d098ec2d67c2227ee7a2796a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 17:47:58 -0500 Subject: [PATCH 06/63] OOFed Fraggle --- src/modules/symba_classes.f90 | 15 +- src/symba/symba_collision.f90 | 289 +++++++++++++++++----------------- 2 files changed, 147 insertions(+), 157 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index b61b2079e..c30762243 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -344,33 +344,24 @@ pure module subroutine symba_gr_p4_tp(self, system, param, dt) real(DP), intent(in) :: dt !! Step size end subroutine symba_gr_p4_tp - module function symba_collision_casedisruption(system, param, colliders, fragments) result(status) - use fraggle_classes, only : fraggle_colliders, fraggle_fragments + module function symba_collision_casedisruption(system, param) result(status) implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casedisruption - module function symba_collision_casehitandrun(system, param, colliders, fragments) result(status) - use fraggle_classes, only : fraggle_colliders, fraggle_fragments + module function symba_collision_casehitandrun(system, param) result(status) implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casehitandrun - module function symba_collision_casemerge(system, param, colliders, fragments) result(status) - use fraggle_classes, only : fraggle_colliders, fraggle_fragments + module function symba_collision_casemerge(system, param) result(status) implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casemerge diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 45c4fe854..be6406374 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -12,7 +12,7 @@ contains - module function symba_collision_casedisruption(system, param, colliders, fragments) result(status) + module function symba_collision_casedisruption(system, param) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic disruption collision @@ -21,8 +21,6 @@ module function symba_collision_casedisruption(system, param, colliders, fragmen ! Arguments class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -30,57 +28,60 @@ module function symba_collision_casedisruption(system, param, colliders, fragmen logical :: lfailure character(len=STRMAX) :: message - select case(fragments%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - message = "Disruption between" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - message = "Supercatastrophic disruption between" - end select - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - - ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call fragments%set_mass_dist(colliders, param) - - ! Generate the position and velocity distributions of the fragments - call fragments%generate_fragments(colliders, system, param, lfailure) + associate(colliders => system%colliders, fragments => system%fragments) - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") - status = ACTIVE - nfrag = 0 - select type(pl => system%pl) - class is (symba_pl) - pl%status(colliders%idx(:)) = status - pl%ldiscard(colliders%idx(:)) = .false. - pl%lcollision(colliders%idx(:)) = .false. - end select - else - ! Populate the list of new bodies - nfrag = fragments%nbody - write(message, *) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") select case(fragments%regime) case(COLLRESOLVE_REGIME_DISRUPTION) - status = DISRUPTION - ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) - fragments%id(1) = system%pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) + message = "Disruption between" case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - status = SUPERCATASTROPHIC - fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = fragments%id(nfrag) + message = "Supercatastrophic disruption between" end select + call symba_collision_collider_message(system%pl, colliders%idx, message) + call io_log_one_message(FRAGGLE_LOG_OUT, message) - call symba_collision_mergeaddsub(system, param, colliders, fragments, status) - end if + ! Collisional fragments will be uniformly distributed around the pre-impact barycenter + call fragments%set_mass_dist(colliders, param) + + ! Generate the position and velocity distributions of the fragments + call fragments%generate_fragments(colliders, system, param, lfailure) + + if (lfailure) then + call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") + status = ACTIVE + nfrag = 0 + select type(pl => system%pl) + class is (symba_pl) + pl%status(colliders%idx(:)) = status + pl%ldiscard(colliders%idx(:)) = .false. + pl%lcollision(colliders%idx(:)) = .false. + end select + else + ! Populate the list of new bodies + nfrag = fragments%nbody + write(message, *) nfrag + call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + select case(fragments%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + status = DISRUPTION + ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) + fragments%id(1) = system%pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + status = SUPERCATASTROPHIC + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) + end select + + call symba_collision_mergeaddsub(system, param, status) + end if + end associate return end function symba_collision_casedisruption - module function symba_collision_casehitandrun(system, param, colliders, fragments) result(status) + module function symba_collision_casehitandrun(system, param) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic hit-and-run collision @@ -89,8 +90,6 @@ module function symba_collision_casehitandrun(system, param, colliders, fragment ! Arguments class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcom ! Internals @@ -98,60 +97,63 @@ module function symba_collision_casehitandrun(system, param, colliders, fragment logical :: lpure character(len=STRMAX) :: message - message = "Hit and run between" - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) + associate(colliders => system%colliders, fragments => system%fragments) + message = "Hit and run between" + call symba_collision_collider_message(system%pl, colliders%idx, message) + call io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) - if (colliders%mass(1) > colliders%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if + if (colliders%mass(1) > colliders%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if - if (fragments%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched - call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") - nfrag = 0 - lpure = .true. - else ! Imperfect hit and run, so we'll keep the largest body and destroy the other - lpure = .false. - call fragments%set_mass_dist(colliders, param) + if (fragments%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") + nfrag = 0 + lpure = .true. + else ! Imperfect hit and run, so we'll keep the largest body and destroy the other + lpure = .false. + call fragments%set_mass_dist(colliders, param) - ! Generate the position and velocity distributions of the fragments - call fragments%generate_fragments(colliders, system, param, lpure) + ! Generate the position and velocity distributions of the fragments + call fragments%generate_fragments(colliders, system, param, lpure) - if (lpure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") - nfrag = 0 + if (lpure) then + call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") + nfrag = 0 + else + nfrag = fragments%nbody + write(message, *) nfrag + call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + end if + end if + if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them + status = HIT_AND_RUN_PURE + select type(pl => system%pl) + class is (symba_pl) + pl%status(colliders%idx(:)) = ACTIVE + pl%ldiscard(colliders%idx(:)) = .false. + pl%lcollision(colliders%idx(:)) = .false. + end select else - nfrag = fragments%nbody - write(message, *) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) + fragments%id(1) = system%pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + status = HIT_AND_RUN_DISRUPT + call symba_collision_mergeaddsub(system, param, status) end if - end if - if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them - status = HIT_AND_RUN_PURE - select type(pl => system%pl) - class is (symba_pl) - pl%status(colliders%idx(:)) = ACTIVE - pl%ldiscard(colliders%idx(:)) = .false. - pl%lcollision(colliders%idx(:)) = .false. - end select - else - ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) - fragments%id(1) = system%pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) - status = HIT_AND_RUN_DISRUPT - call symba_collision_mergeaddsub(system, param, colliders, fragments, status) - end if + + end associate return end function symba_collision_casehitandrun - module function symba_collision_casemerge(system, param, colliders, fragments) result(status) + module function symba_collision_casemerge(system, param) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Merge massive bodies. @@ -163,8 +165,6 @@ module function symba_collision_casemerge(system, param, colliders, fragments) ! Arguments class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -173,62 +173,63 @@ module function symba_collision_casemerge(system, param, colliders, fragments) real(DP), dimension(NDIM) :: L_spin_new character(len=STRMAX) :: message - message = "Merging" - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - - select type(pl => system%pl) - class is (symba_pl) + associate(colliders => system%colliders, fragments => system%fragments) + message = "Merging" + call symba_collision_collider_message(system%pl, colliders%idx, message) + call io_log_one_message(FRAGGLE_LOG_OUT, message) - call fragments%set_mass_dist(colliders, param) - ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%xb(:,1) = fragments%xbcom(:) - fragments%vb(:,1) = fragments%vbcom(:) + select type(pl => system%pl) + class is (symba_pl) - if (param%lrotation) then - ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body - L_spin_new(:) = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) + call fragments%set_mass_dist(colliders, param) + ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%xb(:,1) = fragments%xbcom(:) + fragments%vb(:,1) = fragments%vbcom(:) - ! Assume prinicpal axis rotation on 3rd Ip axis - fragments%rot(:,1) = L_spin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) - else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - param%Lescape(:) = param%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) - end if + if (param%lrotation) then + ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body + L_spin_new(:) = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) - ! Keep track of the component of potential energy due to the pre-impact colliders%idx for book-keeping - pe = 0.0_DP - do j = 1, colliders%ncoll - do i = j + 1, colliders%ncoll - pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%xb(:, i) - pl%xb(:, j)) - end do - end do - system%Ecollisions = system%Ecollisions + pe - system%Euntracked = system%Euntracked - pe + ! Assume prinicpal axis rotation on 3rd Ip axis + fragments%rot(:,1) = L_spin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) + else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable + param%Lescape(:) = param%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + end if - ! Update any encounter lists that have the removed bodies in them so that they instead point to the new - do k = 1, system%plplenc_list%nenc + ! Keep track of the component of potential energy due to the pre-impact colliders%idx for book-keeping + pe = 0.0_DP do j = 1, colliders%ncoll - i = colliders%idx(j) - if (i == ibiggest) cycle - if (system%plplenc_list%id1(k) == pl%id(i)) then - system%plplenc_list%id1(k) = pl%id(ibiggest) - system%plplenc_list%index1(k) = i - end if - if (system%plplenc_list%id2(k) == pl%id(i)) then - system%plplenc_list%id2(k) = pl%id(ibiggest) - system%plplenc_list%index2(k) = i - end if - if (system%plplenc_list%id1(k) == system%plplenc_list%id2(k)) system%plplenc_list%status(k) = INACTIVE + do i = j + 1, colliders%ncoll + pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%xb(:, i) - pl%xb(:, j)) + end do + end do + system%Ecollisions = system%Ecollisions + pe + system%Euntracked = system%Euntracked - pe + + ! Update any encounter lists that have the removed bodies in them so that they instead point to the new + do k = 1, system%plplenc_list%nenc + do j = 1, colliders%ncoll + i = colliders%idx(j) + if (i == ibiggest) cycle + if (system%plplenc_list%id1(k) == pl%id(i)) then + system%plplenc_list%id1(k) = pl%id(ibiggest) + system%plplenc_list%index1(k) = i + end if + if (system%plplenc_list%id2(k) == pl%id(i)) then + system%plplenc_list%id2(k) = pl%id(ibiggest) + system%plplenc_list%index2(k) = i + end if + if (system%plplenc_list%id1(k) == system%plplenc_list%id2(k)) system%plplenc_list%status(k) = INACTIVE + end do end do - end do - - status = MERGED - - call symba_collision_mergeaddsub(system, param, colliders, fragments, status) - end select + status = MERGED + + call symba_collision_mergeaddsub(system, param, status) + end select + end associate return end function symba_collision_casemerge @@ -708,7 +709,7 @@ module subroutine symba_collision_make_colliders_pl(self, idx) end subroutine symba_collision_make_colliders_pl - subroutine symba_collision_mergeaddsub(system, param, colliders, fragments, status) + subroutine symba_collision_mergeaddsub(system, param, status) !! author: David A. Minton !! !! Fills the pl_discards and pl_adds with removed and added bodies @@ -717,8 +718,6 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, fragments, stat ! Arguments class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B), intent(in) :: status !! Status flag to assign to adds ! Internals integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, ncolliders, nfrag @@ -731,7 +730,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, fragments, stat class is (symba_pl) select type(pl_discards => system%pl_discards) class is (symba_merger) - associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody) + associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody, colliders => system%colliders, fragments => system%fragments) ! Add the colliders%idx bodies to the subtraction list ncolliders = colliders%ncoll nfrag = fragments%nbody @@ -901,11 +900,11 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) select case (fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plplcollision_list%status(i) = symba_collision_casedisruption(system, param, colliders, fragments) + plplcollision_list%status(i) = symba_collision_casedisruption(system, param) case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, colliders, fragments) + plplcollision_list%status(i) = symba_collision_casehitandrun(system, param) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, fragments) + plplcollision_list%status(i) = symba_collision_casemerge(system, param) case default write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) @@ -953,7 +952,7 @@ module subroutine symba_resolve_collision_mergers(self, system, param) fragments%mass_dist(3) = 0.0_DP fragments%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / fragments%mtot fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, fragments) + plplcollision_list%status(i) = symba_collision_casemerge(system, param) end do end select end select From 127e73609141830997735c874f1bbca571ed6287 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 18:18:20 -0500 Subject: [PATCH 07/63] Added collision detection logicals to encounter list so that the collision stuff can get saved to the snapshot --- src/modules/encounter_classes.f90 | 25 +++++++++++++------------ src/symba/symba_step.f90 | 5 +++-- 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 3329fde02..8bc1e00b7 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -19,18 +19,19 @@ module encounter_classes integer(I4B), parameter :: SWEEPDIM = 3 type :: encounter_list - integer(I8B) :: nenc = 0 !! Total number of encounters - real(DP) :: t !! Time of encounter - logical, dimension(:), allocatable :: lvdotr !! relative vdotr flag - integer(I4B), dimension(:), allocatable :: status !! status of the interaction - integer(I4B), dimension(:), allocatable :: index1 !! position of the first body in the encounter - integer(I4B), dimension(:), allocatable :: index2 !! position of the second body in the encounter - integer(I4B), dimension(:), allocatable :: id1 !! id of the first body in the encounter - integer(I4B), dimension(:), allocatable :: id2 !! id of the second body in the encounter - real(DP), dimension(:,:), allocatable :: x1 !! the position of body 1 in the encounter - real(DP), dimension(:,:), allocatable :: x2 !! the position of body 2 in the encounter - real(DP), dimension(:,:), allocatable :: v1 !! the velocity of body 1 in the encounter - real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter + integer(I8B) :: nenc = 0 !! Total number of encounters + logical :: lcollision !! Indicates if the encounter resulted in at least one collision + real(DP) :: t !! Time of encounter + logical, dimension(:), allocatable :: lvdotr !! relative vdotr flag + integer(I4B), dimension(:), allocatable :: status !! status of the interaction + integer(I4B), dimension(:), allocatable :: index1 !! position of the first body in the encounter + integer(I4B), dimension(:), allocatable :: index2 !! position of the second body in the encounter + integer(I4B), dimension(:), allocatable :: id1 !! id of the first body in the encounter + integer(I4B), dimension(:), allocatable :: id2 !! id of the second body in the encounter + real(DP), dimension(:,:), allocatable :: x1 !! the position of body 1 in the encounter + real(DP), dimension(:,:), allocatable :: x2 !! the position of body 2 in the encounter + real(DP), dimension(:,:), allocatable :: v1 !! the velocity of body 1 in the encounter + real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter contains procedure :: setup => encounter_setup_list !! A constructor that sets the number of encounters and allocates and initializes all arrays procedure :: append => encounter_util_append_list !! Appends elements from one structure to another diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 0b8879464..cf2b819e7 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -178,9 +178,10 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) ! Internals integer(I4B) :: j, irecp, nloops real(DP) :: dtl, dth - logical :: lencounter, lplpl_collision, lpltp_collision + logical :: lencounter - associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list) + associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list, & + lplpl_collision => self%plplenc_list%lcollision, lpltp_collision => self%pltpenc_list%lcollision) select type(param) class is (symba_parameters) select type(pl => self%pl) From 2ea96cd7bfd0cab6df008088bac6625a99a261a1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 18:25:05 -0500 Subject: [PATCH 08/63] Save fraggle snapshot to the symba storage object --- src/symba/symba_util.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index c2a837599..0e090601e 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1296,7 +1296,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time ! Arguments - type(encounter_snapshot) :: snapshot + type(fraggle_encounter_snapshot) :: snapshot integer(I4B) :: i, npl_snap, ntp_snap associate(npl => self%pl%nbody, ntp => self%tp%nbody) @@ -1380,6 +1380,10 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select end select + if (self%plplenc_list%lcollision) then + allocate(snapshot%colliders, source=self%colliders) + allocate(snapshot%fragments, source=self%fragments) + end if ! Save the snapshot call symba_util_save_storage(self,snapshot,t) From 9ae43a7cee149dfa742aa520263542318523cf1b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 19:31:50 -0500 Subject: [PATCH 09/63] Did some OOF magic to get the fraggle encounters saved and output selected --- src/encounter/encounter_io.f90 | 6 +++++- src/modules/fraggle_classes.f90 | 5 +++-- src/symba/symba_step.f90 | 2 ++ src/symba/symba_util.f90 | 12 +++++++++--- 4 files changed, 19 insertions(+), 6 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 86a0c60ad..7c3730df2 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -23,13 +23,17 @@ module subroutine encounter_io_dump(self, param) ! Internals integer(I4B) :: i - do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) 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 + end select else exit diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index a45ceb873..581eb1a65 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -123,8 +123,9 @@ module fraggle_classes end type fraggle_storage type, extends(encounter_snapshot) :: fraggle_encounter_snapshot - class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot - class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot + logical :: lcollision !! Indicates that this snapshot contains at least one collision + class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot + class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot contains procedure :: write_frame => fraggle_io_encounter_write_frame !! Writes a frame of encounter data to file final :: fraggle_util_final_snapshot diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index cf2b819e7..9e8f643bd 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -296,6 +296,7 @@ module subroutine symba_step_reset_system(self, param) call pl%set_renc(0) call system%plplenc_list%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step system%plplenc_list%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + system%plplenc_list%lcollision = .false. end if nenc_old = system%pltpenc_list%nenc @@ -308,6 +309,7 @@ module subroutine symba_step_reset_system(self, param) tp%ldiscard(1:ntp) = .false. call system%pltpenc_list%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step system%pltpenc_list%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + system%pltpenc_list%lcollision = .false. end if call system%pl_adds%setup(0, param) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 0e090601e..ffd077f0e 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1296,11 +1296,16 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time ! Arguments - type(fraggle_encounter_snapshot) :: snapshot + class(encounter_snapshot), allocatable :: snapshot integer(I4B) :: i, npl_snap, ntp_snap associate(npl => self%pl%nbody, ntp => self%tp%nbody) + if (self%plplenc_list%lcollision) then + allocate(fraggle_encounter_snapshot :: snapshot) + else + allocate(encounter_snapshot :: snapshot) + end if snapshot%t = t snapshot%iloop = param%iloop @@ -1380,10 +1385,11 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select end select - if (self%plplenc_list%lcollision) then + select type(snapshot) + class is (fraggle_encounter_snapshot) allocate(snapshot%colliders, source=self%colliders) allocate(snapshot%fragments, source=self%fragments) - end if + end select ! Save the snapshot call symba_util_save_storage(self,snapshot,t) From aa96f8ea97bf39c5a7f77999d5402a234a6c111c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 19:35:40 -0500 Subject: [PATCH 10/63] Removed unecessary fraggle_storage type definition --- src/fraggle/fraggle_io.f90 | 6 ------ src/fraggle/fraggle_util.f90 | 13 ------------- src/modules/fraggle_classes.f90 | 18 ------------------ 3 files changed, 37 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 9d00bfb0f..6d912a5fb 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -13,12 +13,6 @@ contains - module subroutine fraggle_io_encounter_dump(self, param) - implicit none - class(fraggle_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine fraggle_io_encounter_dump - module subroutine fraggle_io_encounter_initialize_output(self, param) implicit none class(fraggle_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 8688ec2d9..c65b96282 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -168,19 +168,6 @@ module subroutine fraggle_util_final_fragments(self) end subroutine fraggle_util_final_fragments - module subroutine fraggle_util_final_storage(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(fraggle_storage(*)), intent(inout) :: self !! Fraggle encountar storage object - - call util_final_storage(self%swiftest_storage) - - return - end subroutine fraggle_util_final_storage - module subroutine fraggle_util_final_snapshot(self) !! author: David A. Minton !! diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 581eb1a65..a7dcfedc8 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -115,13 +115,6 @@ module fraggle_classes procedure :: initialize => fraggle_io_encounter_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object end type fraggle_io_encounter_parameters - !> A class that that is used to store fragmentation data between file output - type, extends(swiftest_storage) :: fraggle_storage - contains - procedure :: dump => fraggle_io_encounter_dump !! Dumps contents of encounter history to file - final :: fraggle_util_final_storage - end type fraggle_storage - type, extends(encounter_snapshot) :: fraggle_encounter_snapshot logical :: lcollision !! Indicates that this snapshot contains at least one collision class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot @@ -142,12 +135,6 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_fragments - module subroutine fraggle_io_encounter_dump(self, param) - implicit none - class(fraggle_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine fraggle_io_encounter_dump - module subroutine fraggle_io_encounter_initialize_output(self, param) implicit none class(fraggle_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset @@ -294,11 +281,6 @@ module subroutine fraggle_util_final_fragments(self) type(fraggle_fragments), intent(inout) :: self !! Fraggle encountar storage object end subroutine fraggle_util_final_fragments - module subroutine fraggle_util_final_storage(self) - implicit none - type(fraggle_storage(*)), intent(inout) :: self !! Fraggle encountar storage object - end subroutine fraggle_util_final_storage - module subroutine fraggle_util_final_snapshot(self) implicit none type(fraggle_encounter_snapshot), intent(inout) :: self !! Fraggle encountar storage object From 503156d3700cf271db5bf2e58912c79c6fb755fd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 22:55:41 -0500 Subject: [PATCH 11/63] Started to flesh out the fraggle netcdf output --- src/fraggle/fraggle_io.f90 | 100 ++++++++++++++++++++++++++++-- src/modules/encounter_classes.f90 | 2 +- src/modules/fraggle_classes.f90 | 29 ++++++--- src/modules/swiftest_classes.f90 | 2 +- src/setup/setup.f90 | 1 + src/symba/symba_io.f90 | 4 ++ src/symba/symba_util.f90 | 1 + 7 files changed, 123 insertions(+), 16 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 6d912a5fb..28457d570 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -13,18 +13,108 @@ contains - module subroutine fraggle_io_encounter_initialize_output(self, param) + module subroutine fraggle_io_initialize_output(self, param) + !! author: David A. Minton + !! + !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. + use, intrinsic :: ieee_arithmetic + use netcdf implicit none - class(fraggle_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + ! Arguments + class(fraggle_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(in) :: param - end subroutine fraggle_io_encounter_initialize_output + ! Internals + integer(I4B) :: i, nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + associate(nc => self) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select + + ! Check if the file exists, and if it does, delete it + inquire(file=nc%frag_file, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%enc_file, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + + call check( nf90_create(nc%frag_file, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "fraggle_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + + ! Variables + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid" ) + if (param%lclose) then + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid" ) + end if + if (param%lrotation) then + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid" ) + end if + + call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "fraggle_io_initialize nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nc%id, varid, 0, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" ) + end select + end do + ! Take the file out of define mode + call check( nf90_enddef(nc%id), "fraggle_io_initialize nf90_enddef" ) + + ! Add in the space and stage dimension coordinates + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "fraggle_io_initialize nf90_put_var space" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords, start=[1], count=[2]), "fraggle_io_initialize nf90_put_var stage" ) + + ! Pre-fill id slots with ids + call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_var pl id_varid" ) + end associate + + return - module subroutine fraggle_io_encounter_write_frame(self, nc, param) + 667 continue + write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + 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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine fraggle_io_encounter_write_frame + + return + end subroutine fraggle_io_write_frame module subroutine fraggle_io_log_generate(frag) !! author: David A. Minton diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 8bc1e00b7..b350f1a1c 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -68,7 +68,7 @@ module encounter_classes !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: encounter_storage - type(encounter_io_parameters) :: nc !! NetCDF parameter object containing the details about the file attached to this storage object + class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file final :: encounter_util_final_storage diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index a7dcfedc8..d09c0d159 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -110,17 +110,28 @@ module fraggle_classes end type fraggle_fragments !! NetCDF dimension and variable names for the enounter save object - type, extends(encounter_io_parameters) :: fraggle_io_encounter_parameters + 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) + character(len=6), dimension(2) :: stage_coords = ["before", "after "] !! The stage coordinate labels + + character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable + integer(I4B) :: Qloss_varid !! ID for the energy loss variable + character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable + integer(I4B) :: regime_varid !! ID for the collision regime variable + contains - procedure :: initialize => fraggle_io_encounter_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - end type fraggle_io_encounter_parameters + procedure :: initialize => fraggle_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + end type fraggle_io_parameters type, extends(encounter_snapshot) :: fraggle_encounter_snapshot logical :: lcollision !! Indicates that this snapshot contains at least one collision class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot contains - procedure :: write_frame => fraggle_io_encounter_write_frame !! Writes a frame of encounter data to file + procedure :: write_frame => fraggle_io_write_frame !! Writes a frame of encounter data to file final :: fraggle_util_final_snapshot end type fraggle_encounter_snapshot @@ -135,18 +146,18 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_fragments - module subroutine fraggle_io_encounter_initialize_output(self, param) + module subroutine fraggle_io_initialize_output(self, param) implicit none - class(fraggle_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(fraggle_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(in) :: param - end subroutine fraggle_io_encounter_initialize_output + end subroutine fraggle_io_initialize_output - module subroutine fraggle_io_encounter_write_frame(self, nc, param) + 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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine fraggle_io_encounter_write_frame + end subroutine fraggle_io_write_frame module subroutine fraggle_io_log_generate(frag) implicit none diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index abda5adc2..1bd1edef8 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -45,7 +45,7 @@ module swiftest_classes character(NAMELEN) :: ptype_varname = "particle_type" !! name of the particle type variable integer(I4B) :: ptype_varid !! ID for the particle type variable character(NAMELEN) :: name_varname = "name" !! name of the particle name variable - integer(I4B) :: name_varid !! ID for the namevariable + integer(I4B) :: name_varid !! ID for the name variable character(NAMELEN) :: npl_varname = "npl" !! name of the number of active massive bodies variable integer(I4B) :: npl_varid !! ID for the number of active massive bodies variable character(NAMELEN) :: ntp_varname = "ntp" !! name of the number of active test particles variable diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 13e3ec9a1..481d35761 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -73,6 +73,7 @@ module subroutine setup_construct_system(system, 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) call system%encounter_history%reset() system%encounter_history%nc%file_number = param%iloop / param%dump_cadence end if diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 606d359cf..0fde607f6 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -26,6 +26,10 @@ module subroutine symba_io_dump_encounter(self, param) ! 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() diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index ffd077f0e..faa6bf431 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -903,6 +903,7 @@ 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) 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) From da267de02fe9bf0cc750153e9406c6b1136d7db4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 12:17:26 -0500 Subject: [PATCH 12/63] Made a number of structural improvements to the outputting as I work on implementing a NetCDF-based fragmentation log file --- src/fraggle/fraggle_io.f90 | 75 ++++++++++++++------------------------ 1 file changed, 28 insertions(+), 47 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 28457d570..60b96f855 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -22,14 +22,14 @@ module subroutine fraggle_io_initialize_output(self, param) implicit none ! Arguments class(fraggle_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param + class(swiftest_parameters), intent(in) :: param ! 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) :: i, ndims associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) @@ -44,14 +44,14 @@ module subroutine fraggle_io_initialize_output(self, param) end select ! Check if the file exists, and if it does, delete it - inquire(file=nc%frag_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%frag_file, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) ! Dimensions call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "fraggle_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension @@ -60,19 +60,32 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + ! Dimension coordinates + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) + + ! Variables call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid" ) call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid" ) call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid" ) call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid" ) call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid" ) - if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid" ) - end if - if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid" ) - end if + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid" ) + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid" ) + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid" ) + call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) + call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) + call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + call check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "netcdf_initialize_output nf90_def_var L_escape_varid" ) + call check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "netcdf_initialize_output nf90_def_var Ecollisions_varid" ) + call check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "netcdf_initialize_output nf90_def_var Euntracked_varid" ) + call check( nf90_def_var(nc%id, nc%GMescape_varname, nc%out_type, nc%time_dimid, nc%GMescape_varid), "netcdf_initialize_output nf90_def_var GMescape_varid" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) do varid = 1, nvar @@ -102,7 +115,7 @@ module subroutine fraggle_io_initialize_output(self, param) return 667 continue - write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) + write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) call util_exit(FAILURE) end subroutine fraggle_io_initialize_output @@ -110,44 +123,12 @@ 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 return end subroutine fraggle_io_write_frame - module subroutine fraggle_io_log_generate(frag) - !! author: David A. Minton - !! - !! Writes a log of the results of the fragment generation - implicit none - ! Arguments - class(fraggle_fragments), intent(in) :: frag - ! Internals - integer(I4B) :: i - character(STRMAX) :: errmsg - character(len=*), parameter :: fmtlabel = "(A14,10(ES11.4,1X,:))" - - open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) " Fraggle fragment generation results" - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, "(' dL_tot should be very small' )") - write(LUN,fmtlabel) ' dL_tot |', (.mag.(frag%Ltot_after(:) - frag%Ltot_before(:))) / (.mag.frag%Ltot_before(:)) - write(LUN, "(' dE_tot should be negative and equal to Qloss' )") - write(LUN,fmtlabel) ' dE_tot |', (frag%Etot_after - frag%Etot_before) / abs(frag%Etot_before) - write(LUN,fmtlabel) ' Qloss |', -frag%Qloss / abs(frag%Etot_before) - write(LUN,fmtlabel) ' dE - Qloss |', (frag%Etot_after - frag%Etot_before + frag%Qloss) / abs(frag%Etot_before) - write(LUN, "(' -------------------------------------------------------------------------------------')") - - close(LUN) - - return - 667 continue - write(*,*) "Error writing Fraggle message to log file: " // trim(adjustl(errmsg)) - end subroutine fraggle_io_log_generate - module subroutine fraggle_io_log_pl(pl, param) !! author: David A. Minton From 3e678c1c5c835986fbccddeee6d2b203b4f3b0a6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 12:18:55 -0500 Subject: [PATCH 13/63] Made a number of structural improvements to the outputting as I work on implementing a NetCDF-based fragmentation log file (take 2) --- python/swiftest/swiftest/io.py | 3 +- python/swiftest/swiftest/simulation_class.py | 3 +- src/encounter/encounter_io.f90 | 43 ++++++++++---------- src/fraggle/fraggle_generate.f90 | 1 - src/io/io.f90 | 5 ++- src/modules/encounter_classes.f90 | 6 +-- src/modules/fraggle_classes.f90 | 12 ++---- src/modules/swiftest_classes.f90 | 1 + src/modules/symba_classes.f90 | 16 ++++---- src/netcdf/netcdf.f90 | 13 +++--- src/setup/setup.f90 | 8 ++-- src/symba/symba_io.f90 | 29 +++++++------ src/symba/symba_util.f90 | 3 +- 13 files changed, 75 insertions(+), 68 deletions(-) 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) From 876f2b7ec5ed0f03b403bda7226106b3e863d9c2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 16:38:55 -0500 Subject: [PATCH 14/63] Added in the correct dimensions to the collision output file, and changed "fragmentation_" to "collision_" for the file names --- src/fraggle/fraggle_io.f90 | 59 +++++++++++++++++++++++++++----------- src/symba/symba_io.f90 | 2 +- 2 files changed, 43 insertions(+), 18 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 60b96f855..5702759f1 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -68,23 +68,48 @@ module subroutine fraggle_io_initialize_output(self, param) ! Variables - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid" ) - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid" ) - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid" ) - call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid" ) - call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) - call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) - call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) - call check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "netcdf_initialize_output nf90_def_var L_escape_varid" ) - call check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "netcdf_initialize_output nf90_def_var Ecollisions_varid" ) - call check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "netcdf_initialize_output nf90_def_var Euntracked_varid" ) - call check( nf90_def_var(nc%id, nc%GMescape_varname, nc%out_type, nc%time_dimid, nc%GMescape_varid), "netcdf_initialize_output nf90_def_var GMescape_varid" ) + + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & + [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & + [ nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") + + call check( nf90_def_var(nc%id, nc%rh_varname,nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") + + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") + + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& + [ nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") + + + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& + [ nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") + + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") + + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + [ nc%stage_dimid, nc%time_dimid], nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid") + + call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& + [ nc%stage_dimid, nc%time_dimid], nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) + + call check( nf90_def_var(nc%id, nc%pe_varname,& + nc%out_type,& + [ nc%stage_dimid, nc%time_dimid], nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) + + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + [ nc%space_dimid, nc%stage_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) + + call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& + [ nc%space_dimid, nc%stage_dimid, nc%time_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 6c1d53a6c..b1fb0faf4 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -31,7 +31,7 @@ module subroutine symba_io_dump_encounter(self, param) 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 + write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number call nce%initialize(param) call ncc%initialize(param) call encounter_history%dump(param) From 9af252dff210c57782bc4c2cfbf4314acc9d2bfa Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 17:03:52 -0500 Subject: [PATCH 15/63] Started fleshing out the write_frame method for collisions --- src/fraggle/fraggle_io.f90 | 42 +++++++++++++++++++++++++++++-- src/modules/encounter_classes.f90 | 1 - 2 files changed, 40 insertions(+), 3 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 5702759f1..025b793c6 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -35,7 +35,6 @@ module subroutine fraggle_io_initialize_output(self, param) dfill = ieee_value(dfill, IEEE_QUIET_NAN) sfill = ieee_value(sfill, IEEE_QUIET_NAN) - select case (param%out_type) case("NETCDF_FLOAT") self%out_type = NF90_FLOAT @@ -50,7 +49,6 @@ module subroutine fraggle_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) ! Dimensions @@ -146,10 +144,50 @@ end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) + !! author: David A. Minton + !! + !! Write a frame of output of a collision result + use netcdf implicit none + ! Arguments 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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, tslot, idslot, old_mode, npl + character(len=NAMELEN) :: charstring + + tslot = param%ioutput + associate(pl => self%pl, colliders => self%colliders, fragments => self%fragments) + + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "fraggle_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]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) + + ! npl = pl%nbody + ! do i = 1, npl + ! idslot = pl%id(i) + ! call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "fraggle_io_write_frame nf90_put_var pl id_varid" ) + ! call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) + ! call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) + ! call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) + + ! if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) + + ! if (param%lrotation) then + ! call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) + ! call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) + ! end if + + ! charstring = trim(adjustl(pl%info(i)%name)) + ! call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl name_varid" ) + ! charstring = trim(adjustl(pl%info(i)%particle_type)) + ! call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl particle_type_varid" ) + ! end do + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end associate return end subroutine fraggle_io_write_frame diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 2af59b94b..69ed90e19 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -55,7 +55,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(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 From 0a808bf8d757b67d42f9a3e1fa582a71ce24c71a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 17:14:56 -0500 Subject: [PATCH 16/63] Switched collision outputs to an "event" dimension instead of time --- src/fraggle/fraggle_io.f90 | 58 ++++++++++++++++++--------------- src/modules/fraggle_classes.f90 | 16 +++++---- 2 files changed, 41 insertions(+), 33 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 025b793c6..8db44eb3c 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -52,61 +52,65 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) ! Dimensions - call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "fraggle_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_var(nc%id, nc%event_dimname, NF90_INT, nc%event_dimid, nc%event_varid), "fraggle_io_initialize nf90_def_var event_varid" ) call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%event_dimname, nc%out_type, nc%event_dimid, nc%event_varid), "fraggle_io_initialize nf90_def_var event_varid" ) call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) - ! Variables - + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & + nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & + [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") + call check( nf90_def_var(nc%id, nc%Qloss_varname, NF90_CHAR, & + [ nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") + [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") call check( nf90_def_var(nc%id, nc%rh_varname,nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") + [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") + [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%time_dimid], nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid") + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid") call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%time_dimid], nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) call check( nf90_def_var(nc%id, nc%pe_varname,& nc%out_type,& - [ nc%stage_dimid, nc%time_dimid], nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%time_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) @@ -154,30 +158,30 @@ module subroutine fraggle_io_write_frame(self, nc, param) 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 + integer(I4B) :: i, eslot, idslot, old_mode, npl character(len=NAMELEN) :: charstring - tslot = param%ioutput + eslot = param%ioutput associate(pl => self%pl, colliders => self%colliders, fragments => self%fragments) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "fraggle_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]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) ! npl = pl%nbody ! do i = 1, npl ! idslot = pl%id(i) ! call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "fraggle_io_write_frame nf90_put_var pl id_varid" ) - ! call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) - ! call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) - ! call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) + ! call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) + ! call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) + ! call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, eslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) - ! if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) + ! if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, eslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) ! if (param%lrotation) then - ! call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) - ! call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) + ! call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) + ! call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) ! end if ! charstring = trim(adjustl(pl%info(i)%name)) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 0aa7421a3..3ffd84d87 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -111,15 +111,19 @@ module fraggle_classes !! NetCDF dimension and variable names for the enounter save object type, extends(encounter_io_parameters) :: fraggle_io_parameters - integer(I4B) :: stage_dimid !! ID for the name variable - integer(I4B) :: stage_varid !! ID for the name variable + integer(I4B) :: stage_dimid !! ID for the stage dimension + integer(I4B) :: stage_varid !! ID for the stage variable character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) character(len=6), dimension(2) :: stage_coords = ["before", "after "] !! The stage coordinate labels - character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable - integer(I4B) :: Qloss_varid !! ID for the energy loss variable - character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable - integer(I4B) :: regime_varid !! ID for the collision regime variable + character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension + integer(I4B) :: event_dimid !! ID for the collision event dimension + integer(I4B) :: event_varid !! ID for the collision event variable + + character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable + integer(I4B) :: Qloss_varid !! ID for the energy loss variable + character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable + integer(I4B) :: regime_varid !! ID for the collision regime variable contains procedure :: initialize => fraggle_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object From b3f8c06438df9833b1babfa798e344fe6172383f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 17:41:03 -0500 Subject: [PATCH 17/63] Added more detail to the fraggle output. I discovered a need to take a snapshot of some of the planet variables in the colliders object. --- src/fraggle/fraggle_io.f90 | 62 ++++++++++++++++---------------- src/modules/fraggle_classes.f90 | 1 + src/modules/swiftest_globals.f90 | 1 + 3 files changed, 34 insertions(+), 30 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 8db44eb3c..0a302f020 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -158,39 +158,41 @@ module subroutine fraggle_io_write_frame(self, nc, param) 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, eslot, idslot, old_mode, npl + integer(I4B) :: i, j, eslot, idslot, old_mode, npl character(len=NAMELEN) :: charstring eslot = param%ioutput - associate(pl => self%pl, colliders => self%colliders, fragments => self%fragments) - - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) - - ! npl = pl%nbody - ! do i = 1, npl - ! idslot = pl%id(i) - ! call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "fraggle_io_write_frame nf90_put_var pl id_varid" ) - ! call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) - ! call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) - ! call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, eslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) - - ! if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, eslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) - - ! if (param%lrotation) then - ! call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) - ! call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) - ! end if - - ! charstring = trim(adjustl(pl%info(i)%name)) - ! call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl name_varid" ) - ! charstring = trim(adjustl(pl%info(i)%particle_type)) - ! call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl particle_type_varid" ) - ! end do - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + associate(pl => self%colliders%pl, colliders => self%colliders, fragments => self%fragments) + select type(nc) + class is (fraggle_io_parameters) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) + call check( nf90_put_var(nc%id, nc%regime_varid, REGIME_NAMES(fragments%regime) , start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) + + ! Stage 1: The Colliders + npl = size(colliders%idx) + do j = 1, npl + i = colliders%idx(j) + idslot = pl%id(i) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var pl id_varid" ) + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl particle_type_varid" ) + end do + + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) + + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end select end associate return diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 3ffd84d87..ff6563b3e 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -35,6 +35,7 @@ module fraggle_classes real(DP), dimension(NDIM,2) :: Ip !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision + class(swiftest_pl), allocatable :: pl !! A snapshot of the planets involved in the collision contains procedure :: regime => fraggle_regime_colliders !! Determine which fragmentation regime the set of colliders will be final :: fraggle_util_final_colliders !! Finalizer will deallocate all allocatables diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index 4c8c21693..25f355152 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -101,6 +101,7 @@ module swiftest_globals integer(I4B), parameter :: COLLRESOLVE_REGIME_SUPERCATASTROPHIC = 3 integer(I4B), parameter :: COLLRESOLVE_REGIME_GRAZE_AND_MERGE = 4 integer(I4B), parameter :: COLLRESOLVE_REGIME_HIT_AND_RUN = 5 + character(len=*),dimension(5), parameter :: REGIME_NAMES = ["Merge", "Disruption", "Supercatastrophic", "Graze and Merge", "Hit and Run"] !> String labels for body/particle addition/subtraction in discard file character(*), parameter :: ADD = '+1' From 948aca431cdc1d690aed5eb1d1429247fc29d7ff Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 17:41:51 -0500 Subject: [PATCH 18/63] Minor fixes --- src/fraggle/fraggle_io.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 0a302f020..12e2db7b8 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -172,7 +172,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%regime_varid, REGIME_NAMES(fragments%regime) , start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) ! Stage 1: The Colliders - npl = size(colliders%idx) + npl = pl%nbody do j = 1, npl i = colliders%idx(j) idslot = pl%id(i) @@ -181,7 +181,6 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl particle_type_varid" ) - end do call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) @@ -190,6 +189,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) + end do call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select From fa3b7f3d02bff4a4e0d79c24f9325a6f440dcfb5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 18:06:15 -0500 Subject: [PATCH 19/63] Added the structure necessary to snapshot collisions. Refactored fragmentation_save to collision_save --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/simulation_class.py | 22 +++++++-------- src/encounter/encounter_io.f90 | 2 +- src/fraggle/fraggle_io.f90 | 2 +- src/fraggle/fraggle_util.f90 | 2 +- src/modules/fraggle_classes.f90 | 8 +++--- src/modules/symba_classes.f90 | 13 +++++++-- src/symba/symba_collision.f90 | 6 ++-- src/symba/symba_io.f90 | 8 +++--- src/symba/symba_step.f90 | 6 ++-- src/symba/symba_util.f90 | 28 +++++++++++++++++-- 11 files changed, 67 insertions(+), 32 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index a664ef49e..e68c8a260 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -202,7 +202,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(fragmentation=True, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(fragmentation=True, collision_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 8f6a8d9dd..b7fdc1b7a 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -227,7 +227,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. Parameter input file equivalent: `FRAGMENTATION` - fragmentation_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" + collision_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" Indicate if and how fragmentation data should be saved. If set to "TRAJECTORY" the full close encounter trajectories associated with each collision are saved to file. If set to "CLOSEST" only the trajectories at a the time the collision occurs are saved. If set to "NONE" no trajectory information is saved (collision @@ -794,7 +794,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "ephemeris_date": "MBCL", "restart": False, "encounter_save" : "NONE", - "fragmentation_save" : "NONE" + "collision_save" : "NONE" } param_file = kwargs.pop("param_file",None) @@ -1031,7 +1031,7 @@ def set_feature(self, interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] | None = None, encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] | None = None, encounter_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, - fragmentation_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, + collision_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, verbose: bool | None = None, **kwargs: Any ): @@ -1053,7 +1053,7 @@ def set_feature(self, fragmentation : bool, optional If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. - fragmentation_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" + collision_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" Indicate if and how fragmentation data should be saved. If set to "TRAJECTORY" the full close encounter trajectories associated with each collision are saved to file. If set to "CLOSEST" only the trajectories at a the time the collision occurs are saved. If set to "NONE" no trajectory information is saved (collision @@ -1226,18 +1226,18 @@ def set_feature(self, update_list.append("encounter_save") - if fragmentation_save is not None: - fragmentation_save = fragmentation_save.upper() + if collision_save is not None: + collision_save = collision_save.upper() valid_vals = ["NONE", "TRAJECTORY", "CLOSEST"] - if fragmentation_save not in valid_vals: - msg = f"{fragmentation_save} is not a valid option for fragmentation_save." + if collision_save not in valid_vals: + msg = f"{collision_save} is not a valid option for collision_save." msg += f"\nMust be one of {valid_vals}" warnings.warn(msg,stacklevel=2) if "FRAGMENTATION_SAVE" not in self.param: self.param["FRAGMENTATION_SAVE"] = valid_vals[0] else: - self.param["FRAGMENTATION_SAVE"] = fragmentation_save - update_list.append("fragmentation_save") + self.param["FRAGMENTATION_SAVE"] = collision_save + update_list.append("collision_save") self.param["TIDES"] = False @@ -1271,7 +1271,7 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N valid_var = {"close_encounter_check": "CHK_CLOSE", "fragmentation": "FRAGMENTATION", "encounter_save": "ENCOUNTER_SAVE", - "fragmentation_save": "FRAGMENTATION_SAVE", + "collision_save": "FRAGMENTATION_SAVE", "minimum_fragment_gmass": "MIN_GMFRAG", "rotation": "ROTATION", "general_relativity": "GR", diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 22412e97f..aece1e89f 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -28,7 +28,7 @@ module subroutine encounter_io_dump(self, param) param%ioutput = self%tslot(i) select type(snapshot => self%frame(i)%item) - class is (fraggle_encounter_snapshot) + class is (fraggle_collision_snapshot) call snapshot%write_frame(self%ncc,param) call snapshot%encounter_snapshot%write_frame(self%nce,param) class is (encounter_snapshot) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 12e2db7b8..5f3d6169e 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -154,7 +154,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) use netcdf implicit none ! Arguments - class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(fraggle_collision_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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index c65b96282..2f708859c 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -174,7 +174,7 @@ module subroutine fraggle_util_final_snapshot(self) !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(fraggle_encounter_snapshot), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object call encounter_util_final_snapshot(self%encounter_snapshot) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index ff6563b3e..79c929710 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -130,14 +130,14 @@ module fraggle_classes procedure :: initialize => fraggle_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object end type fraggle_io_parameters - type, extends(encounter_snapshot) :: fraggle_encounter_snapshot + type, extends(encounter_snapshot) :: fraggle_collision_snapshot logical :: lcollision !! Indicates that this snapshot contains at least one collision class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot contains procedure :: write_frame => fraggle_io_write_frame !! Writes a frame of encounter data to file final :: fraggle_util_final_snapshot - end type fraggle_encounter_snapshot + end type fraggle_collision_snapshot interface module subroutine fraggle_generate_fragments(self, colliders, system, param, lfailure) @@ -158,7 +158,7 @@ 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(fraggle_collision_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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine fraggle_io_write_frame @@ -293,7 +293,7 @@ end subroutine fraggle_util_final_fragments module subroutine fraggle_util_final_snapshot(self) implicit none - type(fraggle_encounter_snapshot), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object end subroutine fraggle_util_final_snapshot module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index a896c3dc1..f0c7ee340 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -31,7 +31,7 @@ module symba_classes integer(I4B), dimension(:), allocatable :: seed !! Random seeds logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved - character(STRMAX) :: fragmentation_save = "NONE" !! Indicate if and how fragmentation data should be saved + character(STRMAX) :: collision_save = "NONE" !! Indicate if and how fragmentation data should be saved logical :: lencounter_save = .false. !! Turns on encounter saving contains procedure :: reader => symba_io_param_reader @@ -200,7 +200,8 @@ module symba_classes procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step - procedure :: snapshot => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter + procedure :: encounter_snap => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter + procedure :: collision_snap => symba_util_take_collision_snapshot !! Take a minimal snapshot of the system before and after a collision procedure :: dump_encounter => symba_io_dump_encounter !! Saves the encounter and/or fragmentation data to file(s) final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system @@ -371,6 +372,14 @@ module subroutine symba_util_set_renc(self, scale) integer(I4B), intent(in) :: scale !! Current recursion depth end subroutine symba_util_set_renc + module subroutine symba_util_take_collision_snapshot(self, param, t, stage) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + character(*), intent(in) :: stage !! Either before or afte + end subroutine symba_util_take_collision_snapshot + module subroutine symba_util_take_encounter_snapshot(self, param, t) use swiftest_classes, only : swiftest_parameters implicit none diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index be6406374..6107e9d12 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -885,7 +885,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) logical :: lgoodcollision integer(I4B) :: i - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, colliders => system%colliders, fragments => system%fragments) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, colliders => system%colliders, fragments => system%fragments, t => system%t) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) @@ -897,7 +897,8 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle call colliders%regime(fragments, system, param) - + + if (param%lencounter_save) call system%collision_snap(param, t, "before") select case (fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param) @@ -909,6 +910,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) end select + if (param%lencounter_save) call system%collision_snap(param, t, "after") end do end select end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index b1fb0faf4..d76bb9e59 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -101,7 +101,7 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms read(param_value, *) param%encounter_save case ("FRAGMENTATION_SAVE") call io_toupper(param_value) - read(param_value, *) param%fragmentation_save + read(param_value, *) param%collision_save case("SEED") read(param_value, *) nseeds_from_file ! Because the number of seeds can vary between compilers/systems, we need to make sure we can handle cases in which the input file has a different @@ -159,14 +159,14 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms return end if - if ((param%fragmentation_save /= "NONE") .and. (param%fragmentation_save /= "TRAJECTORY") .and. (param%fragmentation_save /= "CLOSEST")) then - write(iomsg,*) 'Invalid fragmentation_save parameter: ',trim(adjustl(param%out_type)) + if ((param%collision_save /= "NONE") .and. (param%collision_save /= "TRAJECTORY") .and. (param%collision_save /= "CLOSEST")) then + write(iomsg,*) 'Invalid collision_save parameter: ',trim(adjustl(param%out_type)) write(iomsg,*) 'Valid options are NONE, TRAJECTORY, or CLOSEST' iostat = -1 return end if param%lencounter_save = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "CLOSEST") .or. & - (param%fragmentation_save == "TRAJECTORY") .or. (param%fragmentation_save == "CLOSEST") + (param%collision_save == "TRAJECTORY") .or. (param%collision_save == "CLOSEST") ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 9e8f643bd..dc303b4f7 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -37,9 +37,9 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then - if (param%lencounter_save) call self%snapshot(param, t) + if (param%lencounter_save) call self%encounter_snap(param, t) call self%interp(param, t, dt) - if (param%lencounter_save) call self%snapshot(param, t+dt) + if (param%lencounter_save) call self%encounter_snap(param, t+dt) else self%irec = -1 call helio_step_system(self, param, t, dt) @@ -244,7 +244,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) end if - if (param%lencounter_save) call system%snapshot(param, t+dtl) + if (param%lencounter_save) call system%encounter_snap(param, t+dtl) call self%set_recur_levels(ireci) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 5d8a4a444..5c902730d 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1287,6 +1287,30 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_tp + module subroutine symba_util_take_collision_snapshot(self, param, t, stage) + !! author: David A. Minton + !! + !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! can be played back through the encounter + implicit none + ! Internals + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + character(*), intent(in) :: stage !! Either before or after + ! Arguments + class(fraggle_collision_snapshot), allocatable :: snapshot + + select case(stage) + case("before") + + case("after") + + end select + + return + end subroutine symba_util_take_collision_snapshot + module subroutine symba_util_take_encounter_snapshot(self, param, t) !! author: David A. Minton !! @@ -1304,7 +1328,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) associate(npl => self%pl%nbody, ntp => self%tp%nbody) if (self%plplenc_list%lcollision) then - allocate(fraggle_encounter_snapshot :: snapshot) + allocate(fraggle_collision_snapshot :: snapshot) else allocate(encounter_snapshot :: snapshot) end if @@ -1388,7 +1412,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select select type(snapshot) - class is (fraggle_encounter_snapshot) + class is (fraggle_collision_snapshot) allocate(snapshot%colliders, source=self%colliders) allocate(snapshot%fragments, source=self%fragments) end select From df77b321cc728b5677bcc3aa31bea7da11bc0dc0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 18:22:44 -0500 Subject: [PATCH 20/63] Switched fragments and colliders to be allocatables so they get wiped out between collision resolves --- src/modules/symba_classes.f90 | 4 ++-- src/symba/symba_collision.f90 | 11 +++++++---- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index f0c7ee340..93640a8d1 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -189,8 +189,8 @@ module symba_classes 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(fraggle_colliders), allocatable :: colliders !! Fraggle colliders object + class(fraggle_fragments), allocatable :: 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/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 6107e9d12..12822cb07 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -885,21 +885,23 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) logical :: lgoodcollision integer(I4B) :: i - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, colliders => system%colliders, fragments => system%fragments, t => system%t) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, t => system%t) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) class is (symba_cb) do i = 1, ncollisions + allocate(fraggle_colliders :: system%colliders) + allocate(fraggle_fragments :: system%fragments) idx_parent(1) = pl%kin(idx1(i))%parent idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) + lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, system%colliders) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle - call colliders%regime(fragments, system, param) + call system%colliders%regime(system%fragments, system, param) if (param%lencounter_save) call system%collision_snap(param, t, "before") - select case (fragments%regime) + select case (system%fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param) case (COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -911,6 +913,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) call util_exit(FAILURE) end select if (param%lencounter_save) call system%collision_snap(param, t, "after") + deallocate(system%colliders,system%fragments) end do end select end select From 245c9bd8c3acc95540e252810f28f10e3cb11868 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 18:56:30 -0500 Subject: [PATCH 21/63] More updates to the collision snapshot taker --- src/symba/symba_util.f90 | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 5c902730d..853a3db0f 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1300,14 +1300,35 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) character(*), intent(in) :: stage !! Either before or after ! Arguments class(fraggle_collision_snapshot), allocatable :: snapshot + integer(I4B) :: i,j select case(stage) case("before") + associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) + allocate(fraggle_collision_snapshot :: snapshot) + allocate(snapshot%colliders, source=self%colliders) + allocate(symba_pl :: snapshot%colliders%pl) + select type(pl => snapshot%colliders%pl) + class is (symba_pl) + call pl%setup(ncoll, param) + pl%id(:) = self%pl%id(idx(:)) + pl%Gmass(:) = self%pl%Gmass(idx(:)) + pl%radius(:) = self%pl%radius(idx(:)) + pl%rot(:,:) = self%pl%rot(:,idx(:)) + pl%Ip(:,:) = self%pl%Ip(:,idx(:)) + pl%rh(:,:) = self%pl%rh(:,idx(:)) + pl%vh(:,:) = self%pl%vh(:,idx(:)) + pl%info(:) = self%pl%info(idx(:)) + end select + end associate case("after") end select + + ! Save the self + call symba_util_save_storage(self,snapshot,t) return end subroutine symba_util_take_collision_snapshot @@ -1411,12 +1432,6 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select end select - select type(snapshot) - class is (fraggle_collision_snapshot) - allocate(snapshot%colliders, source=self%colliders) - allocate(snapshot%fragments, source=self%fragments) - end select - ! Save the snapshot call symba_util_save_storage(self,snapshot,t) end select From 4d2fb37cfc1f552e89ffcc8b208a21ccf43523d9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 19:11:50 -0500 Subject: [PATCH 22/63] Keep on adding snapshot stuff --- src/modules/fraggle_classes.f90 | 1 + src/symba/symba_collision.f90 | 1 + src/symba/symba_util.f90 | 6 +++--- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 79c929710..0aaead00b 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -66,6 +66,7 @@ module fraggle_classes real(DP), dimension(:), allocatable :: rotmag !! Array of rotation magnitudes of individual fragments real(DP), dimension(:), allocatable :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments real(DP), dimension(:), allocatable :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments + class(swiftest_pl), allocatable :: pl !! A snapshot of the fragments created in the collision ! Energy and momentum book-keeping variables that characterize the whole system of fragments real(DP) :: ke_orbit !! Current orbital kinetic energy of the system of fragments in the collisional frame diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 12822cb07..53e0a84bc 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -831,6 +831,7 @@ subroutine symba_collision_mergeaddsub(system, param, status) ! Log the properties of the new bodies call fraggle_io_log_pl(plnew, param) + allocate(system%fragments%pl, source=plnew) ! Append the new merged body to the list nstart = pl_adds%nbody + 1 diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 853a3db0f..eedb632fc 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1323,12 +1323,12 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) end associate case("after") - + allocate(snapshot%fragments, source=self%fragments) end select - ! Save the self - call symba_util_save_storage(self,snapshot,t) + ! Save the snapshot + !call symba_util_save_storage(self,snapshot,t) return end subroutine symba_util_take_collision_snapshot From f1387ba295c0d5cb0f5b1738e6b03e6420a50b5a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 19:15:20 -0500 Subject: [PATCH 23/63] Rearranged snapshot taking for collisions --- src/symba/symba_util.f90 | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index eedb632fc..d54027696 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1299,16 +1299,14 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) real(DP), intent(in) :: t !! current time character(*), intent(in) :: stage !! Either before or after ! Arguments - class(fraggle_collision_snapshot), allocatable :: snapshot + class(fraggle_collision_snapshot), allocatable:: snapshot integer(I4B) :: i,j select case(stage) case("before") associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) - allocate(fraggle_collision_snapshot :: snapshot) - allocate(snapshot%colliders, source=self%colliders) - allocate(symba_pl :: snapshot%colliders%pl) - select type(pl => snapshot%colliders%pl) + allocate(symba_pl :: self%colliders%pl) + select type(pl => self%colliders%pl) class is (symba_pl) call pl%setup(ncoll, param) pl%id(:) = self%pl%id(idx(:)) @@ -1321,14 +1319,14 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) pl%info(:) = self%pl%info(idx(:)) end select end associate - case("after") - allocate(snapshot%fragments, source=self%fragments) + allocate(fraggle_collision_snapshot :: snapshot) + allocate(snapshot%colliders, source=self%colliders) + allocate(snapshot%fragments, source=self%fragments) + !call symba_util_save_storage(self,snapshot,t) + deallocate(snapshot) end select - - ! Save the snapshot - !call symba_util_save_storage(self,snapshot,t) return end subroutine symba_util_take_collision_snapshot From e08f725691745f60d28c769869a729ea36c0ff8e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 19:16:34 -0500 Subject: [PATCH 24/63] Helpful comments --- src/symba/symba_util.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index d54027696..9b6d11463 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1304,6 +1304,7 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) select case(stage) case("before") + ! Saves the states of the bodies involved in the collision before the collision is resolved associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) allocate(symba_pl :: self%colliders%pl) select type(pl => self%colliders%pl) @@ -1324,7 +1325,6 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) allocate(snapshot%colliders, source=self%colliders) allocate(snapshot%fragments, source=self%fragments) !call symba_util_save_storage(self,snapshot,t) - deallocate(snapshot) end select return From dc894e69f258ab1c219ab125139fb9f55be942d3 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 20:13:30 -0500 Subject: [PATCH 25/63] OOF stuff --- src/setup/setup.f90 | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 835d1c995..9123514ad 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -73,11 +73,19 @@ module subroutine setup_construct_system(system, param) class is (symba_parameters) if (param%lencounter_save) then 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%nce%file_number = param%iloop / param%dump_cadence - system%encounter_history%ncc%file_number = param%iloop / param%dump_cadence + associate (encounter_history => system%encounter_history) + allocate(encounter_io_parameters :: encounter_history%nce) + call encounter_history%reset() + select type(nce => encounter_history%nce) + class is (encounter_io_parameters) + nce%file_number = param%iloop / param%dump_cadence + end select + allocate(fraggle_io_parameters :: encounter_history%ncc) + select type(ncc => encounter_history%ncc) + class is (fraggle_io_parameters) + ncc%file_number = param%iloop / param%dump_cadence + end select + end associate end if end select end select From 7972bcc5137f490d7427760fccb586531e76ca26 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 21:10:23 -0500 Subject: [PATCH 26/63] Made new collision_history storage object --- src/encounter/encounter_io.f90 | 6 +++--- src/modules/encounter_classes.f90 | 3 +-- src/modules/symba_classes.f90 | 1 + src/setup/setup.f90 | 17 +++++++++++------ src/symba/symba_io.f90 | 16 ++++++++++------ src/symba/symba_util.f90 | 3 +-- 6 files changed, 27 insertions(+), 19 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index aece1e89f..025b923fc 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -29,10 +29,10 @@ module subroutine encounter_io_dump(self, param) select type(snapshot => self%frame(i)%item) class is (fraggle_collision_snapshot) - call snapshot%write_frame(self%ncc,param) - call snapshot%encounter_snapshot%write_frame(self%nce,param) + call snapshot%write_frame(self%nc,param) + call snapshot%encounter_snapshot%write_frame(self%nc,param) class is (encounter_snapshot) - call snapshot%write_frame(self%nce,param) + call snapshot%write_frame(self%nc,param) end select else exit diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 69ed90e19..95f230344 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -66,8 +66,7 @@ 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 :: 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 + class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file final :: encounter_util_final_storage diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 93640a8d1..a31d042f9 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -192,6 +192,7 @@ module symba_classes class(fraggle_colliders), allocatable :: colliders !! Fraggle colliders object class(fraggle_fragments), allocatable :: fragments !! Fraggle fragmentation system object type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file + type(encounter_storage(nframes=:)), allocatable :: collision_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 procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 9123514ad..ea822f45d 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -74,16 +74,21 @@ module subroutine setup_construct_system(system, param) if (param%lencounter_save) then allocate(encounter_storage :: system%encounter_history) associate (encounter_history => system%encounter_history) - allocate(encounter_io_parameters :: encounter_history%nce) + allocate(encounter_io_parameters :: encounter_history%nc) call encounter_history%reset() - select type(nce => encounter_history%nce) + select type(nc => encounter_history%nc) class is (encounter_io_parameters) - nce%file_number = param%iloop / param%dump_cadence + nc%file_number = param%iloop / param%dump_cadence end select - allocate(fraggle_io_parameters :: encounter_history%ncc) - select type(ncc => encounter_history%ncc) + end associate + + allocate(encounter_storage :: system%collision_history) + associate (collision_history => system%collision_history) + allocate(fraggle_io_parameters :: collision_history%nc) + call collision_history%reset() + select type(nc => collision_history%nc) class is (fraggle_io_parameters) - ncc%file_number = param%iloop / param%dump_cadence + nc%file_number = param%iloop / param%dump_cadence end select end associate end if diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index d76bb9e59..94f53d3f9 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -23,21 +23,25 @@ module subroutine symba_io_dump_encounter(self, param) if (self%encounter_history%iframe == 0) return ! No enounters in this interval - associate(encounter_history => self%encounter_history, nce => self%encounter_history%nce, ncc => self%encounter_history%ncc, iframe => self%encounter_history%iframe) + associate(encounter_history => self%encounter_history, nce => self%encounter_history%nc, eframe => self%encounter_history%iframe,& + collision_history => self%collision_history, ncc => self%collision_history%nc, cframe => self%collision_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, '("collision_",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() + + ncc%file_number = ncc%file_number + 1 + write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number + ncc%time_dimsize = maxval(collision_history%tslot(:)) + call ncc%initialize(param) + call collision_history%dump(param) + call ncc%close() + call collision_history%reset() end associate return diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 9b6d11463..d90c3268c 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -903,8 +903,7 @@ 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%nce, tmp%nce) - call move_alloc(system%encounter_history%ncc, tmp%ncc) + call move_alloc(system%encounter_history%nc, tmp%nc) 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) From ec08c01f98913ebeb607bd5d1e1fc4add3568888 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 23:30:02 -0500 Subject: [PATCH 27/63] More progress. Everything is connected. Just needs to be tested and bugs fixed --- src/encounter/encounter_io.f90 | 4 +-- src/symba/symba_util.f90 | 57 +++++++++++++++++++++++++++++++--- 2 files changed, 55 insertions(+), 6 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 025b923fc..d4677ac3c 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -25,13 +25,13 @@ 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_collision_snapshot) + param%ioutput = i call snapshot%write_frame(self%nc,param) - call snapshot%encounter_snapshot%write_frame(self%nc,param) class is (encounter_snapshot) + param%ioutput = self%tslot(i) call snapshot%write_frame(self%nc,param) end select else diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index d90c3268c..c149e1126 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -869,7 +869,56 @@ module subroutine symba_util_resize_pl(self, nnew) end subroutine symba_util_resize_pl - subroutine symba_util_save_storage(system, snapshot, t) + subroutine symba_util_save_collision(system, snapshot) + !! author: David A. Minton + !! + !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. + !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing every time you want to add an + !! encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff between performance (fewer resize calls) and memory managment + !! Memory usage grows by a factor of 2 each time it fills up, but no more. + implicit none + ! Arguments + type(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + ! Internals + type(encounter_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nnew, nold, nbig + + ! Advance the snapshot frame counter + system%collision_history%iframe = system%collision_history%iframe + 1 + + ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 + nnew = system%encounter_history%iframe + nold = system%encounter_history%nframes + + if (nnew > nold) then + nbig = nold + do while (nbig < nnew) + nbig = nbig * 2 + end do + allocate(encounter_storage(nbig) :: tmp) + tmp%tvals(1:nold) = system%encounter_history%tvals(1:nold) + tmp%tvals(nold+1:nbig) = huge(1.0_DP) + 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) + + 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) + end do + deallocate(system%encounter_history) + call move_alloc(tmp,system%encounter_history) + nnew = nbig + end if + + system%collision_history%frame(nnew) = snapshot + + return + end subroutine symba_util_save_collision + + + subroutine symba_util_save_encounter(system, snapshot, t) !! author: David A. Minton !! !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. @@ -925,7 +974,7 @@ subroutine symba_util_save_storage(system, snapshot, t) end do return - end subroutine symba_util_save_storage + end subroutine symba_util_save_encounter module subroutine symba_util_resize_tp(self, nnew) @@ -1323,7 +1372,7 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) allocate(fraggle_collision_snapshot :: snapshot) allocate(snapshot%colliders, source=self%colliders) allocate(snapshot%fragments, source=self%fragments) - !call symba_util_save_storage(self,snapshot,t) + call symba_util_save_collision(self,snapshot) end select return @@ -1430,7 +1479,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select ! Save the snapshot - call symba_util_save_storage(self,snapshot,t) + call symba_util_save_encounter(self,snapshot,t) end select end select end associate From 076126bdd80f64e5205e0d5d61c22c1b3c3b1037 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 23:32:57 -0500 Subject: [PATCH 28/63] Fixed wrong object --- src/symba/symba_util.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index c149e1126..d5ff2ba2e 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -888,8 +888,8 @@ subroutine symba_util_save_collision(system, snapshot) system%collision_history%iframe = system%collision_history%iframe + 1 ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = system%encounter_history%iframe - nold = system%encounter_history%nframes + nnew = system%collision_history%iframe + nold = system%collision_history%nframes if (nnew > nold) then nbig = nold @@ -897,18 +897,18 @@ subroutine symba_util_save_collision(system, snapshot) nbig = nbig * 2 end do allocate(encounter_storage(nbig) :: tmp) - tmp%tvals(1:nold) = system%encounter_history%tvals(1:nold) + tmp%tvals(1:nold) = system%collision_history%tvals(1:nold) tmp%tvals(nold+1:nbig) = huge(1.0_DP) - tmp%tslot(1:nold) = system%encounter_history%tslot(1:nold) + tmp%tslot(1:nold) = system%collision_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) + tmp%iframe = system%collision_history%iframe + call move_alloc(system%collision_history%nc, tmp%nc) 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) + if (allocated(system%collision_history%frame(i)%item)) call move_alloc(system%collision_history%frame(i)%item, tmp%frame(i)%item) end do - deallocate(system%encounter_history) - call move_alloc(tmp,system%encounter_history) + deallocate(system%collision_history) + call move_alloc(tmp,system%collision_history) nnew = nbig end if From 38b375325d1571dd9a6db27afe260568f07d4899 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 07:58:02 -0500 Subject: [PATCH 29/63] Fixed incorrect type allocation --- src/encounter/encounter_io.f90 | 1 - src/symba/symba_util.f90 | 6 +----- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index d4677ac3c..3f34c0e83 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -25,7 +25,6 @@ module subroutine encounter_io_dump(self, param) do i = 1, self%nframes if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) class is (fraggle_collision_snapshot) param%ioutput = i diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index d5ff2ba2e..5b840ad0c 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1394,11 +1394,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) associate(npl => self%pl%nbody, ntp => self%tp%nbody) - if (self%plplenc_list%lcollision) then - allocate(fraggle_collision_snapshot :: snapshot) - else - allocate(encounter_snapshot :: snapshot) - end if + allocate(encounter_snapshot :: snapshot) snapshot%t = t snapshot%iloop = param%iloop From 71e8c27e01020304a62bc589ab4a6019c2efcb23 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 08:11:45 -0500 Subject: [PATCH 30/63] Fixed up some netcdf stuff --- src/fraggle/fraggle_io.f90 | 43 +++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 5f3d6169e..43f4f25ff 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -52,17 +52,16 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) ! Dimensions - call check( nf90_def_var(nc%id, nc%event_dimname, NF90_INT, nc%event_dimid, nc%event_varid), "fraggle_io_initialize nf90_def_var event_varid" ) - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call check( nf90_def_dim(nc%id, nc%event_dimname, NF90_UNLIMITED, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%event_dimname, nc%out_type, nc%event_dimid, nc%event_varid), "fraggle_io_initialize nf90_def_var event_varid" ) - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) ! Variables call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & @@ -136,7 +135,7 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords, start=[1], count=[2]), "fraggle_io_initialize nf90_put_var stage" ) ! Pre-fill id slots with ids - call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_varid_varid" ) end associate return @@ -168,26 +167,26 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) - call check( nf90_put_var(nc%id, nc%regime_varid, REGIME_NAMES(fragments%regime) , start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) + call check( nf90_put_var (nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) + call check( nf90_put_var(nc%id, nc%regime_varid, REGIME_NAMES(fragments%regime) , start=[eslot]), "fraggle_io_write_frame nf90_put_var regime_varid" ) ! Stage 1: The Colliders npl = pl%nbody do j = 1, npl i = colliders%idx(j) idslot = pl%id(i) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) - call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) end do @@ -205,7 +204,7 @@ module subroutine fraggle_io_log_pl(pl, param) !! Writes a single message to the fraggle log file implicit none ! Arguments - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object (only the new bodies generated in a collision) + class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object (only the new bodies generated in a collision) class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters ! Internals integer(I4B) :: i From 05359b1673db63f1d71743402a7253231ce0a27a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 08:17:57 -0500 Subject: [PATCH 31/63] Fixed a bunch of NetCDF fraggle stuff and now it compiles and doesn't crash! --- src/fraggle/fraggle_io.f90 | 63 +++++++++++++++++++------------------- 1 file changed, 32 insertions(+), 31 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 43f4f25ff..e8dafd84c 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -64,52 +64,54 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) ! Variables - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & + nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") - call check( nf90_def_var(nc%id, nc%Qloss_varname, NF90_CHAR, & + call check( nf90_def_var(nc%id, nc%Qloss_varname, NF90_CHAR, & [ nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & + [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & + [nc%str_dimid, nc%id_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & + [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") - call check( nf90_def_var(nc%id, nc%rh_varname,nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& + [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") - call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid") + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "fraggle_io_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(nc%id, nc%pe_varname,& - nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) + call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "fraggle_io_initialize_output nf90_def_var PE_varid" ) - call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "fraggle_io_initialize_output nf90_def_var L_orb_varid" ) call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "fraggle_io_initialize_output nf90_def_var L_spin_varid" ) @@ -157,7 +159,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) 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, j, eslot, idslot, old_mode, npl + integer(I4B) :: i, eslot, idslot, old_mode, npl character(len=NAMELEN) :: charstring eslot = param%ioutput @@ -172,14 +174,13 @@ module subroutine fraggle_io_write_frame(self, nc, param) ! Stage 1: The Colliders npl = pl%nbody - do j = 1, npl - i = colliders%idx(j) + do i = 1, npl idslot = pl%id(i) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, eslot], count=[NAMELEN, 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) From 8eeae19ff7f42b1be1a985ce4ae3dbd4be651196 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 08:44:24 -0500 Subject: [PATCH 32/63] Getting the collision ouput data cleaned up. --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/simulation_class.py | 4 +- src/encounter/encounter_io.f90 | 11 +++--- src/fraggle/fraggle_io.f90 | 11 +++--- src/modules/fraggle_classes.f90 | 2 +- src/netcdf/netcdf.f90 | 14 +++---- src/symba/symba_io.f90 | 37 ++++++++++--------- 7 files changed, 42 insertions(+), 39 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index e68c8a260..0e4a6c598 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -203,7 +203,7 @@ def data_stream(self, frame=0): minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades sim.set_parameter(fragmentation=True, collision_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=0) + sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index b7fdc1b7a..2c2d10c98 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2958,8 +2958,8 @@ def clean(self): ] glob_files = [self.simdir.glob("**/dump_param?.in")] \ + [self.simdir.glob("**/dump_bin?.nc")] \ - + [self.simdir.glob("**/enc*.nc")] \ - + [self.simdir.glob("**/frag*.nc")] + + [self.simdir.glob("**/encounter_*.nc")] \ + + [self.simdir.glob("**/collision_*.nc")] for f in old_files: if f.exists(): diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 3f34c0e83..eade6d9e3 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -60,7 +60,6 @@ module subroutine encounter_io_initialize(self, param) logical :: fileExists character(len=STRMAX) :: errmsg integer(I4B) :: ndims, i - character(len=NAMELEN) :: charstring associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) @@ -153,7 +152,7 @@ module subroutine encounter_io_write_frame(self, nc, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp - character(len=NAMELEN) :: charstring + character(len=:), allocatable :: charstring tslot = param%ioutput associate(pl => self%pl, tp => self%tp) @@ -179,9 +178,9 @@ module subroutine encounter_io_write_frame(self, nc, param) end if charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%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 pl particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) end do ntp = tp%nbody @@ -192,9 +191,9 @@ module subroutine encounter_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) charstring = trim(adjustl(tp%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) 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" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) end do call check( nf90_set_fill(nc%id, old_mode, old_mode) ) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index e8dafd84c..faedff8a8 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -61,7 +61,7 @@ module subroutine fraggle_io_initialize_output(self, param) ! Dimension coordinates call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) ! Variables call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & @@ -134,7 +134,8 @@ module subroutine fraggle_io_initialize_output(self, param) ! Add in the space and stage dimension coordinates call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "fraggle_io_initialize nf90_put_var space" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords, start=[1], count=[2]), "fraggle_io_initialize nf90_put_var stage" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "fraggle_io_initialize nf90_put_var stage 1" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "fraggle_io_initialize nf90_put_var stage 2" ) ! Pre-fill id slots with ids call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_varid_varid" ) @@ -160,7 +161,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, eslot, idslot, old_mode, npl - character(len=NAMELEN) :: charstring + character(len=:), allocatable :: charstring eslot = param%ioutput associate(pl => self%colliders%pl, colliders => self%colliders, fragments => self%fragments) @@ -178,9 +179,9 @@ module subroutine fraggle_io_write_frame(self, nc, param) idslot = pl%id(i) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, eslot], count=[NAMELEN, 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 0aaead00b..0b95fd67a 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -116,7 +116,7 @@ module fraggle_classes integer(I4B) :: stage_dimid !! ID for the stage dimension integer(I4B) :: stage_varid !! ID for the stage variable character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) - character(len=6), dimension(2) :: stage_coords = ["before", "after "] !! The stage coordinate labels + character(len=6), dimension(2) :: stage_coords = ["before", "after"] !! The stage coordinate labels character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension integer(I4B) :: event_dimid !! ID for the collision event dimension diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index d44cbb5a7..8cfc6432f 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -1163,7 +1163,7 @@ module subroutine netcdf_write_info_base(self, nc, param) ! Internals integer(I4B) :: i, j, idslot, old_mode integer(I4B), dimension(:), allocatable :: ind - character(len=NAMELEN) :: charstring + character(len=:), allocatable :: charstring ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_write_info_base nf90_set_fill nf90_nofill" ) @@ -1180,14 +1180,14 @@ module subroutine netcdf_write_info_base(self, nc, param) call check( nf90_put_var(nc%id, nc%id_varid, self%id(j), start=[idslot]), "netcdf_write_info_base nf90_put_var id_varid" ) charstring = trim(adjustl(self%info(j)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var name_varid" ) charstring = trim(adjustl(self%info(j)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var particle_type_varid" ) if (param%lclose) then charstring = trim(adjustl(self%info(j)%origin_type)) - call check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var origin_type_varid" ) + call check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var origin_type_varid" ) call check( nf90_put_var(nc%id, nc%origin_time_varid, self%info(j)%origin_time, start=[idslot]), "netcdf_write_info_base nf90_put_var origin_time_varid" ) call check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info(j)%origin_rh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var origin_rh_varid" ) call check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info(j)%origin_vh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var origin_vh_varid" ) @@ -1206,14 +1206,14 @@ module subroutine netcdf_write_info_base(self, nc, param) call check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "netcdf_write_info_base nf90_put_var cb id_varid" ) charstring = trim(adjustl(self%info%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var cb name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var cb name_varid" ) charstring = trim(adjustl(self%info%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var cb ptype_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var cb ptype_varid" ) if (param%lclose) then charstring = trim(adjustl(self%info%origin_type)) - call check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var cb origin_type_varid" ) + call check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var cb origin_type_varid" ) call check( nf90_put_var(nc%id, nc%origin_time_varid, self%info%origin_time, start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_time_varid" ) call check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info%origin_rh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var cb origin_rh_varid" ) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 94f53d3f9..9722fa0c3 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -21,27 +21,30 @@ module subroutine symba_io_dump_encounter(self, param) class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - if (self%encounter_history%iframe == 0) return ! No enounters in this interval associate(encounter_history => self%encounter_history, nce => self%encounter_history%nc, eframe => self%encounter_history%iframe,& collision_history => self%collision_history, ncc => self%collision_history%nc, cframe => self%collision_history%iframe) - ! Create and save the output files for this encounter and fragmentation - nce%file_number = nce%file_number + 1 - nce%time_dimsize = maxval(encounter_history%tslot(:)) - write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number - call nce%initialize(param) - call encounter_history%dump(param) - call nce%close() - call encounter_history%reset() - - ncc%file_number = ncc%file_number + 1 - write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number - ncc%time_dimsize = maxval(collision_history%tslot(:)) - call ncc%initialize(param) - call collision_history%dump(param) - call ncc%close() - call collision_history%reset() + if (encounter_history%iframe > 0) then + ! Create and save the output files for this encounter and fragmentation + nce%file_number = nce%file_number + 1 + nce%time_dimsize = maxval(encounter_history%tslot(:)) + write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number + call nce%initialize(param) + call encounter_history%dump(param) + call nce%close() + call encounter_history%reset() + end if + + if (collision_history%iframe > 0) then + ncc%file_number = ncc%file_number + 1 + write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number + ncc%time_dimsize = maxval(collision_history%tslot(:)) + call ncc%initialize(param) + call collision_history%dump(param) + call ncc%close() + call collision_history%reset() + end if end associate return From 536f3182e21862df0368a288f28b4243fe996a5a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 10:26:15 -0500 Subject: [PATCH 33/63] Fixed id position issue --- src/encounter/encounter_io.f90 | 4 ++-- src/fraggle/fraggle_io.f90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index eade6d9e3..94b0fade6 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -164,7 +164,7 @@ module subroutine encounter_io_write_frame(self, nc, param) npl = pl%nbody do i = 1, npl - idslot = pl%id(i) + idslot = pl%id(i) + 1 call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) @@ -185,7 +185,7 @@ module subroutine encounter_io_write_frame(self, nc, param) ntp = tp%nbody do i = 1, ntp - idslot = tp%id(i) + idslot = tp%id(i) + 1 call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index faedff8a8..524ac7d2d 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -176,7 +176,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) ! Stage 1: The Colliders npl = pl%nbody do i = 1, npl - idslot = pl%id(i) + idslot = pl%id(i) + 1 call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) From beaef0b00c392eb012cb0ea11ca7dcfb93af046a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 10:29:35 -0500 Subject: [PATCH 34/63] Minor bug fixes to fraggle netcdf --- src/fraggle/fraggle_io.f90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 524ac7d2d..a16084184 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -171,7 +171,8 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) call check( nf90_put_var (nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) - call check( nf90_put_var(nc%id, nc%regime_varid, REGIME_NAMES(fragments%regime) , start=[eslot]), "fraggle_io_write_frame nf90_put_var regime_varid" ) + charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) + call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) ! Stage 1: The Colliders npl = pl%nbody @@ -179,7 +180,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) idslot = pl%id(i) + 1 call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) @@ -189,9 +190,11 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) - end do + ! Stage 2: The fragments + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select end associate From 7c0afc030e8bfb7c5c608beadd51da8b4cbdd29a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 10:44:09 -0500 Subject: [PATCH 35/63] Save the before and after state variables in the collision history --- src/fraggle/fraggle_io.f90 | 57 +++++++++++++++++++++----------------- 1 file changed, 31 insertions(+), 26 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index a16084184..29fc40b8e 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -74,7 +74,7 @@ module subroutine fraggle_io_initialize_output(self, param) [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") + [nc%str_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") @@ -160,45 +160,50 @@ module subroutine fraggle_io_write_frame(self, nc, param) 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, eslot, idslot, old_mode, npl + integer(I4B) :: i, eslot, idslot, old_mode, npl, stage character(len=:), allocatable :: charstring + class(swiftest_pl), allocatable :: pl - eslot = param%ioutput - associate(pl => self%colliders%pl, colliders => self%colliders, fragments => self%fragments) + associate(colliders => self%colliders, fragments => self%fragments) + eslot = param%ioutput select type(nc) class is (fraggle_io_parameters) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) call check( nf90_put_var (nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) + charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) - ! Stage 1: The Colliders - npl = pl%nbody - do i = 1, npl - idslot = pl%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) - - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) - call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) + do stage = 1,2 + if (allocated(pl)) deallocate(pl) + select case(stage) + case(1) + allocate(pl, source=colliders%pl) + case(2) + allocate(pl, source=fragments%pl) + end select + npl = pl%nbody + do i = 1, npl + idslot = pl%id(i) + 1 + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) + end do end do - - ! Stage 2: The fragments - - + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select - end associate + end associate return end subroutine fraggle_io_write_frame From d38350729e6d44b61a834c32497abacfa9607de2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 10:53:58 -0500 Subject: [PATCH 36/63] added energy tracking variables to fragmentation output --- src/fraggle/fraggle_io.f90 | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 29fc40b8e..866c7b093 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -169,11 +169,12 @@ module subroutine fraggle_io_write_frame(self, nc, param) select type(nc) class is (fraggle_io_parameters) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var (nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) - call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) + call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) do stage = 1,2 if (allocated(pl)) deallocate(pl) @@ -199,6 +200,16 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) end do end do + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select From 5d72cf4fffec07953f30c49d6dd2f77c3e714774 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 10:56:52 -0500 Subject: [PATCH 37/63] Fixed indexing of id dimension coordinate --- src/encounter/encounter_io.f90 | 4 ++-- src/fraggle/fraggle_io.f90 | 6 ++---- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 94b0fade6..4789ab2bf 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -84,7 +84,7 @@ module subroutine encounter_io_initialize(self, param) ! 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 call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates @@ -129,7 +129,7 @@ module subroutine encounter_io_initialize(self, param) 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 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" ) + call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "encounter_io_initialize nf90_put_var pl id_varid" ) end associate return diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 866c7b093..85dcf6e0e 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -54,7 +54,7 @@ module subroutine fraggle_io_initialize_output(self, param) ! Dimensions call check( nf90_def_dim(nc%id, nc%event_dimname, NF90_UNLIMITED, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" @@ -138,7 +138,7 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "fraggle_io_initialize nf90_put_var stage 2" ) ! Pre-fill id slots with ids - call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_varid_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "fraggle_io_initialize nf90_put_varid_varid" ) end associate return @@ -208,8 +208,6 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select From 7553ca4a792229365d672d4189be53ad0ea95d61 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 11:13:15 -0500 Subject: [PATCH 38/63] Fixed a problem with id values getting shifted by one. We count from 0 because the central body is always 0 --- src/netcdf/netcdf.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 8cfc6432f..b573688c3 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -808,7 +808,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma call pl%info(i)%set_value(status="ACTIVE") end do allocate(plind(npl)) - plind(:) = pack([(i, i = 1, idmax)], plmask(:)) + plind(:) = pack([(i, i = 0, idmax-1)], plmask(:)) end if if (ntp > 0) then tp%status(:) = ACTIVE @@ -817,7 +817,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma call tp%info(i)%set_value(status="ACTIVE") end do allocate(tpind(ntp)) - tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) + tpind(:) = pack([(i, i = 0, idmax-1)], tpmask(:)) end if call check( nf90_get_var(nc%id, nc%id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar id_varid" ) @@ -825,8 +825,8 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma 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) + pl%id(:) = pack([(i,i=0,idmax-1)],plmask) + tp%id(:) = pack([(i,i=0,idmax-1)],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)) From 850f3adb933dbeb89158e5f9d8515673eebed980 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 11:38:03 -0500 Subject: [PATCH 39/63] Fixed lots of netcdf bugs --- src/fraggle/fraggle_io.f90 | 23 +++++++-------- src/modules/fraggle_classes.f90 | 1 + src/symba/symba_io.f90 | 50 ++++++++++++++++++--------------- 3 files changed, 41 insertions(+), 33 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 85dcf6e0e..4feb40dbe 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -52,11 +52,11 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) ! Dimensions - call check( nf90_def_dim(nc%id, nc%event_dimname, NF90_UNLIMITED, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) @@ -68,8 +68,8 @@ module subroutine fraggle_io_initialize_output(self, param) nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") - call check( nf90_def_var(nc%id, nc%Qloss_varname, NF90_CHAR, & - [ nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") + call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & + [ nc%event_dimid], nc%Qloss_varid), "fraggle_io_initialize nf90_def_var Qloss_varid") call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") @@ -175,6 +175,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) + call check( nf90_put_var(nc%id, nc%Qloss_varid, fragments%Qloss, start=[eslot] ), "fraggle_io_write_frame nf90_put_var Qloss_varid" ) do stage = 1,2 if (allocated(pl)) deallocate(pl) @@ -204,10 +205,10 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 0b95fd67a..2dfbe8b5a 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -121,6 +121,7 @@ module fraggle_classes character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension integer(I4B) :: event_dimid !! ID for the collision event dimension integer(I4B) :: event_varid !! ID for the collision event variable + integer(I4B) :: event_dimsize = 0 !! Number of events character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable integer(I4B) :: Qloss_varid !! ID for the energy loss variable diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 9722fa0c3..cd8693598 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -22,29 +22,35 @@ module subroutine symba_io_dump_encounter(self, param) class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - associate(encounter_history => self%encounter_history, nce => self%encounter_history%nc, eframe => self%encounter_history%iframe,& - collision_history => self%collision_history, ncc => self%collision_history%nc, cframe => self%collision_history%iframe) - - if (encounter_history%iframe > 0) then - ! Create and save the output files for this encounter and fragmentation - nce%file_number = nce%file_number + 1 - nce%time_dimsize = maxval(encounter_history%tslot(:)) - write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number - call nce%initialize(param) - call encounter_history%dump(param) - call nce%close() - call encounter_history%reset() - end if + associate(encounter_history => self%encounter_history, num_enc_frames => self%encounter_history%iframe,& + collision_history => self%collision_history, num_coll_frames => self%collision_history%iframe) + + select type(nce => self%encounter_history%nc) + class is (encounter_io_parameters) + if (num_enc_frames > 0) then + ! Create and save the output files for this encounter and fragmentation + nce%file_number = nce%file_number + 1 + nce%time_dimsize = maxval(encounter_history%tslot(:)) + write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number + call nce%initialize(param) + call encounter_history%dump(param) + call nce%close() + call encounter_history%reset() + end if + end select - if (collision_history%iframe > 0) then - ncc%file_number = ncc%file_number + 1 - write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number - ncc%time_dimsize = maxval(collision_history%tslot(:)) - call ncc%initialize(param) - call collision_history%dump(param) - call ncc%close() - call collision_history%reset() - end if + select type(ncc => self%collision_history%nc) + class is (fraggle_io_parameters) + if (num_coll_frames > 0) then + ncc%file_number = ncc%file_number + 1 + ncc%event_dimsize = num_coll_frames + write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number + call ncc%initialize(param) + call collision_history%dump(param) + call ncc%close() + call collision_history%reset() + end if + end select end associate return From 82859d31e6635ff5f6165c5758e7a2d42b201dea Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 19:30:14 -0500 Subject: [PATCH 40/63] Fixed and rearranged a bunch of stuff getting the collision history object to work --- src/CMakeLists.txt | 2 +- src/encounter/encounter_io.f90 | 32 +++++++++++++-- src/encounter/encounter_util.f90 | 41 +++++++++++++++++++ src/fraggle/fraggle_io.f90 | 1 - src/modules/encounter_classes.f90 | 39 ++++++++++++++++-- src/modules/fraggle_classes.f90 | 6 +-- src/modules/swiftest_classes.f90 | 21 ++++++---- src/modules/symba_classes.f90 | 4 +- src/netcdf/netcdf.f90 | 8 ++-- src/setup/setup.f90 | 2 +- src/symba/symba_collision.f90 | 1 - src/symba/symba_util.f90 | 34 +++++++-------- .../{util_index_array.f90 => util_index.f90} | 13 ++++++ 13 files changed, 160 insertions(+), 44 deletions(-) rename src/util/{util_index_array.f90 => util_index.f90} (84%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index eb9fb20d5..344a2e7d8 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -78,7 +78,7 @@ SET(FAST_MATH_FILES ${SRC}/util/util_final.f90 ${SRC}/util/util_flatten.f90 ${SRC}/util/util_get_energy_momentum.f90 - ${SRC}/util/util_index_array.f90 + ${SRC}/util/util_index.f90 ${SRC}/util/util_minimize_bfgs.f90 ${SRC}/util/util_peri.f90 ${SRC}/util/util_rescale.f90 diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 4789ab2bf..414c3854a 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -12,14 +12,14 @@ contains - module subroutine encounter_io_dump(self, param) + module subroutine encounter_io_dump_collision_storage(self, param) !! author: David A. Minton !! !! Dumps the time history of an encounter to file. implicit none ! Arguments - class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(collision_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -29,6 +29,30 @@ module subroutine encounter_io_dump(self, param) class is (fraggle_collision_snapshot) param%ioutput = i call snapshot%write_frame(self%nc,param) + end select + else + exit + end if + end do + + return + end subroutine encounter_io_dump_collision_storage + + + module subroutine encounter_io_dump_storage(self, param) + !! author: David A. Minton + !! + !! Dumps the time history of an encounter to file. + implicit none + ! Arguments + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) param%ioutput = self%tslot(i) call snapshot%write_frame(self%nc,param) @@ -40,7 +64,7 @@ module subroutine encounter_io_dump(self, param) return - end subroutine encounter_io_dump + end subroutine encounter_io_dump_storage module subroutine encounter_io_initialize(self, param) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 0d3a66d62..7d5094ede 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -152,6 +152,20 @@ module subroutine encounter_util_final_snapshot(self) end subroutine encounter_util_final_snapshot + module subroutine encounter_util_final_collision_storage(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_storage(*)), intent(inout) :: self !! SyMBA nbody system object + + call util_final_storage(self%swiftest_storage) + + return + end subroutine encounter_util_final_collision_storage + + module subroutine encounter_util_final_storage(self) !! author: David A. Minton !! @@ -166,6 +180,33 @@ module subroutine encounter_util_final_storage(self) end subroutine encounter_util_final_storage + module subroutine encounter_util_index_map_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + + return + end subroutine encounter_util_index_map_storage + + + + module subroutine encounter_util_index_map_collision_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + + return + end subroutine encounter_util_index_map_collision_storage + + module subroutine encounter_util_resize_list(self, nnew) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 4feb40dbe..4f5fec19b 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -12,7 +12,6 @@ contains - module subroutine fraggle_io_initialize_output(self, param) !! author: David A. Minton !! diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 95f230344..49065fc2a 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -68,10 +68,20 @@ module encounter_classes 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 contains - procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file - final :: encounter_util_final_storage + procedure :: dump => encounter_io_dump_storage !! Dumps contents of encounter history to file + procedure :: mapid => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: encounter_util_final_storage end type encounter_storage + !> A class that that is used to store simulation history data between file output + type, extends(swiftest_storage) :: collision_storage + class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object + contains + procedure :: dump => encounter_io_dump_collision_storage !! Dumps contents of encounter history to file + procedure :: mapid => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: encounter_util_final_collision_storage + end type collision_storage + type encounter_bounding_box_1D integer(I4B) :: n !! Number of bodies with extents integer(I4B), dimension(:), allocatable :: ind !! Sorted minimum/maximum extent indices (value > n indicates an ending index) @@ -204,11 +214,17 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, x, v, renc, dt logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical array indicating which pairs are approaching end subroutine encounter_check_sweep_aabb_single_list - module subroutine encounter_io_dump(self, param) + module subroutine encounter_io_dump_collision_storage(self, param) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Collision storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine encounter_io_dump_collision_storage + + module subroutine encounter_io_dump_storage(self, param) implicit none class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_io_dump + end subroutine encounter_io_dump_storage module subroutine encounter_io_initialize(self, param) implicit none @@ -264,6 +280,11 @@ module subroutine encounter_util_final_aabb(self) type(encounter_bounding_box_1D), intent(inout) :: self !!Bounding box structure along a single dimension end subroutine encounter_util_final_aabb + module subroutine encounter_util_final_collision_storage(self) + implicit none + type(collision_storage(*)), intent(inout) :: self !! SyMBA nbody system object + end subroutine encounter_util_final_collision_storage + module subroutine encounter_util_final_list(self) implicit none type(encounter_list), intent(inout) :: self !! Swiftest encounter list object @@ -279,6 +300,16 @@ module subroutine encounter_util_final_storage(self) type(encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object end subroutine encounter_util_final_storage + module subroutine encounter_util_index_map_collision_storage(self) + implicit none + class(collision_storage(*)), intent(inout) :: self !! E + end subroutine encounter_util_index_map_collision_storage + + module subroutine encounter_util_index_map_storage(self) + implicit none + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine encounter_util_index_map_storage + module subroutine encounter_util_resize_list(self, nnew) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 2dfbe8b5a..8d8e1c33e 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -285,17 +285,17 @@ end subroutine fraggle_util_construct_temporary_system module subroutine fraggle_util_final_colliders(self) implicit none - type(fraggle_colliders), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_colliders), intent(inout) :: self !! Fraggle colliders object end subroutine fraggle_util_final_colliders module subroutine fraggle_util_final_fragments(self) implicit none - type(fraggle_fragments), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_fragments), intent(inout) :: self !! Fraggle frgments object end subroutine fraggle_util_final_fragments module subroutine fraggle_util_final_snapshot(self) implicit none - type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle storage snapshot object end subroutine fraggle_util_final_snapshot module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 9c60dd884..8624f8ece 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -153,14 +153,16 @@ module swiftest_classes type :: swiftest_storage(nframes) !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored - type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames - integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system - integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame - real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots + integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored + type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames + integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system + integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame + real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots + integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map contains - procedure :: dump => io_dump_storage !! Dumps storage object contents to file - procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + procedure :: dump => io_dump_storage !! Dumps storage object contents to file + procedure :: mapid => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 final :: util_final_storage end type swiftest_storage @@ -1515,6 +1517,11 @@ module subroutine util_index_array(ind_arr, n) integer(I4B), intent(in) :: n !! The new size of the index array end subroutine util_index_array + module subroutine util_index_map_storage(self) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine util_index_map_storage + module function util_minimize_bfgs(f, N, x0, eps, maxloop, lerr) result(x1) use lambda_function implicit none diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index a31d042f9..ff2597b5f 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_snapshot, encounter_storage + use encounter_classes, only : encounter_list, encounter_snapshot, encounter_storage, collision_storage implicit none public @@ -192,7 +192,7 @@ module symba_classes class(fraggle_colliders), allocatable :: colliders !! Fraggle colliders object class(fraggle_fragments), allocatable :: fragments !! Fraggle fragmentation system object type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file - type(encounter_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file + type(collision_storage(nframes=:)), allocatable :: collision_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 procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index b573688c3..8cfc6432f 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -808,7 +808,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma call pl%info(i)%set_value(status="ACTIVE") end do allocate(plind(npl)) - plind(:) = pack([(i, i = 0, idmax-1)], plmask(:)) + plind(:) = pack([(i, i = 1, idmax)], plmask(:)) end if if (ntp > 0) then tp%status(:) = ACTIVE @@ -817,7 +817,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma call tp%info(i)%set_value(status="ACTIVE") end do allocate(tpind(ntp)) - tpind(:) = pack([(i, i = 0, idmax-1)], tpmask(:)) + tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) end if call check( nf90_get_var(nc%id, nc%id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar id_varid" ) @@ -825,8 +825,8 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma pl%id(:) = pack(itemp, plmask) tp%id(:) = pack(itemp, tpmask) cb%id = 0 - pl%id(:) = pack([(i,i=0,idmax-1)],plmask) - tp%id(:) = pack([(i,i=0,idmax-1)],tpmask) + 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 ea822f45d..a107179a1 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -82,7 +82,7 @@ module subroutine setup_construct_system(system, param) end select end associate - allocate(encounter_storage :: system%collision_history) + allocate(collision_storage :: system%collision_history) associate (collision_history => system%collision_history) allocate(fraggle_io_parameters :: collision_history%nc) call collision_history%reset() diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 53e0a84bc..95d0dcf4f 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -494,7 +494,6 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid associate(idx_arr => parent_child_index_array(j)%idx, & id_arr => parent_child_index_array(j)%id, & ncj => nchild(j), & - pl => pl, & plkinj => pl%kin(idx_parent(j))) idx_arr(1) = idx_parent(j) if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 5b840ad0c..60c3311c4 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -881,7 +881,7 @@ subroutine symba_util_save_collision(system, snapshot) type(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object ! Internals - type(encounter_storage(nframes=:)), allocatable :: tmp + type(collision_storage(nframes=:)), allocatable :: tmp integer(I4B) :: i, nnew, nold, nbig ! Advance the snapshot frame counter @@ -896,7 +896,7 @@ subroutine symba_util_save_collision(system, snapshot) do while (nbig < nnew) nbig = nbig * 2 end do - allocate(encounter_storage(nbig) :: tmp) + allocate(collision_storage(nbig) :: tmp) tmp%tvals(1:nold) = system%collision_history%tvals(1:nold) tmp%tvals(nold+1:nbig) = huge(1.0_DP) tmp%tslot(1:nold) = system%collision_history%tslot(1:nold) @@ -1347,26 +1347,28 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) real(DP), intent(in) :: t !! current time character(*), intent(in) :: stage !! Either before or after ! Arguments - class(fraggle_collision_snapshot), allocatable:: snapshot + class(fraggle_collision_snapshot), allocatable :: snapshot + type(symba_pl) :: pl integer(I4B) :: i,j select case(stage) case("before") ! Saves the states of the bodies involved in the collision before the collision is resolved associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) - allocate(symba_pl :: self%colliders%pl) - select type(pl => self%colliders%pl) - class is (symba_pl) - call pl%setup(ncoll, param) - pl%id(:) = self%pl%id(idx(:)) - pl%Gmass(:) = self%pl%Gmass(idx(:)) - pl%radius(:) = self%pl%radius(idx(:)) - pl%rot(:,:) = self%pl%rot(:,idx(:)) - pl%Ip(:,:) = self%pl%Ip(:,idx(:)) - pl%rh(:,:) = self%pl%rh(:,idx(:)) - pl%vh(:,:) = self%pl%vh(:,idx(:)) - pl%info(:) = self%pl%info(idx(:)) - end select + !allocate(symba_pl :: self%colliders%pl) + !select type(pl => self%colliders%pl) + !class is (symba_pl) + call pl%setup(ncoll, param) + pl%id(:) = self%pl%id(idx(:)) + pl%Gmass(:) = self%pl%Gmass(idx(:)) + pl%radius(:) = self%pl%radius(idx(:)) + pl%rot(:,:) = self%pl%rot(:,idx(:)) + pl%Ip(:,:) = self%pl%Ip(:,idx(:)) + pl%rh(:,:) = self%pl%rh(:,idx(:)) + pl%vh(:,:) = self%pl%vh(:,idx(:)) + pl%info(:) = self%pl%info(idx(:)) + !end select + allocate(self%colliders%pl, source=pl) end associate case("after") allocate(fraggle_collision_snapshot :: snapshot) diff --git a/src/util/util_index_array.f90 b/src/util/util_index.f90 similarity index 84% rename from src/util/util_index_array.f90 rename to src/util/util_index.f90 index b59e829e1..20772a2a6 100644 --- a/src/util/util_index_array.f90 +++ b/src/util/util_index.f90 @@ -44,4 +44,17 @@ module subroutine util_index_array(ind_arr, n) return end subroutine util_index_array + + module subroutine util_index_map_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + + return + end subroutine util_index_map_storage + end submodule s_util_index_array \ No newline at end of file From a83690cd75a73f2e689a5937eb94ab171860b30f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 21:08:06 -0500 Subject: [PATCH 41/63] Started working on a more efficient way to store ids --- src/CMakeLists.txt | 1 + src/encounter/encounter_io.f90 | 2 +- src/encounter/encounter_util.f90 | 32 ++++++++++++++++++++++++- src/modules/swiftest_classes.f90 | 7 ++++++ src/symba/symba_util.f90 | 2 ++ src/util/util_reset.f90 | 2 ++ src/util/util_unique.f90 | 41 ++++++++++++++++++++++++++++++++ 7 files changed, 85 insertions(+), 2 deletions(-) create mode 100644 src/util/util_unique.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 344a2e7d8..6f382cd8e 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -88,6 +88,7 @@ SET(FAST_MATH_FILES ${SRC}/util/util_solve.f90 ${SRC}/util/util_sort.f90 ${SRC}/util/util_spill.f90 + ${SRC}/util/util_unique.f90 ${SRC}/util/util_valid.f90 ${SRC}/util/util_version.f90 ${SRC}/walltime/walltime.f90 diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 414c3854a..c5e458e57 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -50,6 +50,7 @@ module subroutine encounter_io_dump_storage(self, param) ! Internals integer(I4B) :: i + call self%mapid() do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) @@ -62,7 +63,6 @@ module subroutine encounter_io_dump_storage(self, param) end if end do - return end subroutine encounter_io_dump_storage diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 7d5094ede..9385ad2c0 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -183,11 +183,41 @@ end subroutine encounter_util_final_storage module subroutine encounter_util_index_map_storage(self) !! author: David A. Minton !! - !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id. + !! Basically this will make a unique list of ids that exist in all of the saved snapshots implicit none ! Arguments class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals + integer(I4B) :: i, n, nold + integer(I4B), dimension(:), allocatable :: idlist + + if (self%nid == 0) return + allocate(idlist(self%nid)) + + n = 0 + nold = 1 + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (encounter_snapshot) + if (allocated(snapshot%pl)) then + n = n + snapshot%pl%nbody + idlist(nold:n) = snapshot%pl%id(:) + nold = n+1 + end if + if (allocated(snapshot%tp)) then + n = n + snapshot%tp%nbody + idlist(nold:n) = snapshot%tp%id(:) + nold = n+1 + end if + end select + else + exit + end if + end do + + call util_unique(idlist,self%idmap) return end subroutine encounter_util_index_map_storage diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 8624f8ece..6fb35383e 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -159,6 +159,7 @@ module swiftest_classes integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map + integer(I4B) :: nid !! Number of unique id values in all saved snapshots contains procedure :: dump => io_dump_storage !! Dumps storage object contents to file procedure :: mapid => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id @@ -1956,6 +1957,12 @@ module subroutine util_spill_tp(self, discards, lspill_list, ldestructive) logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine util_spill_tp + module subroutine util_unique(input_array, output_array) + implicit none + integer(I4B), dimension(:), intent(in) :: input_array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array + end subroutine util_unique + module subroutine util_valid_id_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 60c3311c4..f7711e6bf 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1380,6 +1380,7 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) return end subroutine symba_util_take_collision_snapshot + module subroutine symba_util_take_encounter_snapshot(self, param, t) !! author: David A. Minton !! @@ -1477,6 +1478,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select ! Save the snapshot + self%encounter_history%nid = self%encounter_history%nid + ntp_snap + npl_snap call symba_util_save_encounter(self,snapshot,t) end select end select diff --git a/src/util/util_reset.f90 b/src/util/util_reset.f90 index 7bb8d5ee3..a588c65fe 100644 --- a/src/util/util_reset.f90 +++ b/src/util/util_reset.f90 @@ -27,6 +27,8 @@ module subroutine util_reset_storage(self) self%tslot(:) = 0 self%tvals(:) = huge(1.0_DP) self%iframe = 0 + if (allocated(self%idmap)) deallocate(self%idmap) + self%nid = 0 return end subroutine util_reset_storage diff --git a/src/util/util_unique.f90 b/src/util/util_unique.f90 new file mode 100644 index 000000000..9cf77536c --- /dev/null +++ b/src/util/util_unique.f90 @@ -0,0 +1,41 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (swiftest_classes) s_util_unique + use swiftest +contains + + module subroutine util_unique(input_array, output_array) + !! author: David A. Minton + !! + !! Takes an input unsorted integer array and returns a new array of sorted, unique values + implicit none + ! Arguments + integer(I4B), dimension(:), intent(in) :: input_array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array + ! Internals + integer(I4B), dimension(:), allocatable :: unique_array + integer(I4B) :: n, lo, hi + + allocate(unique_array, mold=input_array) + lo = minval(input_array) - 1 + hi = maxval(input_array) + + n = 0 + do while (lo < hi) + n = n + 1 + lo = minval(input_array, mask=input_array > lo) + unique_array(n) = lo + enddo + allocate(output_array(n), source=unique_array(1:n)) + + return + end subroutine util_unique + +end submodule s_util_unique \ No newline at end of file From 0fe3f1f90cfa394f70dd49a17968be31b754e1b7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 11 Dec 2022 09:31:08 -0500 Subject: [PATCH 42/63] Another major restructuring aimed toward improving how the storage objects handle the indexing of bodies and time steps --- src/CMakeLists.txt | 1 + src/encounter/encounter_io.f90 | 3 +- src/encounter/encounter_util.f90 | 23 ++++++++++---- src/io/io.f90 | 8 +++-- src/main/swiftest_driver.f90 | 8 ++--- src/modules/encounter_classes.f90 | 12 +++---- src/modules/swiftest_classes.f90 | 50 ++++++++++++++++++++--------- src/netcdf/netcdf.f90 | 4 +-- src/symba/symba_io.f90 | 3 +- src/symba/symba_util.f90 | 17 +--------- src/util/util_index.f90 | 42 ++++++++++++++++++++++++ src/util/util_reset.f90 | 7 ++-- src/util/util_snapshot.f90 | 33 +++++++++++++++++++ src/util/util_unique.f90 | 53 +++++++++++++++++++++++++++---- 14 files changed, 198 insertions(+), 66 deletions(-) create mode 100644 src/util/util_snapshot.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 6f382cd8e..594850a50 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -85,6 +85,7 @@ SET(FAST_MATH_FILES ${SRC}/util/util_reset.f90 ${SRC}/util/util_resize.f90 ${SRC}/util/util_set.f90 + ${SRC}/util/util_snapshot.f90 ${SRC}/util/util_solve.f90 ${SRC}/util/util_sort.f90 ${SRC}/util/util_spill.f90 diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index c5e458e57..0f821f49b 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -50,12 +50,11 @@ module subroutine encounter_io_dump_storage(self, param) ! Internals integer(I4B) :: i - call self%mapid() do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) - param%ioutput = self%tslot(i) + param%ioutput = self%tmap(i) call snapshot%write_frame(self%nc,param) end select else diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 9385ad2c0..ef89b3cf3 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -189,11 +189,14 @@ module subroutine encounter_util_index_map_storage(self) ! Arguments class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals - integer(I4B) :: i, n, nold - integer(I4B), dimension(:), allocatable :: idlist + ! Internals + integer(I4B) :: i, n, nold, nt + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals if (self%nid == 0) return - allocate(idlist(self%nid)) + allocate(idvals(self%nid)) + allocate(tvals(self%nframes)) n = 0 nold = 1 @@ -201,23 +204,29 @@ module subroutine encounter_util_index_map_storage(self) if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) + tvals(i) = snapshot%t if (allocated(snapshot%pl)) then n = n + snapshot%pl%nbody - idlist(nold:n) = snapshot%pl%id(:) + idvals(nold:n) = snapshot%pl%id(:) nold = n+1 - end if + end if if (allocated(snapshot%tp)) then n = n + snapshot%tp%nbody - idlist(nold:n) = snapshot%tp%id(:) + idvals(nold:n) = snapshot%tp%id(:) nold = n+1 end if end select else + nt = i-1 exit end if end do - call util_unique(idlist,self%idmap) + call util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + call util_unique(tvals(1:nt),self%tvals,self%tmap) + self%nt = size(self%tvals) return end subroutine encounter_util_index_map_storage diff --git a/src/io/io.f90 b/src/io/io.f90 index 74116d5b0..3d694e027 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -294,9 +294,11 @@ module subroutine io_dump_storage(self, param) integer(I4B) :: i integer(I8B) :: iloop_start - iloop_start = max(param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B),1) + if (self%iframe == 0) return + iloop_start = param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B) + 1 + call self%make_index_map() do i = 1, param%dump_cadence - param%ioutput = max(int(iloop_start / param%istep_out, kind=I4B),1) + i + param%ioutput = iloop_start + self%tmap(i) if (allocated(self%frame(i)%item)) then select type(system => self%frame(i)%item) class is (swiftest_nbody_system) @@ -305,7 +307,7 @@ module subroutine io_dump_storage(self, param) deallocate(self%frame(i)%item) end if end do - + call self%reset() return end subroutine io_dump_storage diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index bfc0b38c6..803ca6849 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -88,15 +88,15 @@ program swiftest_driver call system%initialize(param) - ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. if (param%lrestart) then if (param%lenergy) call system%conservation_report(param, lterminal=.true.) else if (param%lenergy) call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum - call system%write_frame(param) - call system%dump(param) + call system_history%take_snapshot(system) + call system_history%dump(param) end if + call system%dump(param) write(display_unit, *) " *************** Main Loop *************** " @@ -130,7 +130,7 @@ program swiftest_driver if (iout == istep_out) then iout = 0 idump = idump + 1 - system_history%frame(idump) = system ! Store a snapshot of the system for posterity + call system_history%take_snapshot(system) if (idump == dump_cadence) then idump = 0 diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 49065fc2a..b1b7bb079 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -68,18 +68,18 @@ module encounter_classes 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 contains - procedure :: dump => encounter_io_dump_storage !! Dumps contents of encounter history to file - procedure :: mapid => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: encounter_util_final_storage + procedure :: dump => encounter_io_dump_storage !! Dumps contents of encounter history to file + procedure :: make_index_map => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: encounter_util_final_storage end type encounter_storage !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: collision_storage class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains - procedure :: dump => encounter_io_dump_collision_storage !! Dumps contents of encounter history to file - procedure :: mapid => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: encounter_util_final_collision_storage + procedure :: dump => encounter_io_dump_collision_storage !! Dumps contents of encounter history to file + procedure :: make_index_map => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: encounter_util_final_collision_storage end type collision_storage type encounter_bounding_box_1D diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 6fb35383e..4894e305d 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -148,7 +148,7 @@ module swiftest_classes contains procedure :: store => util_copy_store !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. generic :: assignment(=) => store - final :: util_final_storage_frame + final :: util_final_storage_frame end type type :: swiftest_storage(nframes) @@ -156,15 +156,18 @@ module swiftest_classes integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system - integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame - real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots - integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map integer(I4B) :: nid !! Number of unique id values in all saved snapshots + integer(I4B), dimension(:), allocatable :: idvals !! The set of unique id values contained in the snapshots + integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map + integer(I4B) :: nt !! Number of unique time values in all saved snapshots + real(DP), dimension(:), allocatable :: tvals !! The set of unique time values contained in the snapshots + integer(I4B), dimension(:), allocatable :: tmap !! The t value -> index map contains - procedure :: dump => io_dump_storage !! Dumps storage object contents to file - procedure :: mapid => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 - final :: util_final_storage + procedure :: dump => io_dump_storage !! Dumps storage object contents to file + procedure :: make_index_map => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + procedure :: take_snapshot => util_snapshot_system !! Takes a snapshot of the system for later file storage + final :: util_final_storage end type swiftest_storage !******************************************************************************************************************************** @@ -550,7 +553,7 @@ module swiftest_classes procedure :: finalize => setup_finalize_system !! Runs any finalization subroutines when ending the simulation. procedure :: initialize => setup_initialize_system !! Initialize the system from input files procedure :: init_particle_info => setup_initialize_particle_info_system !! Initialize the system from input files - ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. + ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. procedure :: set_msys => util_set_msys !! Sets the value of msys from the masses of system bodies. procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum procedure :: rescale => util_rescale_system !! Rescales the system into a new set of units @@ -611,11 +614,9 @@ subroutine abstract_step_system(self, param, t, dt) real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize end subroutine abstract_step_system - end interface interface - module subroutine check(status, call_identifier) implicit none integer, intent (in) :: status !! The status code returned by a NetCDF function @@ -1690,6 +1691,12 @@ module subroutine util_set_rhill_approximate(self,cb) class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object end subroutine util_set_rhill_approximate + + module subroutine util_snapshot_system(self, system) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object to store + end subroutine util_snapshot_system end interface interface util_solve_linear_system @@ -1957,12 +1964,25 @@ module subroutine util_spill_tp(self, discards, lspill_list, ldestructive) logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine util_spill_tp - module subroutine util_unique(input_array, output_array) + end interface + + interface util_unique + module subroutine util_unique_DP(input_array, output_array, index_map) implicit none - integer(I4B), dimension(:), intent(in) :: input_array - integer(I4B), dimension(:), allocatable, intent(out) :: output_array - end subroutine util_unique + real(DP), dimension(:), intent(in) :: input_array !! Unsorted input array + real(DP), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) + end subroutine util_unique_DP + module subroutine util_unique_I4B(input_array, output_array, index_map) + implicit none + integer(I4B), dimension(:), intent(in) :: input_array !! Unsorted input array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) + end subroutine util_unique_I4B + end interface util_unique + + interface module subroutine util_valid_id_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 8cfc6432f..9bc945227 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -825,8 +825,8 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma 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) + pl%id(:) = pack([(i,i=0,idmax-1)],plmask) + tp%id(:) = pack([(i,i=0,idmax-1)],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/symba/symba_io.f90 b/src/symba/symba_io.f90 index cd8693598..d1f36abca 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -30,7 +30,7 @@ module subroutine symba_io_dump_encounter(self, param) if (num_enc_frames > 0) then ! Create and save the output files for this encounter and fragmentation nce%file_number = nce%file_number + 1 - nce%time_dimsize = maxval(encounter_history%tslot(:)) + call encounter_history%make_index_map() write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number call nce%initialize(param) call encounter_history%dump(param) @@ -44,6 +44,7 @@ module subroutine symba_io_dump_encounter(self, param) if (num_coll_frames > 0) then ncc%file_number = ncc%file_number + 1 ncc%event_dimsize = num_coll_frames + call collision_history%make_index_map() write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number call ncc%initialize(param) call collision_history%dump(param) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index f7711e6bf..4381ce93b 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -897,10 +897,6 @@ subroutine symba_util_save_collision(system, snapshot) nbig = nbig * 2 end do allocate(collision_storage(nbig) :: tmp) - tmp%tvals(1:nold) = system%collision_history%tvals(1:nold) - tmp%tvals(nold+1:nbig) = huge(1.0_DP) - tmp%tslot(1:nold) = system%collision_history%tslot(1:nold) - tmp%tslot(nold+1:nbig) = 0 tmp%iframe = system%collision_history%iframe call move_alloc(system%collision_history%nc, tmp%nc) @@ -947,10 +943,6 @@ subroutine symba_util_save_encounter(system, snapshot, t) nbig = nbig * 2 end do allocate(encounter_storage(nbig) :: tmp) - tmp%tvals(1:nold) = system%encounter_history%tvals(1:nold) - tmp%tvals(nold+1:nbig) = huge(1.0_DP) - 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) @@ -964,14 +956,7 @@ subroutine symba_util_save_encounter(system, snapshot, t) ! Find out which time slot this belongs in by searching for an existing slot ! with the same value of time or the first available one - do i = 1, nnew - if (t <= system%encounter_history%tvals(i)) then - system%encounter_history%tvals(i) = t - system%encounter_history%tslot(nnew) = i - system%encounter_history%frame(nnew) = snapshot - exit - end if - end do + system%encounter_history%frame(nnew) = snapshot return end subroutine symba_util_save_encounter diff --git a/src/util/util_index.f90 b/src/util/util_index.f90 index 20772a2a6..ae4a80ce8 100644 --- a/src/util/util_index.f90 +++ b/src/util/util_index.f90 @@ -53,6 +53,48 @@ module subroutine util_index_map_storage(self) ! Arguments class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals + integer(I4B) :: i, n, nold, nt + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals + + if (self%nid == 0) return + allocate(idvals(self%nid)) + allocate(tvals(self%nframes)) + + n = 0 + nold = 1 + nt = 0 + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + nt = i + select type(snapshot => self%frame(i)%item) + class is (swiftest_nbody_system) + tvals(i) = snapshot%t + ! Central body + n = n + 1 + idvals(n) = snapshot%cb%id + nold = n + 1 + if (allocated(snapshot%pl)) then + n = n + snapshot%pl%nbody + idvals(nold:n) = snapshot%pl%id(:) + nold = n+1 + end if + if (allocated(snapshot%tp)) then + n = n + snapshot%tp%nbody + idvals(nold:n) = snapshot%tp%id(:) + nold = n+1 + end if + end select + else + exit + end if + end do + + call util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + call util_unique(tvals(1:nt),self%tvals,self%tmap) + self%nt = size(self%tvals) return end subroutine util_index_map_storage diff --git a/src/util/util_reset.f90 b/src/util/util_reset.f90 index a588c65fe..9b37f7d15 100644 --- a/src/util/util_reset.f90 +++ b/src/util/util_reset.f90 @@ -24,11 +24,12 @@ module subroutine util_reset_storage(self) do i = 1, self%nframes if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) end do - self%tslot(:) = 0 - self%tvals(:) = huge(1.0_DP) - self%iframe = 0 + if (allocated(self%idmap)) deallocate(self%idmap) + if (allocated(self%tmap)) deallocate(self%tmap) self%nid = 0 + self%nt = 0 + self%iframe = 0 return end subroutine util_reset_storage diff --git a/src/util/util_snapshot.f90 b/src/util/util_snapshot.f90 new file mode 100644 index 000000000..1c67bc7f8 --- /dev/null +++ b/src/util/util_snapshot.f90 @@ -0,0 +1,33 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule(swiftest_classes) s_util_snapshot + use swiftest +contains + + module subroutine util_snapshot_system(self, system) + !! author: David A. Minton + !! + !! Takes a snapshot of the system for later file storage + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object to store + + self%iframe = self%iframe + 1 + self%nt = self%iframe + self%frame(self%iframe) = system ! Store a snapshot of the system for posterity + self%nid = self%nid + 1 ! Central body + if (allocated(system%pl)) self%nid = self%nid + system%pl%nbody + if (allocated(system%tp)) self%nid = self%nid + system%tp%nbody + + return + end subroutine util_snapshot_system + +end submodule s_util_snapshot \ No newline at end of file diff --git a/src/util/util_unique.f90 b/src/util/util_unique.f90 index 9cf77536c..19eb4ba78 100644 --- a/src/util/util_unique.f90 +++ b/src/util/util_unique.f90 @@ -11,31 +11,70 @@ use swiftest contains - module subroutine util_unique(input_array, output_array) + module subroutine util_unique_DP(input_array, output_array, index_map) !! author: David A. Minton !! - !! Takes an input unsorted integer array and returns a new array of sorted, unique values + !! Takes an input unsorted integer array and returns a new array of sorted, unique values (DP version) implicit none ! Arguments - integer(I4B), dimension(:), intent(in) :: input_array - integer(I4B), dimension(:), allocatable, intent(out) :: output_array + real(DP), dimension(:), intent(in) :: input_array !! Unsorted input array + real(DP), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) + ! Internals + real(DP), dimension(:), allocatable :: unique_array + integer(I4B) :: n + real(DP) :: lo, hi + + allocate(unique_array, mold=input_array) + allocate(index_map(size(input_array))) + lo = minval(input_array) - 1 + hi = maxval(input_array) + + n = 0 + do + n = n + 1 + lo = minval(input_array(:), mask=input_array(:) > lo) + unique_array(n) = lo + where(input_array(:) == lo) index_map(:) = n + if (lo >= hi) exit + enddo + allocate(output_array(n), source=unique_array(1:n)) + + return + end subroutine util_unique_DP + + + module subroutine util_unique_I4B(input_array, output_array, index_map) + !! author: David A. Minton + !! + !! Takes an input unsorted integer array and returns a new array of sorted, unique values (I4B version) + implicit none + ! Arguments + integer(I4B), dimension(:), intent(in) :: input_array !! Unsorted input array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) ! Internals integer(I4B), dimension(:), allocatable :: unique_array integer(I4B) :: n, lo, hi allocate(unique_array, mold=input_array) + allocate(index_map, mold=input_array) lo = minval(input_array) - 1 hi = maxval(input_array) n = 0 - do while (lo < hi) + do n = n + 1 - lo = minval(input_array, mask=input_array > lo) + lo = minval(input_array(:), mask=input_array(:) > lo) unique_array(n) = lo + where(input_array(:) == lo) index_map(:) = n + if (lo >= hi) exit enddo allocate(output_array(n), source=unique_array(1:n)) return - end subroutine util_unique + end subroutine util_unique_I4B + + end submodule s_util_unique \ No newline at end of file From a7fb1c76168beb1827ebc1cc08dcc8b1c0b26e6f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 11 Dec 2022 17:21:35 -0500 Subject: [PATCH 43/63] I am once again restructuring. This time to try to get all of the storage objects to have a consistent structure and set of methods --- src/discard/discard.f90 | 4 +- src/encounter/encounter_io.f90 | 171 +++++++++++-------- src/encounter/encounter_util.f90 | 262 ++++++++++++++++++++++++++++++ src/fraggle/fraggle_io.f90 | 100 ++++++------ src/io/io.f90 | 101 ++++++------ src/main/swiftest_driver.f90 | 153 ++++++++--------- src/modules/encounter_classes.f90 | 55 +++++-- src/modules/fraggle_classes.f90 | 6 +- src/modules/swiftest_classes.f90 | 13 +- src/modules/symba_classes.f90 | 29 +--- src/netcdf/netcdf.f90 | 82 +++++----- src/setup/setup.f90 | 22 ++- src/symba/symba_collision.f90 | 6 +- src/symba/symba_io.f90 | 49 +----- src/symba/symba_step.f90 | 47 +++--- src/symba/symba_util.f90 | 247 +--------------------------- src/util/util_snapshot.f90 | 9 +- 17 files changed, 690 insertions(+), 666 deletions(-) diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 1e0be68bd..72782df84 100644 --- a/src/discard/discard.f90 +++ b/src/discard/discard.f90 @@ -38,8 +38,8 @@ module subroutine discard_system(self, param) call tp%discard(system, param) ltp_discards = (tp_discards%nbody > 0) end if - if (ltp_discards) call tp_discards%write_info(param%nc, param) - if (lpl_discards) call pl_discards%write_info(param%nc, param) + if (ltp_discards) call tp_discards%write_info(param%system_history%nc, param) + if (lpl_discards) call pl_discards%write_info(param%system_history%nc, param) if (lpl_discards .and. param%lenergy) call self%conservation_report(param, lterminal=.false.) if (lpl_check) call pl_discards%setup(0,param) if (ltp_check) call tp_discards%setup(0,param) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 0f821f49b..350f2f1d2 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -12,35 +12,49 @@ contains - module subroutine encounter_io_dump_collision_storage(self, param) + module subroutine encounter_io_dump_collision(self, param) !! author: David A. Minton !! !! Dumps the time history of an encounter to file. implicit none ! Arguments - class(collision_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(collision_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (fraggle_collision_snapshot) - param%ioutput = i - call snapshot%write_frame(self%nc,param) - end select - else - exit + select type(nc => self%nc) + class is (fraggle_io_parameters) + if (self%iframe > 0) then + nc%file_number = nc%file_number + 1 + nc%event_dimsize = self%iframe + call self%make_index_map() + write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number + call nc%initialize(param) + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (fraggle_collision_snapshot) + param%ioutput = i + call snapshot%write_frame(nc,param) + end select + else + exit + end if + end do + + call nc%close() + call self%reset() end if - end do + end select return - end subroutine encounter_io_dump_collision_storage + end subroutine encounter_io_dump_collision - module subroutine encounter_io_dump_storage(self, param) - !! author: David A. Minton + module subroutine encounter_io_dump_encounter(self, param) + ! author: David A. Minton !! !! Dumps the time history of an encounter to file. implicit none @@ -50,20 +64,34 @@ module subroutine encounter_io_dump_storage(self, param) ! Internals integer(I4B) :: i - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (encounter_snapshot) - param%ioutput = self%tmap(i) - call snapshot%write_frame(self%nc,param) - end select - else - exit + select type(nc => self%nc) + class is (encounter_io_parameters) + if (self%iframe > 0) then + ! Create and save the output files for this encounter and fragmentation + nc%file_number = nc%file_number + 1 + call self%make_index_map() + write(nc%file_name, '("encounter_",I0.6,".nc")') nc%file_number + call nc%initialize(param) + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (encounter_snapshot) + param%ioutput = self%tmap(i) + call snapshot%write_frame(nc,param) + end select + else + exit + end if + end do + + call nc%close() + call self%reset() end if - end do + end select return - end subroutine encounter_io_dump_storage + end subroutine encounter_io_dump_encounter module subroutine encounter_io_initialize(self, param) @@ -170,56 +198,59 @@ module subroutine encounter_io_write_frame(self, nc, param) use netcdf 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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(netcdf_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=:), allocatable :: charstring tslot = param%ioutput associate(pl => self%pl, tp => self%tp) + select type (nc) + class is (encounter_io_parameters) - 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" ) - - npl = pl%nbody - do i = 1, npl - idslot = pl%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) - - if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) - - if (param%lrotation) then - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) - end if - - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) - end do - - ntp = tp%nbody - do i = 1, ntp - idslot = tp%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) - - charstring = trim(adjustl(tp%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) - charstring = trim(adjustl(tp%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) - end do - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + 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" ) + + npl = pl%nbody + do i = 1, npl + idslot = pl%id(i) + 1 + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) + + if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) + + if (param%lrotation) then + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) + end if + + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) + end do + + ntp = tp%nbody + do i = 1, ntp + idslot = tp%id(i) + 1 + call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) + + charstring = trim(adjustl(tp%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) + charstring = trim(adjustl(tp%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) + end do + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end select end associate return diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index ef89b3cf3..45766a887 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -320,4 +320,266 @@ module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestru return end subroutine encounter_util_spill_list + + + subroutine encounter_util_save_collision(param, snapshot) + !! author: David A. Minton + !! + !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. + !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing every time you want to add an + !! encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff between performance (fewer resize calls) and memory managment + !! Memory usage grows by a factor of 2 each time it fills up, but no more. + implicit none + ! Arguments + class(symba_parameters), intent(inout) :: param !! SyMBA parameter object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + ! Internals + type(collision_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nnew, nold, nbig + + ! Advance the snapshot frame counter + param%collision_history%iframe = param%collision_history%iframe + 1 + + ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 + nnew = param%collision_history%iframe + nold = param%collision_history%nframes + + if (nnew > nold) then + nbig = nold + do while (nbig < nnew) + nbig = nbig * 2 + end do + allocate(collision_storage(nbig) :: tmp) + tmp%iframe = param%collision_history%iframe + call move_alloc(param%collision_history%nc, tmp%nc) + + do i = 1, nold + if (allocated(param%collision_history%frame(i)%item)) call move_alloc(param%collision_history%frame(i)%item, tmp%frame(i)%item) + end do + deallocate(param%collision_history) + call move_alloc(tmp,param%collision_history) + nnew = nbig + end if + + param%collision_history%frame(nnew) = snapshot + + return + end subroutine encounter_util_save_collision + + + subroutine encounter_util_save_encounter(param, snapshot, t) + !! author: David A. Minton + !! + !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. + !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing every time you want to add an + !! encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff between performance (fewer resize calls) and memory managment + !! Memory usage grows by a factor of 2 each time it fills up, but no more. + implicit none + ! Arguments + class(symba_parameters), intent(inout) :: param !! SyMBA parameter object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + real(DP), intent(in) :: t !! The time of the snapshot + ! Internals + type(encounter_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nnew, nold, nbig + + ! Advance the snapshot frame counter + param%encounter_history%iframe = param%encounter_history%iframe + 1 + + ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 + nnew = param%encounter_history%iframe + nold = param%encounter_history%nframes + + if (nnew > nold) then + nbig = nold + do while (nbig < nnew) + nbig = nbig * 2 + end do + allocate(encounter_storage(nbig) :: tmp) + tmp%iframe = param%encounter_history%iframe + call move_alloc(param%encounter_history%nc, tmp%nc) + + do i = 1, nold + if (allocated(param%encounter_history%frame(i)%item)) call move_alloc(param%encounter_history%frame(i)%item, tmp%frame(i)%item) + end do + deallocate(param%encounter_history) + call move_alloc(tmp,param%encounter_history) + nnew = nbig + end if + + ! Find out which time slot this belongs in by searching for an existing slot + ! with the same value of time or the first available one + param%encounter_history%frame(nnew) = snapshot + + return + end subroutine encounter_util_save_encounter + + + module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) + !! author: David A. Minton + !! + !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! can be played back through the encounter + implicit none + ! Internals + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + ! Arguments + class(fraggle_collision_snapshot), allocatable :: snapshot + type(symba_pl) :: pl + character(len=:), allocatable :: stage + integer(I4B) :: i,j + + + if (present(arg)) then + stage = arg + else + stage = "" + end if + + select type (system) + class is (symba_nbody_system) + + select case(stage) + case("before") + ! Saves the states of the bodies involved in the collision before the collision is resolved + associate (idx => system%colliders%idx, ncoll => system%colliders%ncoll) + call pl%setup(ncoll, param) + pl%id(:) = system%pl%id(idx(:)) + pl%Gmass(:) = system%pl%Gmass(idx(:)) + pl%radius(:) = system%pl%radius(idx(:)) + pl%rot(:,:) = system%pl%rot(:,idx(:)) + pl%Ip(:,:) = system%pl%Ip(:,idx(:)) + pl%rh(:,:) = system%pl%rh(:,idx(:)) + pl%vh(:,:) = system%pl%vh(:,idx(:)) + pl%info(:) = system%pl%info(idx(:)) + !end select + allocate(system%colliders%pl, source=pl) + end associate + case("after") + allocate(fraggle_collision_snapshot :: snapshot) + allocate(snapshot%colliders, source=system%colliders) + allocate(snapshot%fragments, source=system%fragments) + select type (param) + class is (symba_parameters) + call encounter_util_save_collision(param,snapshot) + end select + case default + write(*,*) "encounter_util_snapshot_collision requies either 'before' or 'after' passed to 'arg'" + end select + + end select + + return + end subroutine encounter_util_snapshot_collision + + + module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) + !! author: David A. Minton + !! + !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! can be played back through the encounter + implicit none + ! Internals + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + ! Arguments + class(encounter_snapshot), allocatable :: snapshot + integer(I4B) :: i, npl_snap, ntp_snap + + if (.not.present(t)) then + write(*,*) "encounter_util_snapshot_encounter requires `t` to be passed" + end if + select type (system) + class is (symba_nbody_system) + select type(pl => system%pl) + class is (symba_pl) + select type (tp => system%tp) + class is (symba_tp) + associate(npl => pl%nbody, ntp => tp%nbody) + + allocate(encounter_snapshot :: snapshot) + snapshot%t = t + snapshot%iloop = param%iloop + + if (npl + ntp == 0) return + npl_snap = npl + ntp_snap = ntp + + allocate(snapshot%pl, mold=pl) + allocate(snapshot%tp, mold=tp) + select type(pl_snap => snapshot%pl) + class is (symba_pl) + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec + npl_snap = count(pl%lmask(1:npl)) + end if + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec + ntp_snap = count(tp%lmask(1:ntp)) + end if + pl_snap%nbody = npl_snap + end select + + select type(pl_snap => snapshot%pl) + class is (symba_pl) + ! Take snapshot of the currently encountering massive bodies + if (npl_snap > 0) then + call pl_snap%setup(npl_snap, param) + pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) + pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) + do i = 1, NDIM + pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) + end do + if (param%lclose) then + pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if + + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + end do + end if + call pl_snap%sort("id", ascending=.true.) + end if + end select + + select type(tp_snap => snapshot%tp) + class is (symba_tp) + ! Take snapshot of the currently encountering test particles + tp_snap%nbody = ntp_snap + if (ntp_snap > 0) then + call tp_snap%setup(ntp_snap, param) + tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + do i = 1, NDIM + tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + end select + end associate + ! Save the snapshot + select type(param) + class is (symba_parameters) + param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap + call encounter_util_save_encounter(param,snapshot,t) + end select + end select + end select + end select + + return + end subroutine encounter_util_snapshot_encounter + end submodule s_encounter_util \ No newline at end of file diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 4f5fec19b..d4a8d3d9e 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -155,64 +155,66 @@ module subroutine fraggle_io_write_frame(self, nc, param) use netcdf implicit none ! Arguments - class(fraggle_collision_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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(netcdf_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, eslot, idslot, old_mode, npl, stage character(len=:), allocatable :: charstring class(swiftest_pl), allocatable :: pl associate(colliders => self%colliders, fragments => self%fragments) - eslot = param%ioutput select type(nc) - class is (fraggle_io_parameters) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) - - charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) - call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) - call check( nf90_put_var(nc%id, nc%Qloss_varid, fragments%Qloss, start=[eslot] ), "fraggle_io_write_frame nf90_put_var Qloss_varid" ) - - do stage = 1,2 - if (allocated(pl)) deallocate(pl) - select case(stage) - case(1) - allocate(pl, source=colliders%pl) - case(2) - allocate(pl, source=fragments%pl) - end select - npl = pl%nbody - do i = 1, npl - idslot = pl%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) - call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) + class is (encounter_io_parameters) + eslot = param%ioutput + select type(nc) + class is (fraggle_io_parameters) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) + + charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) + call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) + call check( nf90_put_var(nc%id, nc%Qloss_varid, fragments%Qloss, start=[eslot] ), "fraggle_io_write_frame nf90_put_var Qloss_varid" ) + + do stage = 1,2 + if (allocated(pl)) deallocate(pl) + select case(stage) + case(1) + allocate(pl, source=colliders%pl) + case(2) + allocate(pl, source=fragments%pl) + end select + npl = pl%nbody + do i = 1, npl + idslot = pl%id(i) + 1 + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) + end do end do - end do - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end select end select - - end associate + end associate return end subroutine fraggle_io_write_frame diff --git a/src/io/io.f90 b/src/io/io.f90 index 3d694e027..af4b30442 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -130,7 +130,7 @@ module subroutine io_conservation_report(self, param, lterminal) "; D(Eorbit+Ecollisions)/|E0| = ", ES12.5, & "; DM/M0 = ", ES12.5)' - associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit) + associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit, nc => param%system_history%nc) call pl%vb2vh(cb) call pl%xh2xb(cb) @@ -177,8 +177,8 @@ module subroutine io_conservation_report(self, param, lterminal) write(*,*) "Severe error! Mass not conserved! Halting!" ! Save the frame of data to the bin file in the slot just after the present one for diagnostics param%ioutput = param%ioutput + 1 - call self%write_frame(param%nc, param) - call param%nc%close() + call self%write_frame(nc, param) + call nc%close() call util_exit(FAILURE) end if end if @@ -246,20 +246,22 @@ module subroutine io_dump_system(self, param) dump_param%out_stat = 'APPEND' dump_param%in_type = "NETCDF_DOUBLE" dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) - dump_param%nc%id_chunk = self%pl%nbody + self%tp%nbody - dump_param%nc%time_chunk = 1 - dump_param%tstart = self%t - - call dump_param%dump(param_file_name) - - dump_param%out_form = "XV" - 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) - call dump_param%nc%close() - ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - call param%nc%flush(param) + associate(nc => dump_param%system_history%nc) + nc%id_chunk = self%pl%nbody + self%tp%nbody + nc%time_chunk = 1 + dump_param%tstart = self%t + + call dump_param%dump(param_file_name) + + dump_param%out_form = "XV" + nc%file_name = trim(adjustl(DUMP_NC_FILE(idx))) + dump_param%ioutput = 1 + call nc%initialize(dump_param) + call self%write_frame(nc, dump_param) + call nc%close() + ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) + call nc%flush(param) + end associate idx = idx + 1 if (idx > NDUMPFILES) idx = 1 @@ -267,14 +269,13 @@ module subroutine io_dump_system(self, param) ! Dump the encounter history if necessary select type(param) class is (symba_parameters) - if (param%lencounter_save) then - select type(self) - class is (symba_nbody_system) - call self%dump_encounter(param) - end select - end if + call param%encounter_history%dump(param) + call param%collision_history%dump(param) end select + ! Dump the system history to file + call param%system_history%dump(param) + return end subroutine io_dump_system @@ -1314,13 +1315,13 @@ module subroutine io_read_in_system(self, param) self%Euntracked = param%Euntracked else allocate(tmp_param, source=param) - tmp_param%nc%file_name = param%in_netcdf + tmp_param%system_history%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 tmp_param%lenergy = .false. end if - ierr = self%read_frame(tmp_param%nc, tmp_param) + ierr = self%read_frame(tmp_param%system_history%nc, tmp_param) deallocate(tmp_param) if (ierr /=0) call util_exit(FAILURE) end if @@ -1549,32 +1550,34 @@ module subroutine io_write_frame_system(self, param) character(len=STRMAX) :: errmsg logical :: fileExists - 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) - - select case(param%out_stat) - case('APPEND') - if (.not.fileExists) then - errmsg = param%outfile // " not found! You must specify OUT_STAT = NEW, REPLACE, or UNKNOWN" - goto 667 - end if - case('NEW') - if (fileExists) then - errmsg = param%outfile // " Alread Exists! You must specify OUT_STAT = APPEND, REPLACE, or UNKNOWN" - goto 667 - end if - call param%nc%initialize(param) - case('REPLACE', 'UNKNOWN') - call param%nc%initialize(param) - end select + associate (nc => param%system_history%nc, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) + nc%id_chunk = npl + ntp + nc%time_chunk = max(param%dump_cadence / param%istep_out, 1) + nc%file_name = param%outfile + if (lfirst) then + inquire(file=param%outfile, exist=fileExists) + + select case(param%out_stat) + case('APPEND') + if (.not.fileExists) then + errmsg = param%outfile // " not found! You must specify OUT_STAT = NEW, REPLACE, or UNKNOWN" + goto 667 + end if + case('NEW') + if (fileExists) then + errmsg = param%outfile // " Alread Exists! You must specify OUT_STAT = APPEND, REPLACE, or UNKNOWN" + goto 667 + end if + call nc%initialize(param) + case('REPLACE', 'UNKNOWN') + call nc%initialize(param) + end select - lfirst = .false. - end if + lfirst = .false. + end if - call self%write_frame(param%nc, param) + call self%write_frame(nc, param) + end associate return diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 803ca6849..cab6d4aca 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -21,7 +21,7 @@ program swiftest_driver class(swiftest_nbody_system), allocatable :: system !! Polymorphic object containing the nbody system to be integrated class(swiftest_parameters), allocatable :: param !! Run configuration parameters character(len=:), allocatable :: integrator !! Integrator type code (see swiftest_globals for symbolic names) - character(len=:),allocatable :: param_file_name !! Name of the file containing user-defined parameters + character(len=:), allocatable :: param_file_name !! Name of the file containing user-defined parameters character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" integer(I8B) :: istart !! Starting index for loop counter integer(I8B) :: nloops !! Number of steps to take in the simulation @@ -38,7 +38,7 @@ program swiftest_driver character(len=64) :: pbarmessage character(*), parameter :: symbacompactfmt = '(";NPLM",ES22.15,$)' - type(swiftest_storage(nframes=:)), allocatable :: system_history + !type(swiftest_storage(nframes=:)), allocatable :: system_history call io_get_args(integrator, param_file_name, display_style) @@ -73,7 +73,6 @@ program swiftest_driver ! Set up system storage for intermittent file dumps if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) - allocate(swiftest_storage(dump_cadence) :: system_history) ! Construct the main n-body system using the user-input integrator to choose the type of system call setup_construct_system(system, param) @@ -88,84 +87,86 @@ program swiftest_driver call system%initialize(param) - ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. - if (param%lrestart) then - if (param%lenergy) call system%conservation_report(param, lterminal=.true.) - else - if (param%lenergy) call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum - call system_history%take_snapshot(system) - call system_history%dump(param) - end if - call system%dump(param) - - write(display_unit, *) " *************** Main Loop *************** " - - if (display_style == "PROGRESS") then - call pbar%reset(nloops) - write(pbarmessage,fmt=pbarfmt) t0, tstop - call pbar%update(1,message=pbarmessage) - else if (display_style == "COMPACT") then - write(*,*) "SWIFTEST START " // param%integrator - call system%compact_output(param,integration_timer) - end if - - iout = 0 - idump = 0 - system%t = tstart - do iloop = istart, nloops - !> Step the system forward in time - call integration_timer%start() - call system%step(param, system%t, dt) - call integration_timer%stop() - - system%t = t0 + iloop * dt - - !> Evaluate any discards or collisional outcomes - call system%discard(param) - if (display_style == "PROGRESS") call pbar%update(iloop) - - !> If the loop counter is at the output cadence value, append the data file with a single frame - if (istep_out > 0) then - iout = iout + 1 - if (iout == istep_out) then - iout = 0 - idump = idump + 1 - call system_history%take_snapshot(system) - - if (idump == dump_cadence) then - idump = 0 - call system%dump(param) - call system_history%dump(param) - end if + associate (system_history => param%system_history) + ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. + if (param%lrestart) then + if (param%lenergy) call system%conservation_report(param, lterminal=.true.) + else + if (param%lenergy) call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum + call system_history%take_snapshot(param,system) + call system_history%dump(param) + end if + call system%dump(param) - tfrac = (system%t - t0) / (tstop - t0) - - select type(pl => system%pl) - class is (symba_pl) - write(display_unit, symbastatfmt) system%t, tfrac, pl%nplm, pl%nbody, system%tp%nbody - class default - write(display_unit, statusfmt) system%t, tfrac, pl%nbody, system%tp%nbody - end select - if (param%lenergy) call system%conservation_report(param, lterminal=.true.) - call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) - - if (display_style == "PROGRESS") then - write(pbarmessage,fmt=pbarfmt) system%t, tstop - call pbar%update(1,message=pbarmessage) - else if (display_style == "COMPACT") then - call system%compact_output(param,integration_timer) - end if + write(display_unit, *) " *************** Main Loop *************** " - call integration_timer%reset() + if (display_style == "PROGRESS") then + call pbar%reset(nloops) + write(pbarmessage,fmt=pbarfmt) t0, tstop + call pbar%update(1,message=pbarmessage) + else if (display_style == "COMPACT") then + write(*,*) "SWIFTEST START " // param%integrator + call system%compact_output(param,integration_timer) + end if + iout = 0 + idump = 0 + system%t = tstart + do iloop = istart, nloops + !> Step the system forward in time + call integration_timer%start() + call system%step(param, system%t, dt) + call integration_timer%stop() + + system%t = t0 + iloop * dt + + !> Evaluate any discards or collisional outcomes + call system%discard(param) + if (display_style == "PROGRESS") call pbar%update(iloop) + + !> If the loop counter is at the output cadence value, append the data file with a single frame + if (istep_out > 0) then + iout = iout + 1 + if (iout == istep_out) then + iout = 0 + idump = idump + 1 + call system_history%take_snapshot(param,system) + + if (idump == dump_cadence) then + idump = 0 + call system%dump(param) + + end if + + tfrac = (system%t - t0) / (tstop - t0) + + select type(pl => system%pl) + class is (symba_pl) + write(display_unit, symbastatfmt) system%t, tfrac, pl%nplm, pl%nbody, system%tp%nbody + class default + write(display_unit, statusfmt) system%t, tfrac, pl%nbody, system%tp%nbody + end select + if (param%lenergy) call system%conservation_report(param, lterminal=.true.) + call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) + + if (display_style == "PROGRESS") then + write(pbarmessage,fmt=pbarfmt) system%t, tstop + call pbar%update(1,message=pbarmessage) + else if (display_style == "COMPACT") then + call system%compact_output(param,integration_timer) + end if + + call integration_timer%reset() + + end if end if - end if - end do - ! Dump any remaining history if it exists - call system%dump(param) - call system_history%dump(param) - if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator + end do + ! Dump any remaining history if it exists + call system%dump(param) + call system_history%dump(param) + if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator + end associate end associate call util_exit(SUCCESS) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index b1b7bb079..d339b6660 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -64,24 +64,24 @@ module encounter_classes procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object end type encounter_io_parameters - !> 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 - contains - procedure :: dump => encounter_io_dump_storage !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: encounter_util_final_storage - end type encounter_storage - !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: collision_storage - class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains - procedure :: dump => encounter_io_dump_collision_storage !! Dumps contents of encounter history to file + procedure :: dump => encounter_io_dump_collision !! Dumps contents of encounter history to file procedure :: make_index_map => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: take_snapshot => encounter_util_snapshot_collision !! Take a minimal snapshot of the system through an encounter final :: encounter_util_final_collision_storage end type collision_storage + !> A class that that is used to store simulation history data between file output + type, extends(swiftest_storage) :: encounter_storage + contains + procedure :: dump => encounter_io_dump_encounter !! Dumps contents of encounter history to file + procedure :: make_index_map => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: take_snapshot => encounter_util_snapshot_encounter !! Take a minimal snapshot of the system through an encounter + final :: encounter_util_final_storage + end type encounter_storage + type encounter_bounding_box_1D integer(I4B) :: n !! Number of bodies with extents integer(I4B), dimension(:), allocatable :: ind !! Sorted minimum/maximum extent indices (value > n indicates an ending index) @@ -214,17 +214,17 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, x, v, renc, dt logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical array indicating which pairs are approaching end subroutine encounter_check_sweep_aabb_single_list - module subroutine encounter_io_dump_collision_storage(self, param) + module subroutine encounter_io_dump_collision(self, param) implicit none class(collision_storage(*)), intent(inout) :: self !! Collision storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_io_dump_collision_storage + end subroutine encounter_io_dump_collision - module subroutine encounter_io_dump_storage(self, param) + module subroutine encounter_io_dump_encounter(self, param) implicit none class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_io_dump_storage + end subroutine encounter_io_dump_encounter module subroutine encounter_io_initialize(self, param) implicit none @@ -234,9 +234,9 @@ 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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(netcdf_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 module subroutine encounter_setup_aabb(self, n, n_last) @@ -316,6 +316,25 @@ module subroutine encounter_util_resize_list(self, nnew) integer(I8B), intent(in) :: nnew !! New size of list needed end subroutine encounter_util_resize_list + module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + end subroutine encounter_util_snapshot_collision + + module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) + implicit none + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + end subroutine encounter_util_snapshot_encounter + + module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 8d8e1c33e..2bd120b83 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -160,9 +160,9 @@ end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) implicit none - class(fraggle_collision_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(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(netcdf_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_pl(pl, param) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 4894e305d..b89e9eee8 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -162,6 +162,7 @@ module swiftest_classes integer(I4B) :: nt !! Number of unique time values in all saved snapshots real(DP), dimension(:), allocatable :: tvals !! The set of unique time values contained in the snapshots integer(I4B), dimension(:), allocatable :: tmap !! The t value -> index map + class(netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object contains procedure :: dump => io_dump_storage !! Dumps storage object contents to file procedure :: make_index_map => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id @@ -255,8 +256,7 @@ module swiftest_classes logical :: lgr = .false. !! Turn on GR logical :: lyarkovsky = .false. !! Turn on Yarkovsky effect logical :: lyorp = .false. !! Turn on YORP effect - - type(netcdf_parameters) :: nc !! Object containing NetCDF parameters + type(swiftest_storage(nframes=:)), allocatable :: system_history contains procedure :: reader => io_param_reader procedure :: writer => io_param_writer @@ -1692,10 +1692,13 @@ module subroutine util_set_rhill_approximate(self,cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object end subroutine util_set_rhill_approximate - module subroutine util_snapshot_system(self, system) + module subroutine util_snapshot_system(self, param, system, t, arg) implicit none - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object to store + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) end subroutine util_snapshot_system end interface diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index ff2597b5f..3dbcfb90f 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -33,6 +33,8 @@ module symba_classes character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved character(STRMAX) :: collision_save = "NONE" !! Indicate if and how fragmentation data should be saved logical :: lencounter_save = .false. !! Turns on encounter saving + type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file + type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file contains procedure :: reader => symba_io_param_reader procedure :: writer => symba_io_param_writer @@ -191,8 +193,6 @@ module symba_classes integer(I4B) :: irec !! System recursion level class(fraggle_colliders), allocatable :: colliders !! Fraggle colliders object class(fraggle_fragments), allocatable :: fragments !! Fraggle fragmentation system object - type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file - type(collision_storage(nframes=:)), allocatable :: collision_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 procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps @@ -201,9 +201,6 @@ module symba_classes procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step - procedure :: encounter_snap => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter - procedure :: collision_snap => symba_util_take_collision_snapshot !! Take a minimal snapshot of the system before and after a collision - procedure :: dump_encounter => symba_io_dump_encounter !! Saves the encounter and/or fragmentation data to file(s) final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system @@ -373,22 +370,6 @@ module subroutine symba_util_set_renc(self, scale) integer(I4B), intent(in) :: scale !! Current recursion depth end subroutine symba_util_set_renc - module subroutine symba_util_take_collision_snapshot(self, param, t, stage) - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - character(*), intent(in) :: stage !! Either before or afte - end subroutine symba_util_take_collision_snapshot - - module subroutine symba_util_take_encounter_snapshot(self, param, t) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - end subroutine symba_util_take_encounter_snapshot - module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) implicit none class(symba_parameters), intent(inout) :: self !! Current run configuration parameters with SyMBA additionss @@ -411,12 +392,6 @@ module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, ioms character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 end subroutine symba_io_param_writer - module subroutine symba_io_dump_encounter(self, param) - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_io_dump_encounter - module subroutine symba_io_write_discard(self, param) use swiftest_classes, only : swiftest_parameters implicit none diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 9bc945227..42e2a2ea6 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -80,63 +80,65 @@ module function netcdf_get_old_t_final_system(self, param) result(old_t_final) real(DP), dimension(NDIM) :: rot0, Ip0, Lnow real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig - call param%nc%open(param) - call check( nf90_inquire_dimension(param%nc%id, param%nc%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) - call check( nf90_inquire_dimension(param%nc%id, param%nc%id_dimid, len=idmax), "netcdf_get_old_t_final_system id_dimid" ) - allocate(vals(idmax)) - call check( nf90_get_var(param%nc%id, param%nc%time_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) + associate (nc => param%system_history%nc) + call nc%open(param) + call check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) + call check( nf90_inquire_dimension(nc%id, nc%id_dimid, len=idmax), "netcdf_get_old_t_final_system id_dimid" ) + allocate(vals(idmax)) + call check( nf90_get_var(nc%id, nc%time_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) - !old_t_final = rtemp(1) - old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart + !old_t_final = rtemp(1) + old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart - if (param%lenergy) then - call check( nf90_get_var(param%nc%id, param%nc%KE_orb_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_orb_varid" ) - KE_orb_orig = rtemp(1) + if (param%lenergy) then + call check( nf90_get_var(nc%id, nc%KE_orb_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_orb_varid" ) + KE_orb_orig = rtemp(1) - call check( nf90_get_var(param%nc%id, param%nc%KE_spin_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_spin_varid" ) - KE_spin_orig = rtemp(1) + call check( nf90_get_var(nc%id, nc%KE_spin_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_spin_varid" ) + KE_spin_orig = rtemp(1) - call check( nf90_get_var(param%nc%id, param%nc%PE_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system PE_varid" ) - PE_orig = rtemp(1) + call check( nf90_get_var(nc%id, nc%PE_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system PE_varid" ) + PE_orig = rtemp(1) - call check( nf90_get_var(param%nc%id, param%nc%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_get_old_t_final_system Ecollisions_varid" ) - call check( nf90_get_var(param%nc%id, param%nc%Euntracked_varid, self%Euntracked, start=[1]), "netcdf_get_old_t_final_system Euntracked_varid" ) + call check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_get_old_t_final_system Ecollisions_varid" ) + call check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[1]), "netcdf_get_old_t_final_system Euntracked_varid" ) - self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + self%Ecollisions + self%Euntracked + self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + self%Ecollisions + self%Euntracked - call check( nf90_get_var(param%nc%id, param%nc%L_orb_varid, self%Lorbit_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system L_orb_varid" ) - call check( nf90_get_var(param%nc%id, param%nc%L_spin_varid, self%Lspin_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system L_spin_varid" ) - call check( nf90_get_var(param%nc%id, param%nc%L_escape_varid, self%Lescape(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system L_escape_varid" ) + call check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system L_orb_varid" ) + call check( nf90_get_var(nc%id, nc%L_spin_varid, self%Lspin_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system L_spin_varid" ) + call check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system L_escape_varid" ) - self%Ltot_orig(:) = self%Lorbit_orig(:) + self%Lspin_orig(:) + self%Lescape(:) + self%Ltot_orig(:) = self%Lorbit_orig(:) + self%Lspin_orig(:) + self%Lescape(:) - call check( nf90_get_var(param%nc%id, param%nc%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "netcdf_get_old_t_final_system Gmass_varid" ) - call check( nf90_get_var(param%nc%id, param%nc%GMescape_varid, self%GMescape, start=[1]), "netcdf_get_old_t_final_system GMescape_varid" ) - self%GMtot_orig = vals(1) + sum(vals(2:idmax), vals(2:idmax) == vals(2:idmax)) + self%GMescape + call check( nf90_get_var(nc%id, nc%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "netcdf_get_old_t_final_system Gmass_varid" ) + call check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[1]), "netcdf_get_old_t_final_system GMescape_varid" ) + self%GMtot_orig = vals(1) + sum(vals(2:idmax), vals(2:idmax) == vals(2:idmax)) + self%GMescape - select type(cb => self%cb) - class is (symba_cb) - cb%GM0 = vals(1) - cb%dGM = cb%Gmass - cb%GM0 + select type(cb => self%cb) + class is (symba_cb) + cb%GM0 = vals(1) + cb%dGM = cb%Gmass - cb%GM0 - call check( nf90_get_var(param%nc%id, param%nc%radius_varid, rtemp, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system radius_varid" ) - cb%R0 = rtemp(1) + call check( nf90_get_var(nc%id, nc%radius_varid, rtemp, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system radius_varid" ) + cb%R0 = rtemp(1) - if (param%lrotation) then + if (param%lrotation) then - call check( nf90_get_var(param%nc%id, param%nc%rot_varid, rot0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_get_old_t_final_system rot_varid" ) - call check( nf90_get_var(param%nc%id, param%nc%Ip_varid, Ip0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_get_old_t_final_system Ip_varid" ) + call check( nf90_get_var(nc%id, nc%rot_varid, rot0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_get_old_t_final_system rot_varid" ) + call check( nf90_get_var(nc%id, nc%Ip_varid, Ip0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_get_old_t_final_system Ip_varid" ) - cb%L0(:) = Ip0(3) * cb%GM0 * cb%R0**2 * rot0(:) + cb%L0(:) = Ip0(3) * cb%GM0 * cb%R0**2 * rot0(:) - Lnow(:) = cb%Ip(3) * cb%Gmass * cb%radius**2 * cb%rot(:) - cb%dL(:) = Lnow(:) - cb%L0(:) - end if - end select + Lnow(:) = cb%Ip(3) * cb%Gmass * cb%radius**2 * cb%rot(:) + cb%dL(:) = Lnow(:) - cb%L0(:) + end if + end select - end if + end if - deallocate(vals) + deallocate(vals) + end associate return end function netcdf_get_old_t_final_system diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index a107179a1..64c63b390 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -21,6 +21,10 @@ module subroutine setup_construct_system(system, param) class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object class(swiftest_parameters), intent(inout) :: param !! Swiftest parameters + allocate(swiftest_storage(param%dump_cadence) :: param%system_history) + allocate(netcdf_parameters :: param%system_history%nc) + call param%system_history%reset() + select case(param%integrator) case (BS) write(*,*) 'Bulirsch-Stoer integrator not yet enabled' @@ -72,8 +76,8 @@ module subroutine setup_construct_system(system, param) select type(param) class is (symba_parameters) if (param%lencounter_save) then - allocate(encounter_storage :: system%encounter_history) - associate (encounter_history => system%encounter_history) + allocate(encounter_storage :: param%encounter_history) + associate (encounter_history => param%encounter_history) allocate(encounter_io_parameters :: encounter_history%nc) call encounter_history%reset() select type(nc => encounter_history%nc) @@ -81,9 +85,9 @@ module subroutine setup_construct_system(system, param) nc%file_number = param%iloop / param%dump_cadence end select end associate - - allocate(collision_storage :: system%collision_history) - associate (collision_history => system%collision_history) + + allocate(collision_storage :: param%collision_history) + associate (collision_history => param%collision_history) allocate(fraggle_io_parameters :: collision_history%nc) call collision_history%reset() select type(nc => collision_history%nc) @@ -93,6 +97,8 @@ module subroutine setup_construct_system(system, param) end associate end if end select + + end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' @@ -101,6 +107,10 @@ module subroutine setup_construct_system(system, param) call util_exit(FAILURE) end select + + + + return end subroutine setup_construct_system @@ -116,7 +126,7 @@ module subroutine setup_finalize_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters associate(system => self) - call param%nc%close() + call param%system_history%nc%close() end associate return diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 95d0dcf4f..ab2962054 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -885,7 +885,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) logical :: lgoodcollision integer(I4B) :: i - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, t => system%t) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, t => system%t, collision_history => param%collision_history) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) @@ -900,7 +900,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) call system%colliders%regime(system%fragments, system, param) - if (param%lencounter_save) call system%collision_snap(param, t, "before") + if (param%lencounter_save) call collision_history%take_snapshot(param,system, t, "before") select case (system%fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param) @@ -912,7 +912,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) end select - if (param%lencounter_save) call system%collision_snap(param, t, "after") + if (param%lencounter_save) call collision_history%take_snapshot(param,system, t, "after") deallocate(system%colliders,system%fragments) end do end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index d1f36abca..18b56767e 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -12,51 +12,6 @@ contains - module subroutine symba_io_dump_encounter(self, param) - !! author: David A. Minton - !! - !! Saves the encounter and/or fragmentation data to file with the name of the current output interval number attached - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - - - associate(encounter_history => self%encounter_history, num_enc_frames => self%encounter_history%iframe,& - collision_history => self%collision_history, num_coll_frames => self%collision_history%iframe) - - select type(nce => self%encounter_history%nc) - class is (encounter_io_parameters) - if (num_enc_frames > 0) then - ! Create and save the output files for this encounter and fragmentation - nce%file_number = nce%file_number + 1 - call encounter_history%make_index_map() - write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number - call nce%initialize(param) - call encounter_history%dump(param) - call nce%close() - call encounter_history%reset() - end if - end select - - select type(ncc => self%collision_history%nc) - class is (fraggle_io_parameters) - if (num_coll_frames > 0) then - ncc%file_number = ncc%file_number + 1 - ncc%event_dimsize = num_coll_frames - call collision_history%make_index_map() - write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number - call ncc%initialize(param) - call collision_history%dump(param) - call ncc%close() - call collision_history%reset() - end if - end select - end associate - - return - end subroutine symba_io_dump_encounter - module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott @@ -246,12 +201,12 @@ module subroutine symba_io_write_discard(self, param) associate(pl => self%pl, npl => self%pl%nbody, pl_adds => self%pl_adds) - if (self%tp_discards%nbody > 0) call self%tp_discards%write_info(param%nc, param) + if (self%tp_discards%nbody > 0) call self%tp_discards%write_info(param%system_history%nc, param) select type(pl_discards => self%pl_discards) class is (symba_merger) if (pl_discards%nbody == 0) return - call pl_discards%write_info(param%nc, param) + call pl_discards%write_info(param%system_history%nc, param) end select end associate diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index dc303b4f7..54e2464d1 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -34,17 +34,19 @@ module subroutine symba_step_system(self, param, t, dt) class is (symba_tp) select type(param) class is (symba_parameters) - call self%reset(param) - lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) - if (lencounter) then - if (param%lencounter_save) call self%encounter_snap(param, t) - call self%interp(param, t, dt) - if (param%lencounter_save) call self%encounter_snap(param, t+dt) - else - self%irec = -1 - call helio_step_system(self, param, t, dt) - end if - param%lfirstkick = pl%lfirst + associate(encounter_history => param%encounter_history) + call self%reset(param) + lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) + if (lencounter) then + if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t) + call self%interp(param, t, dt) + if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t+dt) + else + self%irec = -1 + call helio_step_system(self, param, t, dt) + end if + param%lfirstkick = pl%lfirst + end associate end select end select end select @@ -180,14 +182,15 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) real(DP) :: dtl, dth logical :: lencounter - associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list, & - lplpl_collision => self%plplenc_list%lcollision, lpltp_collision => self%pltpenc_list%lcollision) - select type(param) - class is (symba_parameters) - select type(pl => self%pl) - class is (symba_pl) - select type(tp => self%tp) - class is (symba_tp) + select type(param) + class is (symba_parameters) + select type(pl => self%pl) + class is (symba_pl) + select type(tp => self%tp) + class is (symba_tp) + associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list, & + lplpl_collision => self%plplenc_list%lcollision, lpltp_collision => self%pltpenc_list%lcollision, & + encounter_history => param%encounter_history) system%irec = ireci dtl = param%dt / (NTENC**ireci) dth = 0.5_DP * dtl @@ -244,15 +247,15 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) end if - if (param%lencounter_save) call system%encounter_snap(param, t+dtl) + if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t+dtl) call self%set_recur_levels(ireci) end do - end select + end associate end select end select - end associate + end select return end subroutine symba_step_recur_system diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 4381ce93b..9443d658c 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -667,7 +667,7 @@ module subroutine symba_util_rearray_pl(self, system, param) end where end select - call pl%write_info(param%nc, param) + call pl%write_info(param%system_history%nc, param) deallocate(ldump_mask) ! Reindex the new list of bodies @@ -868,100 +868,6 @@ module subroutine symba_util_resize_pl(self, nnew) return end subroutine symba_util_resize_pl - - subroutine symba_util_save_collision(system, snapshot) - !! author: David A. Minton - !! - !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. - !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing every time you want to add an - !! encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff between performance (fewer resize calls) and memory managment - !! Memory usage grows by a factor of 2 each time it fills up, but no more. - implicit none - ! Arguments - type(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object - ! Internals - type(collision_storage(nframes=:)), allocatable :: tmp - integer(I4B) :: i, nnew, nold, nbig - - ! Advance the snapshot frame counter - system%collision_history%iframe = system%collision_history%iframe + 1 - - ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = system%collision_history%iframe - nold = system%collision_history%nframes - - if (nnew > nold) then - nbig = nold - do while (nbig < nnew) - nbig = nbig * 2 - end do - allocate(collision_storage(nbig) :: tmp) - tmp%iframe = system%collision_history%iframe - call move_alloc(system%collision_history%nc, tmp%nc) - - do i = 1, nold - if (allocated(system%collision_history%frame(i)%item)) call move_alloc(system%collision_history%frame(i)%item, tmp%frame(i)%item) - end do - deallocate(system%collision_history) - call move_alloc(tmp,system%collision_history) - nnew = nbig - end if - - system%collision_history%frame(nnew) = snapshot - - return - end subroutine symba_util_save_collision - - - subroutine symba_util_save_encounter(system, snapshot, t) - !! author: David A. Minton - !! - !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. - !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing every time you want to add an - !! encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff between performance (fewer resize calls) and memory managment - !! Memory usage grows by a factor of 2 each time it fills up, but no more. - implicit none - ! Arguments - type(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object - real(DP), intent(in) :: t !! The time of the snapshot - ! Internals - type(encounter_storage(nframes=:)), allocatable :: tmp - integer(I4B) :: i, nnew, nold, nbig - - ! Advance the snapshot frame counter - system%encounter_history%iframe = system%encounter_history%iframe + 1 - - ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = system%encounter_history%iframe - nold = system%encounter_history%nframes - - if (nnew > nold) then - nbig = nold - do while (nbig < nnew) - nbig = nbig * 2 - end do - allocate(encounter_storage(nbig) :: tmp) - tmp%iframe = system%encounter_history%iframe - call move_alloc(system%encounter_history%nc, tmp%nc) - - 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) - end do - deallocate(system%encounter_history) - call move_alloc(tmp,system%encounter_history) - nnew = nbig - end if - - ! Find out which time slot this belongs in by searching for an existing slot - ! with the same value of time or the first available one - system%encounter_history%frame(nnew) = snapshot - - return - end subroutine symba_util_save_encounter - - module subroutine symba_util_resize_tp(self, nnew) !! author: David A. Minton !! @@ -1320,156 +1226,5 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_tp - module subroutine symba_util_take_collision_snapshot(self, param, t, stage) - !! author: David A. Minton - !! - !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories - !! can be played back through the encounter - implicit none - ! Internals - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - character(*), intent(in) :: stage !! Either before or after - ! Arguments - class(fraggle_collision_snapshot), allocatable :: snapshot - type(symba_pl) :: pl - integer(I4B) :: i,j - - select case(stage) - case("before") - ! Saves the states of the bodies involved in the collision before the collision is resolved - associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) - !allocate(symba_pl :: self%colliders%pl) - !select type(pl => self%colliders%pl) - !class is (symba_pl) - call pl%setup(ncoll, param) - pl%id(:) = self%pl%id(idx(:)) - pl%Gmass(:) = self%pl%Gmass(idx(:)) - pl%radius(:) = self%pl%radius(idx(:)) - pl%rot(:,:) = self%pl%rot(:,idx(:)) - pl%Ip(:,:) = self%pl%Ip(:,idx(:)) - pl%rh(:,:) = self%pl%rh(:,idx(:)) - pl%vh(:,:) = self%pl%vh(:,idx(:)) - pl%info(:) = self%pl%info(idx(:)) - !end select - allocate(self%colliders%pl, source=pl) - end associate - case("after") - allocate(fraggle_collision_snapshot :: snapshot) - allocate(snapshot%colliders, source=self%colliders) - allocate(snapshot%fragments, source=self%fragments) - call symba_util_save_collision(self,snapshot) - end select - - return - end subroutine symba_util_take_collision_snapshot - - - module subroutine symba_util_take_encounter_snapshot(self, param, t) - !! author: David A. Minton - !! - !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories - !! can be played back through the encounter - implicit none - ! Internals - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - ! Arguments - class(encounter_snapshot), allocatable :: snapshot - integer(I4B) :: i, npl_snap, ntp_snap - - associate(npl => self%pl%nbody, ntp => self%tp%nbody) - - allocate(encounter_snapshot :: snapshot) - snapshot%t = t - snapshot%iloop = param%iloop - - if (npl + ntp == 0) return - npl_snap = npl - ntp_snap = ntp - - select type (pl => self%pl) - class is (symba_pl) - select type (tp => self%tp) - class is (symba_tp) - allocate(symba_pl :: snapshot%pl) - allocate(symba_tp :: snapshot%tp) - - select type(pl_snap => snapshot%pl) - class is (symba_pl) - select type(tp_snap => snapshot%tp) - class is (symba_tp) - - if (npl > 0) then - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == self%irec - npl_snap = count(pl%lmask(1:npl)) - end if - if (ntp > 0) then - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == self%irec - ntp_snap = count(tp%lmask(1:ntp)) - end if - pl_snap%nbody = npl_snap - - ! Take snapshot of the currently encountering massive bodies - if (npl_snap > 0) then - allocate(pl_snap%id(npl_snap)) - allocate(pl_snap%info(npl_snap)) - allocate(pl_snap%Gmass(npl_snap)) - - allocate(pl_snap%levelg(npl_snap)) - pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) - pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) - pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) - pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) - allocate(pl_snap%rh(NDIM,npl_snap)) - allocate(pl_snap%vh(NDIM,npl_snap)) - do i = 1, NDIM - pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) - pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) - end do - if (param%lclose) then - allocate(pl_snap%radius(npl_snap)) - pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) - end if - - if (param%lrotation) then - allocate(pl_snap%Ip(NDIM,npl_snap)) - allocate(pl_snap%rot(NDIM,npl_snap)) - do i = 1, NDIM - pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) - pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) - end do - end if - call pl_snap%sort("id", ascending=.true.) - end if - - ! Take snapshot of the currently encountering test particles - tp_snap%nbody = ntp_snap - if (ntp_snap > 0) then - allocate(tp_snap%id(ntp_snap)) - allocate(tp_snap%info(ntp_snap)) - tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) - tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) - allocate(tp_snap%rh(NDIM,ntp_snap)) - allocate(tp_snap%vh(NDIM,ntp_snap)) - do i = 1, NDIM - tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) - tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) - end do - end if - end select - end select - - ! Save the snapshot - self%encounter_history%nid = self%encounter_history%nid + ntp_snap + npl_snap - call symba_util_save_encounter(self,snapshot,t) - end select - end select - end associate - - return - end subroutine symba_util_take_encounter_snapshot end submodule s_symba_util diff --git a/src/util/util_snapshot.f90 b/src/util/util_snapshot.f90 index 1c67bc7f8..c3a98855b 100644 --- a/src/util/util_snapshot.f90 +++ b/src/util/util_snapshot.f90 @@ -11,14 +11,17 @@ use swiftest contains - module subroutine util_snapshot_system(self, system) + module subroutine util_snapshot_system(self, param, system, t, arg) !! author: David A. Minton !! !! Takes a snapshot of the system for later file storage implicit none ! Arguments - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object to store + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) self%iframe = self%iframe + 1 self%nt = self%iframe From 69ebd88a506b6708de9a6f1e7357fca6cf74defd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 11 Dec 2022 17:33:32 -0500 Subject: [PATCH 44/63] Got rid of spurious flush command and simplified the driver a tad --- src/io/io.f90 | 2 -- src/main/swiftest_driver.f90 | 13 +++++++------ 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index af4b30442..062d0f70a 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -259,8 +259,6 @@ module subroutine io_dump_system(self, param) call nc%initialize(dump_param) call self%write_frame(nc, dump_param) call nc%close() - ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - call nc%flush(param) end associate idx = idx + 1 diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index cab6d4aca..ebd207e54 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -89,13 +89,14 @@ program swiftest_driver associate (system_history => param%system_history) ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. - if (param%lrestart) then - if (param%lenergy) call system%conservation_report(param, lterminal=.true.) - else - if (param%lenergy) call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum - call system_history%take_snapshot(param,system) - call system_history%dump(param) + if (param%lenergy) then + if (param%lrestart) then + call system%conservation_report(param, lterminal=.true.) + else + call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum + end if end if + call system_history%take_snapshot(param,system) call system%dump(param) write(display_unit, *) " *************** Main Loop *************** " From eb781b480c9296db8f32e99f7b7da7e590fdd270 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 11 Dec 2022 18:02:24 -0500 Subject: [PATCH 45/63] Refactored .enc to .encounters --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/simulation_class.py | 29 ++++++++++--------- 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 0e4a6c598..c7fc31299 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -90,7 +90,7 @@ def encounter_combiner(sim): # Only keep a minimal subset of necessary data from the simulation and encounter datasets keep_vars = ['rh','Gmass','radius'] data = sim.data[keep_vars] - enc = sim.enc[keep_vars].load() + enc = sim.encounters[keep_vars].load() # Remove any encounter data at the same time steps that appear in the data to prevent duplicates t_not_duplicate = ~enc['time'].isin(data['time']) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 2c2d10c98..ca11f121e 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -319,7 +319,8 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, self.param = {} self.data = xr.Dataset() self.ic = xr.Dataset() - self.enc = xr.Dataset() + self.encounters = xr.Dataset() + self.collision = xr.Dataset() self.simdir = Path(simdir) if self.simdir.exists(): @@ -2735,9 +2736,9 @@ def read_output_file(self,read_init_cond : bool = True): # results if "ENCOUNTER_SAVE" in self.param or "FRAGMENTATION_SAVE" in self.param: - read_encounter = self.param["ENCOUNTER_SAVE"] != "NONE" or self.param["FRAGMENTATION_SAVE"] != "NONE" + read_encounters = self.param["ENCOUNTER_SAVE"] != "NONE" or self.param["FRAGMENTATION_SAVE"] != "NONE" else: - read_encounter = False + read_encounters = False param_tmp = self.param.copy() param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": @@ -2752,8 +2753,8 @@ def read_output_file(self,read_init_cond : bool = True): self.ic = io.swiftest2xr(param_tmp, verbose=self.verbose) else: self.ic = self.data.isel(time=0) - if read_encounter: - self.read_encounter() + if read_encounters: + self.read_encounters() elif self.codename == "Swifter": self.data = io.swifter2xr(param_tmp, verbose=self.verbose) @@ -2764,9 +2765,9 @@ def read_output_file(self,read_init_cond : bool = True): warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) return - def read_encounter(self): + def read_encounters(self): if self.verbose: - print("Reading encounter history file as .enc") + print("Reading encounter history file as .encounters") enc_files = glob(f"{self.simdir}{os.path.sep}encounter_*.nc") enc_files.sort() @@ -2775,16 +2776,16 @@ def _preprocess(ds, param): return io.process_netcdf_input(ds,param) partial_func = partial(_preprocess, param=self.param) - self.enc = xr.open_mfdataset(enc_files,parallel=True,combine="nested",concat_dim="time",join="left",preprocess=partial_func,mask_and_scale=True) - self.enc = io.process_netcdf_input(self.enc, self.param) + self.encounters = xr.open_mfdataset(enc_files,parallel=True,combine="nested",concat_dim="time",join="left",preprocess=partial_func,mask_and_scale=True) + self.encounters = io.process_netcdf_input(self.encounters, self.param) # Remove any overlapping time values - tgood,tid = np.unique(self.enc.time,return_index=True) - self.enc = self.enc.isel(time=tid) + tgood,tid = np.unique(self.encounters.time,return_index=True) + self.encounters = self.encounters.isel(time=tid) # Reduce the dimensionality of variables that got expanded in the combine process - self.enc['loopnum'] = self.enc['loopnum'].max(dim="name") - self.enc['id'] = self.enc['id'].max(dim="time") - self.enc['particle_type'] = self.enc['particle_type'].max(dim="time") + self.encounters['loopnum'] = self.encounters['loopnum'].max(dim="name") + self.encounters['id'] = self.encounters['id'].max(dim="time") + self.encounters['particle_type'] = self.encounters['particle_type'].max(dim="time") return From 25acb8492bd2c949f6460840c1463f14d8db963a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 12 Dec 2022 08:03:56 -0500 Subject: [PATCH 46/63] Refactor --- src/encounter/encounter_io.f90 | 86 ++++++++++++++++--------------- src/encounter/encounter_util.f90 | 8 +-- src/modules/encounter_classes.f90 | 12 ++--- 3 files changed, 55 insertions(+), 51 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 350f2f1d2..265cfde5c 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -209,47 +209,51 @@ module subroutine encounter_io_write_frame(self, nc, param) associate(pl => self%pl, tp => self%tp) select type (nc) class is (encounter_io_parameters) - - 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" ) - - npl = pl%nbody - do i = 1, npl - idslot = pl%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) - - if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) - - if (param%lrotation) then - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) - end if - - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) - end do - - ntp = tp%nbody - do i = 1, ntp - idslot = tp%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) - - charstring = trim(adjustl(tp%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) - charstring = trim(adjustl(tp%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) - end do - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + select type (param) + class is (symba_parameters) + + 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" ) + + npl = pl%nbody + do i = 1, npl + idslot = pl%id(i) + 1 + idslot = param%encounter_history%idmap(pl%id(i)) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) + + if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) + + if (param%lrotation) then + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) + end if + + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) + end do + + ntp = tp%nbody + do i = 1, ntp + idslot = tp%id(i) + 1 + call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) + + charstring = trim(adjustl(tp%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) + charstring = trim(adjustl(tp%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) + end do + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end select end select end associate diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 45766a887..f5467b69f 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -180,7 +180,7 @@ module subroutine encounter_util_final_storage(self) end subroutine encounter_util_final_storage - module subroutine encounter_util_index_map_storage(self) + module subroutine encounter_util_index_map_encounter(self) !! author: David A. Minton !! !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id. @@ -229,11 +229,11 @@ module subroutine encounter_util_index_map_storage(self) self%nt = size(self%tvals) return - end subroutine encounter_util_index_map_storage + end subroutine encounter_util_index_map_encounter - module subroutine encounter_util_index_map_collision_storage(self) + module subroutine encounter_util_index_map_collision(self) !! author: David A. Minton !! !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id @@ -243,7 +243,7 @@ module subroutine encounter_util_index_map_collision_storage(self) ! Internals return - end subroutine encounter_util_index_map_collision_storage + end subroutine encounter_util_index_map_collision module subroutine encounter_util_resize_list(self, nnew) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index d339b6660..f9ed5b896 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -68,7 +68,7 @@ module encounter_classes type, extends(swiftest_storage) :: collision_storage contains procedure :: dump => encounter_io_dump_collision !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: make_index_map => encounter_util_index_map_collision !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id procedure :: take_snapshot => encounter_util_snapshot_collision !! Take a minimal snapshot of the system through an encounter final :: encounter_util_final_collision_storage end type collision_storage @@ -77,7 +77,7 @@ module encounter_classes type, extends(swiftest_storage) :: encounter_storage contains procedure :: dump => encounter_io_dump_encounter !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: make_index_map => encounter_util_index_map_encounter !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id procedure :: take_snapshot => encounter_util_snapshot_encounter !! Take a minimal snapshot of the system through an encounter final :: encounter_util_final_storage end type encounter_storage @@ -300,15 +300,15 @@ module subroutine encounter_util_final_storage(self) type(encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object end subroutine encounter_util_final_storage - module subroutine encounter_util_index_map_collision_storage(self) + module subroutine encounter_util_index_map_collision(self) implicit none class(collision_storage(*)), intent(inout) :: self !! E - end subroutine encounter_util_index_map_collision_storage + end subroutine encounter_util_index_map_collision - module subroutine encounter_util_index_map_storage(self) + module subroutine encounter_util_index_map_encounter(self) implicit none class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object - end subroutine encounter_util_index_map_storage + end subroutine encounter_util_index_map_encounter module subroutine encounter_util_resize_list(self, nnew) implicit none From 682b6f353576ab821954591fde88cc067214d9da Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 12 Dec 2022 08:37:47 -0500 Subject: [PATCH 47/63] Fixed encounter id indexing --- src/encounter/encounter_io.f90 | 133 ++++++++++++++++--------------- src/encounter/encounter_util.f90 | 2 +- 2 files changed, 69 insertions(+), 66 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 265cfde5c..bc3bfaac2 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -113,74 +113,77 @@ module subroutine encounter_io_initialize(self, param) integer(I4B) :: ndims, i associate(nc => self) - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select - - ! Check if the file exists, and if it does, delete it - inquire(file=nc%file_name, exist=fileExists) - if (fileExists) then - 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%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 - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - - ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) - - ! Variables - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) - if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) - end if - if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) - end if - - call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) + select type(param) + class is (symba_parameters) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE end select - end do - ! Take the file out of define mode - call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" ) + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + 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%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 + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, param%encounter_history%nid, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + + ! Dimension coordinates + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) + + ! Variables + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) + if (param%lclose) then + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) + end if + if (param%lrotation) then + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) + end if + + call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) + end select + end do - ! 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" ) + ! Take the file out of define mode + call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" ) - ! Pre-fill name slots with ids - call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "encounter_io_initialize nf90_put_var pl id_varid" ) + ! 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 name slots with ids + !call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "encounter_io_initialize nf90_put_var pl id_varid" ) + end select end associate return @@ -220,7 +223,7 @@ module subroutine encounter_io_write_frame(self, nc, param) npl = pl%nbody do i = 1, npl idslot = pl%id(i) + 1 - idslot = param%encounter_history%idmap(pl%id(i)) + idslot = findloc(param%encounter_history%idvals,pl%id(i),dim=1) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index f5467b69f..5c4212253 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -191,7 +191,7 @@ module subroutine encounter_util_index_map_encounter(self) ! Internals ! Internals integer(I4B) :: i, n, nold, nt - integer(I4B), dimension(:), allocatable :: idvals + integer(I4B), dimension(:), allocatable :: idvals, tmp real(DP), dimension(:), allocatable :: tvals if (self%nid == 0) return From 1b82c228d5f5829c7b83e0e9fd399743fd2cfb55 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 12 Dec 2022 12:39:48 -0500 Subject: [PATCH 48/63] Lots of fixes to indexing of encounters and collisions --- src/encounter/encounter_io.f90 | 160 ++++++++++++------------ src/encounter/encounter_util.f90 | 144 ++++++++++++++++----- src/fraggle/fraggle_io.f90 | 200 +++++++++++++++--------------- src/fraggle/fraggle_util.f90 | 36 +++++- src/modules/encounter_classes.f90 | 17 ++- src/modules/fraggle_classes.f90 | 15 ++- src/modules/swiftest_classes.f90 | 7 ++ src/util/util_index.f90 | 130 +++++++++++++------ 8 files changed, 447 insertions(+), 262 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index bc3bfaac2..09c2dd676 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -27,15 +27,17 @@ module subroutine encounter_io_dump_collision(self, param) class is (fraggle_io_parameters) if (self%iframe > 0) then nc%file_number = nc%file_number + 1 - nc%event_dimsize = self%iframe call self%make_index_map() + nc%event_dimsize = self%nt + nc%id_dimsize = self%nid + write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number call nc%initialize(param) do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) - class is (fraggle_collision_snapshot) + class is (fraggle_snapshot) param%ioutput = i call snapshot%write_frame(nc,param) end select @@ -70,6 +72,8 @@ module subroutine encounter_io_dump_encounter(self, param) ! Create and save the output files for this encounter and fragmentation nc%file_number = nc%file_number + 1 call self%make_index_map() + nc%time_dimsize = self%nt + nc%id_dimsize = self%nid write(nc%file_name, '("encounter_",I0.6,".nc")') nc%file_number call nc%initialize(param) @@ -113,77 +117,72 @@ module subroutine encounter_io_initialize(self, param) integer(I4B) :: ndims, i associate(nc => self) - select type(param) - class is (symba_parameters) - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select - ! Check if the file exists, and if it does, delete it - inquire(file=nc%file_name, exist=fileExists) - if (fileExists) then - 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%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 - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%encounter_history%nid, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - - ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) - - ! Variables - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) - if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) - end if - if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) - end if - - call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) - end select - end do + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if - ! Take the file out of define mode - call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" ) + 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 + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, nc%id_dimsize, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + + ! Dimension coordinates + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) + + ! Variables + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) + if (param%lclose) then + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) + end if + if (param%lrotation) then + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) + end if - ! 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" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) + end select + end do + + ! Take the file out of define mode + call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" ) + + ! 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 name slots with ids - !call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "encounter_io_initialize nf90_put_var pl id_varid" ) - end select end associate return @@ -205,16 +204,14 @@ module subroutine encounter_io_write_frame(self, nc, param) class(netcdf_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 + integer(I4B) :: i, idslot, old_mode, npl, ntp character(len=:), allocatable :: charstring - tslot = param%ioutput - associate(pl => self%pl, tp => self%tp) - select type (nc) - class is (encounter_io_parameters) - select type (param) - class is (symba_parameters) - + select type (nc) + class is (encounter_io_parameters) + select type (param) + class is (symba_parameters) + associate(pl => self%pl, tp => self%tp, encounter_history => param%encounter_history, tslot => param%ioutput) 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" ) @@ -222,8 +219,7 @@ module subroutine encounter_io_write_frame(self, nc, param) npl = pl%nbody do i = 1, npl - idslot = pl%id(i) + 1 - idslot = findloc(param%encounter_history%idvals,pl%id(i),dim=1) + idslot = findloc(encounter_history%idvals,pl%id(i),dim=1) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) @@ -244,7 +240,7 @@ module subroutine encounter_io_write_frame(self, nc, param) ntp = tp%nbody do i = 1, ntp - idslot = tp%id(i) + 1 + idslot = findloc(param%encounter_history%idvals,tp%id(i),dim=1) call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) @@ -256,9 +252,9 @@ module subroutine encounter_io_write_frame(self, nc, param) end do call check( nf90_set_fill(nc%id, old_mode, old_mode) ) - end select + end associate end select - end associate + end select return end subroutine encounter_io_write_frame diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 5c4212253..3a9f4b062 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -180,6 +180,97 @@ module subroutine encounter_util_final_storage(self) end subroutine encounter_util_final_storage + module subroutine encounter_util_get_idvalues_snapshot(self, idvals) + !! author: David A. Minton + !! + !! Returns an array of all id values saved in this snapshot + implicit none + ! Arguments + class(encounter_snapshot), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + ! Internals + integer(I4B) :: npl, ntp + + if (allocated(self%pl)) then + npl = self%pl%nbody + else + npl = 0 + end if + if (allocated(self%tp)) then + ntp = self%tp%nbody + else + ntp = 0 + end if + + if (npl + ntp == 0) return + allocate(idvals(npl+ntp)) + + if (npl > 0) idvals(1:npl) = self%pl%id(:) + if (ntp >0) idvals(npl+1:npl+ntp) = self%tp%id(:) + + return + + end subroutine encounter_util_get_idvalues_snapshot + + + subroutine encounter_util_get_vals_storage(storage, idvals, tvals) + !! author: David A. Minton + !! + !! Gets the id values in a storage object, regardless of whether it is encounter of collision + ! Argument + class(swiftest_storage(*)), intent(in) :: storage !! Swiftest storage object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + ! Internals + integer(I4B) :: i, n, nlo, nhi, ntotal + integer(I4B), dimension(:), allocatable :: itmp + + associate(nsnaps => storage%iframe) + + allocate(tvals(nsnaps)) + + tvals(:) = 0.0_DP + + ! First pass to get total number of ids + ntotal = 0 + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (encounter_snapshot) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + ntotal = ntotal + n + end if + end select + end if + end do + + allocate(idvals(ntotal)) + nlo = 1 + ! Second pass to store all ids get all of the ids stored + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (encounter_snapshot) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + nhi = nlo + n - 1 + idvals(nlo:nhi) = itmp(1:n) + nlo = nhi + 1 + end if + end select + end if + end do + + end associate + return + end subroutine encounter_util_get_vals_storage + + module subroutine encounter_util_index_map_encounter(self) !! author: David A. Minton !! @@ -189,43 +280,17 @@ module subroutine encounter_util_index_map_encounter(self) ! Arguments class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals - ! Internals - integer(I4B) :: i, n, nold, nt - integer(I4B), dimension(:), allocatable :: idvals, tmp + integer(I4B), dimension(:), allocatable :: idvals real(DP), dimension(:), allocatable :: tvals - if (self%nid == 0) return - allocate(idvals(self%nid)) - allocate(tvals(self%nframes)) - - n = 0 - nold = 1 - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (encounter_snapshot) - tvals(i) = snapshot%t - if (allocated(snapshot%pl)) then - n = n + snapshot%pl%nbody - idvals(nold:n) = snapshot%pl%id(:) - nold = n+1 - end if - if (allocated(snapshot%tp)) then - n = n + snapshot%tp%nbody - idvals(nold:n) = snapshot%tp%id(:) - nold = n+1 - end if - end select - else - nt = i-1 - exit - end if - end do + call encounter_util_get_vals_storage(self, idvals, tvals) + ! Consolidate ids to only unique values call util_unique(idvals,self%idvals,self%idmap) self%nid = size(self%idvals) - call util_unique(tvals(1:nt),self%tvals,self%tmap) + ! Consolidate time values to only unique values + call util_unique(tvals,self%tvals,self%tmap) self%nt = size(self%tvals) return @@ -239,8 +304,19 @@ module subroutine encounter_util_index_map_collision(self) !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id implicit none ! Arguments - class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals + + call encounter_util_get_vals_storage(self, idvals, tvals) + + ! Consolidate ids to only unique values + call util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + ! Don't consolidate time values (multiple collisions can happen in a single time step) + self%nt = size(self%tvals) return end subroutine encounter_util_index_map_collision @@ -428,7 +504,7 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) real(DP), intent(in), optional :: t !! Time of snapshot if different from system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments - class(fraggle_collision_snapshot), allocatable :: snapshot + class(fraggle_snapshot), allocatable :: snapshot type(symba_pl) :: pl character(len=:), allocatable :: stage integer(I4B) :: i,j @@ -460,7 +536,7 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) allocate(system%colliders%pl, source=pl) end associate case("after") - allocate(fraggle_collision_snapshot :: snapshot) + allocate(fraggle_snapshot :: snapshot) allocate(snapshot%colliders, source=system%colliders) allocate(snapshot%fragments, source=system%fragments) select type (param) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index d4a8d3d9e..ff20394e7 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -30,115 +30,116 @@ module subroutine fraggle_io_initialize_output(self, param) character(len=STRMAX) :: errmsg integer(I4B) :: i, ndims - associate(nc => self) - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select + select type(param) + class is (symba_parameters) + associate(nc => self, collision_history => param%collision_history) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select - ! Check if the file exists, and if it does, delete it - inquire(file=nc%file_name, exist=fileExists) - if (fileExists) then - 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%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) - - ! Dimensions - call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" - - ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) - - ! Variables - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & - [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") - call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & - [ nc%event_dimid], nc%Qloss_varid), "fraggle_io_initialize nf90_def_var Qloss_varid") - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + 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%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, nc%id_dimsize, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + + ! Dimension coordinates + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") + ! Variables + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & + nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & + [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") + call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & + [ nc%event_dimid], nc%Qloss_varid), "fraggle_io_initialize nf90_def_var Qloss_varid") + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & + [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & + [nc%str_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & + [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& + [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& + [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") - call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") - call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "fraggle_io_initialize_output nf90_def_var KE_spin_varid" ) + call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "fraggle_io_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "fraggle_io_initialize_output nf90_def_var PE_varid" ) + call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "fraggle_io_initialize_output nf90_def_var PE_varid" ) - call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "fraggle_io_initialize_output nf90_def_var L_orb_varid" ) + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "fraggle_io_initialize_output nf90_def_var L_orb_varid" ) - call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "fraggle_io_initialize_output nf90_def_var L_spin_varid" ) + call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "fraggle_io_initialize_output nf90_def_var L_spin_varid" ) - call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "fraggle_io_initialize nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, 0, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" ) - end select - end do - ! Take the file out of define mode - call check( nf90_enddef(nc%id), "fraggle_io_initialize nf90_enddef" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "fraggle_io_initialize nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nc%id, varid, 0, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" ) + end select + end do + ! Take the file out of define mode + call check( nf90_enddef(nc%id), "fraggle_io_initialize nf90_enddef" ) - ! Add in the space and stage dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "fraggle_io_initialize nf90_put_var space" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "fraggle_io_initialize nf90_put_var stage 1" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "fraggle_io_initialize nf90_put_var stage 2" ) + ! Add in the space and stage dimension coordinates + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "fraggle_io_initialize nf90_put_var space" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "fraggle_io_initialize nf90_put_var stage 1" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "fraggle_io_initialize nf90_put_var stage 2" ) - ! Pre-fill id slots with ids - call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "fraggle_io_initialize nf90_put_varid_varid" ) - end associate + end associate + end select return @@ -155,20 +156,19 @@ module subroutine fraggle_io_write_frame(self, nc, param) use netcdf implicit none ! Arguments - class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(fraggle_snapshot), intent(in) :: self !! Swiftest encounter structure class(netcdf_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, eslot, idslot, old_mode, npl, stage + integer(I4B) :: i, idslot, old_mode, npl, stage character(len=:), allocatable :: charstring class(swiftest_pl), allocatable :: pl - associate(colliders => self%colliders, fragments => self%fragments) - select type(nc) - class is (encounter_io_parameters) - eslot = param%ioutput - select type(nc) - class is (fraggle_io_parameters) + select type(nc) + class is (fraggle_io_parameters) + select type (param) + class is (symba_parameters) + associate(colliders => self%colliders, fragments => self%fragments, collision_history => param%collision_history, eslot => param%ioutput) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) @@ -188,7 +188,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) end select npl = pl%nbody do i = 1, npl - idslot = pl%id(i) + 1 + idslot = findloc(collision_history%idvals,pl%id(i),dim=1) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) @@ -212,9 +212,9 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) call check( nf90_set_fill(nc%id, old_mode, old_mode) ) - end select + end associate end select - end associate + end select return end subroutine fraggle_io_write_frame diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 2f708859c..22ca5cd55 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -174,7 +174,7 @@ module subroutine fraggle_util_final_snapshot(self) !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_snapshot), intent(inout) :: self !! Fraggle encountar storage object call encounter_util_final_snapshot(self%encounter_snapshot) @@ -257,6 +257,40 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para end subroutine fraggle_util_get_energy_momentum + module subroutine fraggle_util_get_idvalues_snapshot(self, idvals) + !! author: David A. Minton + !! + !! Returns an array of all id values saved in this snapshot + implicit none + ! Arguments + class(fraggle_snapshot), intent(in) :: self !! Fraggle snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + ! Internals + integer(I4B) :: ncoll, nfrag + + if (allocated(self%colliders)) then + ncoll = self%colliders%pl%nbody + else + ncoll = 0 + end if + + if (allocated(self%fragments)) then + nfrag = self%fragments%pl%nbody + else + nfrag = 0 + end if + + if (ncoll + nfrag == 0) return + allocate(idvals(ncoll+nfrag)) + + if (ncoll > 0) idvals(1:ncoll) = self%colliders%pl%id(:) + if (nfrag > 0) idvals(ncoll+1:ncoll+nfrag) = self%fragments%pl%id(:) + + return + + end subroutine fraggle_util_get_idvalues_snapshot + + module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_start) !! Author: David A. Minton !! diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index f9ed5b896..f5429fd12 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -49,7 +49,8 @@ module encounter_classes real(DP) :: t !! Simulation time when snapshot was taken integer(I8B) :: iloop !! Loop number at time of snapshot contains - procedure :: write_frame => encounter_io_write_frame !! Writes a frame of encounter data to file + procedure :: write_frame => encounter_io_write_frame !! Writes a frame of encounter data to file + procedure :: get_idvals => encounter_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot final :: encounter_util_final_snapshot end type encounter_snapshot @@ -68,8 +69,8 @@ module encounter_classes type, extends(swiftest_storage) :: collision_storage contains procedure :: dump => encounter_io_dump_collision !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_collision !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: take_snapshot => encounter_util_snapshot_collision !! Take a minimal snapshot of the system through an encounter + procedure :: take_snapshot => encounter_util_snapshot_collision !! Take a minimal snapshot of the system through an encounter + procedure :: make_index_map => encounter_util_index_map_collision !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id final :: encounter_util_final_collision_storage end type collision_storage @@ -300,14 +301,20 @@ module subroutine encounter_util_final_storage(self) type(encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object end subroutine encounter_util_final_storage + module subroutine encounter_util_get_idvalues_snapshot(self, idvals) + implicit none + class(encounter_snapshot), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine encounter_util_get_idvalues_snapshot + module subroutine encounter_util_index_map_collision(self) implicit none - class(collision_storage(*)), intent(inout) :: self !! E + class(collision_storage(*)), intent(inout) :: self !! Collision storage object end subroutine encounter_util_index_map_collision module subroutine encounter_util_index_map_encounter(self) implicit none - class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object end subroutine encounter_util_index_map_encounter module subroutine encounter_util_resize_list(self, nnew) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 2bd120b83..989399f94 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -132,14 +132,15 @@ module fraggle_classes procedure :: initialize => fraggle_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object end type fraggle_io_parameters - type, extends(encounter_snapshot) :: fraggle_collision_snapshot + type, extends(encounter_snapshot) :: fraggle_snapshot logical :: lcollision !! Indicates that this snapshot contains at least one collision class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot contains procedure :: write_frame => fraggle_io_write_frame !! Writes a frame of encounter data to file + procedure :: get_idvals => fraggle_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot final :: fraggle_util_final_snapshot - end type fraggle_collision_snapshot + end type fraggle_snapshot interface module subroutine fraggle_generate_fragments(self, colliders, system, param, lfailure) @@ -160,7 +161,7 @@ end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) implicit none - class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(fraggle_snapshot), intent(in) :: self !! Swiftest encounter structure class(netcdf_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 @@ -295,7 +296,7 @@ end subroutine fraggle_util_final_fragments module subroutine fraggle_util_final_snapshot(self) implicit none - type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle storage snapshot object + type(fraggle_snapshot), intent(inout) :: self !! Fraggle storage snapshot object end subroutine fraggle_util_final_snapshot module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) @@ -308,6 +309,12 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with colliders included and fragments excluded or vice versa end subroutine fraggle_util_get_energy_momentum + module subroutine fraggle_util_get_idvalues_snapshot(self, idvals) + implicit none + class(fraggle_snapshot), intent(in) :: self !! Fraggle snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine fraggle_util_get_idvalues_snapshot + module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_start) implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index b89e9eee8..6dc6a9877 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -556,6 +556,7 @@ module swiftest_classes ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. procedure :: set_msys => util_set_msys !! Sets the value of msys from the masses of system bodies. procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum + procedure :: get_idvals => util_get_idvalues_system !! Returns an array of all id values in use in the system procedure :: rescale => util_rescale_system !! Rescales the system into a new set of units procedure :: validate_ids => util_valid_id_system !! Validate the numerical ids passed to the system and save the maximum value generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data @@ -1620,6 +1621,12 @@ module subroutine util_get_energy_momentum_system(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine util_get_energy_momentum_system + module subroutine util_get_idvalues_system(self, idvals) + implicit none + class(swiftest_nbody_system), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine util_get_idvalues_system + module subroutine util_set_beg_end_pl(self, xbeg, xend, vbeg) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object diff --git a/src/util/util_index.f90 b/src/util/util_index.f90 index ae4a80ce8..0fbd40319 100644 --- a/src/util/util_index.f90 +++ b/src/util/util_index.f90 @@ -45,55 +45,113 @@ module subroutine util_index_array(ind_arr, n) end subroutine util_index_array + module subroutine util_get_idvalues_system(self, idvals) + !! author: David A. Minton + !! + !! Returns an array of all id values saved in this snapshot + implicit none + ! Arguments + class(swiftest_nbody_system), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + ! Internals + integer(I4B) :: npl, ntp + + if (allocated(self%pl)) then + npl = self%pl%nbody + else + npl = 0 + end if + if (allocated(self%tp)) then + ntp = self%tp%nbody + else + ntp = 0 + end if + + allocate(idvals(1 + npl+ntp)) + + idvals(1) = self%cb%id + if (npl > 0) idvals(2:npl+1) = self%pl%id(:) + if (ntp > 0) idvals(npl+2:npl+ntp+1) = self%tp%id(:) + + return + + end subroutine util_get_idvalues_system + + + subroutine util_get_vals_storage(storage, idvals, tvals) + !! author: David A. Minton + !! + !! Gets the id values in a storage object, regardless of whether it is encounter of collision + ! Argument + class(swiftest_storage(*)), intent(in) :: storage !! Swiftest storage object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + ! Internals + integer(I4B) :: i, n, nlo, nhi, ntotal + integer(I4B), dimension(:), allocatable :: itmp + + associate(nsnaps => storage%iframe) + + allocate(tvals(nsnaps)) + tvals(:) = 0.0_DP + + ! First pass to get total number of ids + ntotal = 0 + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (swiftest_nbody_system) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + ntotal = ntotal + n + end if + end select + end if + end do + + allocate(idvals(ntotal)) + nlo = 1 + ! Second pass to store all ids get all of the ids stored + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (swiftest_nbody_system) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + nhi = nlo + n - 1 + idvals(nlo:nhi) = itmp(1:n) + nlo = nhi + 1 + end if + end select + end if + end do + + end associate + return + end subroutine util_get_vals_storage + + module subroutine util_index_map_storage(self) !! author: David A. Minton !! !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id implicit none ! Arguments - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals - integer(I4B) :: i, n, nold, nt integer(I4B), dimension(:), allocatable :: idvals real(DP), dimension(:), allocatable :: tvals - - if (self%nid == 0) return - allocate(idvals(self%nid)) - allocate(tvals(self%nframes)) - - n = 0 - nold = 1 - nt = 0 - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - nt = i - select type(snapshot => self%frame(i)%item) - class is (swiftest_nbody_system) - tvals(i) = snapshot%t - ! Central body - n = n + 1 - idvals(n) = snapshot%cb%id - nold = n + 1 - if (allocated(snapshot%pl)) then - n = n + snapshot%pl%nbody - idvals(nold:n) = snapshot%pl%id(:) - nold = n+1 - end if - if (allocated(snapshot%tp)) then - n = n + snapshot%tp%nbody - idvals(nold:n) = snapshot%tp%id(:) - nold = n+1 - end if - end select - else - exit - end if - end do + + call util_get_vals_storage(self, idvals, tvals) call util_unique(idvals,self%idvals,self%idmap) self%nid = size(self%idvals) - call util_unique(tvals(1:nt),self%tvals,self%tmap) + call util_unique(tvals,self%tvals,self%tmap) self%nt = size(self%tvals) return From c12ec199c83487737eb7eace7bbd895283bedef7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 12 Dec 2022 12:55:08 -0500 Subject: [PATCH 49/63] Collisions are now processed in the Python side --- python/swiftest/swiftest/io.py | 6 +-- python/swiftest/swiftest/simulation_class.py | 44 ++++++++++++++++---- src/io/io.f90 | 2 +- src/symba/symba_io.f90 | 2 +- 4 files changed, 42 insertions(+), 12 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 5331e50fd..beb5ebab9 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -33,7 +33,7 @@ "TSTART", "DUMP_CADENCE", "ENCOUNTER_SAVE", - "FRAGMENTATION_SAVE") + "COLLISION_SAVE") @@ -55,14 +55,14 @@ float_param = ["T0", "TSTART", "TSTOP", "DT", "CHK_RMIN", "CHK_RMAX", "CHK_EJECT", "CHK_QMIN", "DU2M", "MU2KG", "TU2S", "MIN_GMFRAG", "GMTINY"] -upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM","ENCOUNTER_SAVE","FRAGMENTATION_SAVE", "CHK_QMIN_COORD"] +upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM","ENCOUNTER_SAVE","COLLISION_SAVE", "CHK_QMIN_COORD"] lower_str_param = ["NC_IN", "PL_IN", "TP_IN", "CB_IN", "CHK_QMIN_RANGE"] param_keys = ['! VERSION'] + int_param + float_param + upper_str_param + lower_str_param+ bool_param # This defines Xarray Dataset variables that are strings, which must be processed due to quirks in how NetCDF-Fortran # handles strings differently than Python's Xarray. -string_varnames = ["name", "particle_type", "status", "origin_type"] +string_varnames = ["name", "particle_type", "status", "origin_type", "stage", "regime"] char_varnames = ["space"] int_varnames = ["id", "ntp", "npl", "nplm", "discard_body_id", "collision_id", "loopnum"] diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index ca11f121e..58bc3b713 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -320,7 +320,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, self.data = xr.Dataset() self.ic = xr.Dataset() self.encounters = xr.Dataset() - self.collision = xr.Dataset() + self.collisions = xr.Dataset() self.simdir = Path(simdir) if self.simdir.exists(): @@ -1234,10 +1234,10 @@ def set_feature(self, msg = f"{collision_save} is not a valid option for collision_save." msg += f"\nMust be one of {valid_vals}" warnings.warn(msg,stacklevel=2) - if "FRAGMENTATION_SAVE" not in self.param: - self.param["FRAGMENTATION_SAVE"] = valid_vals[0] + if "COLLISION_SAVE" not in self.param: + self.param["COLLISION_SAVE"] = valid_vals[0] else: - self.param["FRAGMENTATION_SAVE"] = collision_save + self.param["COLLISION_SAVE"] = collision_save update_list.append("collision_save") self.param["TIDES"] = False @@ -1272,7 +1272,7 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N valid_var = {"close_encounter_check": "CHK_CLOSE", "fragmentation": "FRAGMENTATION", "encounter_save": "ENCOUNTER_SAVE", - "collision_save": "FRAGMENTATION_SAVE", + "collision_save": "COLLISION_SAVE", "minimum_fragment_gmass": "MIN_GMFRAG", "rotation": "ROTATION", "general_relativity": "GR", @@ -2735,10 +2735,16 @@ def read_output_file(self,read_init_cond : bool = True): # This is done to handle cases where the method is called from a different working directory than the simulation # results - if "ENCOUNTER_SAVE" in self.param or "FRAGMENTATION_SAVE" in self.param: - read_encounters = self.param["ENCOUNTER_SAVE"] != "NONE" or self.param["FRAGMENTATION_SAVE"] != "NONE" + if "ENCOUNTER_SAVE" in self.param: + read_encounters = self.param["ENCOUNTER_SAVE"] != "NONE" else: read_encounters = False + + if "COLLISION_SAVE" in self.param: + read_collisions = self.param["COLLISION_SAVE"] != "NONE" + else: + read_collisions = False + param_tmp = self.param.copy() param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": @@ -2755,6 +2761,8 @@ def read_output_file(self,read_init_cond : bool = True): self.ic = self.data.isel(time=0) if read_encounters: self.read_encounters() + if read_collisions: + self.read_collisions() elif self.codename == "Swifter": self.data = io.swifter2xr(param_tmp, verbose=self.verbose) @@ -2790,6 +2798,28 @@ def _preprocess(ds, param): return + def read_collisions(self): + if self.verbose: + print("Reading collision history file as .collisions") + col_files = glob(f"{self.simdir}{os.path.sep}collision_*.nc") + col_files.sort() + + # This is needed in order to pass the param argument down to the io.process_netcdf_input function + def _preprocess(ds, param): + return io.process_netcdf_input(ds,param) + partial_func = partial(_preprocess, param=self.param) + + self.collisions = xr.open_mfdataset(col_files,parallel=True,combine="nested",concat_dim="collision",join="left",preprocess=partial_func,mask_and_scale=True) + self.collisions = io.process_netcdf_input(self.collisions, self.param) + + # # Reduce the dimensionality of variables that got expanded in the combine process + # self.encounters['loopnum'] = self.encounters['loopnum'].max(dim="name") + # self.encounters['id'] = self.encounters['id'].max(dim="time") + # self.encounters['particle_type'] = self.encounters['particle_type'].max(dim="time") + + return + + def follow(self, codestyle="Swifter"): """ An implementation of the Swift tool_follow algorithm. Under development. Currently only for Swift simulations. diff --git a/src/io/io.f90 b/src/io/io.f90 index 062d0f70a..71815b4be 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -682,7 +682,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%lrestart = .true. end if ! Ignore SyMBA-specific, not-yet-implemented, or obsolete input parameters - case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP", "ENCOUNTER_SAVE", "FRAGMENTATION_SAVE") + case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP", "ENCOUNTER_SAVE", "COLLISION_SAVE") case default write(*,*) "Ignoring unknown parameter -> ",param_name end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 18b56767e..4f19bfd30 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -68,7 +68,7 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms case ("ENCOUNTER_SAVE") call io_toupper(param_value) read(param_value, *) param%encounter_save - case ("FRAGMENTATION_SAVE") + case ("COLLISION_SAVE") call io_toupper(param_value) read(param_value, *) param%collision_save case("SEED") From e9ee8cd2c566f8e0206479ef2448be45da5c8eef Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 12 Dec 2022 22:52:33 -0500 Subject: [PATCH 50/63] Now index by "name" instead of "id" on the Fortran side --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/io.py | 21 +++-- python/swiftest/swiftest/simulation_class.py | 12 +-- src/encounter/encounter_io.f90 | 26 +++--- src/fraggle/fraggle_io.f90 | 23 +++--- src/modules/encounter_classes.f90 | 2 +- src/modules/swiftest_classes.f90 | 10 +-- src/netcdf/netcdf.f90 | 80 +++++++++---------- 8 files changed, 81 insertions(+), 95 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index c7fc31299..090a4f4a3 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -202,7 +202,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(fragmentation=True, collision_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(fragmentation=True, collision_save="TRAJECTORY", encounter_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index beb5ebab9..be70cae50 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -817,18 +817,18 @@ def process_netcdf_input(ds, param): ds : xarray dataset """ # - ds = ds.where(ds.id >=0,drop=True) + #ds = ds.where(ds.id >=0,drop=True) if param['OUT_TYPE'] == "NETCDF_DOUBLE": ds = fix_types(ds,ftype=np.float64) elif param['OUT_TYPE'] == "NETCDF_FLOAT": ds = fix_types(ds,ftype=np.float32) - # Check if the name variable contains unique values. If so, make name the dimension instead of id - if "id" in ds.dims: - if len(np.unique(ds['name'])) == len(ds['name']): - ds = ds.swap_dims({"id" : "name"}) - if "id" in ds: - ds = ds.reset_coords("id") + # # Check if the name variable contains unique values. If so, make name the dimension instead of id + # if "id" in ds.dims: + # if len(np.unique(ds['name'])) == len(ds['name']): + # ds = ds.swap_dims({"id" : "name"}) + # if "id" in ds: + # ds = ds.reset_coords("id") return ds @@ -1127,9 +1127,6 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram param_tmp['OUT_FORM'] = param['IN_FORM'] frame = select_active_from_frame(ds, param_tmp, framenum) - if "name" in frame.dims: - frame = frame.swap_dims({"name" : "id"}) - frame = frame.reset_coords("name") if in_type == "NETCDF_DOUBLE" or in_type == "NETCDF_FLOAT": # Convert strings back to byte form and save the NetCDF file @@ -1146,8 +1143,8 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram return frame # All other file types need seperate files for each of the inputs - cb = frame.where(frame.id == 0, drop=True) - pl = frame.where(frame.id > 0, drop=True) + cb = frame.isel(name=0) + pl = frame.where(name != cb.name) pl = pl.where(np.invert(np.isnan(pl['Gmass'])), drop=True).drop_vars(['j2rp2', 'j2rp2'],errors="ignore") tp = frame.where(np.isnan(frame['Gmass']), drop=True).drop_vars(['Gmass', 'radius', 'j2rp2', 'j4rp4'],errors="ignore") diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 58bc3b713..1bedfeba4 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2790,11 +2790,6 @@ def _preprocess(ds, param): tgood,tid = np.unique(self.encounters.time,return_index=True) self.encounters = self.encounters.isel(time=tid) - # Reduce the dimensionality of variables that got expanded in the combine process - self.encounters['loopnum'] = self.encounters['loopnum'].max(dim="name") - self.encounters['id'] = self.encounters['id'].max(dim="time") - self.encounters['particle_type'] = self.encounters['particle_type'].max(dim="time") - return @@ -2809,14 +2804,9 @@ def _preprocess(ds, param): return io.process_netcdf_input(ds,param) partial_func = partial(_preprocess, param=self.param) - self.collisions = xr.open_mfdataset(col_files,parallel=True,combine="nested",concat_dim="collision",join="left",preprocess=partial_func,mask_and_scale=True) + self.collisions = xr.open_mfdataset(col_files,parallel=True, coords=["collision"], join="inner", preprocess=partial_func,mask_and_scale=True) self.collisions = io.process_netcdf_input(self.collisions, self.param) - # # Reduce the dimensionality of variables that got expanded in the combine process - # self.encounters['loopnum'] = self.encounters['loopnum'].max(dim="name") - # self.encounters['id'] = self.encounters['id'].max(dim="time") - # self.encounters['particle_type'] = self.encounters['particle_type'].max(dim="time") - return diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 09c2dd676..22827f611 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -29,7 +29,7 @@ module subroutine encounter_io_dump_collision(self, param) nc%file_number = nc%file_number + 1 call self%make_index_map() nc%event_dimsize = self%nt - nc%id_dimsize = self%nid + nc%name_dimsize = self%nid write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number call nc%initialize(param) @@ -73,7 +73,7 @@ module subroutine encounter_io_dump_encounter(self, param) nc%file_number = nc%file_number + 1 call self%make_index_map() nc%time_dimsize = self%nt - nc%id_dimsize = self%nid + nc%name_dimsize = self%nid write(nc%file_name, '("encounter_",I0.6,".nc")') nc%file_number call nc%initialize(param) @@ -138,28 +138,28 @@ module subroutine encounter_io_initialize(self, param) ! 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 - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, nc%id_dimsize, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_initialize nf90_def_dim name_dimid" ) ! dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var id_varid" ) ! Variables - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) end if if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) end if call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index ff20394e7..f47a64047 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -55,49 +55,48 @@ module subroutine fraggle_io_initialize_output(self, param) ! Dimensions call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, nc%id_dimsize, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "fraggle_io_initialize nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) + call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) ! Variables + call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & [ nc%event_dimid], nc%Qloss_varid), "fraggle_io_initialize nf90_def_var Qloss_varid") - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") + [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index f5429fd12..8e74913ed 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -59,7 +59,7 @@ module encounter_classes 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 - integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot + integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot integer(I4B) :: file_number = 1 !! The number to append on the output file contains procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 6dc6a9877..1762a8e78 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -34,9 +34,9 @@ module swiftest_classes character(NAMELEN) :: time_dimname = "time" !! name of the time dimension integer(I4B) :: time_dimid !! ID for the time dimension integer(I4B) :: time_varid !! ID for the time variable - character(NAMELEN) :: id_dimname = "id" !! name of the particle id dimension - integer(I4B) :: id_dimid !! ID for the particle id dimension - integer(I4B) :: id_varid !! ID for the particle name variable + character(NAMELEN) :: name_dimname = "name" !! name of the particle name dimension + integer(I4B) :: name_dimid !! ID for the particle name dimension + integer(I4B) :: name_varid !! ID for the particle name variable character(NAMELEN) :: space_dimname = "space" !! name of the space dimension integer(I4B) :: space_dimid !! ID for the space dimension integer(I4B) :: space_varid !! ID for the space variable @@ -45,8 +45,8 @@ module swiftest_classes ! Non-dimension ids and variable names character(NAMELEN) :: ptype_varname = "particle_type" !! name of the particle type variable integer(I4B) :: ptype_varid !! ID for the particle type variable - character(NAMELEN) :: name_varname = "name" !! name of the particle name variable - integer(I4B) :: name_varid !! ID for the name variable + character(NAMELEN) :: id_varname = "id" !! name of the particle id variable + integer(I4B) :: id_varid !! ID for the id variable character(NAMELEN) :: npl_varname = "npl" !! name of the number of active massive bodies variable integer(I4B) :: npl_varid !! ID for the number of active massive bodies variable character(NAMELEN) :: ntp_varname = "ntp" !! name of the number of active test particles variable diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 42e2a2ea6..588a138d6 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -83,7 +83,7 @@ module function netcdf_get_old_t_final_system(self, param) result(old_t_final) associate (nc => param%system_history%nc) call nc%open(param) call check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) - call check( nf90_inquire_dimension(nc%id, nc%id_dimid, len=idmax), "netcdf_get_old_t_final_system id_dimid" ) + call check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_get_old_t_final_system name_dimid" ) allocate(vals(idmax)) call check( nf90_get_var(nc%id, nc%time_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) @@ -186,77 +186,77 @@ module subroutine netcdf_initialize_output(self, param) ! 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 call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, NF90_UNLIMITED, nc%id_dimid), "netcdf_initialize_output nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%name_dimname, NF90_UNLIMITED, nc%name_dimid), "netcdf_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "netcdf_initialize_output nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "netcdf_initialize_output nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "netcdf_initialize_output nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "netcdf_initialize_output nf90_def_var name_varid" ) ! Variables + call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "netcdf_initialize_output nf90_def_var id_varid" ) call check( nf90_def_var(nc%id, nc%npl_varname, NF90_INT, nc%time_dimid, nc%npl_varid), "netcdf_initialize_output nf90_def_var npl_varid" ) call check( nf90_def_var(nc%id, nc%ntp_varname, NF90_INT, nc%time_dimid, nc%ntp_varid), "netcdf_initialize_output nf90_def_var ntp_varid" ) if (param%integrator == SYMBA) call check( nf90_def_var(nc%id, nc%nplm_varname, NF90_INT, nc%time_dimid, nc%nplm_varid), "netcdf_initialize_output nf90_def_var nplm_varid" ) - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "netcdf_initialize_output nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "netcdf_initialize_output nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "netcdf_initialize_output nf90_def_var ptype_varid" ) if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "netcdf_initialize_output nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "netcdf_initialize_output nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "netcdf_initialize_output nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "netcdf_initialize_output nf90_def_var vh_varid" ) !! When GR is enabled, we need to save the pseudovelocity vectors in addition to the true heliocentric velocity vectors, otherwise !! we cannnot expect bit-identical runs from restarted runs with GR enabled due to floating point errors during the conversion. if (param%lgr) then - call check( nf90_def_var(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%gr_pseudo_vh_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vh_varid" ) + call check( nf90_def_var(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%gr_pseudo_vh_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vh_varid" ) nc%lpseudo_vel_exists = .true. end if end if if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - call check( nf90_def_var(nc%id, nc%a_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%a_varid), "netcdf_initialize_output nf90_def_var a_varid" ) - call check( nf90_def_var(nc%id, nc%e_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%e_varid), "netcdf_initialize_output nf90_def_var e_varid" ) - call check( nf90_def_var(nc%id, nc%inc_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%inc_varid), "netcdf_initialize_output nf90_def_var inc_varid" ) - call check( nf90_def_var(nc%id, nc%capom_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%capom_varid), "netcdf_initialize_output nf90_def_var capom_varid" ) - call check( nf90_def_var(nc%id, nc%omega_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%omega_varid), "netcdf_initialize_output nf90_def_var omega_varid" ) - call check( nf90_def_var(nc%id, nc%capm_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%capm_varid), "netcdf_initialize_output nf90_def_var capm_varid" ) - call check( nf90_def_var(nc%id, nc%varpi_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%varpi_varid), "netcdf_initialize_output nf90_def_var varpi_varid" ) - call check( nf90_def_var(nc%id, nc%lam_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%lam_varid), "netcdf_initialize_output nf90_def_var lam_varid" ) - call check( nf90_def_var(nc%id, nc%f_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%f_varid), "netcdf_initialize_output nf90_def_var f_varid" ) - call check( nf90_def_var(nc%id, nc%cape_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%cape_varid), "netcdf_initialize_output nf90_def_var cape_varid" ) + call check( nf90_def_var(nc%id, nc%a_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%a_varid), "netcdf_initialize_output nf90_def_var a_varid" ) + call check( nf90_def_var(nc%id, nc%e_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%e_varid), "netcdf_initialize_output nf90_def_var e_varid" ) + call check( nf90_def_var(nc%id, nc%inc_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%inc_varid), "netcdf_initialize_output nf90_def_var inc_varid" ) + call check( nf90_def_var(nc%id, nc%capom_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capom_varid), "netcdf_initialize_output nf90_def_var capom_varid" ) + call check( nf90_def_var(nc%id, nc%omega_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%omega_varid), "netcdf_initialize_output nf90_def_var omega_varid" ) + call check( nf90_def_var(nc%id, nc%capm_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capm_varid), "netcdf_initialize_output nf90_def_var capm_varid" ) + call check( nf90_def_var(nc%id, nc%varpi_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%varpi_varid), "netcdf_initialize_output nf90_def_var varpi_varid" ) + call check( nf90_def_var(nc%id, nc%lam_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%lam_varid), "netcdf_initialize_output nf90_def_var lam_varid" ) + call check( nf90_def_var(nc%id, nc%f_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%f_varid), "netcdf_initialize_output nf90_def_var f_varid" ) + call check( nf90_def_var(nc%id, nc%cape_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%cape_varid), "netcdf_initialize_output nf90_def_var cape_varid" ) end if - call check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "netcdf_initialize_output nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "netcdf_initialize_output nf90_def_var Gmass_varid" ) if (param%lrhill_present) then - call check( nf90_def_var(nc%id, nc%rhill_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%rhill_varid), "netcdf_initialize_output nf90_def_var rhill_varid" ) + call check( nf90_def_var(nc%id, nc%rhill_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%rhill_varid), "netcdf_initialize_output nf90_def_var rhill_varid" ) end if if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "netcdf_initialize_output nf90_def_var radius_varid" ) + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "netcdf_initialize_output nf90_def_var radius_varid" ) - call check( nf90_def_var(nc%id, nc%origin_time_varname, nc%out_type, nc%id_dimid, nc%origin_time_varid), "netcdf_initialize_output nf90_def_var origin_time_varid" ) - call check( nf90_def_var(nc%id, nc%origin_type_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], & + call check( nf90_def_var(nc%id, nc%origin_time_varname, nc%out_type, nc%name_dimid, nc%origin_time_varid), "netcdf_initialize_output nf90_def_var origin_time_varid" ) + call check( nf90_def_var(nc%id, nc%origin_type_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], & nc%origin_type_varid), "netcdf_initialize_output nf90_create" ) - call check( nf90_def_var(nc%id, nc%origin_rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%origin_rh_varid), "netcdf_initialize_output nf90_def_var origin_rh_varid" ) - call check( nf90_def_var(nc%id, nc%origin_vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%origin_vh_varid), "netcdf_initialize_output nf90_def_var origin_vh_varid" ) - - call check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, nc%id_dimid, nc%collision_id_varid), "netcdf_initialize_output nf90_def_var collision_id_varid" ) - call check( nf90_def_var(nc%id, nc%discard_time_varname, nc%out_type, nc%id_dimid, nc%discard_time_varid), "netcdf_initialize_output nf90_def_var discard_time_varid" ) - call check( nf90_def_var(nc%id, nc%discard_rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%discard_rh_varid), "netcdf_initialize_output nf90_def_var discard_rh_varid" ) - call check( nf90_def_var(nc%id, nc%discard_vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%discard_vh_varid), "netcdf_initialize_output nf90_def_var discard_vh_varid" ) - call check( nf90_def_var(nc%id, nc%discard_body_id_varname, NF90_INT, nc%id_dimid, nc%discard_body_id_varid), "netcdf_initialize_output nf90_def_var discard_body_id_varid" ) + call check( nf90_def_var(nc%id, nc%origin_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_rh_varid), "netcdf_initialize_output nf90_def_var origin_rh_varid" ) + call check( nf90_def_var(nc%id, nc%origin_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_vh_varid), "netcdf_initialize_output nf90_def_var origin_vh_varid" ) + + call check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, nc%name_dimid, nc%collision_id_varid), "netcdf_initialize_output nf90_def_var collision_id_varid" ) + call check( nf90_def_var(nc%id, nc%discard_time_varname, nc%out_type, nc%name_dimid, nc%discard_time_varid), "netcdf_initialize_output nf90_def_var discard_time_varid" ) + call check( nf90_def_var(nc%id, nc%discard_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_rh_varid), "netcdf_initialize_output nf90_def_var discard_rh_varid" ) + call check( nf90_def_var(nc%id, nc%discard_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_vh_varid), "netcdf_initialize_output nf90_def_var discard_vh_varid" ) + call check( nf90_def_var(nc%id, nc%discard_body_id_varname, NF90_INT, nc%name_dimid, nc%discard_body_id_varid), "netcdf_initialize_output nf90_def_var discard_body_id_varid" ) end if if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "netcdf_initialize_output nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "netcdf_initialize_output nf90_def_var rot_varid" ) + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "netcdf_initialize_output nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "netcdf_initialize_output nf90_def_var rot_varid" ) end if ! if (param%ltides) then - ! call check( nf90_def_var(nc%id, nc%k2_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%k2_varid), "netcdf_initialize_output nf90_def_var k2_varid" ) - ! call check( nf90_def_var(nc%id, nc%q_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Q_varid), "netcdf_initialize_output nf90_def_var Q_varid" ) + ! call check( nf90_def_var(nc%id, nc%k2_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%k2_varid), "netcdf_initialize_output nf90_def_var k2_varid" ) + ! call check( nf90_def_var(nc%id, nc%q_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Q_varid), "netcdf_initialize_output nf90_def_var Q_varid" ) ! end if if (param%lenergy) then @@ -332,16 +332,16 @@ module subroutine netcdf_open(self, param, readonly) ! Dimensions call check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) call check( nf90_inq_dimid(nc%id, nc%space_dimname, nc%space_dimid), "netcdf_open nf90_inq_dimid space_dimid" ) - call check( nf90_inq_dimid(nc%id, nc%id_dimname, nc%id_dimid), "netcdf_open nf90_inq_dimid id_dimid" ) + call check( nf90_inq_dimid(nc%id, nc%name_dimname, nc%name_dimid), "netcdf_open nf90_inq_dimid name_dimid" ) call check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%str_dimid), "netcdf_open nf90_inq_dimid str_dimid" ) ! Dimension coordinates call check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), "netcdf_open nf90_inq_varid time_varid" ) call check( nf90_inq_varid(nc%id, nc%space_dimname, nc%space_varid), "netcdf_open nf90_inq_varid space_varid" ) - call check( nf90_inq_varid(nc%id, nc%id_dimname, nc%id_varid), "netcdf_open nf90_inq_varid id_varid" ) + call check( nf90_inq_varid(nc%id, nc%name_dimname, nc%name_varid), "netcdf_open nf90_inq_varid name_varid" ) ! Required Variables - call check( nf90_inq_varid(nc%id, nc%name_varname, nc%name_varid), "netcdf_open nf90_inq_varid name_varid" ) + call check( nf90_inq_varid(nc%id, nc%id_varname, nc%id_varid), "netcdf_open nf90_inq_varid name_varid" ) call check( nf90_inq_varid(nc%id, nc%gmass_varname, nc%Gmass_varid), "netcdf_open nf90_inq_varid Gmass_varid" ) if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then @@ -461,7 +461,7 @@ module function netcdf_read_frame_system(self, nc, param) result(ierr) call pl%setup(npl, param) call tp%setup(ntp, param) - call check( nf90_inquire_dimension(nc%id, nc%id_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension id_dimid" ) + call check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension name_dimid" ) allocate(rtemp(idmax)) allocate(vectemp(NDIM,idmax)) allocate(itemp(idmax)) @@ -703,7 +703,7 @@ module subroutine netcdf_read_hdr_system(self, nc, param) tslot = param%ioutput - call check( nf90_inquire_dimension(nc%id, nc%id_dimid, len=idmax), "netcdf_read_hdr_system nf90_inquire_dimension id_dimid" ) + call check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_read_hdr_system nf90_inquire_dimension name_dimid" ) call check( nf90_get_var(nc%id, nc%time_varid, self%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) allocate(gmtemp(idmax)) From ff507bddd6190452e07bb45bb6ce7c8270df9904 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 05:50:18 -0500 Subject: [PATCH 51/63] Refactored xh,xb -> rh,rb --- src/discard/discard.f90 | 2 +- src/fraggle/fraggle_generate.f90 | 14 +++++----- src/fraggle/fraggle_regime.f90 | 14 +++++----- src/fraggle/fraggle_set.f90 | 12 ++++----- src/fraggle/fraggle_setup.f90 | 2 +- src/fraggle/fraggle_util.f90 | 4 +-- src/helio/helio_kick.f90 | 4 +-- src/io/io.f90 | 2 +- src/kick/kick.f90 | 6 ++--- src/modules/fraggle_classes.f90 | 4 +-- src/modules/rmvs_classes.f90 | 2 +- src/modules/swiftest_classes.f90 | 26 +++++++++--------- src/rmvs/rmvs_encounter_check.f90 | 2 +- src/rmvs/rmvs_kick.f90 | 12 ++++----- src/rmvs/rmvs_setup.f90 | 2 +- src/rmvs/rmvs_step.f90 | 28 ++++++++++---------- src/rmvs/rmvs_util.f90 | 8 +++--- src/setup/setup.f90 | 4 +-- src/symba/symba_collision.f90 | 38 +++++++++++++-------------- src/symba/symba_discard.f90 | 24 ++++++++--------- src/symba/symba_kick.f90 | 2 +- src/symba/symba_util.f90 | 8 +++--- src/tides/tides_spin_step.f90 | 22 ++++++++-------- src/util/util_append.f90 | 4 +-- src/util/util_coord.f90 | 24 ++++++++--------- src/util/util_dealloc.f90 | 2 +- src/util/util_fill.f90 | 4 +-- src/util/util_get_energy_momentum.f90 | 32 +++++++++++----------- src/util/util_peri.f90 | 4 +-- src/util/util_rescale.f90 | 4 +-- src/util/util_resize.f90 | 4 +-- src/util/util_set.f90 | 12 ++++----- src/util/util_sort.f90 | 8 +++--- src/util/util_spill.f90 | 4 +-- src/whm/whm_kick.f90 | 14 +++++----- 35 files changed, 179 insertions(+), 179 deletions(-) diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 72782df84..fc5160fd7 100644 --- a/src/discard/discard.f90 +++ b/src/discard/discard.f90 @@ -153,7 +153,7 @@ subroutine discard_cb_tp(tp, system, param) call tp%info(i)%set_value(status="DISCARDED_RMIN", discard_time=system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=cb%id) else if (param%rmaxu >= 0.0_DP) then - rb2 = dot_product(tp%xb(:, i), tp%xb(:, i)) + rb2 = dot_product(tp%rb(:, i), tp%rb(:, i)) vb2 = dot_product(tp%vb(:, i), tp%vb(:, i)) energy = 0.5_DP * vb2 - Gmtot / sqrt(rb2) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 4da30c3d8..8253fb12a 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -72,7 +72,7 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa call frag%get_energy_and_momentum(colliders, system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution - r_max_start = 1 * norm2(colliders%xb(:,2) - colliders%xb(:,1)) + r_max_start = 1 * norm2(colliders%rb(:,2) - colliders%rb(:,1)) lfailure = .false. try = 1 do while (try < MAXTRY) @@ -194,8 +194,8 @@ subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) call random_number(frag%x_coll(:,3:nfrag)) loverlap(:) = .true. do while (any(loverlap(3:nfrag))) - frag%x_coll(:, 1) = colliders%xb(:, 1) - frag%xbcom(:) - frag%x_coll(:, 2) = colliders%xb(:, 2) - frag%xbcom(:) + frag%x_coll(:, 1) = colliders%rb(:, 1) - frag%rbcom(:) + frag%x_coll(:, 2) = colliders%rb(:, 2) - frag%rbcom(:) r_max = r_max + 0.1_DP * rad do i = 3, nfrag if (loverlap(i)) then @@ -215,14 +215,14 @@ subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) call frag%set_coordinate_system(colliders) do i = 1, nfrag - frag%xb(:,i) = frag%x_coll(:,i) + frag%xbcom(:) + frag%rb(:,i) = frag%x_coll(:,i) + frag%rbcom(:) end do - frag%xbcom(:) = 0.0_DP + frag%rbcom(:) = 0.0_DP do i = 1, nfrag - frag%xbcom(:) = frag%xbcom(:) + frag%mass(i) * frag%xb(:,i) + frag%rbcom(:) = frag%rbcom(:) + frag%mass(i) * frag%rb(:,i) end do - frag%xbcom(:) = frag%xbcom(:) / frag%mtot + frag%rbcom(:) = frag%rbcom(:) / frag%mtot end associate return diff --git a/src/fraggle/fraggle_regime.f90 b/src/fraggle/fraggle_regime.f90 index cf8d5891c..7b3191149 100644 --- a/src/fraggle/fraggle_regime.f90 +++ b/src/fraggle/fraggle_regime.f90 @@ -42,9 +42,9 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) mass_si(:) = colliders%mass([jtarg, jproj]) * param%MU2KG !! The two-body equivalent masses of the collider system radius_si(:) = colliders%radius([jtarg, jproj]) * param%DU2M !! The two-body equivalent radii of the collider system density_si(:) = mass_si(:) / (4.0_DP / 3._DP * PI * radius_si(:)**3) !! The two-body equivalent density of the collider system - x1_si(:) = colliders%xb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system + x1_si(:) = colliders%rb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system v1_si(:) = colliders%vb(:,jtarg) * param%DU2M / param%TU2S !! The first body of the two-body equivalent velocity vector the collider system - x2_si(:) = colliders%xb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system + x2_si(:) = colliders%rb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system v2_si(:) = colliders%vb(:,jproj) * param%DU2M / param%TU2S !! The second body of the two-body equivalent velocity vector the collider system Mcb_si = system%cb%mass * param%MU2KG !! The central body mass of the system select type(param) @@ -68,7 +68,7 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) ! Find the center of mass of the collisional system frag%mtot = sum(colliders%mass(:)) - frag%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / frag%mtot + frag%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / frag%mtot frag%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / frag%mtot ! Convert quantities back to the system units and save them into the fragment system @@ -82,7 +82,7 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) end subroutine fraggle_regime_colliders - subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb2, den1, den2, min_mfrag, & + subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, den1, den2, min_mfrag, & regime, Mlr, Mslr, Qloss) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! @@ -103,7 +103,7 @@ subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb implicit none ! Arguments real(DP), intent(in) :: Mcb, m1, m2, rad1, rad2, den1, den2, min_mfrag - real(DP), dimension(:), intent(in) :: xh1, xh2, vb1, vb2 + real(DP), dimension(:), intent(in) :: rh1, rh2, vb1, vb2 integer(I4B), intent(out) :: regime real(DP), intent(out) :: Mlr, Mslr real(DP), intent(out) :: Qloss !! The residual energy after the collision @@ -130,9 +130,9 @@ subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb real(DP) :: U_binding Vimp = norm2(vb2(:) - vb1(:)) - b = calc_b(xh2, vb2, xh1, vb1) + b = calc_b(rh2, vb2, rh1, vb1) l = (rad1 + rad2) * (1 - b) - egy = 0.5_DP * dot_product(vb1, vb1) - GC * Mcb / norm2(xh1) + egy = 0.5_DP * dot_product(vb1, vb1) - GC * Mcb / norm2(rh1) a1 = - GC * Mcb / 2.0_DP / egy Mtot = m1 + m2 mu = (m1 * m2) / Mtot diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 6f61b989c..4a70130b6 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -177,7 +177,7 @@ module subroutine fraggle_set_coordinate_system(self, colliders) associate(frag => self, nfrag => self%nbody) delta_v(:) = colliders%vb(:, 2) - colliders%vb(:, 1) v_col_norm = .mag. delta_v(:) - delta_r(:) = colliders%xb(:, 2) - colliders%xb(:, 1) + delta_r(:) = colliders%rb(:, 2) - colliders%rb(:, 1) r_col_norm = .mag. delta_r(:) ! We will initialize fragments on a plane defined by the pre-impact system, with the z-axis aligned with the angular momentum vector @@ -234,9 +234,9 @@ module subroutine fraggle_set_natural_scale_factors(self, colliders) frag%Lscale = frag%mscale * frag%dscale * frag%vscale ! Scale all dimensioned quantities of colliders and fragments - frag%xbcom(:) = frag%xbcom(:) / frag%dscale + frag%rbcom(:) = frag%rbcom(:) / frag%dscale frag%vbcom(:) = frag%vbcom(:) / frag%vscale - colliders%xb(:,:) = colliders%xb(:,:) / frag%dscale + colliders%rb(:,:) = colliders%rb(:,:) / frag%dscale colliders%vb(:,:) = colliders%vb(:,:) / frag%vscale colliders%mass(:) = colliders%mass(:) / frag%mscale colliders%radius(:) = colliders%radius(:) / frag%dscale @@ -276,12 +276,12 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) associate(frag => self) ! Restore scale factors - frag%xbcom(:) = frag%xbcom(:) * frag%dscale + frag%rbcom(:) = frag%rbcom(:) * frag%dscale frag%vbcom(:) = frag%vbcom(:) * frag%vscale colliders%mass = colliders%mass * frag%mscale colliders%radius = colliders%radius * frag%dscale - colliders%xb = colliders%xb * frag%dscale + colliders%rb = colliders%rb * frag%dscale colliders%vb = colliders%vb * frag%vscale colliders%L_spin = colliders%L_spin * frag%Lscale do i = 1, 2 @@ -297,7 +297,7 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) frag%v_coll = frag%v_coll * frag%vscale do i = 1, frag%nbody - frag%xb(:, i) = frag%x_coll(:, i) + frag%xbcom(:) + frag%rb(:, i) = frag%x_coll(:, i) + frag%rbcom(:) frag%vb(:, i) = frag%v_coll(:, i) + frag%vbcom(:) end do diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index 2eff96c29..ab31af995 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -19,7 +19,7 @@ module subroutine fraggle_setup_reset_fragments(self) ! Arguments class(fraggle_fragments), intent(inout) :: self - self%xb(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP self%vb(:,:) = 0.0_DP self%rot(:,:) = 0.0_DP self%x_coll(:,:) = 0.0_DP diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 22ca5cd55..038b3c1a5 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -35,9 +35,9 @@ module subroutine fraggle_util_add_fragments_to_system(frag, colliders, system, pl%Gmass(npl_before+1:npl_after) = frag%mass(1:nfrag) * param%GU pl%radius(npl_before+1:npl_after) = frag%radius(1:nfrag) do concurrent (i = 1:nfrag) - pl%xb(:,npl_before+i) = frag%xb(:,i) + pl%rb(:,npl_before+i) = frag%rb(:,i) pl%vb(:,npl_before+i) = frag%vb(:,i) - pl%rh(:,npl_before+i) = frag%xb(:,i) - cb%xb(:) + pl%rh(:,npl_before+i) = frag%rb(:,i) - cb%rb(:) pl%vh(:,npl_before+i) = frag%vb(:,i) - cb%vb(:) end do if (param%lrotation) then diff --git a/src/helio/helio_kick.f90 b/src/helio/helio_kick.f90 index b5161b405..03bc688b5 100644 --- a/src/helio/helio_kick.f90 +++ b/src/helio/helio_kick.f90 @@ -75,7 +75,7 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) associate(tp => self, cb => system%cb, pl => system%pl, npl => system%pl%nbody) system%lbeg = lbeg if (system%lbeg) then - call tp%accel_int(param, pl%Gmass(1:npl), pl%xbeg(:,1:npl), npl) + call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:,1:npl), npl) else call tp%accel_int(param, pl%Gmass(1:npl), pl%xend(:,1:npl), npl) end if @@ -112,7 +112,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) pl%ah(:, 1:npl) = 0.0_DP call pl%accel(system, param, t, lbeg) if (lbeg) then - call pl%set_beg_end(xbeg = pl%rh) + call pl%set_beg_end(rbeg = pl%rh) else call pl%set_beg_end(xend = pl%rh) end if diff --git a/src/io/io.f90 b/src/io/io.f90 index 71815b4be..c58eb4dbb 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -133,7 +133,7 @@ module subroutine io_conservation_report(self, param, lterminal) associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit, nc => param%system_history%nc) call pl%vb2vh(cb) - call pl%xh2xb(cb) + call pl%rh2rb(cb) call system%get_energy_and_momentum(param) ke_orbit_now = system%ke_orbit diff --git a/src/kick/kick.f90 b/src/kick/kick.f90 index 40b238fec..8f1ae7e08 100644 --- a/src/kick/kick.f90 +++ b/src/kick/kick.f90 @@ -63,7 +63,7 @@ module subroutine kick_getacch_int_pl(self, param) end subroutine kick_getacch_int_pl - module subroutine kick_getacch_int_tp(self, param, GMpl, xhp, npl) + module subroutine kick_getacch_int_tp(self, param, GMpl, rhp, npl) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies @@ -75,12 +75,12 @@ module subroutine kick_getacch_int_tp(self, param, GMpl, xhp, npl) class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters real(DP), dimension(:), intent(in) :: GMpl !! Massive body masses - real(DP), dimension(:,:), intent(in) :: xhp !! Massive body position vectors + real(DP), dimension(:,:), intent(in) :: rhp !! Massive body position vectors integer(I4B), intent(in) :: npl !! Number of active massive bodies if ((self%nbody == 0) .or. (npl == 0)) return - call kick_getacch_int_all_tp(self%nbody, npl, self%rh, xhp, GMpl, self%lmask, self%ah) + call kick_getacch_int_all_tp(self%nbody, npl, self%rh, rhp, GMpl, self%lmask, self%ah) return end subroutine kick_getacch_int_tp diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 989399f94..8c75a3fc6 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -27,7 +27,7 @@ module fraggle_classes type :: fraggle_colliders integer(I4B) :: ncoll !! Number of bodies involved in the collision integer(I4B), dimension(:), allocatable :: idx !! Index of bodies involved in the collision - real(DP), dimension(NDIM,2) :: xb !! Two-body equivalent position vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: rb !! Two-body equivalent position vectors of the collider bodies prior to collision real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision real(DP), dimension(NDIM,2) :: rot !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision real(DP), dimension(NDIM,2) :: L_spin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision @@ -52,7 +52,7 @@ module fraggle_classes integer(I4B) :: regime !! Collresolve regime code for this collision ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors (these are used internally by the fragment generation subroutine) - real(DP), dimension(NDIM) :: xbcom !! Center of mass position vector of the collider system in system barycentric coordinates + real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider system in system barycentric coordinates real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider system in system barycentric coordinates real(DP), dimension(NDIM) :: x_coll_unit !! x-direction unit vector of collisional system real(DP), dimension(NDIM) :: y_coll_unit !! y-direction unit vector of collisional system diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs_classes.f90 index ec7dfcf16..f8add18eb 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs_classes.f90 @@ -77,7 +77,7 @@ module rmvs_classes ! The following are used to correctly set the oblateness values of the acceleration during an inner encounter with a planet type(rmvs_cb) :: cb_heliocentric !! Copy of original central body object passed to close encounter (used for oblateness acceleration during planetocentric encoountters) - real(DP), dimension(:,:), allocatable :: xheliocentric !! original heliocentric position (used for oblateness calculation during close encounters) + real(DP), dimension(:,:), allocatable :: rheliocentric !! original heliocentric position (used for oblateness calculation during close encounters) integer(I4B) :: index !! inner substep number within current set integer(I4B) :: ipleP !! index value of encountering planet logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 1762a8e78..d86a742b2 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -320,7 +320,7 @@ module swiftest_classes real(DP), dimension(NDIM) :: aoblend = 0.0_DP !! Barycentric acceleration due to central body oblatenes at end of step real(DP), dimension(NDIM) :: atidebeg = 0.0_DP !! Barycentric acceleration due to central body oblatenes at beginning of step real(DP), dimension(NDIM) :: atideend = 0.0_DP !! Barycentric acceleration due to central body oblatenes at end of step - real(DP), dimension(NDIM) :: xb = 0.0_DP !! Barycentric position (units DU) + real(DP), dimension(NDIM) :: rb = 0.0_DP !! Barycentric position (units DU) real(DP), dimension(NDIM) :: vb = 0.0_DP !! Barycentric velocity (units DU / TU) real(DP), dimension(NDIM) :: agr = 0.0_DP !! Acceleration due to post-Newtonian correction real(DP), dimension(NDIM) :: Ip = 0.0_DP !! Unitless principal moments of inertia (I1, I2, I3) / (MR**2). Principal axis rotation assumed. @@ -349,7 +349,7 @@ module swiftest_classes real(DP), dimension(:), allocatable :: mu !! G * (Mcb + [m]) real(DP), dimension(:,:), allocatable :: rh !! Swiftestcentric position real(DP), dimension(:,:), allocatable :: vh !! Swiftestcentric velocity - real(DP), dimension(:,:), allocatable :: xb !! Barycentric position + real(DP), dimension(:,:), allocatable :: rb !! Barycentric position real(DP), dimension(:,:), allocatable :: vb !! Barycentric velocity real(DP), dimension(:,:), allocatable :: ah !! Total heliocentric acceleration real(DP), dimension(:,:), allocatable :: aobl !! Barycentric accelerations of bodies due to central body oblatenes @@ -402,7 +402,7 @@ module swiftest_classes real(DP), dimension(:), allocatable :: rhill !! Body mass (units MU) real(DP), dimension(:), allocatable :: renc !! Critical radius for close encounters real(DP), dimension(:), allocatable :: radius !! Body radius (units DU) - real(DP), dimension(:,:), allocatable :: xbeg !! Position at beginning of step + real(DP), dimension(:,:), allocatable :: rbeg !! Position at beginning of step real(DP), dimension(:,:), allocatable :: xend !! Position at end of step real(DP), dimension(:,:), allocatable :: vbeg !! Velocity at beginning of step real(DP), dimension(:), allocatable :: density !! Body mass density - calculated internally (units MU / DU**3) @@ -429,7 +429,7 @@ module swiftest_classes procedure :: b2h => util_coord_b2h_pl !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) procedure :: vh2vb => util_coord_vh2vb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) procedure :: vb2vh => util_coord_vb2vh_pl !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) - procedure :: xh2xb => util_coord_rh2xb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position only) + procedure :: rh2rb => util_coord_rh2rb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position only) procedure :: dealloc => util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: resize => util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. @@ -469,7 +469,7 @@ module swiftest_classes procedure :: b2h => util_coord_b2h_tp !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) procedure :: vb2vh => util_coord_vb2vh_tp !! Convert test particles from barycentric to heliocentric coordinates (velocity only) procedure :: vh2vb => util_coord_vh2vb_tp !! Convert test particles from heliocentric to barycentric coordinates (velocity only) - procedure :: xh2xb => util_coord_rh2xb_tp !! Convert test particles from heliocentric to barycentric coordinates (position only) + procedure :: rh2rb => util_coord_rh2rb_tp !! Convert test particles from heliocentric to barycentric coordinates (position only) procedure :: dealloc => util_dealloc_tp !! Deallocates all allocatable arrays procedure :: fill => util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: get_peri => util_peri_tp !! Determine system pericenter passages for test particles @@ -928,12 +928,12 @@ module subroutine kick_getacch_int_pl(self, param) class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters end subroutine kick_getacch_int_pl - module subroutine kick_getacch_int_tp(self, param, GMpl, xhp, npl) + module subroutine kick_getacch_int_tp(self, param, GMpl, rhp, npl) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters real(DP), dimension(:), intent(in) :: GMpl !! Massive body masses - real(DP), dimension(:,:), intent(in) :: xhp !! Massive body position vectors + real(DP), dimension(:,:), intent(in) :: rhp !! Massive body position vectors integer(I4B), intent(in) :: npl !! Number of active massive bodies end subroutine kick_getacch_int_tp @@ -1350,17 +1350,17 @@ module subroutine util_coord_vh2vb_tp(self, vbcb) real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body end subroutine util_coord_vh2vb_tp - module subroutine util_coord_rh2xb_pl(self, cb) + module subroutine util_coord_rh2rb_pl(self, cb) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_coord_rh2xb_pl + end subroutine util_coord_rh2rb_pl - module subroutine util_coord_rh2xb_tp(self, cb) + module subroutine util_coord_rh2rb_tp(self, cb) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - end subroutine util_coord_rh2xb_tp + end subroutine util_coord_rh2rb_tp module subroutine util_copy_particle_info(self, source) implicit none @@ -1627,10 +1627,10 @@ module subroutine util_get_idvalues_system(self, idvals) integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot end subroutine util_get_idvalues_system - module subroutine util_set_beg_end_pl(self, xbeg, xend, vbeg) + module subroutine util_set_beg_end_pl(self, rbeg, xend, vbeg) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), dimension(:,:), intent(in), optional :: xbeg !! Position vectors at beginning of step + real(DP), dimension(:,:), intent(in), optional :: rbeg !! Position vectors at beginning of step real(DP), dimension(:,:), intent(in), optional :: xend !! Positions vectors at end of step real(DP), dimension(:,:), intent(in), optional :: vbeg !! vbeg is an unused variable to keep this method forward compatible with RMVS end subroutine util_set_beg_end_pl diff --git a/src/rmvs/rmvs_encounter_check.f90 b/src/rmvs/rmvs_encounter_check.f90 index 860bcacfb..be0c8ba62 100644 --- a/src/rmvs/rmvs_encounter_check.f90 +++ b/src/rmvs/rmvs_encounter_check.f90 @@ -42,7 +42,7 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount class is (rmvs_pl) associate(tp => self, ntp => self%nbody, npl => pl%nbody) tp%plencP(1:ntp) = 0 - call encounter_check_all_pltp(param, npl, ntp, pl%xbeg, pl%vbeg, tp%rh, tp%vh, pl%renc, dt, & + call encounter_check_all_pltp(param, npl, ntp, pl%rbeg, pl%vbeg, tp%rh, tp%vh, pl%renc, dt, & nenc, index1, index2, lvdotr) lencounter = (nenc > 0_I8B) diff --git a/src/rmvs/rmvs_kick.f90 b/src/rmvs/rmvs_kick.f90 index bb43aba94..88b71d0a9 100644 --- a/src/rmvs/rmvs_kick.f90 +++ b/src/rmvs/rmvs_kick.f90 @@ -27,7 +27,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step ! Internals class(swiftest_parameters), allocatable :: param_planetocen - real(DP), dimension(:, :), allocatable :: xh_original + real(DP), dimension(:, :), allocatable :: rh_original real(DP) :: GMcb_original integer(I4B) :: i @@ -46,7 +46,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) system_planetocen%lbeg = lbeg ! Save the original heliocentric position for later - allocate(xh_original, source=tp%rh) + allocate(rh_original, source=tp%rh) ! Temporarily turn off the heliocentric-dependent acceleration terms during an inner encounter using a copy of the parameter list with all of the heliocentric-specific acceleration terms turned off allocate(param_planetocen, source=param) @@ -60,17 +60,17 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) ! Now compute any heliocentric values of acceleration if (tp%lfirst) then do concurrent(i = 1:ntp, tp%lmask(i)) - tp%xheliocentric(:,i) = tp%rh(:,i) + cb%inner(inner_index - 1)%x(:,1) + tp%rheliocentric(:,i) = tp%rh(:,i) + cb%inner(inner_index - 1)%x(:,1) end do else do concurrent(i = 1:ntp, tp%lmask(i)) - tp%xheliocentric(:,i) = tp%rh(:,i) + cb%inner(inner_index )%x(:,1) + tp%rheliocentric(:,i) = tp%rh(:,i) + cb%inner(inner_index )%x(:,1) end do end if ! Swap the planetocentric and heliocentric position vectors and central body masses do concurrent(i = 1:ntp, tp%lmask(i)) - tp%rh(:, i) = tp%xheliocentric(:, i) + tp%rh(:, i) = tp%rheliocentric(:, i) end do GMcb_original = cb%Gmass cb%Gmass = tp%cb_heliocentric%Gmass @@ -81,7 +81,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) ! Put everything back the way we found it - call move_alloc(xh_original, tp%rh) + call move_alloc(rh_original, tp%rh) cb%Gmass = GMcb_original end associate diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 index 2c5a0faea..9c0b88876 100644 --- a/src/rmvs/rmvs_setup.f90 +++ b/src/rmvs/rmvs_setup.f90 @@ -156,7 +156,7 @@ module subroutine rmvs_setup_tp(self, n, param) allocate(self%plperP(n)) allocate(self%plencP(n)) - if (self%lplanetocentric) allocate(self%xheliocentric(NDIM, n)) + if (self%lplanetocentric) allocate(self%rheliocentric(NDIM, n)) self%lperi(:) = .false. diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index 132139e33..ab39e6f31 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -26,7 +26,7 @@ module subroutine rmvs_step_system(self, param, t, dt) real(DP), intent(in) :: dt !! Current stepsiz ! Internals logical :: lencounter, lfirstpl - real(DP), dimension(:,:), allocatable :: xbeg, xend, vbeg + real(DP), dimension(:,:), allocatable :: rbeg, xend, vbeg if (self%tp%nbody == 0) then call whm_step_system(self, param, t, dt) @@ -38,15 +38,15 @@ module subroutine rmvs_step_system(self, param, t, dt) select type(tp => self%tp) class is (rmvs_tp) associate(system => self, ntp => tp%nbody, npl => pl%nbody) - allocate(xbeg, source=pl%rh) + allocate(rbeg, source=pl%rh) allocate(vbeg, source=pl%vh) - call pl%set_beg_end(xbeg = xbeg, vbeg = vbeg) + call pl%set_beg_end(rbeg = rbeg, vbeg = vbeg) ! ****** Check for close encounters ***** ! call pl%set_renc(RHSCALE) lencounter = tp%encounter_check(param, system, dt) if (lencounter) then lfirstpl = pl%lfirst - pl%outer(0)%x(:, 1:npl) = xbeg(:, 1:npl) + pl%outer(0)%x(:, 1:npl) = rbeg(:, 1:npl) pl%outer(0)%v(:, 1:npl) = vbeg(:, 1:npl) call pl%step(system, param, t, dt) pl%outer(NTENC)%x(:, 1:npl) = pl%rh(:, 1:npl) @@ -54,7 +54,7 @@ module subroutine rmvs_step_system(self, param, t, dt) call rmvs_interp_out(cb, pl, dt) call rmvs_step_out(cb, pl, tp, system, param, t, dt) tp%lmask(1:ntp) = .not. tp%lmask(1:ntp) - call pl%set_beg_end(xbeg = xbeg, xend = xend) + call pl%set_beg_end(rbeg = rbeg, xend = xend) tp%lfirst = .true. call tp%step(system, param, t, dt) tp%lmask(1:ntp) = .true. @@ -185,7 +185,7 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) call pl%set_renc(RHPSCALE) do outer_index = 1, NTENC outer_time = t + (outer_index - 1) * dto - call pl%set_beg_end(xbeg = pl%outer(outer_index - 1)%x(:, 1:npl), & + call pl%set_beg_end(rbeg = pl%outer(outer_index - 1)%x(:, 1:npl), & vbeg = pl%outer(outer_index - 1)%v(:, 1:npl), & xend = pl%outer(outer_index )%x(:, 1:npl)) lencounter = tp%encounter_check(param, system, dto) @@ -234,7 +234,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) ! Internals integer(I4B) :: i, inner_index real(DP) :: frac, dntphenc - real(DP), dimension(:,:), allocatable :: xtmp, vtmp, xh_original, ah_original + real(DP), dimension(:,:), allocatable :: xtmp, vtmp, rh_original, ah_original real(DP), dimension(:), allocatable :: GMcb, dti integer(I4B), dimension(:), allocatable :: iflag @@ -258,7 +258,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) vtmp(:, 1:npl) = pl%inner(0)%v(:, 1:npl) if ((param%loblatecb) .or. (param%ltides)) then - allocate(xh_original, source=pl%rh) + allocate(rh_original, source=pl%rh) allocate(ah_original, source=pl%ah) pl%rh(:, 1:npl) = xtmp(:, 1:npl) ! Temporarily replace heliocentric position with inner substep values to calculate the oblateness terms end if @@ -339,7 +339,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) ! pl%inner(NTPHENC)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! end if ! Put the planet positions and accelerations back into place - if (allocated(xh_original)) call move_alloc(xh_original, pl%rh) + if (allocated(rh_original)) call move_alloc(rh_original, pl%rh) if (allocated(ah_original)) call move_alloc(ah_original, pl%ah) end associate return @@ -389,7 +389,7 @@ subroutine rmvs_step_in(cb, pl, tp, param, outer_time, dto) lfirsttp = .true. do inner_index = 1, NTPHENC ! Integrate over the encounter region, using the "substitute" planetocentric systems at each level plenci%rh(:, 1:npl) = plenci%inner(inner_index - 1)%x(:, 1:npl) - call plenci%set_beg_end(xbeg = plenci%inner(inner_index - 1)%x, & + call plenci%set_beg_end(rbeg = plenci%inner(inner_index - 1)%x, & xend = plenci%inner(inner_index)%x) if (param%loblatecb) then @@ -403,7 +403,7 @@ subroutine rmvs_step_in(cb, pl, tp, param, outer_time, dto) call tpenci%step(planetocen_system, param, inner_time, dti) do j = 1, pl%nenc(i) - tpenci%xheliocentric(:, j) = tpenci%rh(:, j) + pl%inner(inner_index)%x(:,i) + tpenci%rheliocentric(:, j) = tpenci%rh(:, j) + pl%inner(inner_index)%x(:,i) end do inner_time = outer_time + j * dti call rmvs_peri_tp(tpenci, pl, inner_time, dti, .false., inner_index, i, param) @@ -464,8 +464,8 @@ subroutine rmvs_make_planetocentric(param, cb, pl, tp) ! Grab all the encountering test particles and convert them to a planetocentric frame tpenci%id(1:nenci) = pack(tp%id(1:ntp), encmask(1:ntp)) do j = 1, NDIM - tpenci%xheliocentric(j, 1:nenci) = pack(tp%rh(j,1:ntp), encmask(:)) - tpenci%rh(j, 1:nenci) = tpenci%xheliocentric(j, 1:nenci) - pl%inner(0)%x(j, i) + tpenci%rheliocentric(j, 1:nenci) = pack(tp%rh(j,1:ntp), encmask(:)) + tpenci%rh(j, 1:nenci) = tpenci%rheliocentric(j, 1:nenci) - pl%inner(0)%x(j, i) tpenci%vh(j, 1:nenci) = pack(tp%vh(j, 1:ntp), encmask(1:ntp)) - pl%inner(0)%v(j, i) end do tpenci%lperi(1:nenci) = pack(tp%lperi(1:ntp), encmask(1:ntp)) @@ -534,7 +534,7 @@ subroutine rmvs_peri_tp(tp, pl, t, dt, lfirst, inner_index, ipleP, param) ! Internals integer(I4B) :: i, id1, id2 real(DP) :: r2, mu, rhill2, vdotr, a, peri, capm, tperi, rpl - real(DP), dimension(NDIM) :: xh1, xh2, vh1, vh2 + real(DP), dimension(NDIM) :: rh1, rh2, vh1, vh2 rhill2 = pl%rhill(ipleP)**2 mu = pl%Gmass(ipleP) diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index eb31db53d..b62c3ad88 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -137,7 +137,7 @@ module subroutine rmvs_util_dealloc_tp(self) if (allocated(self%lperi)) deallocate(self%lperi) if (allocated(self%plperP)) deallocate(self%plperP) if (allocated(self%plencP)) deallocate(self%plencP) - if (allocated(self%xheliocentric)) deallocate(self%xheliocentric) + if (allocated(self%rheliocentric)) deallocate(self%rheliocentric) call self%cb_heliocentric%dealloc() call util_dealloc_tp(self) @@ -319,7 +319,7 @@ module subroutine rmvs_util_resize_tp(self, nnew) call util_resize(self%lperi, nnew) call util_resize(self%plperP, nnew) call util_resize(self%plencP, nnew) - call util_resize(self%xheliocentric, nnew) + call util_resize(self%rheliocentric, nnew) call util_resize_tp(self, nnew) @@ -399,7 +399,7 @@ module subroutine rmvs_util_sort_tp(self, sortby, ascending) call util_sort(direction * tp%plperP(1:ntp), ind) case("plencP") call util_sort(direction * tp%plencP(1:ntp), ind) - case("lperi", "cb_heliocentric", "xheliocentric", "index", "ipleP", "lplanetocentric") + case("lperi", "cb_heliocentric", "rheliocentric", "index", "ipleP", "lplanetocentric") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class (*NOTE whm_tp does not need its own sort method, so we go straight to the swiftest_tp method) call util_sort_tp(tp, sortby, ascending) @@ -451,7 +451,7 @@ module subroutine rmvs_util_sort_rearrange_tp(self, ind) call util_sort_rearrange(tp%lperi, ind, ntp) call util_sort_rearrange(tp%plperP, ind, ntp) call util_sort_rearrange(tp%plencP, ind, ntp) - call util_sort_rearrange(tp%xheliocentric, ind, ntp) + call util_sort_rearrange(tp%rheliocentric, ind, ntp) call util_sort_rearrange_tp(tp,ind) end associate diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 64c63b390..36a131611 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -230,7 +230,7 @@ module subroutine setup_body(self, n, param) allocate(self%mu(n)) allocate(self%rh(NDIM, n)) allocate(self%vh(NDIM, n)) - allocate(self%xb(NDIM, n)) + allocate(self%rb(NDIM, n)) allocate(self%vb(NDIM, n)) allocate(self%ah(NDIM, n)) allocate(self%ir3h(n)) @@ -260,7 +260,7 @@ module subroutine setup_body(self, n, param) self%mu(:) = 0.0_DP self%rh(:,:) = 0.0_DP self%vh(:,:) = 0.0_DP - self%xb(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP self%vb(:,:) = 0.0_DP self%ah(:,:) = 0.0_DP self%ir3h(:) = 0.0_DP diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index ab2962054..a32a18c7c 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -184,7 +184,7 @@ module function symba_collision_casemerge(system, param) result(status) call fragments%set_mass_dist(colliders, param) ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) fragments%id(1) = pl%id(ibiggest) - fragments%xb(:,1) = fragments%xbcom(:) + fragments%rb(:,1) = fragments%rbcom(:) fragments%vb(:,1) = fragments%vbcom(:) if (param%lrotation) then @@ -201,7 +201,7 @@ module function symba_collision_casemerge(system, param) result(status) pe = 0.0_DP do j = 1, colliders%ncoll do i = j + 1, colliders%ncoll - pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%xb(:, i) - pl%xb(:, j)) + pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%rb(:, i) - pl%rb(:, j)) end do end do system%Ecollisions = system%Ecollisions + pe @@ -340,16 +340,16 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec lany_collision = any(lcollision(:)) if (lany_collision) then - call pl%xh2xb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary do k = 1, nenc i = self%index1(k) j = self%index2(k) if (lcollision(k)) self%status(k) = COLLISION self%tcollision(k) = t - self%x1(:,k) = pl%rh(:,i) + system%cb%xb(:) + self%x1(:,k) = pl%rh(:,i) + system%cb%rb(:) self%v1(:,k) = pl%vb(:,i) if (isplpl) then - self%x2(:,k) = pl%rh(:,j) + system%cb%xb(:) + self%x2(:,k) = pl%rh(:,j) + system%cb%rb(:) self%v2(:,k) = pl%vb(:,j) if (lcollision(k)) then ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collisional colliders%idx @@ -362,7 +362,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec call pl%info(j)%set_value(status="COLLISION", discard_time=t, discard_rh=pl%rh(:,j), discard_vh=pl%vh(:,j)) end if else - self%x2(:,k) = tp%rh(:,j) + system%cb%xb(:) + self%x2(:,k) = tp%rh(:,j) + system%cb%rb(:) self%v2(:,k) = tp%vb(:,j) if (lcollision(k)) then tp%status(j) = DISCARDED_PLR @@ -513,7 +513,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid ! Find the barycenter of each body along with its children, if it has any do j = 1, 2 - colliders%xb(:, j) = pl%rh(:, idx_parent(j)) + cb%xb(:) + colliders%rb(:, j) = pl%rh(:, idx_parent(j)) + cb%rb(:) colliders%vb(:, j) = pl%vb(:, idx_parent(j)) ! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip) if (param%lrotation) then @@ -526,16 +526,16 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid idx_child = parent_child_index_array(j)%idx(i + 1) if (.not. pl%lcollision(idx_child)) cycle mchild = pl%mass(idx_child) - xchild(:) = pl%rh(:, idx_child) + cb%xb(:) + xchild(:) = pl%rh(:, idx_child) + cb%rb(:) vchild(:) = pl%vb(:, idx_child) volchild = (4.0_DP / 3.0_DP) * PI * pl%radius(idx_child)**3 volume(j) = volume(j) + volchild ! Get angular momentum of the child-parent pair and add that to the spin ! Add the child's spin if (param%lrotation) then - xcom(:) = (colliders%mass(j) * colliders%xb(:,j) + mchild * xchild(:)) / (colliders%mass(j) + mchild) + xcom(:) = (colliders%mass(j) * colliders%rb(:,j) + mchild * xchild(:)) / (colliders%mass(j) + mchild) vcom(:) = (colliders%mass(j) * colliders%vb(:,j) + mchild * vchild(:)) / (colliders%mass(j) + mchild) - xc(:) = colliders%xb(:, j) - xcom(:) + xc(:) = colliders%rb(:, j) - xcom(:) vc(:) = colliders%vb(:, j) - vcom(:) xcrossv(:) = xc(:) .cross. vc(:) colliders%L_spin(:, j) = colliders%L_spin(:, j) + colliders%mass(j) * xcrossv(:) @@ -553,7 +553,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid ! Merge the child and parent colliders%mass(j) = colliders%mass(j) + mchild - colliders%xb(:, j) = xcom(:) + colliders%rb(:, j) = xcom(:) colliders%vb(:, j) = vcom(:) end do end if @@ -563,10 +563,10 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid end do lflag = .true. - xcom(:) = (colliders%mass(1) * colliders%xb(:, 1) + colliders%mass(2) * colliders%xb(:, 2)) / sum(colliders%mass(:)) + xcom(:) = (colliders%mass(1) * colliders%rb(:, 1) + colliders%mass(2) * colliders%rb(:, 2)) / sum(colliders%mass(:)) vcom(:) = (colliders%mass(1) * colliders%vb(:, 1) + colliders%mass(2) * colliders%vb(:, 2)) / sum(colliders%mass(:)) - mxc(:, 1) = colliders%mass(1) * (colliders%xb(:, 1) - xcom(:)) - mxc(:, 2) = colliders%mass(2) * (colliders%xb(:, 2) - xcom(:)) + mxc(:, 1) = colliders%mass(1) * (colliders%rb(:, 1) - xcom(:)) + mxc(:, 2) = colliders%mass(2) * (colliders%rb(:, 2) - xcom(:)) vcc(:, 1) = colliders%vb(:, 1) - vcom(:) vcc(:, 2) = colliders%vb(:, 2) - vcom(:) colliders%L_orbit(:,:) = mxc(:,:) .cross. vcc(:,:) @@ -745,12 +745,12 @@ subroutine symba_collision_mergeaddsub(system, param, status) ! Copy over identification, information, and physical properties of the new bodies from the fragment list plnew%id(1:nfrag) = fragments%id(1:nfrag) - plnew%xb(:, 1:nfrag) = fragments%xb(:, 1:nfrag) + plnew%rb(:, 1:nfrag) = fragments%rb(:, 1:nfrag) plnew%vb(:, 1:nfrag) = fragments%vb(:, 1:nfrag) call pl%vb2vh(cb) - call pl%xh2xb(cb) + call pl%rh2rb(cb) do i = 1, nfrag - plnew%rh(:,i) = fragments%xb(:, i) - cb%xb(:) + plnew%rh(:,i) = fragments%rb(:, i) - cb%rb(:) plnew%vh(:,i) = fragments%vb(:, i) - cb%vb(:) end do plnew%mass(1:nfrag) = fragments%mass(1:nfrag) @@ -955,7 +955,7 @@ module subroutine symba_resolve_collision_mergers(self, system, param) fragments%mass_dist(1) = fragments%mtot fragments%mass_dist(2) = 0.0_DP fragments%mass_dist(3) = 0.0_DP - fragments%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / fragments%mtot + fragments%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / fragments%mtot fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot plplcollision_list%status(i) = symba_collision_casemerge(system, param) end do @@ -994,7 +994,7 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir if (plplcollision_list%nenc == 0) return ! No collisions to resolve ! Make sure that the heliocentric and barycentric coordinates are consistent with each other call pl%vb2vh(system%cb) - call pl%xh2xb(system%cb) + call pl%rh2rb(system%cb) ! Get the energy before the collision is resolved if (param%lenergy) then diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index a380487f7..82741d695 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -74,7 +74,7 @@ subroutine symba_discard_cb_pl(pl, system, param) call pl%info(i)%set_value(status="DISCARDED_RMIN", discard_time=system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i), discard_body_id=cb%id) else if (param%rmaxu >= 0.0_DP) then - rb2 = dot_product(pl%xb(:,i), pl%xb(:,i)) + rb2 = dot_product(pl%rb(:,i), pl%rb(:,i)) vb2 = dot_product(pl%vb(:,i), pl%vb(:,i)) energy = 0.5_DP * vb2 - system%Gmtot / sqrt(rb2) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then @@ -124,7 +124,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) class is (symba_cb) ! Add the potential and kinetic energy of the lost body to the records - pe = -cb%Gmass * pl%mass(ipl) / norm2(pl%xb(:, ipl) - cb%xb(:)) + pe = -cb%Gmass * pl%mass(ipl) / norm2(pl%rb(:, ipl) - cb%rb(:)) ke_orbit = 0.5_DP * pl%mass(ipl) * dot_product(pl%vb(:, ipl), pl%vb(:, ipl)) if (param%lrotation) then ke_spin = 0.5_DP * pl%mass(ipl) * pl%radius(ipl)**2 * pl%Ip(3, ipl) * dot_product(pl%rot(:, ipl), pl%rot(:, ipl)) @@ -138,15 +138,15 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) system%GMescape = system%GMescape + pl%Gmass(ipl) do i = 1, pl%nbody if (i == ipl) cycle - pe = pe - pl%Gmass(i) * pl%mass(ipl) / norm2(pl%xb(:, ipl) - pl%xb(:, i)) + pe = pe - pl%Gmass(i) * pl%mass(ipl) / norm2(pl%rb(:, ipl) - pl%rb(:, i)) end do Ltot(:) = 0.0_DP do i = 1, pl%nbody - Lpl(:) = pL%mass(i) * (pl%xb(:,i) .cross. pl%vb(:, i)) + Lpl(:) = pL%mass(i) * (pl%rb(:,i) .cross. pl%vb(:, i)) Ltot(:) = Ltot(:) + Lpl(:) end do - Ltot(:) = Ltot(:) + cb%mass * (cb%xb(:) .cross. cb%vb(:)) + Ltot(:) = Ltot(:) + cb%mass * (cb%rb(:) .cross. cb%vb(:)) call pl%b2h(cb) oldstat = pl%status(ipl) pl%status(ipl) = INACTIVE @@ -154,21 +154,21 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) pl%status(ipl) = oldstat do i = 1, pl%nbody if (i == ipl) cycle - Lpl(:) = pl%mass(i) * (pl%xb(:,i) .cross. pl%vb(:, i)) + Lpl(:) = pl%mass(i) * (pl%rb(:,i) .cross. pl%vb(:, i)) Ltot(:) = Ltot(:) - Lpl(:) end do - Ltot(:) = Ltot(:) - cb%mass * (cb%xb(:) .cross. cb%vb(:)) + Ltot(:) = Ltot(:) - cb%mass * (cb%rb(:) .cross. cb%vb(:)) system%Lescape(:) = system%Lescape(:) + Ltot(:) if (param%lrotation) system%Lescape(:) = system%Lescape + pl%mass(ipl) * pl%radius(ipl)**2 & * pl%Ip(3, ipl) * pl%rot(:, ipl) else - xcom(:) = (pl%mass(ipl) * pl%xb(:, ipl) + cb%mass * cb%xb(:)) / (cb%mass + pl%mass(ipl)) + xcom(:) = (pl%mass(ipl) * pl%rb(:, ipl) + cb%mass * cb%rb(:)) / (cb%mass + pl%mass(ipl)) vcom(:) = (pl%mass(ipl) * pl%vb(:, ipl) + cb%mass * cb%vb(:)) / (cb%mass + pl%mass(ipl)) - Lpl(:) = (pl%xb(:,ipl) - xcom(:)) .cross. (pL%vb(:,ipl) - vcom(:)) + Lpl(:) = (pl%rb(:,ipl) - xcom(:)) .cross. (pL%vb(:,ipl) - vcom(:)) if (param%lrotation) Lpl(:) = pl%mass(ipl) * (Lpl(:) + pl%radius(ipl)**2 * pl%Ip(3,ipl) * pl%rot(:, ipl)) - Lcb(:) = cb%mass * ((cb%xb(:) - xcom(:)) .cross. (cb%vb(:) - vcom(:))) + Lcb(:) = cb%mass * ((cb%rb(:) - xcom(:)) .cross. (cb%vb(:) - vcom(:))) ke_orbit = ke_orbit + 0.5_DP * cb%mass * dot_product(cb%vb(:), cb%vb(:)) if (param%lrotation) ke_spin = ke_spin + 0.5_DP * cb%mass * cb%radius**2 * cb%Ip(3) * dot_product(cb%rot(:), cb%rot(:)) @@ -186,7 +186,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) cb%rot(:) = (cb%L0(:) + cb%dL(:)) / (cb%Ip(3) * cb%mass * cb%radius**2) ke_spin = ke_spin - 0.5_DP * cb%mass * cb%radius**2 * cb%Ip(3) * dot_product(cb%rot(:), cb%rot(:)) end if - cb%xb(:) = xcom(:) + cb%rb(:) = xcom(:) cb%vb(:) = vcom(:) ke_orbit = ke_orbit - 0.5_DP * cb%mass * dot_product(cb%vb(:), cb%vb(:)) end if @@ -360,7 +360,7 @@ module subroutine symba_discard_pl(self, system, param) class is (symba_parameters) associate(pl => self, plplenc_list => system%plplenc_list, plplcollision_list => system%plplcollision_list) call pl%vb2vh(system%cb) - call pl%xh2xb(system%cb) + call pl%rh2rb(system%cb) !call plplenc_list%write(pl, pl, param) TODO: write the encounter list writer for NetCDF call symba_discard_nonplpl(self, system, param) diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 114160f9a..cdad09045 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -129,7 +129,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) j = pltpenc_list%index2(k) if (tp%lmask(j)) then if (lbeg) then - dx(:) = tp%rh(:,j) - pl%xbeg(:,i) + dx(:) = tp%rh(:,j) - pl%rbeg(:,i) else dx(:) = tp%rh(:,j) - pl%xend(:,i) end if diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 9443d658c..8874be49b 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -532,7 +532,7 @@ module subroutine symba_util_peri_pl(self, system, param) else do i = 1, npl if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%xb(:,i), pl%vb(:,i)) + vdotr = dot_product(pl%rb(:,i), pl%vb(:,i)) if (vdotr > 0.0_DP) then pl%isperi(i) = 1 else @@ -564,11 +564,11 @@ module subroutine symba_util_peri_pl(self, system, param) else do i = 1, npl if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%xb(:,i), pl%vb(:,i)) + vdotr = dot_product(pl%rb(:,i), pl%vb(:,i)) if (pl%isperi(i) == -1) then if (vdotr >= 0.0_DP) then pl%isperi(i) = 0 - CALL orbel_xv2aeq(system%Gmtot, pl%xb(1,i), pl%xb(2,i), pl%xb(3,i), pl%vb(1,i), pl%vb(2,i), pl%vb(3,i),& + CALL orbel_xv2aeq(system%Gmtot, pl%rb(1,i), pl%rb(2,i), pl%rb(3,i), pl%vb(1,i), pl%vb(2,i), pl%vb(3,i),& pl%atp(i), e, pl%peri(i)) end if else @@ -612,7 +612,7 @@ module subroutine symba_util_rearray_pl(self, system, param) nadd = pl_adds%nbody if (npl == 0) return ! Deallocate any temporary variables - if (allocated(pl%xbeg)) deallocate(pl%xbeg) + if (allocated(pl%rbeg)) deallocate(pl%rbeg) if (allocated(pl%xend)) deallocate(pl%xend) ! Remove the discards and destroy the list, as the system already tracks pl_discards elsewhere diff --git a/src/tides/tides_spin_step.f90 b/src/tides/tides_spin_step.f90 index 576aff8d7..ee4309eb6 100644 --- a/src/tides/tides_spin_step.f90 +++ b/src/tides/tides_spin_step.f90 @@ -4,7 +4,7 @@ type, extends(lambda_obj_tvar) :: tides_derivs_func !! Base class for an lambda function object. This object takes no additional arguments other than the dependent variable x, an array of real numbers procedure(tidederiv), pointer, nopass :: lambdaptr_tides_deriv - real(DP), dimension(:,:), allocatable :: xbeg + real(DP), dimension(:,:), allocatable :: rbeg real(DP), dimension(:,:), allocatable :: xend real(DP) :: dt contains @@ -16,13 +16,13 @@ module procedure tides_derivs_init end interface abstract interface - function tidederiv(x, t, dt, xbeg, xend) result(y) + function tidederiv(x, t, dt, rbeg, xend) result(y) ! Template for a 0 argument function import DP, swiftest_nbody_system real(DP), dimension(:), intent(in) :: x real(DP), intent(in) :: t real(DP), intent(in) :: dt - real(DP), dimension(:,:), intent(in) :: xbeg + real(DP), dimension(:,:), intent(in) :: rbeg real(DP), dimension(:,:), intent(in) :: xend real(DP), dimension(:), allocatable :: y end function @@ -51,7 +51,7 @@ module subroutine tides_step_spin_system(self, param, t, dt) rot0 = [pack(pl%rot(:,1:npl),.true.), pack(cb%rot(:),.true.)] ! Use this space call the ode_solver, passing tides_spin_derivs as the function: subdt = dt / 20._DP - !rot1(:) = util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%xbeg, pl%xend), rot0, dt, subdt tol) + !rot1(:) = util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%rbeg, pl%xend), rot0, dt, subdt tol) ! Recover with unpack !pl%rot(:,1:npl) = unpack(rot1... !cb%rot(:) = unpack(rot1... @@ -61,7 +61,7 @@ module subroutine tides_step_spin_system(self, param, t, dt) end subroutine tides_step_spin_system - function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... + function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, xend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... !! author: Jennifer L.L. Pouplin and David A. Minton !! !! function used to calculate the derivatives that are fed to the ODE solver @@ -70,7 +70,7 @@ function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to real(DP), dimension(:,:), intent(in) :: rot_pl_cb !! Array of rotations. The last element is the central body, and all others are massive bodies real(DP), intent(in) :: t !! Current time, which is used to interpolate the massive body positions real(DP), intent(in) :: dt !! Total step size - real(DP), dimension(:,:), intent(in) :: xbeg + real(DP), dimension(:,:), intent(in) :: rbeg real(DP), dimension(:,:), intent(in) :: xend ! Internals real(DP), dimension(:,:), allocatable :: drot @@ -85,7 +85,7 @@ function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to allocate(drot, mold=rot_pl_cb) drot(:,:) = 0.0_DP do i = 1,n-1 - xinterp(:) = xbeg(:,i) + t / dt * (xend(:,i) - xbeg(:,i)) + xinterp(:) = rbeg(:,i) + t / dt * (xend(:,i) - rbeg(:,i)) ! Calculate Ncb and Npl as a function of xinterp !drot(:,i) = -Mcb / (Mcb + Mpl(i)) * (N_Tpl + N_Rpl) !drot(:,n) = drot(:,n) - Mcb / (Mcb + Mpl(i) * (N_Tcb + N_Rcb) @@ -104,7 +104,7 @@ function tides_derivs_eval(self, x, t) result(y) ! Result real(DP), dimension(:), allocatable :: y if (associated(self%lambdaptr_tides_deriv)) then - y = self%lambdaptr_tides_deriv(x, t, self%dt, self%xbeg, self%xend) + y = self%lambdaptr_tides_deriv(x, t, self%dt, self%rbeg, self%xend) else error stop "Lambda function was not initialized" end if @@ -112,18 +112,18 @@ function tides_derivs_eval(self, x, t) result(y) return end function tides_derivs_eval - function tides_derivs_init(lambda, dt, xbeg, xend) result(f) + function tides_derivs_init(lambda, dt, rbeg, xend) result(f) implicit none ! Arguments procedure(tidederiv) :: lambda real(DP), intent(in) :: dt - real(DP), dimension(:,:), intent(in) :: xbeg + real(DP), dimension(:,:), intent(in) :: rbeg real(DP), dimension(:,:), intent(in) :: xend ! Result type(tides_derivs_func) :: f f%lambdaptr_tides_deriv => lambda f%dt = dt - allocate(f%xbeg, source = xbeg) + allocate(f%rbeg, source = rbeg) allocate(f%xend, source = xend) return diff --git a/src/util/util_append.f90 b/src/util/util_append.f90 index a02b28f2b..7470bace4 100644 --- a/src/util/util_append.f90 +++ b/src/util/util_append.f90 @@ -211,7 +211,7 @@ module subroutine util_append_body(self, source, lsource_mask) call util_append(self%mu, source%mu, nold, nsrc, lsource_mask) call util_append(self%rh, source%rh, nold, nsrc, lsource_mask) call util_append(self%vh, source%vh, nold, nsrc, lsource_mask) - call util_append(self%xb, source%xb, nold, nsrc, lsource_mask) + call util_append(self%rb, source%rb, nold, nsrc, lsource_mask) call util_append(self%vb, source%vb, nold, nsrc, lsource_mask) call util_append(self%ah, source%ah, nold, nsrc, lsource_mask) call util_append(self%aobl, source%aobl, nold, nsrc, lsource_mask) @@ -250,7 +250,7 @@ module subroutine util_append_pl(self, source, lsource_mask) call util_append(self%rhill, source%rhill, nold, nsrc, lsource_mask) call util_append(self%renc, source%renc, nold, nsrc, lsource_mask) call util_append(self%radius, source%radius, nold, nsrc, lsource_mask) - call util_append(self%xbeg, source%xbeg, nold, nsrc, lsource_mask) + call util_append(self%rbeg, source%rbeg, nold, nsrc, lsource_mask) call util_append(self%xend, source%xend, nold, nsrc, lsource_mask) call util_append(self%vbeg, source%vbeg, nold, nsrc, lsource_mask) call util_append(self%density, source%density, nold, nsrc, lsource_mask) diff --git a/src/util/util_coord.f90 b/src/util/util_coord.f90 index 98a5549ac..78c2eca83 100644 --- a/src/util/util_coord.f90 +++ b/src/util/util_coord.f90 @@ -38,11 +38,11 @@ module subroutine util_coord_h2b_pl(self, cb) xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,i) vtmp(:) = vtmp(:) + pl%Gmass(i) * pl%vh(:,i) end do - cb%xb(:) = -xtmp(:) / Gmtot + cb%rb(:) = -xtmp(:) / Gmtot cb%vb(:) = -vtmp(:) / Gmtot do i = 1, npl if (pl%status(i) == INACTIVE) cycle - pl%xb(:,i) = pl%rh(:,i) + cb%xb(:) + pl%rb(:,i) = pl%rh(:,i) + cb%rb(:) pl%vb(:,i) = pl%vh(:,i) + cb%vb(:) end do end associate @@ -68,7 +68,7 @@ module subroutine util_coord_h2b_tp(self, cb) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody) do concurrent (i = 1:ntp, tp%status(i) /= INACTIVE) - tp%xb(:, i) = tp%rh(:, i) + cb%xb(:) + tp%rb(:, i) = tp%rh(:, i) + cb%rb(:) tp%vb(:, i) = tp%vh(:, i) + cb%vb(:) end do end associate @@ -95,7 +95,7 @@ module subroutine util_coord_b2h_pl(self, cb) associate(pl => self, npl => self%nbody) do concurrent (i = 1:npl, pl%status(i) /= INACTIVE) - pl%rh(:, i) = pl%xb(:, i) - cb%xb(:) + pl%rh(:, i) = pl%rb(:, i) - cb%rb(:) pl%vh(:, i) = pl%vb(:, i) - cb%vb(:) end do end associate @@ -122,7 +122,7 @@ module subroutine util_coord_b2h_tp(self, cb) associate(tp => self, ntp => self%nbody) do concurrent(i = 1:ntp, tp%status(i) /= INACTIVE) - tp%rh(:, i) = tp%xb(:, i) - cb%xb(:) + tp%rh(:, i) = tp%rb(:, i) - cb%rb(:) tp%vh(:, i) = tp%vb(:, i) - cb%vb(:) end do end associate @@ -246,7 +246,7 @@ module subroutine util_coord_vh2vb_tp(self, vbcb) end subroutine util_coord_vh2vb_tp - module subroutine util_coord_rh2xb_pl(self, cb) + module subroutine util_coord_rh2rb_pl(self, cb) !! author: David A. Minton !! !! Convert position vectors of massive bodies from heliocentric to barycentric coordinates (position only) @@ -271,18 +271,18 @@ module subroutine util_coord_rh2xb_pl(self, cb) Gmtot = Gmtot + pl%Gmass(i) xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,i) end do - cb%xb(:) = -xtmp(:) / Gmtot + cb%rb(:) = -xtmp(:) / Gmtot do i = 1, npl if (pl%status(i) == INACTIVE) cycle - pl%xb(:,i) = pl%rh(:,i) + cb%xb(:) + pl%rb(:,i) = pl%rh(:,i) + cb%rb(:) end do end associate return - end subroutine util_coord_rh2xb_pl + end subroutine util_coord_rh2rb_pl - module subroutine util_coord_rh2xb_tp(self, cb) + module subroutine util_coord_rh2rb_tp(self, cb) !! author: David A. Minton !! !! Convert test particles from heliocentric to barycentric coordinates (position only) @@ -299,11 +299,11 @@ module subroutine util_coord_rh2xb_tp(self, cb) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody) do concurrent (i = 1:ntp, tp%status(i) /= INACTIVE) - tp%xb(:, i) = tp%rh(:, i) + cb%xb(:) + tp%rb(:, i) = tp%rh(:, i) + cb%rb(:) end do end associate return - end subroutine util_coord_rh2xb_tp + end subroutine util_coord_rh2rb_tp end submodule s_util_coord \ No newline at end of file diff --git a/src/util/util_dealloc.f90 b/src/util/util_dealloc.f90 index 54151f567..14309d2a6 100644 --- a/src/util/util_dealloc.f90 +++ b/src/util/util_dealloc.f90 @@ -27,7 +27,7 @@ module subroutine util_dealloc_body(self) if (allocated(self%mu)) deallocate(self%mu) if (allocated(self%rh)) deallocate(self%rh) if (allocated(self%vh)) deallocate(self%vh) - if (allocated(self%xb)) deallocate(self%xb) + if (allocated(self%rb)) deallocate(self%rb) if (allocated(self%vb)) deallocate(self%vb) if (allocated(self%ah)) deallocate(self%ah) if (allocated(self%aobl)) deallocate(self%aobl) diff --git a/src/util/util_fill.f90 b/src/util/util_fill.f90 index 9b542d19c..265138238 100644 --- a/src/util/util_fill.f90 +++ b/src/util/util_fill.f90 @@ -162,7 +162,7 @@ module subroutine util_fill_body(self, inserts, lfill_list) call util_fill(keeps%mu, inserts%mu, lfill_list) call util_fill(keeps%rh, inserts%rh, lfill_list) call util_fill(keeps%vh, inserts%vh, lfill_list) - call util_fill(keeps%xb, inserts%xb, lfill_list) + call util_fill(keeps%rb, inserts%rb, lfill_list) call util_fill(keeps%vb, inserts%vb, lfill_list) call util_fill(keeps%ah, inserts%ah, lfill_list) call util_fill(keeps%aobl, inserts%aobl, lfill_list) @@ -208,7 +208,7 @@ module subroutine util_fill_pl(self, inserts, lfill_list) call util_fill(keeps%k2, inserts%k2, lfill_list) call util_fill(keeps%Q, inserts%Q, lfill_list) call util_fill(keeps%tlag, inserts%tlag, lfill_list) - call util_fill(keeps%xbeg, inserts%xbeg, lfill_list) + call util_fill(keeps%rbeg, inserts%rbeg, lfill_list) call util_fill(keeps%vbeg, inserts%vbeg, lfill_list) call util_fill(keeps%Ip, inserts%Ip, lfill_list) call util_fill(keeps%rot, inserts%rot, lfill_list) diff --git a/src/util/util_get_energy_momentum.f90 b/src/util/util_get_energy_momentum.f90 index ed7119d8b..cc1e64d15 100644 --- a/src/util/util_get_energy_momentum.f90 +++ b/src/util/util_get_energy_momentum.f90 @@ -49,12 +49,12 @@ module subroutine util_get_energy_momentum_system(self, param) system%GMtot = cb%Gmass + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) kecb = cb%mass * dot_product(cb%vb(:), cb%vb(:)) - Lcborbit(:) = cb%mass * (cb%xb(:) .cross. cb%vb(:)) + Lcborbit(:) = cb%mass * (cb%rb(:) .cross. cb%vb(:)) do concurrent (i = 1:npl, pl%lmask(i)) - hx = pl%xb(2,i) * pl%vb(3,i) - pl%xb(3,i) * pl%vb(2,i) - hy = pl%xb(3,i) * pl%vb(1,i) - pl%xb(1,i) * pl%vb(3,i) - hz = pl%xb(1,i) * pl%vb(2,i) - pl%xb(2,i) * pl%vb(1,i) + hx = pl%rb(2,i) * pl%vb(3,i) - pl%rb(3,i) * pl%vb(2,i) + hy = pl%rb(3,i) * pl%vb(1,i) - pl%rb(1,i) * pl%vb(3,i) + hz = pl%rb(1,i) * pl%vb(2,i) - pl%rb(2,i) * pl%vb(1,i) ! Angular momentum from orbit Lplorbitx(i) = pl%mass(i) * hx @@ -87,9 +87,9 @@ module subroutine util_get_energy_momentum_system(self, param) end if if (param%lflatten_interactions) then - call util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%xb, system%pe) + call util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) else - call util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%xb, system%pe) + call util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) end if ! Potential energy from the oblateness term @@ -119,7 +119,7 @@ module subroutine util_get_energy_momentum_system(self, param) end subroutine util_get_energy_momentum_system - subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass, mass, xb, pe) + subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass, mass, rb, pe) !! author: David A. Minton !! !! Compute total system potential energy @@ -132,7 +132,7 @@ subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass real(DP), intent(in) :: GMcb real(DP), dimension(:), intent(in) :: Gmass real(DP), dimension(:), intent(in) :: mass - real(DP), dimension(:,:), intent(in) :: xb + real(DP), dimension(:,:), intent(in) :: rb real(DP), intent(out) :: pe ! Internals integer(I4B) :: i, j @@ -147,18 +147,18 @@ subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass end where do concurrent(i = 1:npl, lmask(i)) - pecb(i) = -GMcb * mass(i) / norm2(xb(:,i)) + pecb(i) = -GMcb * mass(i) / norm2(rb(:,i)) end do !$omp parallel do default(private) schedule(static)& - !$omp shared(k_plpl, xb, mass, Gmass, pepl, lstatpl, lmask) & + !$omp shared(k_plpl, rb, mass, Gmass, pepl, lstatpl, lmask) & !$omp firstprivate(nplpl) do k = 1, nplpl i = k_plpl(1,k) j = k_plpl(2,k) lstatpl(k) = (lmask(i) .and. lmask(j)) if (lstatpl(k)) then - pepl(k) = -(Gmass(i) * mass(j)) / norm2(xb(:, i) - xb(:, j)) + pepl(k) = -(Gmass(i) * mass(j)) / norm2(rb(:, i) - rb(:, j)) else pepl(k) = 0.0_DP end if @@ -171,7 +171,7 @@ subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass end subroutine util_get_energy_potential_flat - subroutine util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, xb, pe) + subroutine util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, rb, pe) !! author: David A. Minton !! !! Compute total system potential energy @@ -182,7 +182,7 @@ subroutine util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, x real(DP), intent(in) :: GMcb real(DP), dimension(:), intent(in) :: Gmass real(DP), dimension(:), intent(in) :: mass - real(DP), dimension(:,:), intent(in) :: xb + real(DP), dimension(:,:), intent(in) :: rb real(DP), intent(out) :: pe ! Internals integer(I4B) :: i, j @@ -194,18 +194,18 @@ subroutine util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, x end where do concurrent(i = 1:npl, lmask(i)) - pecb(i) = -GMcb * mass(i) / norm2(xb(:,i)) + pecb(i) = -GMcb * mass(i) / norm2(rb(:,i)) end do pe = 0.0_DP !$omp parallel do default(private) schedule(static)& - !$omp shared(lmask, Gmass, mass, xb) & + !$omp shared(lmask, Gmass, mass, rb) & !$omp firstprivate(npl) & !$omp reduction(+:pe) do i = 1, npl if (lmask(i)) then do concurrent(j = i+1:npl, lmask(i) .and. lmask(j)) - pepl(j) = - (Gmass(i) * mass(j)) / norm2(xb(:, i) - xb(:, j)) + pepl(j) = - (Gmass(i) * mass(j)) / norm2(rb(:, i) - rb(:, j)) end do pe = pe + sum(pepl(i+1:npl), lmask(i+1:npl)) end if diff --git a/src/util/util_peri.f90 b/src/util/util_peri.f90 index badd0e328..76252828e 100644 --- a/src/util/util_peri.f90 +++ b/src/util/util_peri.f90 @@ -51,11 +51,11 @@ module subroutine util_peri_tp(self, system, param) end do else do i = 1, ntp - vdotr(i) = dot_product(tp%xb(:, i), tp%vb(:, i)) + vdotr(i) = dot_product(tp%rb(:, i), tp%vb(:, i)) if (tp%isperi(i) == -1) then if (vdotr(i) >= 0.0_DP) then tp%isperi(i) = 0 - call orbel_xv2aeq(system%Gmtot, tp%xb(1,i), tp%xb(2,i), tp%xb(3,i), tp%vb(1,i), tp%vb(2,i), tp%vb(3,i), & + call orbel_xv2aeq(system%Gmtot, tp%rb(1,i), tp%rb(2,i), tp%rb(3,i), tp%vb(1,i), tp%vb(2,i), tp%vb(3,i), & tp%atp(i), e, tp%peri(i)) end if else diff --git a/src/util/util_rescale.f90 b/src/util/util_rescale.f90 index deb3e0e1e..372edd3fb 100644 --- a/src/util/util_rescale.f90 +++ b/src/util/util_rescale.f90 @@ -42,7 +42,7 @@ module subroutine util_rescale_system(self, param, mscale, dscale, tscale) cb%mass = cb%mass / mscale cb%Gmass = param%GU * cb%mass cb%radius = cb%radius / dscale - cb%xb(:) = cb%xb(:) / dscale + cb%rb(:) = cb%rb(:) / dscale cb%vb(:) = cb%vb(:) / vscale cb%rot(:) = cb%rot(:) * tscale pl%mass(1:npl) = pl%mass(1:npl) / mscale @@ -50,7 +50,7 @@ module subroutine util_rescale_system(self, param, mscale, dscale, tscale) pl%radius(1:npl) = pl%radius(1:npl) / dscale pl%rh(:,1:npl) = pl%rh(:,1:npl) / dscale pl%vh(:,1:npl) = pl%vh(:,1:npl) / vscale - pl%xb(:,1:npl) = pl%xb(:,1:npl) / dscale + pl%rb(:,1:npl) = pl%rb(:,1:npl) / dscale pl%vb(:,1:npl) = pl%vb(:,1:npl) / vscale pl%rot(:,1:npl) = pl%rot(:,1:npl) * tscale diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 index eee6b0e4c..4963fd689 100644 --- a/src/util/util_resize.f90 +++ b/src/util/util_resize.f90 @@ -299,7 +299,7 @@ module subroutine util_resize_body(self, nnew) call util_resize(self%mu, nnew) call util_resize(self%rh, nnew) call util_resize(self%vh, nnew) - call util_resize(self%xb, nnew) + call util_resize(self%rb, nnew) call util_resize(self%vb, nnew) call util_resize(self%ah, nnew) call util_resize(self%aobl, nnew) @@ -334,7 +334,7 @@ module subroutine util_resize_pl(self, nnew) call util_resize(self%rhill, nnew) call util_resize(self%renc, nnew) call util_resize(self%radius, nnew) - call util_resize(self%xbeg, nnew) + call util_resize(self%rbeg, nnew) call util_resize(self%xend, nnew) call util_resize(self%vbeg, nnew) call util_resize(self%density, nnew) diff --git a/src/util/util_set.f90 b/src/util/util_set.f90 index 05e4b41f9..3e7719bff 100644 --- a/src/util/util_set.f90 +++ b/src/util/util_set.f90 @@ -13,18 +13,18 @@ use swiftest contains - module subroutine util_set_beg_end_pl(self, xbeg, xend, vbeg) + module subroutine util_set_beg_end_pl(self, rbeg, xend, vbeg) !! author: David A. Minton !! - !! Sets one or more of the values of xbeg, xend, and vbeg + !! Sets one or more of the values of rbeg, xend, and vbeg implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), dimension(:,:), intent(in), optional :: xbeg, xend, vbeg + real(DP), dimension(:,:), intent(in), optional :: rbeg, xend, vbeg - if (present(xbeg)) then - if (allocated(self%xbeg)) deallocate(self%xbeg) - allocate(self%xbeg, source=xbeg) + if (present(rbeg)) then + if (allocated(self%rbeg)) deallocate(self%rbeg) + allocate(self%rbeg, source=rbeg) end if if (present(xend)) then if (allocated(self%xend)) deallocate(self%xend) diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 index b1500afab..6b48103d5 100644 --- a/src/util/util_sort.f90 +++ b/src/util/util_sort.f90 @@ -51,7 +51,7 @@ module subroutine util_sort_body(self, sortby, ascending) call util_sort(direction * body%capom(1:n), ind) case("mu") call util_sort(direction * body%mu(1:n), ind) - case("lfirst", "nbody", "ldiscard", "rh", "vh", "xb", "vb", "ah", "aobl", "atide", "agr") + case("lfirst", "nbody", "ldiscard", "rh", "vh", "rb", "vb", "ah", "aobl", "atide", "agr") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not found!' @@ -687,7 +687,7 @@ module subroutine util_sort_pl(self, sortby, ascending) call util_sort(direction * pl%Q(1:npl), ind) case("tlag") call util_sort(direction * pl%tlag(1:npl), ind) - case("xbeg", "xend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") + case("rbeg", "xend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class call util_sort_body(pl, sortby, ascending) @@ -762,7 +762,7 @@ module subroutine util_sort_rearrange_body(self, ind) call util_sort_rearrange(self%ldiscard, ind, n) call util_sort_rearrange(self%rh, ind, n) call util_sort_rearrange(self%vh, ind, n) - call util_sort_rearrange(self%xb, ind, n) + call util_sort_rearrange(self%rb, ind, n) call util_sort_rearrange(self%vb, ind, n) call util_sort_rearrange(self%ah, ind, n) call util_sort_rearrange(self%ir3h, ind, n) @@ -964,7 +964,7 @@ module subroutine util_sort_rearrange_pl(self, ind) call util_sort_rearrange(pl%mass, ind, npl) call util_sort_rearrange(pl%Gmass, ind, npl) call util_sort_rearrange(pl%rhill, ind, npl) - call util_sort_rearrange(pl%xbeg, ind, npl) + call util_sort_rearrange(pl%rbeg, ind, npl) call util_sort_rearrange(pl%vbeg, ind, npl) call util_sort_rearrange(pl%radius, ind, npl) call util_sort_rearrange(pl%density, ind, npl) diff --git a/src/util/util_spill.f90 b/src/util/util_spill.f90 index 9b9208252..1ba4b4a2f 100644 --- a/src/util/util_spill.f90 +++ b/src/util/util_spill.f90 @@ -341,7 +341,7 @@ module subroutine util_spill_body(self, discards, lspill_list, ldestructive) call util_spill(keeps%mu, discards%mu, lspill_list, ldestructive) call util_spill(keeps%rh, discards%rh, lspill_list, ldestructive) call util_spill(keeps%vh, discards%vh, lspill_list, ldestructive) - call util_spill(keeps%xb, discards%xb, lspill_list, ldestructive) + call util_spill(keeps%rb, discards%rb, lspill_list, ldestructive) call util_spill(keeps%vb, discards%vb, lspill_list, ldestructive) call util_spill(keeps%ah, discards%ah, lspill_list, ldestructive) call util_spill(keeps%aobl, discards%aobl, lspill_list, ldestructive) @@ -391,7 +391,7 @@ module subroutine util_spill_pl(self, discards, lspill_list, ldestructive) call util_spill(keeps%k2, discards%k2, lspill_list, ldestructive) call util_spill(keeps%Q, discards%Q, lspill_list, ldestructive) call util_spill(keeps%tlag, discards%tlag, lspill_list, ldestructive) - call util_spill(keeps%xbeg, discards%xbeg, lspill_list, ldestructive) + call util_spill(keeps%rbeg, discards%rbeg, lspill_list, ldestructive) call util_spill(keeps%vbeg, discards%vbeg, lspill_list, ldestructive) call util_spill(keeps%Ip, discards%Ip, lspill_list, ldestructive) call util_spill(keeps%rot, discards%rot, lspill_list, ldestructive) diff --git a/src/whm/whm_kick.f90 b/src/whm/whm_kick.f90 index d782c89f4..b675e4370 100644 --- a/src/whm/whm_kick.f90 +++ b/src/whm/whm_kick.f90 @@ -90,11 +90,11 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) system%lbeg = lbeg if (lbeg) then - ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%xbeg(:, 1:npl), npl) + ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = tp%ah(:, i) + ah0(:) end do - call tp%accel_int(param, pl%Gmass(1:npl), pl%xbeg(:, 1:npl), npl) + call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) else ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%xend(:, 1:npl), npl) do concurrent(i = 1:ntp, tp%lmask(i)) @@ -112,14 +112,14 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) end subroutine whm_kick_getacch_tp - function whm_kick_getacch_ah0(mu, xhp, n) result(ah0) + function whm_kick_getacch_ah0(mu, rhp, n) result(ah0) !! author: David A. Minton !! !! Compute zeroth term heliocentric accelerations of planets implicit none ! Arguments real(DP), dimension(:), intent(in) :: mu - real(DP), dimension(:,:), intent(in) :: xhp + real(DP), dimension(:,:), intent(in) :: rhp integer(I4B), intent(in) :: n ! Result real(DP), dimension(NDIM) :: ah0 @@ -129,11 +129,11 @@ function whm_kick_getacch_ah0(mu, xhp, n) result(ah0) ah0(:) = 0.0_DP do i = 1, n - r2 = dot_product(xhp(:, i), xhp(:, i)) + r2 = dot_product(rhp(:, i), rhp(:, i)) irh = 1.0_DP / sqrt(r2) ir3h = irh / r2 fac = mu(i) * ir3h - ah0(:) = ah0(:) - fac * xhp(:, i) + ah0(:) = ah0(:) - fac * rhp(:, i) end do return @@ -227,7 +227,7 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) call pl%accel(system, param, t, lbeg) pl%lfirst = .false. end if - call pl%set_beg_end(xbeg = pl%rh) + call pl%set_beg_end(rbeg = pl%rh) else pl%ah(:, 1:npl) = 0.0_DP call pl%accel(system, param, t, lbeg) From b862fb4b99f7007afcdb288105a103e2b5846e7e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 06:14:49 -0500 Subject: [PATCH 52/63] Added a check to see if a non-collision is a closest approach (reimplementing an old Swifter feature) --- src/symba/symba_collision.f90 | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index a32a18c7c..222320588 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -279,9 +279,9 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level ! Result - logical :: lany_collision !! Returns true if cany pair of encounters resulted in a collision + logical :: lany_collision, lany_closest !! Returns true if cany pair of encounters resulted in a collision ! Internals - logical, dimension(:), allocatable :: lcollision, lmask + logical, dimension(:), allocatable :: lcollision, lclosest, lmask real(DP), dimension(NDIM) :: xr, vr integer(I4B) :: i, j, k, nenc real(DP) :: rlim, Gmtot @@ -290,6 +290,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec class(symba_encounter), allocatable :: tmp lany_collision = .false. + lany_closest = .false. if (self%nenc == 0) return select type(self) @@ -315,6 +316,8 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec allocate(lcollision(nenc)) lcollision(:) = .false. + allocate(lclosest(nenc)) + lclosest(:) = .false. if (isplpl) then do concurrent(k = 1:nenc, lmask(k)) @@ -324,8 +327,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec vr(:) = pl%vb(:, i) - pl%vb(:, j) rlim = pl%radius(i) + pl%radius(j) Gmtot = pl%Gmass(i) + pl%Gmass(j) - lcollision(k) = symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), & - Gmtot, rlim, dt, self%lvdotr(k)) + call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), lclosest(k)) end do else do concurrent(k = 1:nenc, lmask(k)) @@ -333,12 +335,13 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec j = self%index2(k) xr(:) = pl%rh(:, i) - tp%rh(:, j) vr(:) = pl%vb(:, i) - tp%vb(:, j) - lcollision(k) = symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), & - pl%Gmass(i), pl%radius(i), dt, self%lvdotr(k)) + call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%Gmass(i), pl%radius(i), dt, self%lvdotr(k), lcollision(k), lclosest(k)) end do end if lany_collision = any(lcollision(:)) + lany_closest = any(lclosest(:)) + if (lany_collision) then call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary do k = 1, nenc @@ -379,6 +382,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec end if end do end if + end select end select @@ -397,7 +401,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec end function symba_collision_check_encounter - pure elemental function symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr) result(lcollision) + pure elemental subroutine symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr, lcollision, lclosest) !! author: David A. Minton !! !! Check for a merger between a single pair of particles @@ -413,14 +417,14 @@ pure elemental function symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmt real(DP), intent(in) :: rlim !! Collision limit - Typically the sum of the radii of colliding bodies real(DP), intent(in) :: dt !! Step size logical, intent(in) :: lvdotr !! Logical flag indicating that these two bodies are approaching in the current substep - ! Result - logical :: lcollision !! Logical flag indicating whether these two bodies will collide or not + logical, intent(out) :: lcollision !! Logical flag indicating whether these two bodies will collide or not + logical, intent(out) :: lclosest !! Logical flag indicating that, while not a collision, this is the closest approach for this pair of bodies ! Internals real(DP) :: r2, rlim2, a, e, q, vdotr, tcr2, dt2 r2 = xr**2 + yr**2 + zr**2 rlim2 = rlim**2 - + lclosest = .false. if (r2 <= rlim2) then ! checks if bodies are actively colliding in this time step lcollision = .true. else ! if they are not actively colliding in this time step, checks if they are going to collide next time step based on velocities and q @@ -432,12 +436,13 @@ pure elemental function symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmt if (tcr2 <= dt2) then call orbel_xv2aeq(Gmtot, xr, yr, zr, vxr, vyr, vzr, a, e, q) lcollision = (q < rlim) + lclosest = .not. lcollision end if end if end if return - end function symba_collision_check_one + end subroutine symba_collision_check_one function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) result(lflag) From ecdce0b5be1c5b3f031e5eb812b06c738be70e45 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 06:23:35 -0500 Subject: [PATCH 53/63] Minor restructuring --- src/symba/symba_collision.f90 | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 222320588..405c3855d 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -381,22 +381,20 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec end if end if end do + + ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list + select type(self) + class is (symba_plplenc) + call self%extract_collisions(system, param) + class is (symba_pltpenc) + allocate(tmp, mold=self) + call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list + end select end if end select end select - ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list - if (lany_collision) then - select type(self) - class is (symba_plplenc) - call self%extract_collisions(system, param) - class default - allocate(tmp, mold=self) - call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list - end select - end if - return end function symba_collision_check_encounter From befa1a6f72421dbe3d26a652ed083b89e3d7ace0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 06:32:51 -0500 Subject: [PATCH 54/63] Fixed a typo that would prevent test particle collisions from being resolved. Added close approach flags to encounter check in SyMBA --- src/modules/symba_classes.f90 | 7 ++++--- src/symba/symba_collision.f90 | 11 +++++------ src/symba/symba_step.f90 | 6 +++--- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 3dbcfb90f..47d9c9997 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -207,7 +207,7 @@ module symba_classes interface - module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) + module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision, lany_closest) use swiftest_classes, only : swiftest_parameters implicit none class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object @@ -216,8 +216,9 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level - logical :: lany_collision !! Returns true if cany pair of encounters resulted in a collision n - end function symba_collision_check_encounter + logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision + logical, intent(out) :: lany_closest !! Returns true if any pair of encounters reached their closest approach without colliding + end subroutine symba_collision_check_encounter module subroutine symba_collision_encounter_extract_collisions(self, system, param) implicit none diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 405c3855d..8534237c2 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -262,7 +262,7 @@ subroutine symba_collision_collider_message(pl, collidx, collider_message) end subroutine symba_collision_collider_message - module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) + module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision, lany_closest) !! author: David A. Minton !! !! Check for merger between massive bodies and test particles in SyMBA @@ -278,8 +278,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level - ! Result - logical :: lany_collision, lany_closest !! Returns true if cany pair of encounters resulted in a collision + logical, intent(out) :: lany_collision, lany_closest !! Returns true if cany pair of encounters resulted in a collision ! Internals logical, dimension(:), allocatable :: lcollision, lclosest, lmask real(DP), dimension(NDIM) :: xr, vr @@ -396,7 +395,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec end select return - end function symba_collision_check_encounter + end subroutine symba_collision_check_encounter pure elemental subroutine symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr, lcollision, lclosest) @@ -985,7 +984,7 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir integer(I4B), intent(in) :: irec !! Current recursion level ! Internals real(DP) :: Eorbit_before, Eorbit_after - logical :: lplpl_collision + logical :: lplpl_collision, lplpl_closest character(len=STRMAX) :: timestr class(symba_parameters), allocatable :: tmp_param @@ -1038,7 +1037,7 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir deallocate(tmp_param) ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plplcollision_list - lplpl_collision = plplenc_list%collision_check(system, param, t, dt, irec) + call plplenc_list%collision_check(system, param, t, dt, irec, lplpl_collision, lplpl_closest) if (.not.lplpl_collision) exit end do diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 54e2464d1..ba61844e5 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -180,7 +180,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) ! Internals integer(I4B) :: j, irecp, nloops real(DP) :: dtl, dth - logical :: lencounter + logical :: lencounter, lplpl_closest, lpltp_closest select type(param) class is (symba_parameters) @@ -241,8 +241,8 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) end if if (param%lclose) then - lplpl_collision = plplenc_list%collision_check(system, param, t+dtl, dtl, ireci) - lpltp_collision = pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci) + call plplenc_list%collision_check(system, param, t+dtl, dtl, ireci, lplpl_collision, lplpl_closest) + call pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci, lpltp_collision, lpltp_closest) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) From 52ecbefd61460c837178dddd2d5754f6424da7b8 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 08:18:05 -0500 Subject: [PATCH 55/63] Restructuring so that the saving collisions is not a user option (collision info should always be saved when collisions are turned on) --- examples/Basic_Simulation/output_reader.py | 2 +- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/io.py | 5 +- python/swiftest/swiftest/simulation_class.py | 50 +++---------------- src/io/io.f90 | 2 +- src/modules/symba_classes.f90 | 10 ++-- src/symba/symba_collision.f90 | 19 ++++--- src/symba/symba_io.f90 | 12 +---- src/symba/symba_step.f90 | 6 +-- 9 files changed, 32 insertions(+), 76 deletions(-) diff --git a/examples/Basic_Simulation/output_reader.py b/examples/Basic_Simulation/output_reader.py index a41103ccd..fc332af0c 100644 --- a/examples/Basic_Simulation/output_reader.py +++ b/examples/Basic_Simulation/output_reader.py @@ -28,7 +28,7 @@ import matplotlib.pyplot as plt # Read in the simulation output and store it as an Xarray dataset. -sim = swiftest.Simulation(read_old_output_file=True) +sim = swiftest.Simulation(read_old_output=True) # Plot of the data and save the output plot. colors = ['white' if x == 'Massive Body' else 'black' for x in sim.data['particle_type']] diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 090a4f4a3..a068205fb 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -202,7 +202,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(fragmentation=True, collision_save="TRAJECTORY", encounter_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(fragmentation=True, encounter_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index be70cae50..029672ec7 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -32,8 +32,7 @@ "ENCOUNTER_CHECK", "TSTART", "DUMP_CADENCE", - "ENCOUNTER_SAVE", - "COLLISION_SAVE") + "ENCOUNTER_SAVE") @@ -55,7 +54,7 @@ float_param = ["T0", "TSTART", "TSTOP", "DT", "CHK_RMIN", "CHK_RMAX", "CHK_EJECT", "CHK_QMIN", "DU2M", "MU2KG", "TU2S", "MIN_GMFRAG", "GMTINY"] -upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM","ENCOUNTER_SAVE","COLLISION_SAVE", "CHK_QMIN_COORD"] +upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM","ENCOUNTER_SAVE", "CHK_QMIN_COORD"] lower_str_param = ["NC_IN", "PL_IN", "TP_IN", "CB_IN", "CHK_QMIN_RANGE"] param_keys = ['! VERSION'] + int_param + float_param + upper_str_param + lower_str_param+ bool_param diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 1bedfeba4..a239b9293 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -43,7 +43,7 @@ class Simulation: This is a class that defines the basic Swift/Swifter/Swiftest simulation object """ - def __init__(self,read_param: bool = False, read_old_output_file: bool = False, simdir: os.PathLike | str = "simdata", **kwargs: Any): + def __init__(self,read_param: bool = False, read_old_output: bool = False, simdir: os.PathLike | str = "simdata", **kwargs: Any): """ Parameters @@ -65,7 +65,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, inside the current working directory, which can be changed by passing `param_file` as an argument. - The argument has an equivalent parameter or set of parameters in the parameter input file. 3. Default values (see below) - read_old_output_file : bool, default False + read_old_output : bool, default False If true, read in a pre-existing binary input file given by the argument `output_file_name` if it exists. Parameter input file equivalent: None simdir : PathLike, default `"simdir"` @@ -227,12 +227,6 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. Parameter input file equivalent: `FRAGMENTATION` - collision_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" - Indicate if and how fragmentation data should be saved. If set to "TRAJECTORY" the full close encounter - trajectories associated with each collision are saved to file. If set to "CLOSEST" only the trajectories - at a the time the collision occurs are saved. If set to "NONE" no trajectory information is saved (collision - details are still logged fraggle.log). - *WARNING*: Enabling this feature could lead to very large files. minimum_fragment_gmass : float, optional If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass @@ -329,7 +323,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, msg += "\nDelete the file or change the location of param_file" raise NotADirectoryError(msg) else: - if read_old_output_file or read_param: + if read_old_output or read_param: raise NotADirectoryError(f"Cannot find directory {self.simdir.resolve()} ") else: self.simdir.mkdir(parents=True, exist_ok=False) @@ -354,8 +348,8 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, # If the user asks to read in an old parameter file or output file, override any default parameters with values from the file # If the file doesn't exist, flag it for now so we know to create it param_file_found = False - if read_param or read_old_output_file: - if self.read_param(read_init_cond = not read_old_output_file): + if read_param or read_old_output: + if self.read_param(read_init_cond = not read_old_output): # We will add the parameter file to the kwarg list. This will keep the set_parameter method from # overriding everything with defaults when there are no arguments passed to Simulation() kwargs['param_file'] = self.param_file @@ -375,7 +369,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, self.write_param() # Read in an old simulation file if requested - if read_old_output_file: + if read_old_output: binpath = os.path.join(self.simdir, self.param['BIN_OUT']) if os.path.exists(binpath): self.read_output_file() @@ -762,7 +756,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "init_cond_file_type": "NETCDF_DOUBLE", "init_cond_file_name": None, "init_cond_format": "EL", - "read_old_output_file": False, + "read_old_output": False, "output_file_type": "NETCDF_DOUBLE", "output_file_name": None, "output_format": "XVEL", @@ -794,8 +788,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "encounter_check_loops": "TRIANGULAR", "ephemeris_date": "MBCL", "restart": False, - "encounter_save" : "NONE", - "collision_save" : "NONE" + "encounter_save" : "NONE" } param_file = kwargs.pop("param_file",None) @@ -1032,7 +1025,6 @@ def set_feature(self, interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] | None = None, encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] | None = None, encounter_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, - collision_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, verbose: bool | None = None, **kwargs: Any ): @@ -1054,12 +1046,6 @@ def set_feature(self, fragmentation : bool, optional If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. - collision_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" - Indicate if and how fragmentation data should be saved. If set to "TRAJECTORY" the full close encounter - trajectories associated with each collision are saved to file. If set to "CLOSEST" only the trajectories - at a the time the collision occurs are saved. If set to "NONE" no trajectory information is saved (collision - details are still logged fraggle.log). - *WARNING*: Enabling this feature could lead to very large files. minimum_fragment_gmass : float, optional If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass @@ -1226,20 +1212,6 @@ def set_feature(self, self.param["ENCOUNTER_SAVE"] = encounter_save update_list.append("encounter_save") - - if collision_save is not None: - collision_save = collision_save.upper() - valid_vals = ["NONE", "TRAJECTORY", "CLOSEST"] - if collision_save not in valid_vals: - msg = f"{collision_save} is not a valid option for collision_save." - msg += f"\nMust be one of {valid_vals}" - warnings.warn(msg,stacklevel=2) - if "COLLISION_SAVE" not in self.param: - self.param["COLLISION_SAVE"] = valid_vals[0] - else: - self.param["COLLISION_SAVE"] = collision_save - update_list.append("collision_save") - self.param["TIDES"] = False feature_dict = self.get_feature(update_list, verbose) @@ -1272,7 +1244,6 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N valid_var = {"close_encounter_check": "CHK_CLOSE", "fragmentation": "FRAGMENTATION", "encounter_save": "ENCOUNTER_SAVE", - "collision_save": "COLLISION_SAVE", "minimum_fragment_gmass": "MIN_GMFRAG", "rotation": "ROTATION", "general_relativity": "GR", @@ -2740,11 +2711,6 @@ def read_output_file(self,read_init_cond : bool = True): else: read_encounters = False - if "COLLISION_SAVE" in self.param: - read_collisions = self.param["COLLISION_SAVE"] != "NONE" - else: - read_collisions = False - param_tmp = self.param.copy() param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": diff --git a/src/io/io.f90 b/src/io/io.f90 index c58eb4dbb..f159e6ac7 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -682,7 +682,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%lrestart = .true. end if ! Ignore SyMBA-specific, not-yet-implemented, or obsolete input parameters - case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP", "ENCOUNTER_SAVE", "COLLISION_SAVE") + case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP", "ENCOUNTER_SAVE") case default write(*,*) "Ignoring unknown parameter -> ",param_name end select diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 47d9c9997..ef3297cde 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -31,8 +31,7 @@ module symba_classes integer(I4B), dimension(:), allocatable :: seed !! Random seeds logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved - character(STRMAX) :: collision_save = "NONE" !! Indicate if and how fragmentation data should be saved - logical :: lencounter_save = .false. !! Turns on encounter saving + logical :: lencounter_save type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file contains @@ -175,7 +174,7 @@ module symba_classes !> SyMBA class for tracking pl-pl close encounters in a step type, extends(symba_encounter) :: symba_plplenc contains - procedure :: extract_collisions => symba_collision_encounter_extract_collisions !! Processes the pl-pl encounter list remove only those encounters that led to a collision + procedure :: extract_collisions => symba_collision_extract_collisions_from_encounters !! Processes the pl-pl encounter list remove only those encounters that led to a collision procedure :: resolve_fragmentations => symba_resolve_collision_fragmentations !! Process list of collisions, determine the collisional regime, and then create fragments procedure :: resolve_mergers => symba_resolve_collision_mergers !! Process list of collisions and merge colliding bodies together procedure :: resolve_collision => symba_resolve_collision_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c @@ -207,7 +206,7 @@ module symba_classes interface - module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision, lany_closest) + module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision) use swiftest_classes, only : swiftest_parameters implicit none class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object @@ -217,10 +216,9 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision - logical, intent(out) :: lany_closest !! Returns true if any pair of encounters reached their closest approach without colliding end subroutine symba_collision_check_encounter - module subroutine symba_collision_encounter_extract_collisions(self, system, param) + module subroutine symba_collision_extract_collisions_from_encounters(self, system, param) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 8534237c2..96ab905a0 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -262,7 +262,7 @@ subroutine symba_collision_collider_message(pl, collidx, collider_message) end subroutine symba_collision_collider_message - module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision, lany_closest) + module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision) !! author: David A. Minton !! !! Check for merger between massive bodies and test particles in SyMBA @@ -278,7 +278,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level - logical, intent(out) :: lany_collision, lany_closest !! Returns true if cany pair of encounters resulted in a collision + logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision ! Internals logical, dimension(:), allocatable :: lcollision, lclosest, lmask real(DP), dimension(NDIM) :: xr, vr @@ -289,7 +289,6 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir class(symba_encounter), allocatable :: tmp lany_collision = .false. - lany_closest = .false. if (self%nenc == 0) return select type(self) @@ -339,7 +338,6 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir end if lany_collision = any(lcollision(:)) - lany_closest = any(lclosest(:)) if (lany_collision) then call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary @@ -391,6 +389,11 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir end select end if + ! Take snapshots of pairs of bodies at close approach (but not collision) if requested + if (any(lclosest(:))) then + + end if + end select end select @@ -580,7 +583,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid end function symba_collision_consolidate_colliders - module subroutine symba_collision_encounter_extract_collisions(self, system, param) + module subroutine symba_collision_extract_collisions_from_encounters(self, system, param) !! author: David A. Minton !! !! Processes the pl-pl encounter list remove only those encounters that led to a collision @@ -646,7 +649,7 @@ module subroutine symba_collision_encounter_extract_collisions(self, system, par end select return - end subroutine symba_collision_encounter_extract_collisions + end subroutine symba_collision_extract_collisions_from_encounters module subroutine symba_collision_make_colliders_pl(self, idx) @@ -984,7 +987,7 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir integer(I4B), intent(in) :: irec !! Current recursion level ! Internals real(DP) :: Eorbit_before, Eorbit_after - logical :: lplpl_collision, lplpl_closest + logical :: lplpl_collision character(len=STRMAX) :: timestr class(symba_parameters), allocatable :: tmp_param @@ -1037,7 +1040,7 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir deallocate(tmp_param) ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plplcollision_list - call plplenc_list%collision_check(system, param, t, dt, irec, lplpl_collision, lplpl_closest) + call plplenc_list%collision_check(system, param, t, dt, irec, lplpl_collision) if (.not.lplpl_collision) exit end do diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 4f19bfd30..27a455062 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -68,9 +68,6 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms case ("ENCOUNTER_SAVE") call io_toupper(param_value) read(param_value, *) param%encounter_save - case ("COLLISION_SAVE") - call io_toupper(param_value) - read(param_value, *) param%collision_save case("SEED") read(param_value, *) nseeds_from_file ! Because the number of seeds can vary between compilers/systems, we need to make sure we can handle cases in which the input file has a different @@ -128,14 +125,7 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms return end if - if ((param%collision_save /= "NONE") .and. (param%collision_save /= "TRAJECTORY") .and. (param%collision_save /= "CLOSEST")) then - write(iomsg,*) 'Invalid collision_save parameter: ',trim(adjustl(param%out_type)) - write(iomsg,*) 'Valid options are NONE, TRAJECTORY, or CLOSEST' - iostat = -1 - return - end if - param%lencounter_save = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "CLOSEST") .or. & - (param%collision_save == "TRAJECTORY") .or. (param%collision_save == "CLOSEST") + param%lencounter_save = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "CLOSEST") ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index ba61844e5..eb37c718b 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -180,7 +180,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) ! Internals integer(I4B) :: j, irecp, nloops real(DP) :: dtl, dth - logical :: lencounter, lplpl_closest, lpltp_closest + logical :: lencounter select type(param) class is (symba_parameters) @@ -241,8 +241,8 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) end if if (param%lclose) then - call plplenc_list%collision_check(system, param, t+dtl, dtl, ireci, lplpl_collision, lplpl_closest) - call pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci, lpltp_collision, lpltp_closest) + call plplenc_list%collision_check(system, param, t+dtl, dtl, ireci, lplpl_collision) + call pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci, lpltp_collision) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) From 92f1d8e48484309865af93e26ef043d5e1a30f4f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 08:34:05 -0500 Subject: [PATCH 56/63] Lots of refactoring. Changed bin.nc to data.nc. Changed .ic to .init_cond. Changed the way encounter and collisions are read in (always read the files in if they exist) --- .../Basic_Simulation/initial_conditions.py | 2 +- examples/Basic_Simulation/output_reader.py | 2 +- .../Fragmentation/swiftest_fragmentation.py | 6 +-- examples/helio_gr_test/helio_gr_test.py | 4 +- examples/whm_gr_test/whm_gr_test.py | 4 +- python/swiftest/swiftest/simulation_class.py | 47 +++++++++---------- src/modules/swiftest_globals.f90 | 2 +- 7 files changed, 33 insertions(+), 34 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 861556958..b58522824 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -20,7 +20,7 @@ Output ------ -bin.nc : A NetCDF file containing the simulation output. +data.nc : A NetCDF file containing the simulation output. dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. diff --git a/examples/Basic_Simulation/output_reader.py b/examples/Basic_Simulation/output_reader.py index fc332af0c..977c2a393 100644 --- a/examples/Basic_Simulation/output_reader.py +++ b/examples/Basic_Simulation/output_reader.py @@ -15,7 +15,7 @@ Input ------ -bin.nc : A NetCDF file containing the simulation output. +data.nc : A NetCDF file containing the simulation output. Output ------ diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index 067c53710..3ee13cb2a 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -21,7 +21,7 @@ Output ------ -disruption/bin.nc : A NetCDF file containing the simulation output. +disruption/data.nc : A NetCDF file containing the simulation output. disruption/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. disruption/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. disruption/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. @@ -30,7 +30,7 @@ disruption/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. disruption/param.in : An ASCII file containing the parameters for the simulation. disruption/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -hitandrun/bin.nc : A NetCDF file containing the simulation output. +hitandrun/data.nc : A NetCDF file containing the simulation output. hitandrun/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. hitandrun/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. hitandrun/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. @@ -39,7 +39,7 @@ hitandrun/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. hitandrun/param.in : An ASCII file containing the parameters for the simulation. hitandrun/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -supercat/bin.nc : A NetCDF file containing the simulation output. +supercat/data.nc : A NetCDF file containing the simulation output. supercat/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. supercat/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. supercat/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. diff --git a/examples/helio_gr_test/helio_gr_test.py b/examples/helio_gr_test/helio_gr_test.py index c627be7f4..77ae66740 100644 --- a/examples/helio_gr_test/helio_gr_test.py +++ b/examples/helio_gr_test/helio_gr_test.py @@ -24,7 +24,7 @@ helio_gr_mercury_precession.png : Portable Network Graphic file depicting the precession of Mercury's perihelion over time with data sourced from the JPL Horizons database, Swiftest run with general relativity, and Swiftest run without general relativity. -gr/bin.nc : A NetCDF file containing the simulation output. +gr/data.nc : A NetCDF file containing the simulation output. gr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. gr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. gr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. @@ -32,7 +32,7 @@ gr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. gr/param.in : An ASCII file containing the parameters for the simulation. gr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -nogr/bin.nc : A NetCDF file containing the simulation output. +nogr/data.nc : A NetCDF file containing the simulation output. nogr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. nogr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. nogr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. diff --git a/examples/whm_gr_test/whm_gr_test.py b/examples/whm_gr_test/whm_gr_test.py index d0d2ade69..f4dc185ab 100644 --- a/examples/whm_gr_test/whm_gr_test.py +++ b/examples/whm_gr_test/whm_gr_test.py @@ -24,7 +24,7 @@ whm_gr_mercury_precession.png : Portable Network Graphic file depicting the precession of Mercury's perihelion over time with data sourced from the JPL Horizons database, Swiftest run with general relativity, and Swiftest run without general relativity. -gr/bin.nc : A NetCDF file containing the simulation output. +gr/data.nc : A NetCDF file containing the simulation output. gr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. gr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. gr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. @@ -32,7 +32,7 @@ gr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. gr/param.in : An ASCII file containing the parameters for the simulation. gr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -nogr/bin.nc : A NetCDF file containing the simulation output. +nogr/data.nc : A NetCDF file containing the simulation output. nogr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. nogr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. nogr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index a239b9293..f5517678f 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -141,8 +141,7 @@ def __init__(self,read_param: bool = False, read_old_output: bool = False, simdi Parameter input file equivalent: `OUT_TYPE` output_file_name : str or path-like, optional Name of output file to generate. If not supplied, then one of the default file names are used, depending on - the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "bin.nc". - Otherwise, the default is "bin.dat". + the value passed to `output_file_type`. The default is "data.nc". Parameter input file equivalent: `BIN_OUT` output_format : {"XV","XVEL"}, default "XVEL" Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity @@ -312,7 +311,7 @@ def __init__(self,read_param: bool = False, read_old_output: bool = False, simdi self.param = {} self.data = xr.Dataset() - self.ic = xr.Dataset() + self.init_cond = xr.Dataset() self.encounters = xr.Dataset() self.collisions = xr.Dataset() @@ -1508,7 +1507,7 @@ def set_output_files(self, * Swift: Only "REAL4" supported. output_file_name : str or path-like, optional Name of output file to generate. If not supplied, then one of the default file names are used, depending on - the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "bin.nc". + the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "data.nc". Otherwise, the default is "bin.dat". output_format : {"XV","XVEL"}, optional Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity @@ -1568,7 +1567,7 @@ def set_output_files(self, self.param['OUT_TYPE'] = output_file_type if output_file_name is None: if output_file_type in ["NETCDF_DOUBLE", "NETCDF_FLOAT"]: - self.param['BIN_OUT'] = "bin.nc" + self.param['BIN_OUT'] = "data.nc" else: self.param['BIN_OUT'] = "bin.dat" else: @@ -2157,7 +2156,7 @@ def add_solar_system_body(self, if dsnew['npl'] > 0 or dsnew['ntp'] > 0: self.save(verbose=False) - self.ic = self.data.copy(deep=True) + self.init_cond = self.data.copy(deep=True) return @@ -2456,7 +2455,7 @@ def input_to_array_3d(val,n=None): dsnew = self._combine_and_fix_dsnew(dsnew) self.save(verbose=False) - self.ic = self.data.copy(deep=True) + self.init_cond = self.data.copy(deep=True) return @@ -2563,7 +2562,7 @@ def read_param(self, param_tmp = self.param.copy() param_tmp['BIN_OUT'] = init_cond_file self.data = io.swiftest2xr(param_tmp, verbose=self.verbose) - self.ic = self.data.copy(deep=True) + self.init_cond = self.data.copy(deep=True) else: warnings.warn(f"Initial conditions file file {init_cond_file} not found.", stacklevel=2) else: @@ -2706,11 +2705,6 @@ def read_output_file(self,read_init_cond : bool = True): # This is done to handle cases where the method is called from a different working directory than the simulation # results - if "ENCOUNTER_SAVE" in self.param: - read_encounters = self.param["ENCOUNTER_SAVE"] != "NONE" - else: - read_encounters = False - param_tmp = self.param.copy() param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": @@ -2718,17 +2712,15 @@ def read_output_file(self,read_init_cond : bool = True): if self.verbose: print('Swiftest simulation data stored as xarray DataSet .data') if read_init_cond: if self.verbose: - print("Reading initial conditions file as .ic") + print("Reading initial conditions file as .init_cond") if "NETCDF" in self.param['IN_TYPE']: param_tmp['BIN_OUT'] = self.simdir / self.param['NC_IN'] - - self.ic = io.swiftest2xr(param_tmp, verbose=self.verbose) + self.init_cond = io.swiftest2xr(param_tmp, verbose=False) else: - self.ic = self.data.isel(time=0) - if read_encounters: - self.read_encounters() - if read_collisions: - self.read_collisions() + self.init_cond = self.data.isel(time=0) + + self.read_encounters() + self.read_collisions() elif self.codename == "Swifter": self.data = io.swifter2xr(param_tmp, verbose=self.verbose) @@ -2740,9 +2732,13 @@ def read_output_file(self,read_init_cond : bool = True): return def read_encounters(self): + enc_files = glob(f"{self.simdir}{os.path.sep}encounter_*.nc") + if len(enc_files) == 0: + return + if self.verbose: print("Reading encounter history file as .encounters") - enc_files = glob(f"{self.simdir}{os.path.sep}encounter_*.nc") + enc_files.sort() # This is needed in order to pass the param argument down to the io.process_netcdf_input function @@ -2760,10 +2756,13 @@ def _preprocess(ds, param): def read_collisions(self): - if self.verbose: - print("Reading collision history file as .collisions") col_files = glob(f"{self.simdir}{os.path.sep}collision_*.nc") + if len(col_files) == 0: + return + col_files.sort() + if self.verbose: + print("Reading collision history file as .collisions") # This is needed in order to pass the param argument down to the io.process_netcdf_input function def _preprocess(ds, param): diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index 25f355152..d9590b59e 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -122,7 +122,7 @@ module swiftest_globals character(*), parameter :: PL_INFILE = 'pl.in' character(*), parameter :: TP_INFILE = 'tp.in' character(*), parameter :: NC_INFILE = 'in.nc' - character(*), parameter :: BIN_OUTFILE = 'bin.nc' + character(*), parameter :: BIN_OUTFILE = 'data.nc' integer(I4B), parameter :: BINUNIT = 20 !! File unit number for the binary output file integer(I4B), parameter :: PARTICLEUNIT = 44 !! File unit number for the binary particle info output file integer(I4B), parameter :: LUN = 42 !! File unit number for files that are opened and closed within a single subroutine call, and therefore should not collide From c0adfd83dbe7224f4a5ef63ba0df620588dd4b6b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 09:47:13 -0500 Subject: [PATCH 57/63] Started implementing the CLOSEST vs. TRAJECTORY user options --- src/modules/symba_classes.f90 | 13 +++++++------ src/setup/setup.f90 | 7 ++++--- src/symba/symba_collision.f90 | 4 ++-- src/symba/symba_io.f90 | 3 ++- src/symba/symba_step.f90 | 6 +++--- 5 files changed, 18 insertions(+), 15 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index ef3297cde..ce95269e2 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -26,12 +26,13 @@ module symba_classes real(DP), private, parameter :: RSHELL = 0.48075_DP type, extends(swiftest_parameters) :: symba_parameters - real(DP) :: GMTINY = -1.0_DP !! Smallest G*mass that is fully gravitating - real(DP) :: min_GMfrag = -1.0_DP !! Smallest G*mass that can be produced in a fragmentation event - integer(I4B), dimension(:), allocatable :: seed !! Random seeds - logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. - character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved - logical :: lencounter_save + real(DP) :: GMTINY = -1.0_DP !! Smallest G*mass that is fully gravitating + real(DP) :: min_GMfrag = -1.0_DP !! Smallest G*mass that can be produced in a fragmentation event + integer(I4B), dimension(:), allocatable :: seed !! Random seeds for fragmentation modeling + logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. + character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved + logical :: lenc_trajectory_save = .false. !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved + logical :: lenc_closest_save = .false. !! Indicates that when encounters are saved, the closest approach distance between pairs of bodies is saved type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file contains diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 36a131611..b840528a0 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -75,7 +75,7 @@ module subroutine setup_construct_system(system, param) select type(param) class is (symba_parameters) - if (param%lencounter_save) then + if (param%lenc_trajectory_save .or. param%lenc_closest_save) then allocate(encounter_storage :: param%encounter_history) associate (encounter_history => param%encounter_history) allocate(encounter_io_parameters :: encounter_history%nc) @@ -85,7 +85,9 @@ module subroutine setup_construct_system(system, param) nc%file_number = param%iloop / param%dump_cadence end select end associate - + end if + + if (param%lclose) then allocate(collision_storage :: param%collision_history) associate (collision_history => param%collision_history) allocate(fraggle_io_parameters :: collision_history%nc) @@ -98,7 +100,6 @@ module subroutine setup_construct_system(system, param) end if end select - end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 96ab905a0..637efa412 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -905,7 +905,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) call system%colliders%regime(system%fragments, system, param) - if (param%lencounter_save) call collision_history%take_snapshot(param,system, t, "before") + if (param%lenc_trajectory_save) call collision_history%take_snapshot(param,system, t, "before") select case (system%fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param) @@ -917,7 +917,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) end select - if (param%lencounter_save) call collision_history%take_snapshot(param,system, t, "after") + if (param%lenc_trajectory_save) call collision_history%take_snapshot(param,system, t, "after") deallocate(system%colliders,system%fragments) end do end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 27a455062..46fa3dfd5 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -125,7 +125,8 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms return end if - param%lencounter_save = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "CLOSEST") + param%lenc_trajectory_save = (param%encounter_save == "TRAJECTORY") + param%lenc_closest_save = (param%encounter_save == "CLOSEST") .or. param%lenc_trajectory_save ! Closest approaches are always saved when trajectories are saved ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index eb37c718b..68548bdbe 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -38,9 +38,9 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then - if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t) + if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t) call self%interp(param, t, dt) - if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t+dt) + if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t+dt) else self%irec = -1 call helio_step_system(self, param, t, dt) @@ -247,7 +247,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) end if - if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t+dtl) + if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t+dtl) call self%set_recur_levels(ireci) From 64909af626beeb85141c87f367ecf95b0ba3b2cf Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 11:12:23 -0500 Subject: [PATCH 58/63] More restructruing anc getting close approach saving infrastructure in place --- python/swiftest/swiftest/io.py | 11 +- src/encounter/encounter_setup.f90 | 14 +- src/encounter/encounter_util.f90 | 219 ++++++++++++++++-------------- src/modules/encounter_classes.f90 | 3 +- src/modules/swiftest_classes.f90 | 2 +- src/modules/symba_classes.f90 | 8 +- src/setup/setup.f90 | 2 +- src/symba/symba_collision.f90 | 180 ++++++++++++------------ src/symba/symba_io.f90 | 4 +- src/symba/symba_step.f90 | 6 +- src/symba/symba_util.f90 | 11 +- 11 files changed, 237 insertions(+), 223 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 029672ec7..c002978b9 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -900,15 +900,14 @@ def string_converter(da): ------- da : xarray dataset with the strings cleaned up """ - if da.dtype == np.dtype(object): - da = da.astype(' self) call util_spill(keeps%lvdotr, discards%lvdotr, lspill_list, ldestructive) + call util_spill(keeps%lclosest, discards%lclosest, lspill_list, ldestructive) call util_spill(keeps%status, discards%status, lspill_list, ldestructive) call util_spill(keeps%index1, discards%index1, lspill_list, ldestructive) call util_spill(keeps%index2, discards%index2, lspill_list, ldestructive) @@ -398,7 +403,7 @@ end subroutine encounter_util_spill_list - subroutine encounter_util_save_collision(param, snapshot) + subroutine encounter_util_save_collision(collision_history, snapshot) !! author: David A. Minton !! !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. @@ -407,18 +412,18 @@ subroutine encounter_util_save_collision(param, snapshot) !! Memory usage grows by a factor of 2 each time it fills up, but no more. implicit none ! Arguments - class(symba_parameters), intent(inout) :: param !! SyMBA parameter object - class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + type(collision_storage(*)), allocatable, intent(inout) :: collision_history !! Collision history object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object ! Internals type(collision_storage(nframes=:)), allocatable :: tmp integer(I4B) :: i, nnew, nold, nbig ! Advance the snapshot frame counter - param%collision_history%iframe = param%collision_history%iframe + 1 + collision_history%iframe = collision_history%iframe + 1 ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = param%collision_history%iframe - nold = param%collision_history%nframes + nnew = collision_history%iframe + nold = collision_history%nframes if (nnew > nold) then nbig = nold @@ -426,24 +431,24 @@ subroutine encounter_util_save_collision(param, snapshot) nbig = nbig * 2 end do allocate(collision_storage(nbig) :: tmp) - tmp%iframe = param%collision_history%iframe - call move_alloc(param%collision_history%nc, tmp%nc) + tmp%iframe = collision_history%iframe + call move_alloc(collision_history%nc, tmp%nc) do i = 1, nold - if (allocated(param%collision_history%frame(i)%item)) call move_alloc(param%collision_history%frame(i)%item, tmp%frame(i)%item) + if (allocated(collision_history%frame(i)%item)) call move_alloc(collision_history%frame(i)%item, tmp%frame(i)%item) end do - deallocate(param%collision_history) - call move_alloc(tmp,param%collision_history) + deallocate(collision_history) + call move_alloc(tmp,collision_history) nnew = nbig end if - param%collision_history%frame(nnew) = snapshot + collision_history%frame(nnew) = snapshot return end subroutine encounter_util_save_collision - subroutine encounter_util_save_encounter(param, snapshot, t) + subroutine encounter_util_save_encounter(encounter_history, snapshot, t) !! author: David A. Minton !! !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. @@ -452,19 +457,19 @@ subroutine encounter_util_save_encounter(param, snapshot, t) !! Memory usage grows by a factor of 2 each time it fills up, but no more. implicit none ! Arguments - class(symba_parameters), intent(inout) :: param !! SyMBA parameter object - class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object - real(DP), intent(in) :: t !! The time of the snapshot + type(encounter_storage(*)), allocatable, intent(inout) :: encounter_history !! SyMBA encounter storage object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + real(DP), intent(in) :: t !! The time of the snapshot ! Internals type(encounter_storage(nframes=:)), allocatable :: tmp integer(I4B) :: i, nnew, nold, nbig ! Advance the snapshot frame counter - param%encounter_history%iframe = param%encounter_history%iframe + 1 + encounter_history%iframe = encounter_history%iframe + 1 ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = param%encounter_history%iframe - nold = param%encounter_history%nframes + nnew = encounter_history%iframe + nold = encounter_history%nframes if (nnew > nold) then nbig = nold @@ -472,20 +477,20 @@ subroutine encounter_util_save_encounter(param, snapshot, t) nbig = nbig * 2 end do allocate(encounter_storage(nbig) :: tmp) - tmp%iframe = param%encounter_history%iframe - call move_alloc(param%encounter_history%nc, tmp%nc) + tmp%iframe = encounter_history%iframe + call move_alloc(encounter_history%nc, tmp%nc) do i = 1, nold - if (allocated(param%encounter_history%frame(i)%item)) call move_alloc(param%encounter_history%frame(i)%item, tmp%frame(i)%item) + if (allocated(encounter_history%frame(i)%item)) call move_alloc(encounter_history%frame(i)%item, tmp%frame(i)%item) end do - deallocate(param%encounter_history) - call move_alloc(tmp,param%encounter_history) + deallocate(encounter_history) + call move_alloc(tmp,encounter_history) nnew = nbig end if ! Find out which time slot this belongs in by searching for an existing slot ! with the same value of time or the first available one - param%encounter_history%frame(nnew) = snapshot + encounter_history%frame(nnew) = snapshot return end subroutine encounter_util_save_encounter @@ -502,13 +507,11 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. ! Arguments class(fraggle_snapshot), allocatable :: snapshot type(symba_pl) :: pl character(len=:), allocatable :: stage - integer(I4B) :: i,j - if (present(arg)) then stage = arg @@ -539,10 +542,10 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) allocate(fraggle_snapshot :: snapshot) allocate(snapshot%colliders, source=system%colliders) allocate(snapshot%fragments, source=system%fragments) - select type (param) + select type(param) class is (symba_parameters) - call encounter_util_save_collision(param,snapshot) - end select + call encounter_util_save_collision(param%collision_history,snapshot) + end select case default write(*,*) "encounter_util_snapshot_collision requies either 'before' or 'after' passed to 'arg'" end select @@ -571,87 +574,99 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) if (.not.present(t)) then write(*,*) "encounter_util_snapshot_encounter requires `t` to be passed" + return end if + + if (.not.present(arg)) then + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be passed" + return + end if + select type (system) class is (symba_nbody_system) - select type(pl => system%pl) - class is (symba_pl) - select type (tp => system%tp) - class is (symba_tp) - associate(npl => pl%nbody, ntp => tp%nbody) - - allocate(encounter_snapshot :: snapshot) - snapshot%t = t - snapshot%iloop = param%iloop - - if (npl + ntp == 0) return - npl_snap = npl - ntp_snap = ntp - - allocate(snapshot%pl, mold=pl) - allocate(snapshot%tp, mold=tp) - select type(pl_snap => snapshot%pl) - class is (symba_pl) - if (npl > 0) then - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - npl_snap = count(pl%lmask(1:npl)) - end if - if (ntp > 0) then - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - ntp_snap = count(tp%lmask(1:ntp)) - end if - pl_snap%nbody = npl_snap - end select - - select type(pl_snap => snapshot%pl) - class is (symba_pl) - ! Take snapshot of the currently encountering massive bodies - if (npl_snap > 0) then - call pl_snap%setup(npl_snap, param) - pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) - pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) - pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) - pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) - do i = 1, NDIM - pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) - pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) - end do - if (param%lclose) then - pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + select case(arg) + case("trajectory") + select type(pl => system%pl) + class is (symba_pl) + select type (tp => system%tp) + class is (symba_tp) + associate(npl => pl%nbody, ntp => tp%nbody) + allocate(encounter_snapshot :: snapshot) + snapshot%t = t + snapshot%iloop = param%iloop + + if (npl + ntp == 0) return + npl_snap = npl + ntp_snap = ntp + + allocate(snapshot%pl, mold=pl) + allocate(snapshot%tp, mold=tp) + select type(pl_snap => snapshot%pl) + class is (symba_pl) + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec + npl_snap = count(pl%lmask(1:npl)) end if - - if (param%lrotation) then + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec + ntp_snap = count(tp%lmask(1:ntp)) + end if + pl_snap%nbody = npl_snap + end select + + select type(pl_snap => snapshot%pl) + class is (symba_pl) + ! Take snapshot of the currently encountering massive bodies + if (npl_snap > 0) then + call pl_snap%setup(npl_snap, param) + pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) + pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) do i = 1, NDIM - pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) - pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) end do + if (param%lclose) then + pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if + + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + end do + end if + call pl_snap%sort("id", ascending=.true.) end if - call pl_snap%sort("id", ascending=.true.) - end if - end select - - select type(tp_snap => snapshot%tp) - class is (symba_tp) - ! Take snapshot of the currently encountering test particles - tp_snap%nbody = ntp_snap - if (ntp_snap > 0) then - call tp_snap%setup(ntp_snap, param) - tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) - tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) - do i = 1, NDIM - tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) - tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) - end do - end if + end select + + select type(tp_snap => snapshot%tp) + class is (symba_tp) + ! Take snapshot of the currently encountering test particles + tp_snap%nbody = ntp_snap + if (ntp_snap > 0) then + call tp_snap%setup(ntp_snap, param) + tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + do i = 1, NDIM + tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + end select + end associate + ! Save the snapshot + select type(param) + class is (symba_parameters) + param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap + call encounter_util_save_encounter(param%encounter_history,snapshot,t) end select - end associate - ! Save the snapshot - select type(param) - class is (symba_parameters) - param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap - call encounter_util_save_encounter(param,snapshot,t) end select end select + case("closest") + case default + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" end select end select diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 8e74913ed..f566a8070 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -22,6 +22,7 @@ module encounter_classes integer(I8B) :: nenc = 0 !! Total number of encounters logical :: lcollision !! Indicates if the encounter resulted in at least one collision real(DP) :: t !! Time of encounter + logical, dimension(:), allocatable :: lclosest !! indicates that thie pair of bodies is in currently at its closest approach point logical, dimension(:), allocatable :: lvdotr !! relative vdotr flag integer(I4B), dimension(:), allocatable :: status !! status of the interaction integer(I4B), dimension(:), allocatable :: index1 !! position of the first body in the encounter @@ -329,7 +330,7 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. end subroutine encounter_util_snapshot_collision module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index d86a742b2..2e32f8c1d 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -1705,7 +1705,7 @@ module subroutine util_snapshot_system(self, param, system, t, arg) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in encounter snapshots) end subroutine util_snapshot_system end interface diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index ce95269e2..1d5a708b3 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_snapshot, encounter_storage, collision_storage + use encounter_classes, only : encounter_list, encounter_storage, collision_storage implicit none public @@ -31,8 +31,8 @@ module symba_classes integer(I4B), dimension(:), allocatable :: seed !! Random seeds for fragmentation modeling logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved - logical :: lenc_trajectory_save = .false. !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved - logical :: lenc_closest_save = .false. !! Indicates that when encounters are saved, the closest approach distance between pairs of bodies is saved + logical :: lenc_save_trajectory = .false. !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved + logical :: lenc_save_closest = .false. !! Indicates that when encounters are saved, the closest approach distance between pairs of bodies is saved type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file contains @@ -212,7 +212,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir implicit none class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index b840528a0..ef8558aef 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -75,7 +75,7 @@ module subroutine setup_construct_system(system, param) select type(param) class is (symba_parameters) - if (param%lenc_trajectory_save .or. param%lenc_closest_save) then + if (param%lenc_save_trajectory .or. param%lenc_save_closest) then allocate(encounter_storage :: param%encounter_history) associate (encounter_history => param%encounter_history) allocate(encounter_io_parameters :: encounter_history%nc) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 637efa412..9015d3403 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -274,7 +274,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir ! Arguments class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level @@ -302,97 +302,99 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir class is (symba_pl) select type(tp => system%tp) class is (symba_tp) - nenc = self%nenc - allocate(lmask(nenc)) - lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) - if (isplpl) then - lmask(:) = lmask(:) .and. (pl%levelg(self%index2(1:nenc)) >= irec) - else - lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) - end if - if (.not.any(lmask(:))) return - - allocate(lcollision(nenc)) - lcollision(:) = .false. - allocate(lclosest(nenc)) - lclosest(:) = .false. - - if (isplpl) then - do concurrent(k = 1:nenc, lmask(k)) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%rh(:, i) - pl%rh(:, j) - vr(:) = pl%vb(:, i) - pl%vb(:, j) - rlim = pl%radius(i) + pl%radius(j) - Gmtot = pl%Gmass(i) + pl%Gmass(j) - call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), lclosest(k)) - end do - else - do concurrent(k = 1:nenc, lmask(k)) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%rh(:, i) - tp%rh(:, j) - vr(:) = pl%vb(:, i) - tp%vb(:, j) - call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%Gmass(i), pl%radius(i), dt, self%lvdotr(k), lcollision(k), lclosest(k)) - end do - end if + select type (param) + class is (symba_parameters) + nenc = self%nenc + allocate(lmask(nenc)) + lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) + if (isplpl) then + lmask(:) = lmask(:) .and. (pl%levelg(self%index2(1:nenc)) >= irec) + else + lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) + end if + if (.not.any(lmask(:))) return + + allocate(lcollision(nenc)) + lcollision(:) = .false. + allocate(lclosest(nenc)) + lclosest(:) = .false. + + if (isplpl) then + do concurrent(k = 1:nenc, lmask(k)) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%rh(:, i) - pl%rh(:, j) + vr(:) = pl%vb(:, i) - pl%vb(:, j) + rlim = pl%radius(i) + pl%radius(j) + Gmtot = pl%Gmass(i) + pl%Gmass(j) + call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), lclosest(k)) + end do + else + do concurrent(k = 1:nenc, lmask(k)) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%rh(:, i) - tp%rh(:, j) + vr(:) = pl%vb(:, i) - tp%vb(:, j) + call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%Gmass(i), pl%radius(i), dt, self%lvdotr(k), lcollision(k), lclosest(k)) + end do + end if - lany_collision = any(lcollision(:)) - - if (lany_collision) then - call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary - do k = 1, nenc - i = self%index1(k) - j = self%index2(k) - if (lcollision(k)) self%status(k) = COLLISION - self%tcollision(k) = t - self%x1(:,k) = pl%rh(:,i) + system%cb%rb(:) - self%v1(:,k) = pl%vb(:,i) - if (isplpl) then - self%x2(:,k) = pl%rh(:,j) + system%cb%rb(:) - self%v2(:,k) = pl%vb(:,j) - if (lcollision(k)) then - ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collisional colliders%idx - if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_colliders([i,j]) - - ! Set the collision flag for these to bodies to true in case they become involved in another collision later in the step - pl%lcollision([i, j]) = .true. - pl%status([i, j]) = COLLISION - call pl%info(i)%set_value(status="COLLISION", discard_time=t, discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i)) - call pl%info(j)%set_value(status="COLLISION", discard_time=t, discard_rh=pl%rh(:,j), discard_vh=pl%vh(:,j)) - end if - else - self%x2(:,k) = tp%rh(:,j) + system%cb%rb(:) - self%v2(:,k) = tp%vb(:,j) - if (lcollision(k)) then - tp%status(j) = DISCARDED_PLR - tp%ldiscard(j) = .true. - write(idstri, *) pl%id(i) - write(idstrj, *) tp%id(j) - write(timestr, *) t - call tp%info(j)%set_value(status="DISCARDED_PLR", discard_time=t, discard_rh=tp%rh(:,j), discard_vh=tp%vh(:,j)) - write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & - // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & - // " at t = " // trim(adjustl(timestr)) - call io_log_one_message(FRAGGLE_LOG_OUT, message) + lany_collision = any(lcollision(:)) + + if (lany_collision) then + call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + do k = 1, nenc + i = self%index1(k) + j = self%index2(k) + if (lcollision(k)) self%status(k) = COLLISION + self%tcollision(k) = t + self%x1(:,k) = pl%rh(:,i) + system%cb%rb(:) + self%v1(:,k) = pl%vb(:,i) + if (isplpl) then + self%x2(:,k) = pl%rh(:,j) + system%cb%rb(:) + self%v2(:,k) = pl%vb(:,j) + if (lcollision(k)) then + ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collider pair + if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_colliders([i,j]) + + ! Set the collision flag for these to bodies to true in case they become involved in another collision later in the step + pl%lcollision([i, j]) = .true. + pl%status([i, j]) = COLLISION + call pl%info(i)%set_value(status="COLLISION", discard_time=t, discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i)) + call pl%info(j)%set_value(status="COLLISION", discard_time=t, discard_rh=pl%rh(:,j), discard_vh=pl%vh(:,j)) + end if + else + self%x2(:,k) = tp%rh(:,j) + system%cb%rb(:) + self%v2(:,k) = tp%vb(:,j) + if (lcollision(k)) then + tp%status(j) = DISCARDED_PLR + tp%ldiscard(j) = .true. + write(idstri, *) pl%id(i) + write(idstrj, *) tp%id(j) + write(timestr, *) t + call tp%info(j)%set_value(status="DISCARDED_PLR", discard_time=t, discard_rh=tp%rh(:,j), discard_vh=tp%vh(:,j)) + write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & + // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & + // " at t = " // trim(adjustl(timestr)) + call io_log_one_message(FRAGGLE_LOG_OUT, message) + end if end if - end if - end do + end do - ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list - select type(self) - class is (symba_plplenc) - call self%extract_collisions(system, param) - class is (symba_pltpenc) - allocate(tmp, mold=self) - call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list - end select - end if + ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list + select type(self) + class is (symba_plplenc) + call self%extract_collisions(system, param) + class is (symba_pltpenc) + allocate(tmp, mold=self) + call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list + end select + end if - ! Take snapshots of pairs of bodies at close approach (but not collision) if requested - if (any(lclosest(:))) then + ! Take snapshots of pairs of bodies at close approach (but not collision) if requested + if (param%lenc_save_closest .and. any(lclosest(:))) call param%encounter_history%take_snapshot(param, system, t, "closest") - end if + end select end select end select @@ -905,7 +907,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) call system%colliders%regime(system%fragments, system, param) - if (param%lenc_trajectory_save) call collision_history%take_snapshot(param,system, t, "before") + if (param%lenc_save_trajectory) call collision_history%take_snapshot(param,system, t, "before") select case (system%fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param) @@ -917,7 +919,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) end select - if (param%lenc_trajectory_save) call collision_history%take_snapshot(param,system, t, "after") + if (param%lenc_save_trajectory) call collision_history%take_snapshot(param,system, t, "after") deallocate(system%colliders,system%fragments) end do end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 46fa3dfd5..916fb1a4c 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -125,8 +125,8 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms return end if - param%lenc_trajectory_save = (param%encounter_save == "TRAJECTORY") - param%lenc_closest_save = (param%encounter_save == "CLOSEST") .or. param%lenc_trajectory_save ! Closest approaches are always saved when trajectories are saved + param%lenc_save_trajectory = (param%encounter_save == "TRAJECTORY") + param%lenc_save_closest = (param%encounter_save == "CLOSEST") .or. param%lenc_save_trajectory ! Closest approaches are always saved when trajectories are saved ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 68548bdbe..3b217305f 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -38,9 +38,9 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then - if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t) + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t, "trajectory") call self%interp(param, t, dt) - if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t+dt) + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+dt, "trajectory") else self%irec = -1 call helio_step_system(self, param, t, dt) @@ -247,7 +247,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) end if - if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t+dtl) + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+dtl, "trajectory") call self%set_recur_levels(ireci) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 8874be49b..74b555bce 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -204,6 +204,8 @@ module subroutine symba_util_dealloc_encounter_list(self) if (allocated(self%level)) deallocate(self%level) if (allocated(self%tcollision)) deallocate(self%tcollision) + call self%encounter_list%dealloc() + return end subroutine symba_util_dealloc_encounter_list @@ -232,7 +234,7 @@ module subroutine symba_util_dealloc_merger(self) if (allocated(self%ncomp)) deallocate(self%ncomp) - call symba_util_dealloc_pl(self) + call self%symba_pl%dealloc() return end subroutine symba_util_dealloc_merger @@ -266,7 +268,7 @@ module subroutine symba_util_dealloc_pl(self) deallocate(self%kin) end if - call util_dealloc_pl(self) + call self%helio_pl%dealloc() return end subroutine symba_util_dealloc_pl @@ -284,7 +286,7 @@ module subroutine symba_util_dealloc_tp(self) if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) - call util_dealloc_tp(self) + call self%helio_tp%dealloc() return end subroutine symba_util_dealloc_tp @@ -712,6 +714,7 @@ module subroutine symba_util_rearray_pl(self, system, param) if ((idnew1 == idold1) .and. (idnew2 == idold2)) then ! This is an encounter we already know about, so save the old information system%plplenc_list%lvdotr(k) = plplenc_old%lvdotr(k) + system%plplenc_list%lclosest(k) = plplenc_old%lclosest(k) system%plplenc_list%status(k) = plplenc_old%status(k) system%plplenc_list%x1(:,k) = plplenc_old%x1(:,k) system%plplenc_list%x2(:,k) = plplenc_old%x2(:,k) @@ -722,6 +725,7 @@ module subroutine symba_util_rearray_pl(self, system, param) else if (((idnew1 == idold2) .and. (idnew2 == idold1))) then ! This is an encounter we already know about, but with the order reversed, so save the old information system%plplenc_list%lvdotr(k) = plplenc_old%lvdotr(k) + system%plplenc_list%lclosest(k) = plplenc_old%lclosest(k) system%plplenc_list%status(k) = plplenc_old%status(k) system%plplenc_list%x1(:,k) = plplenc_old%x2(:,k) system%plplenc_list%x2(:,k) = plplenc_old%x1(:,k) @@ -749,6 +753,7 @@ module subroutine symba_util_rearray_pl(self, system, param) system%plplenc_list%id1(1:nencmin) = pack(system%plplenc_list%id1(1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%id2(1:nencmin) = pack(system%plplenc_list%id2(1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%lvdotr(1:nencmin) = pack(system%plplenc_list%lvdotr(1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%lclosest(1:nencmin) = pack(system%plplenc_list%lclosest(1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%status(1:nencmin) = pack(system%plplenc_list%status(1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%tcollision(1:nencmin) = pack(system%plplenc_list%tcollision(1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%level(1:nencmin) = pack(system%plplenc_list%level(1:nenc_old), lmask(1:nenc_old)) From 8af4da899d43ffe810e0bbb3a9aa392148f1fe26 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 14:08:43 -0500 Subject: [PATCH 59/63] Refactored x1,2 -> r1,2 --- src/encounter/encounter_check.f90 | 24 ++-- src/encounter/encounter_setup.f90 | 8 +- src/encounter/encounter_util.f90 | 209 +++++++++++++++++----------- src/modules/encounter_classes.f90 | 10 +- src/symba/symba_collision.f90 | 30 ++-- src/symba/symba_encounter_check.f90 | 4 +- src/symba/symba_util.f90 | 12 +- 7 files changed, 176 insertions(+), 121 deletions(-) diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index 6d866fb50..4e60ecf4f 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -891,7 +891,7 @@ pure module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) end subroutine encounter_check_sort_aabb_1D - module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x2, v2, renc1, renc2, dt, & + module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, r1, v1, r2, v2, renc1, renc2, dt, & nenc, index1, index2, lvdotr) !! author: David A. Minton !! @@ -902,8 +902,8 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x class(encounter_bounding_box), intent(inout) :: self !! Multi-dimensional bounding box structure integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I4B), intent(in) :: n2 !! Number of bodies 2 - real(DP), dimension(:,:), intent(in) :: x1, v1 !! Array of position and velocity vectorrs for bodies 1 - real(DP), dimension(:,:), intent(in) :: x2, v2 !! Array of position and velocity vectorrs for bodies 2 + real(DP), dimension(:,:), intent(in) :: r1, v1 !! Array of position and velocity vectorrs for bodies 1 + real(DP), dimension(:,:), intent(in) :: r2, v2 !! Array of position and velocity vectorrs for bodies 2 real(DP), dimension(:), intent(in) :: renc1 !! Radius of encounter regions of bodies 1 real(DP), dimension(:), intent(in) :: renc2 !! Radius of encounter regions of bodies 2 real(DP), intent(in) :: dt !! Step size @@ -943,17 +943,17 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x dim = 1 where(llist1(dim,:)) - xind(:) = x1(1,ext_ind(dim,:)) - yind(:) = x1(2,ext_ind(dim,:)) - zind(:) = x1(3,ext_ind(dim,:)) + xind(:) = r1(1,ext_ind(dim,:)) + yind(:) = r1(2,ext_ind(dim,:)) + zind(:) = r1(3,ext_ind(dim,:)) vxind(:) = v1(1,ext_ind(dim,:)) vyind(:) = v1(2,ext_ind(dim,:)) vzind(:) = v1(3,ext_ind(dim,:)) rencind(:) = renc1(ext_ind(dim,:)) elsewhere - xind(:) = x2(1,ext_ind(dim,:)) - yind(:) = x2(2,ext_ind(dim,:)) - zind(:) = x2(3,ext_ind(dim,:)) + xind(:) = r2(1,ext_ind(dim,:)) + yind(:) = r2(2,ext_ind(dim,:)) + zind(:) = r2(3,ext_ind(dim,:)) vxind(:) = v2(1,ext_ind(dim,:)) vyind(:) = v2(2,ext_ind(dim,:)) vzind(:) = v2(3,ext_ind(dim,:)) @@ -962,7 +962,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x where(.not.loverlap(:)) lenc(:)%nenc = 0 !$omp parallel default(private) & - !$omp shared(self, ext_ind, lenc, loverlap, x1, v1, x2, v2, renc1, renc2, xind, yind, zind, vxind, vyind, vzind, rencind, llist1) & + !$omp shared(self, ext_ind, lenc, loverlap, r1, v1, r2, v2, renc1, renc2, xind, yind, zind, vxind, vyind, vzind, rencind, llist1) & !$omp firstprivate(ntot, n1, n2, dt, dim) ! Do the first group of bodies (i is in list 1, all the others are from list 2) @@ -972,7 +972,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x ibeg = self%aabb(dim)%ibeg(i) + 1_I8B iend = self%aabb(dim)%iend(i) - 1_I8B nbox = iend - ibeg + 1 - call encounter_check_all_sweep_one(i, nbox, x1(1,i), x1(2,i), x1(3,i), v1(1,i), v1(2,i), v1(3,i), & + call encounter_check_all_sweep_one(i, nbox, r1(1,i), r1(2,i), r1(3,i), v1(1,i), v1(2,i), v1(3,i), & xind(ibeg:iend), yind(ibeg:iend), zind(ibeg:iend),& vxind(ibeg:iend), vyind(ibeg:iend), vzind(ibeg:iend), & renc1(i), rencind(ibeg:iend), dt, ext_ind(dim,ibeg:iend), & @@ -989,7 +989,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x iend = self%aabb(dim)%iend(i) - 1_I8B nbox = iend - ibeg + 1 ii = i - n1 - call encounter_check_all_sweep_one(ii, nbox, x2(1,ii), x2(2,ii), x2(3,ii), v2(1,ii), v2(2,ii), v2(3,ii), & + call encounter_check_all_sweep_one(ii, nbox, r1(1,ii), r1(2,ii), r1(3,ii), v2(1,ii), v2(2,ii), v2(3,ii), & xind(ibeg:iend), yind(ibeg:iend), zind(ibeg:iend),& vxind(ibeg:iend), vyind(ibeg:iend), vzind(ibeg:iend), & renc2(ii), rencind(ibeg:iend), dt, ext_ind(dim,ibeg:iend), & diff --git a/src/encounter/encounter_setup.f90 b/src/encounter/encounter_setup.f90 index 4423952cd..18b60d229 100644 --- a/src/encounter/encounter_setup.f90 +++ b/src/encounter/encounter_setup.f90 @@ -79,8 +79,8 @@ module subroutine encounter_setup_list(self, n) allocate(self%index2(n)) allocate(self%id1(n)) allocate(self%id2(n)) - allocate(self%x1(NDIM,n)) - allocate(self%x2(NDIM,n)) + allocate(self%r1(NDIM,n)) + allocate(self%r2(NDIM,n)) allocate(self%v1(NDIM,n)) allocate(self%v2(NDIM,n)) @@ -91,8 +91,8 @@ module subroutine encounter_setup_list(self, n) self%index2(:) = 0 self%id1(:) = 0 self%id2(:) = 0 - self%x1(:,:) = 0.0_DP - self%x2(:,:) = 0.0_DP + self%r1(:,:) = 0.0_DP + self%r2(:,:) = 0.0_DP self%v1(:,:) = 0.0_DP self%v2(:,:) = 0.0_DP diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 4386ec530..5d9e93a2e 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -33,8 +33,8 @@ module subroutine encounter_util_append_list(self, source, lsource_mask) call util_append(self%index2, source%index2, nold, nsrc, lsource_mask) call util_append(self%id1, source%id1, nold, nsrc, lsource_mask) call util_append(self%id2, source%id2, nold, nsrc, lsource_mask) - call util_append(self%x1, source%x1, nold, nsrc, lsource_mask) - call util_append(self%x2, source%x2, nold, nsrc, lsource_mask) + call util_append(self%r1, source%r1, nold, nsrc, lsource_mask) + call util_append(self%r2, source%r2, nold, nsrc, lsource_mask) call util_append(self%v1, source%v1, nold, nsrc, lsource_mask) call util_append(self%v2, source%v2, nold, nsrc, lsource_mask) self%nenc = nold + count(lsource_mask(1:nsrc)) @@ -62,8 +62,8 @@ module subroutine encounter_util_copy_list(self, source) self%index2(1:n) = source%index2(1:n) self%id1(1:n) = source%id1(1:n) self%id2(1:n) = source%id2(1:n) - self%x1(:,1:n) = source%x1(:,1:n) - self%x2(:,1:n) = source%x2(:,1:n) + self%r1(:,1:n) = source%r1(:,1:n) + self%r2(:,1:n) = source%r2(:,1:n) self%v1(:,1:n) = source%v1(:,1:n) self%v2(:,1:n) = source%v2(:,1:n) end associate @@ -103,8 +103,8 @@ module subroutine encounter_util_dealloc_list(self) if (allocated(self%index2)) deallocate(self%index2) if (allocated(self%id1)) deallocate(self%id1) if (allocated(self%id2)) deallocate(self%id2) - if (allocated(self%x1)) deallocate(self%x1) - if (allocated(self%x2)) deallocate(self%x2) + if (allocated(self%r1)) deallocate(self%r1) + if (allocated(self%r2)) deallocate(self%r2) if (allocated(self%v1)) deallocate(self%v1) if (allocated(self%v2)) deallocate(self%v2) @@ -385,8 +385,8 @@ module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestru call util_spill(keeps%index2, discards%index2, lspill_list, ldestructive) call util_spill(keeps%id1, discards%id1, lspill_list, ldestructive) call util_spill(keeps%id2, discards%id2, lspill_list, ldestructive) - call util_spill(keeps%x1, discards%x1, lspill_list, ldestructive) - call util_spill(keeps%x2, discards%x2, lspill_list, ldestructive) + call util_spill(keeps%r1, discards%r1, lspill_list, ldestructive) + call util_spill(keeps%r2, discards%r2, lspill_list, ldestructive) call util_spill(keeps%v1, discards%v1, lspill_list, ldestructive) call util_spill(keeps%v2, discards%v2, lspill_list, ldestructive) @@ -570,7 +570,10 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments class(encounter_snapshot), allocatable :: snapshot - integer(I4B) :: i, npl_snap, ntp_snap + integer(I4B) :: i, j, k, npl_snap, ntp_snap + real(DP), dimension(NDIM) :: rrel, vrel, rcom, vcom + real(DP) :: mu, a, q, capm, tperi + real(DP), dimension(NDIM,2) :: rb,vb if (.not.present(t)) then write(*,*) "encounter_util_snapshot_encounter requires `t` to be passed" @@ -582,91 +585,139 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) return end if - select type (system) - class is (symba_nbody_system) - select case(arg) - case("trajectory") + select type(param) + class is (symba_parameters) + select type (system) + class is (symba_nbody_system) select type(pl => system%pl) class is (symba_pl) select type (tp => system%tp) class is (symba_tp) associate(npl => pl%nbody, ntp => tp%nbody) - allocate(encounter_snapshot :: snapshot) - snapshot%t = t - snapshot%iloop = param%iloop - if (npl + ntp == 0) return - npl_snap = npl - ntp_snap = ntp - + allocate(encounter_snapshot :: snapshot) allocate(snapshot%pl, mold=pl) allocate(snapshot%tp, mold=tp) - select type(pl_snap => snapshot%pl) - class is (symba_pl) - if (npl > 0) then - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - npl_snap = count(pl%lmask(1:npl)) - end if - if (ntp > 0) then - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - ntp_snap = count(tp%lmask(1:ntp)) - end if - pl_snap%nbody = npl_snap - end select + snapshot%iloop = param%iloop select type(pl_snap => snapshot%pl) class is (symba_pl) - ! Take snapshot of the currently encountering massive bodies - if (npl_snap > 0) then - call pl_snap%setup(npl_snap, param) - pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) - pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) - pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) - pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) - do i = 1, NDIM - pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) - pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) - end do - if (param%lclose) then - pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) - end if - - if (param%lrotation) then - do i = 1, NDIM - pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) - pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) - end do - end if - call pl_snap%sort("id", ascending=.true.) - end if - end select - - select type(tp_snap => snapshot%tp) - class is (symba_tp) - ! Take snapshot of the currently encountering test particles - tp_snap%nbody = ntp_snap - if (ntp_snap > 0) then - call tp_snap%setup(ntp_snap, param) - tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) - tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) - do i = 1, NDIM - tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) - tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) - end do - end if + select type(tp_snap => snapshot%tp) + class is (symba_tp) + + select case(arg) + case("trajectory") + snapshot%t = t + + npl_snap = npl + ntp_snap = ntp + + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec + npl_snap = count(pl%lmask(1:npl)) + end if + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec + ntp_snap = count(tp%lmask(1:ntp)) + end if + + pl_snap%nbody = npl_snap + + ! Take snapshot of the currently encountering massive bodies + if (npl_snap > 0) then + call pl_snap%setup(npl_snap, param) + pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) + pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) + do i = 1, NDIM + pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) + end do + if (param%lclose) then + pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if + + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + end do + end if + call pl_snap%sort("id", ascending=.true.) + end if + + ! Take snapshot of the currently encountering test particles + tp_snap%nbody = ntp_snap + if (ntp_snap > 0) then + call tp_snap%setup(ntp_snap, param) + tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + do i = 1, NDIM + tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + + ! Save the snapshot + param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap + call encounter_util_save_encounter(param%encounter_history,snapshot,t) + case("closest") + associate(plplenc_list => system%plplenc_list, pltpenc_list => system%pltpenc_list) + if (any(plplenc_list%lclosest(:))) then + call pl_snap%setup(2, param) + do k = 1, plplenc_list%nenc + if (plplenc_list%lclosest(k)) then + i = plplenc_list%index1(k) + j = plplenc_list%index2(k) + pl_snap%levelg(:) = pl%levelg([i,j]) + pl_snap%id(:) = pl%id([i,j]) + pl_snap%info(:) = pl%info([i,j]) + pl_snap%Gmass(:) = pl%Gmass([i,j]) + mu = sum(pl_snap%Gmass(:)) + if (param%lclose) pl_snap%radius(:) = pl%radius([i,j]) + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pl%Ip(i,[i,j]) + pl_snap%rot(i,:) = pl%rot(i,[i,j]) + end do + end if + + ! Compute pericenter passage time to get the closest approach parameters + rrel(:) = plplenc_list%r2(:,k) - plplenc_list%r1(:,k) + vrel(:) = plplenc_list%v2(:,k) - plplenc_list%v1(:,k) + call orbel_xv2aqt(mu, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) + snapshot%t = t + tperi + + ! Computer the center mass of the pair + + ! do i = 1, NDIM + ! pl_snap%rh(i,:) = pl%rh(i,[i,j]) + ! pl_snap%vh(i,:) = pl%vb(i,1:npl), pl%lmask(1:npl)) + ! end do + + call pl_snap%sort("id", ascending=.true.) + call encounter_util_save_encounter(param%encounter_history,snapshot,snapshot%t) + end if + end do + + plplenc_list%lclosest(:) = .false. + end if + + if (any(pltpenc_list%lclosest(:))) then + do k = 1, pltpenc_list%nenc + end do + pltpenc_list%lclosest(:) = .false. + end if + end associate + case default + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" + end select + end select end select end associate - ! Save the snapshot - select type(param) - class is (symba_parameters) - param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap - call encounter_util_save_encounter(param%encounter_history,snapshot,t) - end select end select end select - case("closest") - case default - write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" end select end select diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index f566a8070..2b313eeb5 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -29,8 +29,8 @@ module encounter_classes integer(I4B), dimension(:), allocatable :: index2 !! position of the second body in the encounter integer(I4B), dimension(:), allocatable :: id1 !! id of the first body in the encounter integer(I4B), dimension(:), allocatable :: id2 !! id of the second body in the encounter - real(DP), dimension(:,:), allocatable :: x1 !! the position of body 1 in the encounter - real(DP), dimension(:,:), allocatable :: x2 !! the position of body 2 in the encounter + real(DP), dimension(:,:), allocatable :: r1 !! the position of body 1 in the encounter + real(DP), dimension(:,:), allocatable :: r2 !! the position of body 2 in the encounter real(DP), dimension(:,:), allocatable :: v1 !! the velocity of body 1 in the encounter real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter contains @@ -186,14 +186,14 @@ pure module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) real(DP), dimension(:), intent(in) :: extent_arr !! Array of extents of size 2*n end subroutine encounter_check_sort_aabb_1D - module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x2, v2, renc1, renc2, dt, & + module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, r1, v1, r2, v2, renc1, renc2, dt, & nenc, index1, index2, lvdotr) implicit none class(encounter_bounding_box), intent(inout) :: self !! Multi-dimensional bounding box structure integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I4B), intent(in) :: n2 !! Number of bodies 2 - real(DP), dimension(:,:), intent(in) :: x1, v1 !! Array of indices of bodies 1 - real(DP), dimension(:,:), intent(in) :: x2, v2 !! Array of indices of bodies 2 + real(DP), dimension(:,:), intent(in) :: r1, v1 !! Array of indices of bodies 1 + real(DP), dimension(:,:), intent(in) :: r2, v2 !! Array of indices of bodies 2 real(DP), dimension(:), intent(in) :: renc1 !! Radius of encounter regions of bodies 1 real(DP), dimension(:), intent(in) :: renc2 !! Radius of encounter regions of bodies 2 real(DP), intent(in) :: dt !! Step size diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 9015d3403..abfec217d 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -280,11 +280,11 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir integer(I4B), intent(in) :: irec !! Current recursion level logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision ! Internals - logical, dimension(:), allocatable :: lcollision, lclosest, lmask + logical, dimension(:), allocatable :: lcollision, lmask real(DP), dimension(NDIM) :: xr, vr integer(I4B) :: i, j, k, nenc real(DP) :: rlim, Gmtot - logical :: isplpl + logical :: isplpl, lany_closest character(len=STRMAX) :: timestr, idstri, idstrj, message class(symba_encounter), allocatable :: tmp @@ -316,8 +316,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir allocate(lcollision(nenc)) lcollision(:) = .false. - allocate(lclosest(nenc)) - lclosest(:) = .false. + self%lclosest(:) = .false. if (isplpl) then do concurrent(k = 1:nenc, lmask(k)) @@ -327,7 +326,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir vr(:) = pl%vb(:, i) - pl%vb(:, j) rlim = pl%radius(i) + pl%radius(j) Gmtot = pl%Gmass(i) + pl%Gmass(j) - call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), lclosest(k)) + call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), self%lclosest(k)) end do else do concurrent(k = 1:nenc, lmask(k)) @@ -335,23 +334,28 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir j = self%index2(k) xr(:) = pl%rh(:, i) - tp%rh(:, j) vr(:) = pl%vb(:, i) - tp%vb(:, j) - call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%Gmass(i), pl%radius(i), dt, self%lvdotr(k), lcollision(k), lclosest(k)) + call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%Gmass(i), pl%radius(i), dt, self%lvdotr(k), lcollision(k), self%lclosest(k)) end do end if lany_collision = any(lcollision(:)) + lany_closest = (param%lenc_save_closest .and. any(self%lclosest(:))) - if (lany_collision) then + + if (lany_collision .or. lany_closest) then call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary do k = 1, nenc + if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle i = self%index1(k) j = self%index2(k) - if (lcollision(k)) self%status(k) = COLLISION - self%tcollision(k) = t - self%x1(:,k) = pl%rh(:,i) + system%cb%rb(:) + self%r1(:,k) = pl%rh(:,i) + system%cb%rb(:) self%v1(:,k) = pl%vb(:,i) + if (lcollision(k)) then + self%status(k) = COLLISION + self%tcollision(k) = t + end if if (isplpl) then - self%x2(:,k) = pl%rh(:,j) + system%cb%rb(:) + self%r2(:,k) = pl%rh(:,j) + system%cb%rb(:) self%v2(:,k) = pl%vb(:,j) if (lcollision(k)) then ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collider pair @@ -364,7 +368,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir call pl%info(j)%set_value(status="COLLISION", discard_time=t, discard_rh=pl%rh(:,j), discard_vh=pl%vh(:,j)) end if else - self%x2(:,k) = tp%rh(:,j) + system%cb%rb(:) + self%r2(:,k) = tp%rh(:,j) + system%cb%rb(:) self%v2(:,k) = tp%vb(:,j) if (lcollision(k)) then tp%status(j) = DISCARDED_PLR @@ -392,7 +396,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir end if ! Take snapshots of pairs of bodies at close approach (but not collision) if requested - if (param%lenc_save_closest .and. any(lclosest(:))) call param%encounter_history%take_snapshot(param, system, t, "closest") + if (lany_closest) call param%encounter_history%take_snapshot(param, system, t, "closest") end select diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index dd60f2e00..f016af9d9 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -65,8 +65,8 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l plplenc_list%id2(k) = pl%id(j) plplenc_list%status(k) = ACTIVE plplenc_list%level(k) = irec - plplenc_list%x1(:,k) = pl%rh(:,i) - plplenc_list%x2(:,k) = pl%rh(:,j) + plplenc_list%r1(:,k) = pl%rh(:,i) + plplenc_list%r2(:,k) = pl%rh(:,j) plplenc_list%v1(:,k) = pl%vb(:,i) - cb%vb(:) plplenc_list%v2(:,k) = pl%vb(:,j) - cb%vb(:) pl%lencounter(i) = .true. diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 74b555bce..06d75bac8 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -716,8 +716,8 @@ module subroutine symba_util_rearray_pl(self, system, param) system%plplenc_list%lvdotr(k) = plplenc_old%lvdotr(k) system%plplenc_list%lclosest(k) = plplenc_old%lclosest(k) system%plplenc_list%status(k) = plplenc_old%status(k) - system%plplenc_list%x1(:,k) = plplenc_old%x1(:,k) - system%plplenc_list%x2(:,k) = plplenc_old%x2(:,k) + system%plplenc_list%r1(:,k) = plplenc_old%r1(:,k) + system%plplenc_list%r2(:,k) = plplenc_old%r2(:,k) system%plplenc_list%v1(:,k) = plplenc_old%v1(:,k) system%plplenc_list%v2(:,k) = plplenc_old%v2(:,k) system%plplenc_list%tcollision(k) = plplenc_old%tcollision(k) @@ -727,8 +727,8 @@ module subroutine symba_util_rearray_pl(self, system, param) system%plplenc_list%lvdotr(k) = plplenc_old%lvdotr(k) system%plplenc_list%lclosest(k) = plplenc_old%lclosest(k) system%plplenc_list%status(k) = plplenc_old%status(k) - system%plplenc_list%x1(:,k) = plplenc_old%x2(:,k) - system%plplenc_list%x2(:,k) = plplenc_old%x1(:,k) + system%plplenc_list%r1(:,k) = plplenc_old%r2(:,k) + system%plplenc_list%r2(:,k) = plplenc_old%r1(:,k) system%plplenc_list%v1(:,k) = plplenc_old%v2(:,k) system%plplenc_list%v2(:,k) = plplenc_old%v1(:,k) system%plplenc_list%tcollision(k) = plplenc_old%tcollision(k) @@ -758,8 +758,8 @@ module subroutine symba_util_rearray_pl(self, system, param) system%plplenc_list%tcollision(1:nencmin) = pack(system%plplenc_list%tcollision(1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%level(1:nencmin) = pack(system%plplenc_list%level(1:nenc_old), lmask(1:nenc_old)) do i = 1, NDIM - system%plplenc_list%x1(i, 1:nencmin) = pack(system%plplenc_list%x1(i, 1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%x2(i, 1:nencmin) = pack(system%plplenc_list%x2(i, 1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%r1(i, 1:nencmin) = pack(system%plplenc_list%r1(i, 1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%r2(i, 1:nencmin) = pack(system%plplenc_list%r2(i, 1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%v1(i, 1:nencmin) = pack(system%plplenc_list%v1(i, 1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%v2(i, 1:nencmin) = pack(system%plplenc_list%v2(i, 1:nenc_old), lmask(1:nenc_old)) end do From 5719f38ba0ae121e254f81bacd5fb665e19ffb54 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 16:18:35 -0500 Subject: [PATCH 60/63] Got close encounter saves in place. Now just troubleshooting --- examples/Fragmentation/Fragmentation_Movie.py | 4 +- python/swiftest/swiftest/simulation_class.py | 24 ++++++----- src/encounter/encounter_util.f90 | 41 +++++++++++++++---- src/symba/symba_io.f90 | 11 +++-- 4 files changed, 55 insertions(+), 25 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index a068205fb..84488ca14 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -41,7 +41,7 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error -pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), +pos_vectors = {"disruption_headon" : [np.array([1.0005, -5.0e-05, 0.0]), np.array([1.0, 5.0e-05 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], @@ -202,7 +202,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(fragmentation=True, encounter_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(fragmentation=True, encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index f5517678f..9edf289b3 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -214,10 +214,12 @@ def __init__(self,read_param: bool = False, read_old_output: bool = False, simdi Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included in initial conditions. Parameter input file equivalent: `CHK_CLOSE` - encounter_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" - Indicate if and how encounter data should be saved. If set to "TRAJECTORY" the full close encounter - trajectories are saved to file. If set to "CLOSEST" only the trajectories at the time of closest approach - are saved. If set to "NONE" no trajectory information is saved. + encounter_save : {"NONE","TRAJECTORY","CLOSEST", "BOTH"}, default "NONE" + Indicate if and how encounter data should be saved. If set to "TRAJECTORY", the position and velocity vectors + of all bodies undergoing close encounters are saved at each intermediate step to the encounter files. + If set to "CLOSEST", the position and velocities at the point of closest approach between pairs of bodies are + computed and stored to the encounter files. If set to "BOTH", then this stores the values that would be computed + in "TRAJECTORY" and "CLOSEST". If set to "NONE" no trajectory information is saved. *WARNING*: Enabling this feature could lead to very large files. general_relativity : bool, default True Include the post-Newtonian correction in acceleration calculations. @@ -1023,7 +1025,7 @@ def set_feature(self, tides: bool | None = None, interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] | None = None, encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] | None = None, - encounter_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, + encounter_save: Literal["NONE", "TRAJECTORY", "CLOSEST", "BOTH"] | None = None, verbose: bool | None = None, **kwargs: Any ): @@ -1035,10 +1037,12 @@ def set_feature(self, close_encounter_check : bool, optional Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included in initial conditions. - encounter_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" - Indicate if and how encounter data should be saved. If set to "TRAJECTORY" the full close encounter - trajectories are saved to file. If set to "CLOSEST" only the trajectories at the time of closest approach - are saved. If set to "NONE" no trajectory information is saved. + encounter_save : {"NONE","TRAJECTORY","CLOSEST","BOTH"}, default "NONE" + Indicate if and how encounter data should be saved. If set to "TRAJECTORY", the position and velocity vectors + of all bodies undergoing close encounters are saved at each intermediate step to the encounter files. + If set to "CLOSEST", the position and velocities at the point of closest approach between pairs of bodies are + computed and stored to the encounter files. If set to "BOTH", then this stores the values that would be computed + in "TRAJECTORY" and "CLOSEST". If set to "NONE" no trajectory information is saved. *WARNING*: Enabling this feature could lead to very large files. general_relativity : bool, optional Include the post-Newtonian correction in acceleration calculations. @@ -1199,7 +1203,7 @@ def set_feature(self, update_list.append("encounter_check_loops") if encounter_save is not None: - valid_vals = ["NONE", "TRAJECTORY", "CLOSEST"] + valid_vals = ["NONE", "TRAJECTORY", "CLOSEST", "BOTH"] encounter_save = encounter_save.upper() if encounter_save not in valid_vals: msg = f"{encounter_save} is not a valid option for encounter_save." diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 5d9e93a2e..33689dba2 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -570,9 +570,9 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments class(encounter_snapshot), allocatable :: snapshot - integer(I4B) :: i, j, k, npl_snap, ntp_snap + integer(I4B) :: i, j, k, npl_snap, ntp_snap, iflag real(DP), dimension(NDIM) :: rrel, vrel, rcom, vcom - real(DP) :: mu, a, q, capm, tperi + real(DP) :: Gmtot, a, q, capm, tperi real(DP), dimension(NDIM,2) :: rb,vb if (.not.present(t)) then @@ -621,6 +621,8 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) ntp_snap = count(tp%lmask(1:ntp)) end if + if (npl_snap + ntp_snap == 0) return ! Nothing to snapshot + pl_snap%nbody = npl_snap ! Take snapshot of the currently encountering massive bodies @@ -674,7 +676,7 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) pl_snap%id(:) = pl%id([i,j]) pl_snap%info(:) = pl%info([i,j]) pl_snap%Gmass(:) = pl%Gmass([i,j]) - mu = sum(pl_snap%Gmass(:)) + Gmtot = sum(pl_snap%Gmass(:)) if (param%lclose) pl_snap%radius(:) = pl%radius([i,j]) if (param%lrotation) then do i = 1, NDIM @@ -686,15 +688,36 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) ! Compute pericenter passage time to get the closest approach parameters rrel(:) = plplenc_list%r2(:,k) - plplenc_list%r1(:,k) vrel(:) = plplenc_list%v2(:,k) - plplenc_list%v1(:,k) - call orbel_xv2aqt(mu, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) + call orbel_xv2aqt(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) snapshot%t = t + tperi ! Computer the center mass of the pair - - ! do i = 1, NDIM - ! pl_snap%rh(i,:) = pl%rh(i,[i,j]) - ! pl_snap%vh(i,:) = pl%vb(i,1:npl), pl%lmask(1:npl)) - ! end do + rcom(:) = (plplenc_list%r1(:,k) * pl_snap%Gmass(1) + plplenc_list%r2(:,k) * pl_snap%Gmass(2)) / Gmtot + vcom(:) = (plplenc_list%v1(:,k) * pl_snap%Gmass(1) + plplenc_list%v2(:,k) * pl_snap%Gmass(2)) / Gmtot + rb(:,1) = plplenc_list%r1(:,k) - rcom(:) + rb(:,2) = plplenc_list%r2(:,k) - rcom(:) + vb(:,1) = plplenc_list%v1(:,k) - vcom(:) + vb(:,2) = plplenc_list%v2(:,k) - vcom(:) + + ! Drift the relative orbit to get the new relative position and velocity + call drift_one(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), tperi, iflag) + if (iflag /= 0) write(*,*) "Danby error in encounter_util_snapshot_encounter. Closest approach positions and vectors may not be accurate." + + ! Get the new position and velocity vectors + rb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * rrel(:) + rb(:,2) = (pl_snap%Gmass(1)) / Gmtot * rrel(:) + + vb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * vrel(:) + vb(:,2) = (pl_snap%Gmass(1)) / Gmtot * vrel(:) + + ! Move the CoM assuming constant velocity over the time it takes to reach periapsis + !rcom(:) = rcom(:) + vcom(:) * tperi + + ! Compute the heliocentric position and velocity vector at periapsis + pl_snap%rh(:,1) = rb(:,1) + rcom(:) + pl_snap%rh(:,2) = rb(:,2) + rcom(:) + pl_snap%vh(:,1) = vb(:,1) + vcom(:) + pl_snap%vh(:,2) = vb(:,2) + vcom(:) call pl_snap%sort("id", ascending=.true.) call encounter_util_save_encounter(param%encounter_history,snapshot,snapshot%t) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 916fb1a4c..29f1c1fbe 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -118,15 +118,18 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms ! All reporting of collision information in SyMBA (including mergers) is now recorded in the Fraggle logfile call io_log_start(param, FRAGGLE_LOG_OUT, "Fraggle logfile") - if ((param%encounter_save /= "NONE") .and. (param%encounter_save /= "TRAJECTORY") .and. (param%encounter_save /= "CLOSEST")) then + if ((param%encounter_save /= "NONE") .and. & + (param%encounter_save /= "TRAJECTORY") .and. & + (param%encounter_save /= "CLOSEST") .and. & + (param%encounter_save /= "BOTH")) then write(iomsg,*) 'Invalid encounter_save parameter: ',trim(adjustl(param%out_type)) - write(iomsg,*) 'Valid options are NONE, TRAJECTORY, or CLOSEST' + write(iomsg,*) 'Valid options are NONE, TRAJECTORY, CLOSEST, or BOTH' iostat = -1 return end if - param%lenc_save_trajectory = (param%encounter_save == "TRAJECTORY") - param%lenc_save_closest = (param%encounter_save == "CLOSEST") .or. param%lenc_save_trajectory ! Closest approaches are always saved when trajectories are saved + param%lenc_save_trajectory = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "BOTH") + param%lenc_save_closest = (param%encounter_save == "CLOSEST") .or. (param%encounter_save == "BOTH") ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) From 44d0a75118cda903a654e966fbf0bfb27a3c96fb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 17:08:20 -0500 Subject: [PATCH 61/63] Fixed bugs that were preventing close encounters without collision from being recorded --- examples/Fragmentation/Fragmentation_Movie.py | 4 ++-- src/encounter/encounter_util.f90 | 20 +++++++++---------- src/symba/symba_collision.f90 | 2 +- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 84488ca14..af8fa377c 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -41,8 +41,8 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error -pos_vectors = {"disruption_headon" : [np.array([1.0005, -5.0e-05, 0.0]), - np.array([1.0, 5.0e-05 ,0.0])], +pos_vectors = {"disruption_headon" : [np.array([1.0000055, -1.0e-03, 0.0]), + np.array([1.0, 1.0e-03 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 33689dba2..10f8acda4 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -570,7 +570,7 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments class(encounter_snapshot), allocatable :: snapshot - integer(I4B) :: i, j, k, npl_snap, ntp_snap, iflag + integer(I4B) :: i, pi, pj, k, npl_snap, ntp_snap, iflag real(DP), dimension(NDIM) :: rrel, vrel, rcom, vcom real(DP) :: Gmtot, a, q, capm, tperi real(DP), dimension(NDIM,2) :: rb,vb @@ -670,18 +670,18 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) call pl_snap%setup(2, param) do k = 1, plplenc_list%nenc if (plplenc_list%lclosest(k)) then - i = plplenc_list%index1(k) - j = plplenc_list%index2(k) - pl_snap%levelg(:) = pl%levelg([i,j]) - pl_snap%id(:) = pl%id([i,j]) - pl_snap%info(:) = pl%info([i,j]) - pl_snap%Gmass(:) = pl%Gmass([i,j]) + pi = plplenc_list%index1(k) + pj = plplenc_list%index2(k) + pl_snap%levelg(:) = pl%levelg([pi,pj]) + pl_snap%id(:) = pl%id([pi,pj]) + pl_snap%info(:) = pl%info([pi,pj]) + pl_snap%Gmass(:) = pl%Gmass([pi,pj]) Gmtot = sum(pl_snap%Gmass(:)) - if (param%lclose) pl_snap%radius(:) = pl%radius([i,j]) + if (param%lclose) pl_snap%radius(:) = pl%radius([pi,pj]) if (param%lrotation) then do i = 1, NDIM - pl_snap%Ip(i,:) = pl%Ip(i,[i,j]) - pl_snap%rot(i,:) = pl%rot(i,[i,j]) + pl_snap%Ip(i,:) = pl%Ip(i,[pi,pj]) + pl_snap%rot(i,:) = pl%rot(i,[pi,pj]) end do end if diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index abfec217d..67540bfa3 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -442,8 +442,8 @@ pure elemental subroutine symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, G if (tcr2 <= dt2) then call orbel_xv2aeq(Gmtot, xr, yr, zr, vxr, vyr, vzr, a, e, q) lcollision = (q < rlim) - lclosest = .not. lcollision end if + lclosest = .not. lcollision end if end if From 7911210d059fc9dffa1a349e0dbec9f4635522ec Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 18:31:51 -0500 Subject: [PATCH 62/63] Fixed issue with time keeping during recursion steps --- examples/Fragmentation/Fragmentation_Movie.py | 6 ++---- src/symba/symba_encounter_check.f90 | 1 + src/symba/symba_step.f90 | 12 ++++++------ 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index af8fa377c..6822c71de 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -148,20 +148,18 @@ def setup_plot(self): ax.set_title(self.title) fig.add_axes(ax) - self.scatter_artist = ax.scatter([], [], animated=True) + self.scatter_artist = ax.scatter([], [], animated=True, c='k', edgecolors='face') return fig, ax def update_plot(self, frame): # Define a function to calculate the center of mass of the system. def center(Gmass, x, y): - x = x[~np.isnan(x)] - y = y[~np.isnan(y)] - Gmass = Gmass[~np.isnan(Gmass)] x_com = np.sum(Gmass * x) / np.sum(Gmass) y_com = np.sum(Gmass * y) / np.sum(Gmass) return x_com, y_com Gmass, rh, point_rad = next(self.data_stream(frame)) + point_rad*=2 x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) self.scatter_artist.set_offsets(np.c_[rh[:,0] - x_com, rh[:,1] - y_com]) self.scatter_artist.set_sizes(point_rad**2) diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index f016af9d9..f53061b93 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -59,6 +59,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l if (lany_encounter) then do k = 1_I8B, nenc + plplenc_list%t = system%t i = plplenc_list%index1(k) j = plplenc_list%index2(k) plplenc_list%id1(k) = pl%id(i) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 3b217305f..216855118 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -225,7 +225,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) call pl%drift(system, param, dtl) call tp%drift(system, param, dtl) - if (lencounter) call system%recursive_step(param, t+dth,irecp) + if (lencounter) call system%recursive_step(param, t + (j-1)*dtl, irecp) system%irec = ireci if (param%lgr) then @@ -241,13 +241,13 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) end if if (param%lclose) then - call plplenc_list%collision_check(system, param, t+dtl, dtl, ireci, lplpl_collision) - call pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci, lpltp_collision) + call plplenc_list%collision_check(system, param, t+j*dtl, dtl, ireci, lplpl_collision) + call pltpenc_list%collision_check(system, param, t+j*dtl, dtl, ireci, lpltp_collision) - if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) - if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) + if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+j*dtl, dtl, ireci) + if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+j*dtl, dtl, ireci) end if - if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+dtl, "trajectory") + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+j*dtl, "trajectory") call self%set_recur_levels(ireci) From c9aee22b89971652f603f0cdd6dc9bf2ad63f80e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 20:18:28 -0500 Subject: [PATCH 63/63] Finally able to make a collision movie again --- examples/Fragmentation/Fragmentation_Movie.py | 12 +++++++----- src/encounter/encounter_util.f90 | 2 +- src/symba/symba_step.f90 | 2 +- 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 6822c71de..4a0d3b80d 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -41,8 +41,8 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error -pos_vectors = {"disruption_headon" : [np.array([1.0000055, -1.0e-03, 0.0]), - np.array([1.0, 1.0e-03 ,0.0])], +pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), @@ -154,12 +154,14 @@ def setup_plot(self): def update_plot(self, frame): # Define a function to calculate the center of mass of the system. def center(Gmass, x, y): + x = x[~np.isnan(x)] + y = y[~np.isnan(y)] + Gmass = Gmass[~np.isnan(Gmass)] x_com = np.sum(Gmass * x) / np.sum(Gmass) y_com = np.sum(Gmass * y) / np.sum(Gmass) return x_com, y_com Gmass, rh, point_rad = next(self.data_stream(frame)) - point_rad*=2 x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) self.scatter_artist.set_offsets(np.c_[rh[:,0] - x_com, rh[:,1] - y_com]) self.scatter_artist.set_sizes(point_rad**2) @@ -172,7 +174,7 @@ def data_stream(self, frame=0): radius = ds['radius'].values Gmass = ds['Gmass'].values rh = ds['rh'].values - point_rad = 2 * radius * self.ax_pt_size + point_rad = radius * self.ax_pt_size yield Gmass, rh, point_rad if __name__ == "__main__": @@ -200,7 +202,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(fragmentation=True, encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(fragmentation=True, encounter_save="trajectory", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 10f8acda4..e4f0c1fbc 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -711,7 +711,7 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) vb(:,2) = (pl_snap%Gmass(1)) / Gmtot * vrel(:) ! Move the CoM assuming constant velocity over the time it takes to reach periapsis - !rcom(:) = rcom(:) + vcom(:) * tperi + rcom(:) = rcom(:) + vcom(:) * tperi ! Compute the heliocentric position and velocity vector at periapsis pl_snap%rh(:,1) = rb(:,1) + rcom(:) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 216855118..68645d7b8 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -225,7 +225,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) call pl%drift(system, param, dtl) call tp%drift(system, param, dtl) - if (lencounter) call system%recursive_step(param, t + (j-1)*dtl, irecp) + if (lencounter) call system%recursive_step(param, t+(j-1)*dtl, irecp) system%irec = ireci if (param%lgr) then