diff --git a/examples/Fragmentation/param.disruption_headon.in b/examples/Fragmentation/param.disruption_headon.in index 0fd657831..96c8bcaa4 100644 --- a/examples/Fragmentation/param.disruption_headon.in +++ b/examples/Fragmentation/param.disruption_headon.in @@ -17,7 +17,6 @@ OUT_TYPE NETCDF_DOUBLE OUT_STAT REPLACE IN_FORM XV IN_TYPE ASCII -NC_IN -1.0 PL_IN disruption_headon.in TP_IN tp.in CB_IN cb.in @@ -32,7 +31,6 @@ MU2KG 1.98908e30 TU2S 3.1556925e7 DU2M 1.49598e11 EXTRA_FORCE no -PARTICLE_OUT -1.0 BIG_DISCARD no CHK_CLOSE yes GR NO @@ -42,8 +40,6 @@ RHILL_PRESENT yes FRAGMENTATION yes ROTATION yes ENERGY yes -ENERGY_OUT -1.0 -ENC_OUT -1.0 GMTINY 1.0e-11 MIN_GMFRAG 1.0e-11 TIDES NO diff --git a/examples/Fragmentation/param.hitandrun.in b/examples/Fragmentation/param.hitandrun.in index 1bd02166c..cbbbd7873 100644 --- a/examples/Fragmentation/param.hitandrun.in +++ b/examples/Fragmentation/param.hitandrun.in @@ -17,7 +17,6 @@ OUT_TYPE NETCDF_DOUBLE OUT_STAT REPLACE IN_FORM XV IN_TYPE ASCII -NC_IN -1.0 PL_IN hitandrun.in TP_IN tp.in CB_IN cb.in @@ -32,7 +31,6 @@ MU2KG 1.98908e30 TU2S 3.1556925e7 DU2M 1.49598e11 EXTRA_FORCE no -PARTICLE_OUT -1.0 BIG_DISCARD no CHK_CLOSE yes GR NO @@ -42,8 +40,6 @@ RHILL_PRESENT yes FRAGMENTATION yes ROTATION yes ENERGY yes -ENERGY_OUT -1.0 -ENC_OUT -1.0 GMTINY 1.0e-11 MIN_GMFRAG 1.0e-11 TIDES NO diff --git a/examples/Fragmentation/param.supercatastrophic_off_axis.in b/examples/Fragmentation/param.supercatastrophic_off_axis.in index 08b5dd71d..458491c20 100644 --- a/examples/Fragmentation/param.supercatastrophic_off_axis.in +++ b/examples/Fragmentation/param.supercatastrophic_off_axis.in @@ -17,7 +17,6 @@ OUT_TYPE NETCDF_DOUBLE OUT_STAT REPLACE IN_FORM XV IN_TYPE ASCII -NC_IN -1.0 PL_IN supercatastrophic_off_axis.in TP_IN tp.in CB_IN cb.in @@ -32,7 +31,6 @@ MU2KG 1.98908e30 TU2S 3.1556925e7 DU2M 1.49598e11 EXTRA_FORCE no -PARTICLE_OUT -1.0 BIG_DISCARD no CHK_CLOSE yes GR NO @@ -42,8 +40,6 @@ RHILL_PRESENT yes FRAGMENTATION yes ROTATION yes ENERGY yes -ENERGY_OUT -1.0 -ENC_OUT -1.0 GMTINY 1.0e-11 MIN_GMFRAG 1.0e-11 TIDES NO diff --git a/src/io/io.f90 b/src/io/io.f90 index c5af067f5..07ba1b737 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -228,97 +228,6 @@ module subroutine io_dump_param(self, param_file_name) end subroutine io_dump_param - module subroutine io_dump_particle_info(self, iu) - !! author: David A. Minton - !! - !! Reads in particle information object information from an open file unformatted file - implicit none - ! Arguments - class(swiftest_particle_info), intent(in) :: self !! Particle metadata information object - integer(I4B), intent(in) :: iu !! Open file unit number - ! Internals - character(STRMAX) :: errmsg - - write(iu, err = 667, iomsg = errmsg) self%name - write(iu, err = 667, iomsg = errmsg) self%particle_type - write(iu, err = 667, iomsg = errmsg) self%origin_type - write(iu, err = 667, iomsg = errmsg) self%origin_time - write(iu, err = 667, iomsg = errmsg) self%collision_id - write(iu, err = 667, iomsg = errmsg) self%origin_xh(:) - write(iu, err = 667, iomsg = errmsg) self%origin_vh(:) - - return - - 667 continue - write(*,*) "Error writing particle metadata information from file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_dump_particle_info - - - module subroutine io_dump_particle_info_base(self, param, idx) - !! author: David A. Minton - !! - !! Dumps the particle information data to a file. - !! Pass a list of array indices for test particles (tpidx) and/or massive bodies (plidx) to append - implicit none - ! Arguments - class(swiftest_base), intent(inout) :: self !! Swiftest base object (can be cb, pl, or tp) - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B), dimension(:), optional, intent(in) :: idx !! Array of test particle indices to append to the particle file - - ! Internals - logical, save :: lfirst = .true. - integer(I4B) :: i - character(STRMAX) :: errmsg - - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - if (lfirst) then - select case(param%out_stat) - case('APPEND') - open(unit=LUN, file=param%particle_out, status='OLD', position='APPEND', form='UNFORMATTED', err=667, iomsg=errmsg) - case('NEW', 'UNKNOWN', 'REPLACE') - open(unit=LUN, file=param%particle_out, status=param%out_stat, form='UNFORMATTED', err=667, iomsg=errmsg) - case default - write(*,*) 'Invalid status code',trim(adjustl(param%out_stat)) - call util_exit(FAILURE) - end select - - lfirst = .false. - else - open(unit=LUN, file=param%particle_out, status='OLD', position= 'APPEND', form='UNFORMATTED', err=667, iomsg=errmsg) - end if - - select type(self) - class is (swiftest_cb) - write(LUN, err = 667, iomsg = errmsg) self%id - call self%info%dump(LUN) - class is (swiftest_body) - if (present(idx)) then - do i = 1, size(idx) - write(LUN, err = 667, iomsg = errmsg) self%id(idx(i)) - call self%info(idx(i))%dump(LUN) - end do - else - do i = 1, self%nbody - write(LUN, err = 667, iomsg = errmsg) self%id(i) - call self%info(i)%dump(LUN) - end do - end if - end select - - close(unit = LUN, err = 667, iomsg = errmsg) - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - call self%write_particle_info(param%nciu, param) - end if - - return - - 667 continue - write(*,*) "Error writing particle information file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_dump_particle_info_base - - module subroutine io_dump_base(self, param) !! author: David A. Minton !! @@ -749,12 +658,6 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) ifirst = ilast + 1 param_value = io_get_token(line, ifirst, ilast, iostat) read(param_value, *, err = 667, iomsg = iomsg) param%qmin_ahi - case ("ENC_OUT") - param%enc_out = param_value - case ("DISCARD_OUT") - param%discard_out = param_value - case ("ENERGY_OUT") - param%energy_out = param_value case ("EXTRA_FORCE") call io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lextra_force = .true. @@ -843,8 +746,6 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) read(param_value, *, err = 667, iomsg = iomsg) param%maxid case ("MAXID_COLLISION") read(param_value, *, err = 667, iomsg = iomsg) param%maxid_collision - case ("PARTICLE_OUT") - param%particle_out = param_value case ("RESTART") if (param_value == "NO" .or. param_value == 'F') then param%lrestart = .false. @@ -1090,12 +991,6 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) call io_param_writer_one("OUT_FORM", param%out_form, unit) call io_param_writer_one("OUT_STAT", "APPEND", unit) end if - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - call io_param_writer_one("PARTICLE_OUT", param%particle_out, unit) - end if - if (param%enc_out /= "") then - call io_param_writer_one("ENC_OUT", param%enc_out, unit) - end if call io_param_writer_one("CHK_RMIN", param%rmin, unit) call io_param_writer_one("CHK_RMAX", param%rmax, unit) call io_param_writer_one("CHK_EJECT", param%rmaxu, unit) @@ -1109,17 +1004,8 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) call io_param_writer_one("DU2M", param%DU2M, unit) call io_param_writer_one("RHILL_PRESENT", param%lrhill_present, unit) call io_param_writer_one("EXTRA_FORCE", param%lextra_force, unit) - if (param%discard_out /= "") then - call io_param_writer_one("DISCARD_OUT", param%discard_out, unit) - end if - if (param%discard_out /= "") then - call io_param_writer_one("BIG_DISCARD", param%lbig_discard, unit) - end if call io_param_writer_one("CHK_CLOSE", param%lclose, unit) call io_param_writer_one("ENERGY", param%lenergy, unit) - if (param%lenergy .and. (param%energy_out /= "")) then - call io_param_writer_one("ENERGY_OUT", param%energy_out, unit) - end if call io_param_writer_one("GR", param%lgr, unit) call io_param_writer_one("ROTATION", param%lrotation, unit) call io_param_writer_one("TIDES", param%ltides, unit) @@ -1129,17 +1015,6 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) if (param%lenergy) then call io_param_writer_one("FIRSTENERGY", param%lfirstenergy, unit) - if ((param%out_type == REAL8_TYPE) .or. (param%out_type == REAL4_TYPE)) then - call io_param_writer_one("EORBIT_ORIG", param%Eorbit_orig, unit) - call io_param_writer_one("GMTOT_ORIG", param%GMtot_orig, unit) - call io_param_writer_one("LTOT_ORIG", param%Ltot_orig(:), unit) - call io_param_writer_one("LORBIT_ORIG", param%Lorbit_orig(:), unit) - call io_param_writer_one("LSPIN_ORIG", param%Lspin_orig(:), unit) - call io_param_writer_one("LESCAPE", param%Lescape(:), unit) - call io_param_writer_one("GMESCAPE",param%GMescape, unit) - call io_param_writer_one("ECOLLISIONS",param%Ecollisions, unit) - call io_param_writer_one("EUNTRACKED",param%Euntracked, unit) - end if end if call io_param_writer_one("FIRSTKICK",param%lfirstkick, unit) call io_param_writer_one("MAXID",param%maxid, unit) @@ -1940,75 +1815,6 @@ module subroutine io_read_in_particle_info(self, iu) end subroutine io_read_in_particle_info - module subroutine io_read_particle_info_system(self, param) - !! author: David A. Minton - !! - !! Reads an old particle information file for a restartd run - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: id, idx - logical :: lmatch - character(STRMAX) :: errmsg - type(swiftest_particle_info), allocatable :: tmpinfo - - if (.not.((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE))) return ! This subroutine is only necessary for classic binary input files - - open(unit = LUN, file = param%particle_out, status = 'OLD', form = 'UNFORMATTED', err = 667, iomsg = errmsg) - - allocate(tmpinfo, mold=self%cb%info) - - select type(cb => self%cb) - class is (swiftest_cb) - select type(pl => self%pl) - class is (swiftest_pl) - select type(tp => self%tp) - class is (swiftest_tp) - associate(npl => pl%nbody, ntp => tp%nbody) - do - lmatch = .false. - read(LUN, err = 667, iomsg = errmsg, end = 333) id - - if (id == cb%id) then - call cb%info%read_in(LUN) - lmatch = .true. - else - if (npl > 0) then - idx = findloc(pl%id(1:npl), id, dim=1) - if (idx /= 0) then - call pl%info(idx)%read_in(LUN) - lmatch = .true. - end if - end if - if (.not.lmatch .and. ntp > 0) then - idx = findloc(tp%id(1:ntp), id, dim=1) - if (idx /= 0) then - call tp%info(idx)%read_in(LUN) - lmatch = .true. - end if - end if - end if - if (.not.lmatch) then - call tmpinfo%read_in(LUN) - end if - end do - end associate - close(unit = LUN, err = 667, iomsg = errmsg) - end select - end select - end select - - 333 continue - return - - 667 continue - write(*,*) "Error reading particle information file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_read_particle_info_system - - module subroutine io_set_display_param(self, display_style) !! author: David A. Minton !! diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 00cf6583f..f04346624 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -53,7 +53,6 @@ module swiftest_classes character(STRMAX) :: out_type = NETCDF_DOUBLE_TYPE !! Binary format of output file character(STRMAX) :: out_form = XVEL !! Data to write to output file character(STRMAX) :: out_stat = 'NEW' !! Open status for output binary file - character(STRMAX) :: particle_out = PARTICLE_OUTFILE !! Name of output particle information file integer(I4B) :: istep_dump = -1 !! Number of time steps between dumps real(DP) :: rmin = -1.0_DP !! Minimum heliocentric radius for test particle real(DP) :: rmax = -1.0_DP !! Maximum heliocentric radius for test particle @@ -144,7 +143,6 @@ module swiftest_classes real(DP), dimension(NDIM) :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard integer(I4B) :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) contains - procedure :: dump => io_dump_particle_info !! Dumps contents of particle information to file procedure :: read_in => io_read_in_particle_info !! Read in a particle information object from an open file procedure :: copy => util_copy_particle_info !! Copies one set of information object components into another, component-by-component procedure :: set_value => util_set_particle_info !! Sets one or more values of the particle information metadata object @@ -158,12 +156,11 @@ module swiftest_classes contains !! The minimal methods that all systems must have procedure :: dump => io_dump_base !! Dump contents to file - procedure :: dump_particle_info => io_dump_particle_info_base !! Dump contents of particle information metadata to file procedure :: read_in => io_read_in_base !! Read in body initial conditions from a file procedure :: write_frame_netcdf => netcdf_write_frame_base !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format - procedure :: write_particle_info_netcdf => netcdf_write_particle_info_base !! Writes out the particle information metadata to NetCDF file + procedure :: write_particle_info_netcdf => netcdf_write_particle_info_base !! Dump contents of particle information metadata to file generic :: write_frame => write_frame_netcdf !! Set up generic procedure that will switch between NetCDF or Fortran binary depending on arguments - generic :: write_particle_info => write_particle_info_netcdf + generic :: write_particle_info => write_particle_info_netcdf !! Set up generic procedure that will switch between NetCDF or Fortran binary depending on arguments end type swiftest_base !******************************************************************************************************************************** @@ -421,7 +418,6 @@ module swiftest_classes procedure :: read_hdr_netcdf => netcdf_read_hdr_system !! Read a header for an output frame in NetCDF format procedure :: write_hdr_netcdf => netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format procedure :: read_in => io_read_in_system !! Reads the initial conditions for an nbody system - procedure :: read_particle_info_bin => io_read_particle_info_system !! Read in particle metadata from file procedure :: read_particle_info_netcdf => netcdf_read_particle_info_system !! Read in particle metadata from file procedure :: write_discard => io_write_discard !! Write out information about discarded test particles procedure :: obl_pot => obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body @@ -438,7 +434,7 @@ module swiftest_classes generic :: read_hdr => read_hdr_netcdf !! Generic method call for reading headers generic :: read_frame => read_frame_bin, read_frame_netcdf !! Generic method call for reading a frame of output data generic :: write_frame => write_frame_bin, write_frame_netcdf !! Generic method call for writing a frame of output data - generic :: read_particle_info => read_particle_info_bin, read_particle_info_netcdf !! Genereric method call for reading in the particle information metadata + generic :: read_particle_info => read_particle_info_netcdf !! Genereric method call for reading in the particle information metadata end type swiftest_nbody_system @@ -630,19 +626,6 @@ module subroutine io_dump_param(self, param_file_name) character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) end subroutine io_dump_param - module subroutine io_dump_particle_info_base(self, param, idx) - implicit none - class(swiftest_base), intent(inout) :: self !! Swiftest base object (can be cb, pl, or tp) - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B), dimension(:), optional, intent(in) :: idx !! Array of test particle indices to append to the particle file - end subroutine io_dump_particle_info_base - - module subroutine io_dump_particle_info(self, iu) - implicit none - class(swiftest_particle_info), intent(in) :: self !! Swiftest particle info metadata object - integer(I4B), intent(in) :: iu !! Open unformatted file unit number - end subroutine io_dump_particle_info - module subroutine io_dump_base(self, param) implicit none class(swiftest_base), intent(inout) :: self !! Swiftest base object @@ -822,12 +805,6 @@ module function io_read_frame_system(self, iu, param) result(ierr) integer(I4B) :: ierr !! Error code: returns 0 if the read is successful end function io_read_frame_system - module subroutine io_read_particle_info_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_read_particle_info_system - module subroutine io_set_display_param(self, display_style) implicit none class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index 97c68b85e..49fa0b834 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -133,7 +133,6 @@ module swiftest_globals character(*), parameter :: NC_INFILE = 'in.nc' character(*), parameter :: BIN_OUTFILE = 'bin.nc' integer(I4B), parameter :: BINUNIT = 20 !! File unit number for the binary output file - character(*), parameter :: PARTICLE_OUTFILE = 'particle.dat' 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 diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 859e8c6ba..3d0943d95 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -157,9 +157,7 @@ module subroutine setup_initialize_system(self, param) pl%lfirst = param%lfirstkick tp%lfirst = param%lfirstkick - if (param%lrestart) then - call system%read_particle_info(param) - else + if (.not.param%lrestart) then call system%init_particle_info(param) end if end associate diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 8d110451f..0087c24e4 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -676,7 +676,7 @@ module subroutine symba_util_rearray_pl(self, system, param) end where end select - call pl%dump_particle_info(param, idx=pack([(i, i=1, npl)], ldump_mask)) + call pl%write_particle_info(param%nciu, param) deallocate(ldump_mask) ! Reindex the new list of bodies