From f62578f41cfc320e083b15d481a981a113f2fb44 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 13:05:25 -0500 Subject: [PATCH] More cleanup and rearranging --- src/CMakeLists.txt | 1 - src/base/base_module.f90 | 4 +- src/collision/collision_check.f90 | 27 +++-- src/collision/collision_io.f90 | 126 ++++++++++----------- src/collision/collision_module.f90 | 174 ++++++++++++++++++++++------- src/collision/collision_util.f90 | 76 ------------- src/encounter/encounter_io.f90 | 100 ++++++++--------- src/encounter/encounter_module.f90 | 108 +++++++++++++----- src/encounter/encounter_util.f90 | 50 --------- src/fraggle/fraggle_module.f90 | 52 ++++++--- src/fraggle/fraggle_util.f90 | 30 ----- src/helio/helio_module.f90 | 47 ++++++-- src/helio/helio_util.f90 | 55 --------- src/rmvs/rmvs_module.f90 | 30 ++--- src/rmvs/rmvs_util.f90 | 22 ++-- src/swiftest/swiftest_module.f90 | 85 +++++++++++--- src/swiftest/swiftest_obl.f90 | 4 +- src/swiftest/swiftest_util.f90 | 38 +------ src/symba/symba_module.f90 | 110 +++++++++++++----- src/symba/symba_util.f90 | 83 -------------- src/whm/whm_module.f90 | 66 ++++++++--- src/whm/whm_util.f90 | 42 ------- 22 files changed, 644 insertions(+), 686 deletions(-) delete mode 100644 src/helio/helio_util.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 2a2103662..27d4a7bab 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -59,7 +59,6 @@ SET(FAST_MATH_FILES ${SRC}/helio/helio_gr.f90 ${SRC}/helio/helio_setup.f90 ${SRC}/helio/helio_step.f90 - ${SRC}/helio/helio_util.f90 ${SRC}/netcdf_io/netcdf_io_implementations.f90 ${SRC}/operator/operator_cross.f90 ${SRC}/operator/operator_mag.f90 diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index 7e19be601..dba0e5f68 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -237,7 +237,7 @@ subroutine final_storage_frame(self) end subroutine final_storage_frame - subroutine base_util_final_storage(self) + subroutine base_final_storage(self) !! author: David A. Minton !! !! Finalizer for the storage object @@ -251,7 +251,7 @@ subroutine base_util_final_storage(self) call final_storage_frame(self%frame(i)) end do return - end subroutine base_util_final_storage + end subroutine base_final_storage subroutine reset_storage(self) diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 index 290773032..772d4a1a7 100644 --- a/src/collision/collision_check.f90 +++ b/src/collision/collision_check.f90 @@ -91,14 +91,12 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co nenc = self%nenc allocate(lmask(nenc)) - ! TODO: Move this to a SyMBA-specific method - ! 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 + lmask(:) = (self%status(1:nenc) == ACTIVE) + select type(pl) + class is (symba_pl) + lmask(:) = lmask(:).and. (pl%levelg(self%index1(1:nenc)) >= irec)) + end select + if (.not.any(lmask(:))) return allocate(lcollision(nenc)) lcollision(:) = .false. @@ -195,10 +193,15 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co nenc = self%nenc allocate(lmask(nenc)) - ! TODO: Move this to a SyMBA-specific method - ! lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) - ! lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) - ! if (.not.any(lmask(:))) return + lmask(:) = (self%status(1:nenc) == ACTIVE) + select type(pl) + class is (symba_pl) + select type(tp) + class is (symba_tp) + lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) + end select + end select + if (.not.any(lmask(:))) return allocate(lcollision(nenc)) lcollision(:) = .false. diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 963d86463..c734cb4fa 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -7,12 +7,12 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(collision) s_collision_io +submodule(collision) s_collision_netcdf_io use swiftest contains - module subroutine collision_io_dump(self, param) + module subroutine collision_netcdf_io_dump(self, param) !! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -55,9 +55,9 @@ module subroutine collision_io_dump(self, param) end select return - end subroutine collision_io_dump + end subroutine collision_netcdf_io_dump - module subroutine collision_io_initialize_output(self, param) + module subroutine collision_netcdf_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. @@ -96,93 +96,93 @@ module subroutine collision_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_netcdf_io_initialize_output nf90_create" ) ! Dimensions - call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers - call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_netcdf_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_netcdf_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_netcdf_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_netcdf_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_netcdf_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_initialize_output nf90_def_var space_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_initialize_output nf90_def_var name_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_initialize_output nf90_def_var stage_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_netcdf_io_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_netcdf_io_initialize_output nf90_def_var name_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_netcdf_io_initialize_output nf90_def_var stage_varid" ) ! Variables - call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_netcdf_io_initialize_output nf90_def_var id_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%event_dimid, nc%time_varid), "collision_io_initialize_output nf90_def_var time_varid" ) + nc%event_dimid, nc%time_varid), "collision_netcdf_io_initialize_output nf90_def_var time_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & - [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_io_initialize_output nf90_def_var regime_varid") + [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_netcdf_io_initialize_output nf90_def_var regime_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & - [ nc%event_dimid], nc%Qloss_varid), "collision_io_initialize_output nf90_def_var Qloss_varid") + [ nc%event_dimid], nc%Qloss_varid), "collision_netcdf_io_initialize_output nf90_def_var Qloss_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_io_initialize_output nf90_def_var ptype_varid") + [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_netcdf_io_initialize_output nf90_def_var ptype_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%event_dimid], nc%loop_varid), "collision_io_initialize_output nf90_def_var loop_varid") + [ nc%event_dimid], nc%loop_varid), "collision_netcdf_io_initialize_output nf90_def_var loop_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_io_initialize_output nf90_def_var rh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_netcdf_io_initialize_output nf90_def_var rh_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_io_initialize_output nf90_def_var vh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_netcdf_io_initialize_output nf90_def_var vh_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_io_initialize_output nf90_def_var Gmass_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_netcdf_io_initialize_output nf90_def_var Gmass_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_io_initialize_output nf90_def_var radius_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_netcdf_io_initialize_output nf90_def_var radius_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_io_initialize_output nf90_def_var Ip_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_netcdf_io_initialize_output nf90_def_var Ip_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_io_initialize_output nf90_def_var rot_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_netcdf_io_initialize_output nf90_def_var rot_varid") if (param%lenergy) then call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_io_initialize_output nf90_def_var KE_orb_varid") + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_netcdf_io_initialize_output nf90_def_var KE_orb_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_io_initialize_output nf90_def_var KE_spin_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_netcdf_io_initialize_output nf90_def_var KE_spin_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_io_initialize_output nf90_def_var PE_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_netcdf_io_initialize_output nf90_def_var PE_varid" ) call netcdf_io_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), "collision_io_initialize_output nf90_def_var L_orb_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_netcdf_io_initialize_output nf90_def_var L_orb_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_io_initialize_output nf90_def_var Lspin_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_netcdf_io_initialize_output nf90_def_var Lspin_varid" ) end if - call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "collision_netcdf_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_netcdf_io_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call netcdf_io_check( nf90_enddef(nc%id), "collision_io_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "collision_netcdf_io_initialize_output nf90_enddef" ) ! Add in the space and stage dimension coordinates - call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_initialize_output nf90_put_var space" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_initialize_output nf90_put_var stage 1" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_initialize_output nf90_put_var stage 2" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_netcdf_io_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_netcdf_io_initialize_output nf90_put_var stage 1" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_netcdf_io_initialize_output nf90_put_var stage 2" ) end associate end select @@ -192,10 +192,10 @@ module subroutine collision_io_initialize_output(self, param) 667 continue write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) call swiftest_util_exit(FAILURE) - end subroutine collision_io_initialize_output + end subroutine collision_netcdf_io_initialize_output - module subroutine collision_io_write_frame_snapshot(self, history, param) + module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) !! author: David A. Minton !! !! Write a frame of output of a collision result @@ -213,14 +213,14 @@ module subroutine collision_io_write_frame_snapshot(self, history, param) select type(nc => history%nc) class is (collision_netcdf_parameters) associate(system => self%collision_system, impactors => self%collision_system%impactors, fragments => self%collision_system%fragments, eslot => param%ioutput) - call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_io_write_frame_snapshot nf90_set_fill" ) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_netcdf_io_write_frame_snapshot nf90_set_fill" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_write_frame_snapshot nf90_put_var time_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_write_frame_snapshot nf90_put_varloop_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_varloop_varid" ) charstring = trim(adjustl(REGIME_NAMES(impactors%regime))) - call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var regime_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_io_write_frame_snapshot nf90_put_var Qloss_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var regime_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_netcdf_io_write_frame_snapshot nf90_put_var Qloss_varid" ) select type(before =>self%collision_system%before) class is (swiftest_nbody_system) @@ -237,34 +237,34 @@ module subroutine collision_io_write_frame_snapshot(self, history, param) npl = pl%nbody do i = 1, npl idslot = findloc(history%idvals,pl%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_io_write_frame_snapshot nf90_put_var id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_netcdf_io_write_frame_snapshot nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_io_write_frame_snapshot nf90_put_var particle_type_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var vh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var Gmass_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var radius_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var Ip_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rotx_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Gmass_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var radius_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var rotx_varid" ) end do end do end select end select if (param%lenergy) then - call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var pe_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var pe_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) end if call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) end associate end select return - end subroutine collision_io_write_frame_snapshot + end subroutine collision_netcdf_io_write_frame_snapshot -end submodule s_collision_io \ No newline at end of file +end submodule s_collision_netcdf_io \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index ccde318cc..61c7f0fa2 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -32,6 +32,7 @@ module collision procedure :: extract_collisions => collision_resolve_extract_plpl !! Processes the pl-pl encounter list remove only those encounters that led to a collision procedure :: collision_check => collision_check_plpl !! Checks if a test particle is going to collide with a massive body procedure :: resolve_collision => collision_resolve_plpl !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision + final :: collision_final_plpl end type collision_list_plpl @@ -41,6 +42,7 @@ module collision procedure :: extract_collisions => collision_resolve_extract_pltp !! Processes the pl-tp encounter list remove only those encounters that led to a collision procedure :: collision_check => collision_check_pltp !! Checks if a test particle is going to collide with a massive body procedure :: resolve_collision => collision_resolve_pltp !! Process the pl-tp collision list + final :: collision_final_pltp end type collision_list_pltp @@ -73,7 +75,7 @@ module collision contains procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions - final :: collision_util_final_impactors !! Finalizer will deallocate all allocatables + final :: collision_final_impactors !! Finalizer will deallocate all allocatables end type collision_impactors @@ -101,7 +103,7 @@ module collision real(DP), dimension(NDIM,nbody) :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame contains procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 - final :: collision_util_final_fragments !! Finalizer deallocates all allocatables + final :: collision_final_fragments !! Finalizer deallocates all allocatables end type collision_fragments @@ -132,7 +134,7 @@ module collision procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system - final :: collision_util_final_system !! Finalizer will deallocate all allocatables + final :: collision_final_system !! Finalizer will deallocate all allocatables end type collision_system @@ -153,7 +155,8 @@ module collision character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable integer(I4B) :: regime_varid !! ID for the collision regime variable contains - procedure :: initialize => collision_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: initialize => collision_netcdf_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + final :: collision_final_netcdf_parameters !! Finalizer closes the NetCDF file end type collision_netcdf_parameters @@ -161,19 +164,19 @@ module collision logical :: lcollision !! Indicates that this snapshot contains at least one collision class(collision_system), allocatable :: collision_system !! impactors object at this snapshot contains - procedure :: write_frame => collision_io_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: write_frame => collision_netcdf_io_write_frame_snapshot !! Writes a frame of encounter data to file procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot - final :: collision_util_final_snapshot !! Finalizer deallocates all allocatables + final :: collision_final_snapshot !! Finalizer deallocates all allocatables end type collision_snapshot !> A class that that is used to store simulation history data between file output type, extends(encounter_storage) :: collision_storage contains - procedure :: dump => collision_io_dump !! Dumps contents of encounter history to file + procedure :: dump => collision_netcdf_io_dump !! Dumps contents of encounter history to file procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the system through an encounter procedure :: make_index_map => collision_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: collision_util_final_storage !! Finalizer deallocates all allocatables + final :: collision_final_storage !! Finalizer deallocates all allocatables end type collision_storage @@ -197,24 +200,24 @@ end subroutine abstract_set_mass_dist interface - module subroutine collision_io_dump(self, param) + module subroutine collision_netcdf_io_dump(self, param) implicit none class(collision_storage(*)), intent(inout) :: self !! Collision storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_io_dump + end subroutine collision_netcdf_io_dump - module subroutine collision_io_initialize_output(self, param) + module subroutine collision_netcdf_io_initialize_output(self, param) implicit none class(collision_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine collision_io_initialize_output + end subroutine collision_netcdf_io_initialize_output - module subroutine collision_io_write_frame_snapshot(self, history, param) + module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) implicit none class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_storage(*)), intent(inout) :: history !! Collision history object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_io_write_frame_snapshot + end subroutine collision_netcdf_io_write_frame_snapshot module subroutine collision_regime_impactors(self, system, param) implicit none @@ -337,30 +340,6 @@ module subroutine collision_util_reset_fragments(self) class(collision_fragments(*)), intent(inout) :: self end subroutine collision_util_reset_fragments - module subroutine collision_util_final_fragments(self) - implicit none - type(collision_fragments(*)), intent(inout) :: self - end subroutine collision_util_final_fragments - - module subroutine collision_util_final_impactors(self) - implicit none - type(collision_impactors), intent(inout) :: self !! Collision impactors storage object - end subroutine collision_util_final_impactors - - module subroutine collision_util_final_storage(self) - implicit none - type(collision_storage(*)), intent(inout) :: self !! Swiftest nbody system object - end subroutine collision_util_final_storage - - module subroutine collision_util_final_snapshot(self) - implicit none - type(collision_snapshot), intent(inout) :: self !! Fraggle storage snapshot object - end subroutine collision_util_final_snapshot - - module subroutine collision_util_final_system(self) - implicit none - type(collision_system), intent(inout) :: self !! Collision system object - end subroutine collision_util_final_system module subroutine collision_util_get_idvalues_snapshot(self, idvals) implicit none @@ -402,6 +381,125 @@ module subroutine collision_util_snapshot(self, param, system, t, arg) end subroutine collision_util_snapshot end interface + contains + + + subroutine collision_final_fragments(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_fragments(*)), intent(inout) :: self + + call self%reset() + + return + end subroutine collision_final_fragments + + + subroutine collision_final_impactors(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_impactors), intent(inout) :: self !! Collision impactors storage object + + call self%reset() + + return + end subroutine collision_final_impactors + + subroutine collision_final_netcdf_parameters(self) + !! author: David A. Minton + !! + !! Finalize the NetCDF by closing the file + implicit none + ! Arguments + type(collision_netcdf_parameters), intent(inout) :: self + + call self%close() + + return + end subroutine collision_final_netcdf_parameters + + + subroutine collision_final_plpl(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_list_plpl), intent(inout) :: self !! Fraggle encountar storage object + + call self%dealloc() + + return + end subroutine collision_final_plpl + + subroutine collision_final_pltp(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_list_pltp), intent(inout) :: self !! Fraggle encountar storage object + + call self%dealloc() + + return + end subroutine collision_final_pltp + + + subroutine collision_final_snapshot(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object + + call encounter_final_snapshot(self%encounter_snapshot) + + return + end subroutine collision_final_snapshot + + + subroutine collision_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_storage(*)), intent(inout) :: self !! Collision storage object + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + end subroutine collision_final_storage + + + subroutine collision_final_system(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_system), intent(inout) :: self !! Collision system object + + call self%reset() + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) + + return + end subroutine collision_final_system + + end module collision diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index a7506c5db..11d99dfc9 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -118,82 +118,6 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, end subroutine collision_util_construct_temporary_system - module subroutine collision_util_final_fragments(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_fragments(*)), intent(inout) :: self - - call self%reset() - - return - end subroutine collision_util_final_fragments - - - module subroutine collision_util_final_impactors(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_impactors), intent(inout) :: self !! Collision impactors storage object - - call self%reset() - - return - end subroutine collision_util_final_impactors - - - module subroutine collision_util_final_snapshot(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object - - call encounter_util_final_snapshot(self%encounter_snapshot) - - return - end subroutine collision_util_final_snapshot - - - module subroutine collision_util_final_storage(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_storage(*)), intent(inout) :: self !! Collision storage object - ! Internals - integer(I4B) :: i - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) - end do - - return - end subroutine collision_util_final_storage - - - module subroutine collision_util_final_system(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_system), intent(inout) :: self !! Collision system object - - call self%reset() - if (allocated(self%impactors)) deallocate(self%impactors) - if (allocated(self%fragments)) deallocate(self%fragments) - - return - end subroutine collision_util_final_system - - module subroutine collision_util_get_idvalues_snapshot(self, idvals) !! author: David A. Minton !! diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 1529dd955..1e1baae7c 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter) s_encounter_io +submodule (encounter) s_encounter_netcdf_io use swiftest contains - module subroutine encounter_io_dump(self, param) + module subroutine encounter_netcdf_io_dump(self, param) ! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -51,10 +51,10 @@ module subroutine encounter_io_dump(self, param) end select return - end subroutine encounter_io_dump + end subroutine encounter_netcdf_io_dump - module subroutine encounter_io_initialize_output(self, param) + module subroutine encounter_netcdf_io_initialize_output(self, param) !! author: David A. Minton !! !! Initialize a NetCDF encounter file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. @@ -91,54 +91,54 @@ module subroutine encounter_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_netcdf_io_initialize_output nf90_create" ) ! Dimensions - call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers - call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates - call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize_output nf90_def_var time_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize_output nf90_def_var space_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_netcdf_io_initialize_output nf90_def_var time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_netcdf_io_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_netcdf_io_initialize_output nf90_def_var id_varid" ) ! Variables - call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_initialize_output nf90_def_var ptype_varid" ) - call netcdf_io_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_output nf90_def_var rh_varid" ) - call netcdf_io_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_output nf90_def_var vh_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize_output nf90_def_var loop_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_netcdf_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_netcdf_io_initialize_output nf90_def_var ptype_varid" ) + call netcdf_io_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_netcdf_io_initialize_output nf90_def_var rh_varid" ) + call netcdf_io_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_netcdf_io_initialize_output nf90_def_var vh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_netcdf_io_initialize_output nf90_def_var Gmass_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_netcdf_io_initialize_output nf90_def_var loop_varid" ) if (param%lclose) then - call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_netcdf_io_initialize_output nf90_def_var radius_varid" ) end if if (param%lrotation) then - call netcdf_io_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_output nf90_def_var Ip_varid" ) - call netcdf_io_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_output nf90_def_var rot_varid" ) + call netcdf_io_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_netcdf_io_initialize_output nf90_def_var Ip_varid" ) + call netcdf_io_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_netcdf_io_initialize_output nf90_def_var rot_varid" ) end if - call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_netcdf_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_netcdf_io_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call netcdf_io_check( nf90_enddef(nc%id), "encounter_io_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "encounter_netcdf_io_initialize_output nf90_enddef" ) ! Add in the space dimension coordinates - call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_netcdf_io_initialize_output nf90_put_var space" ) end associate @@ -147,10 +147,10 @@ module subroutine encounter_io_initialize_output(self, param) 667 continue write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) call swiftest_util_exit(FAILURE) - end subroutine encounter_io_initialize_output + end subroutine encounter_netcdf_io_initialize_output - module subroutine encounter_io_write_frame_snapshot(self, history, param) + module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) !! author: David A. Minton !! !! Write a frame of output of an encounter trajectory. @@ -174,43 +174,43 @@ module subroutine encounter_io_write_frame_snapshot(self, history, param) select type (nc => history%nc) class is (encounter_netcdf_parameters) associate(tslot => param%ioutput) - call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame_snapshot nf90_set_fill" ) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_netcdf_io_write_frame_snapshot nf90_set_fill" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var time_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl loop_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl loop_varid" ) npl = pl%nbody do i = 1, npl idslot = findloc(history%idvals,pl%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var pl id_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl vh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) - if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl radius_varid" ) + if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl radius_varid" ) if (param%lrotation) then - call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) end if charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) end do ntp = tp%nbody do i = 1, ntp idslot = findloc(history%idvals,tp%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var tp id_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp vh_varid" ) charstring = trim(adjustl(tp%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp name_varid" ) charstring = trim(adjustl(tp%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) end do call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) @@ -221,9 +221,9 @@ module subroutine encounter_io_write_frame_snapshot(self, history, param) end select return - end subroutine encounter_io_write_frame_snapshot + end subroutine encounter_netcdf_io_write_frame_snapshot -end submodule s_encounter_io \ No newline at end of file +end submodule s_encounter_netcdf_io \ No newline at end of file diff --git a/src/encounter/encounter_module.f90 b/src/encounter/encounter_module.f90 index 0911b0afb..d4d35db92 100644 --- a/src/encounter/encounter_module.f90 +++ b/src/encounter/encounter_module.f90 @@ -53,9 +53,9 @@ module encounter 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_snapshot !! Writes a frame of encounter data to file + procedure :: write_frame => encounter_netcdf_io_write_frame_snapshot !! 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 + final :: encounter_final_snapshot end type encounter_snapshot !> NetCDF dimension and variable names for the enounter save object @@ -66,7 +66,8 @@ module encounter 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_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: initialize => encounter_netcdf_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + final :: encounter_final_netcdf_parameters !! Finalizer will close the NetCDF file end type encounter_netcdf_parameters @@ -74,11 +75,11 @@ module encounter type, extends(base_storage) :: encounter_storage class(encounter_netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object contains - procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file + procedure :: dump => encounter_netcdf_io_dump !! Dumps contents of encounter history to file procedure :: get_index_values => encounter_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) - procedure :: make_index_map => encounter_util_index_map !! 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 !! Take a minimal snapshot of the system through an encounter - final :: encounter_util_final_storage + procedure :: make_index_map => encounter_util_index_map !! 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 !! Take a minimal snapshot of the system through an encounter + final :: encounter_final_storage end type encounter_storage @@ -91,7 +92,7 @@ module encounter contains procedure :: sort => encounter_check_sort_aabb_1D !! Sorts the bounding box extents along a single dimension prior to the sweep phase procedure :: dealloc => encounter_util_dealloc_aabb !! Deallocates all allocatables - final :: encounter_util_final_aabb !! Finalize the axis-aligned bounding box (1D) - deallocates all allocatables + final :: encounter_final_aabb !! Finalize the axis-aligned bounding box (1D) - deallocates all allocatables end type @@ -217,24 +218,24 @@ 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_netcdf_io_dump(self, param) implicit none class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_io_dump + end subroutine encounter_netcdf_io_dump - module subroutine encounter_io_initialize_output(self, param) + module subroutine encounter_netcdf_io_initialize_output(self, param) implicit none class(encounter_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param - end subroutine encounter_io_initialize_output + end subroutine encounter_netcdf_io_initialize_output - module subroutine encounter_io_write_frame_snapshot(self, history, param) + module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) implicit none class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_storage(*)), intent(inout) :: history !! Encounter storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_io_write_frame_snapshot + end subroutine encounter_netcdf_io_write_frame_snapshot module subroutine encounter_setup_aabb(self, n, n_last) implicit none @@ -272,20 +273,6 @@ module subroutine encounter_util_dealloc_list(self) class(encounter_list), intent(inout) :: self !! Swiftest encounter list object end subroutine encounter_util_dealloc_list - module subroutine encounter_util_final_aabb(self) - implicit none - 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_snapshot(self) - implicit none - type(encounter_snapshot), intent(inout) :: self !! Encounter snapshot object - end subroutine encounter_util_final_snapshot - - module subroutine encounter_util_final_storage(self) - implicit none - 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 @@ -329,5 +316,70 @@ end subroutine encounter_util_spill_list end interface + contains + + subroutine encounter_final_aabb(self) + !! author: David A. Minton + !! + !! Finalize the axis aligned bounding box (1D) - deallocates all allocatables + implicit none + ! Arguments + type(encounter_bounding_box_1D), intent(inout) :: self + + call self%dealloc() + + return + end subroutine encounter_final_aabb + + + subroutine encounter_final_netcdf_parameters(self) + !! author: David A. Minton + !! + !! Finalize the NetCDF by closing the file + implicit none + ! Arguments + type(encounter_netcdf_parameters), intent(inout) :: self + + call self%close() + + return + end subroutine encounter_final_netcdf_parameters + + + subroutine encounter_final_snapshot(self) + !! author: David A. Minton + !! + !! Deallocates allocatable arrays in an encounter snapshot + implicit none + ! Arguments + type(encounter_snapshot), intent(inout) :: self !! Encounter storage object + + if (allocated(self%pl)) deallocate(self%pl) + if (allocated(self%tp)) deallocate(self%tp) + self%t = 0.0_DP + + return + end subroutine encounter_final_snapshot + + + subroutine encounter_final_storage(self) + !! author: David A. Minton + !! + !! Deallocates allocatable arrays in an encounter snapshot + implicit none + ! Arguments + type(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + + return + end subroutine encounter_final_storage + end module encounter diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index b124c5fbf..5c26771a5 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -119,56 +119,6 @@ module subroutine encounter_util_dealloc_list(self) end subroutine encounter_util_dealloc_list - module subroutine encounter_util_final_aabb(self) - !! author: David A. Minton - !! - !! Finalize the axis aligned bounding box (1D) - deallocates all allocatables - implicit none - ! Arguments - type(encounter_bounding_box_1D), intent(inout) :: self - - call self%dealloc() - - return - end subroutine encounter_util_final_aabb - - - module subroutine encounter_util_final_snapshot(self) - !! author: David A. Minton - !! - !! Deallocates allocatable arrays in an encounter snapshot - implicit none - ! Arguments - type(encounter_snapshot), intent(inout) :: self !! Encounter storage object - - if (allocated(self%pl)) deallocate(self%pl) - if (allocated(self%tp)) deallocate(self%tp) - self%t = 0.0_DP - - return - end subroutine encounter_util_final_snapshot - - - module subroutine encounter_util_final_storage(self) - !! author: David A. Minton - !! - !! Deallocates allocatable arrays in an encounter snapshot - implicit none - ! Arguments - type(encounter_storage(*)), intent(inout) :: self !! Encounter storage object - ! Internals - integer(I4B) :: i - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) - end do - - return - - return - end subroutine encounter_util_final_storage - - module subroutine encounter_util_get_idvalues_snapshot(self, idvals) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 6b336fff4..e77dd44e2 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -21,7 +21,6 @@ module fraggle integer(I4B), parameter :: FRAGGLE_NMASS_DIST = 3 !! Number of mass bins returned by the regime calculation (largest fragment, second largest, and remainder) character(len=*), parameter :: FRAGGLE_LOG_OUT = "fraggle.log" !! Name of log file for Fraggle diagnostic information - !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates type, extends(collision_fragments) :: fraggle_fragments @@ -39,7 +38,7 @@ module fraggle procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints - final :: fraggle_util_final_fragments !! Finalizer will deallocate all allocatables + final :: fraggle_final_fragments !! Finalizer will deallocate all allocatables end type fraggle_fragments @@ -60,7 +59,7 @@ module fraggle procedure :: setup_fragments => fraggle_setup_fragments_system !! Initializer for the fragments of the collision system. procedure :: construct_temporary_system => fraggle_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum procedure :: reset => fraggle_util_reset_system !! Deallocates all allocatables - final :: fraggle_util_final_system !! Finalizer will deallocate all allocatables + final :: fraggle_final_system !! Finalizer will deallocate all allocatables end type fraggle_system @@ -138,20 +137,10 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_final_impactors(self) + module subroutine fraggle_final_impactors(self) implicit none type(collision_impactors), intent(inout) :: self !! Fraggle impactors object - end subroutine fraggle_util_final_impactors - - module subroutine fraggle_util_final_fragments(self) - implicit none - type(fraggle_fragments(*)), intent(inout) :: self !! Fraggle frgments object - end subroutine fraggle_util_final_fragments - - module subroutine fraggle_util_final_system(self) - implicit none - type(fraggle_system), intent(inout) :: self !! Collision system object - end subroutine fraggle_util_final_system + end subroutine fraggle_final_impactors module subroutine fraggle_util_reset_fragments(self) implicit none @@ -189,4 +178,37 @@ module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_ end function fraggle_util_vmag_to_vb end interface + contains + + + + subroutine fraggle_final_fragments(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(fraggle_fragments(*)), intent(inout) :: self !! Fraggle encountar storage object + + call self%collision_fragments%reset() + + return + end subroutine fraggle_final_fragments + + + subroutine fraggle_final_system(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(fraggle_system), intent(inout) :: self !! Collision impactors storage object + + call self%reset() + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) + + return + end subroutine fraggle_final_system + end module fraggle \ No newline at end of file diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 62581c0db..e0303f996 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -62,36 +62,6 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_final_fragments(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(fraggle_fragments(*)), intent(inout) :: self !! Fraggle encountar storage object - - call self%collision_fragments%reset() - - return - end subroutine fraggle_util_final_fragments - - - module subroutine fraggle_util_final_system(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(fraggle_system), intent(inout) :: self !! Collision impactors storage object - - call self%reset() - if (allocated(self%impactors)) deallocate(self%impactors) - if (allocated(self%fragments)) deallocate(self%fragments) - - return - end subroutine fraggle_util_final_system - - module subroutine fraggle_util_reset_fragments(self) !! author: David A. Minton !! diff --git a/src/helio/helio_module.f90 b/src/helio/helio_module.f90 index 8a93badae..c33583529 100644 --- a/src/helio/helio_module.f90 +++ b/src/helio/helio_module.f90 @@ -22,7 +22,7 @@ module helio contains procedure :: step => helio_step_system !! Advance the Helio nbody system forward in time by one step procedure :: initialize => helio_setup_initialize_system !! Performs Helio-specific initilization steps, including converting to DH coordinates - final :: helio_util_final_system !! Finalizes the Helio system object - deallocates all allocatables + final :: helio_final_system !! Finalizes the Helio system object - deallocates all allocatables end type helio_nbody_system @@ -44,7 +44,7 @@ module helio procedure :: accel => helio_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies procedure :: kick => helio_kick_vb_pl !! Kicks the barycentric velocities procedure :: step => helio_step_pl !! Steps the body forward one stepsize - final :: helio_util_final_pl !! Finalizes the Helio massive body object - deallocates all allocatables + final :: helio_final_pl !! Finalizes the Helio massive body object - deallocates all allocatables end type helio_pl @@ -58,7 +58,7 @@ module helio procedure :: accel => helio_kick_getacch_tp !! Compute heliocentric accelerations of massive bodies procedure :: kick => helio_kick_vb_tp !! Kicks the barycentric velocities procedure :: step => helio_step_tp !! Steps the body forward one stepsize - final :: helio_util_final_tp !! Finalizes the Helio test particle object - deallocates all allocatables + final :: helio_final_tp !! Finalizes the Helio test particle object - deallocates all allocatables end type helio_tp interface @@ -199,22 +199,49 @@ module subroutine helio_step_tp(self, system, param, t, dt) real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsizee end subroutine helio_step_tp + end interface + + contains - module subroutine helio_util_final_pl(self) + subroutine helio_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the Helio massive body object - deallocates all allocatables implicit none + ! Arguments type(helio_pl), intent(inout) :: self !! Helio massive body object - end subroutine helio_util_final_pl - module subroutine helio_util_final_system(self) + call self%dealloc() + + return + end subroutine helio_final_pl + + + subroutine helio_final_system(self) + !! author: David A. Minton + !! + !! Finalize the Helio nbody system object - deallocates all allocatables implicit none + ! Arguments type(helio_nbody_system), intent(inout) :: self !! Helio nbody system object - end subroutine helio_util_final_system - module subroutine helio_util_final_tp(self) + call whm_final_system(self%whm_nbody_system) + + return + end subroutine helio_final_system + + + subroutine helio_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the Helio test particle object - deallocates all allocatables implicit none + ! Arguments type(helio_tp), intent(inout) :: self !! Helio test particle object - end subroutine helio_util_final_tp - end interface + call self%dealloc() + + return + end subroutine helio_final_tp end module helio diff --git a/src/helio/helio_util.f90 b/src/helio/helio_util.f90 deleted file mode 100644 index 3568fa557..000000000 --- a/src/helio/helio_util.f90 +++ /dev/null @@ -1,55 +0,0 @@ -!! 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(helio) s_helio_util - use swiftest -contains - - module subroutine helio_util_final_pl(self) - !! author: David A. Minton - !! - !! Finalize the Helio massive body object - deallocates all allocatables - implicit none - ! Arguments - type(helio_pl), intent(inout) :: self !! Helio massive body object - - call self%dealloc() - - return - end subroutine helio_util_final_pl - - - module subroutine helio_util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the Helio nbody system object - deallocates all allocatables - implicit none - ! Arguments - type(helio_nbody_system), intent(inout) :: self !! Helio nbody system object - - call whm_util_final_system(self%whm_nbody_system) - - return - end subroutine helio_util_final_system - - - module subroutine helio_util_final_tp(self) - !! author: David A. Minton - !! - !! Finalize the Helio test particle object - deallocates all allocatables - implicit none - ! Arguments - type(helio_tp), intent(inout) :: self !! Helio test particle object - - call self%dealloc() - - return - end subroutine helio_util_final_tp - -end submodule s_helio_util \ No newline at end of file diff --git a/src/rmvs/rmvs_module.f90 b/src/rmvs/rmvs_module.f90 index b42e0a937..e6d3c7553 100644 --- a/src/rmvs/rmvs_module.f90 +++ b/src/rmvs/rmvs_module.f90 @@ -34,7 +34,7 @@ module rmvs !> Replace the abstract procedures with concrete ones procedure :: initialize => rmvs_setup_initialize_system !! Performs RMVS-specific initilization steps, including generating the close encounter planetocentric structures procedure :: step => rmvs_step_system !! Advance the RMVS nbody system forward in time by one step - final :: rmvs_util_final_system !! Finalizes the RMVS nbody system object - deallocates all allocatables + final :: rmvs_final_system !! Finalizes the RMVS nbody system object - deallocates all allocatables end type rmvs_nbody_system type, private :: rmvs_interp @@ -44,7 +44,7 @@ module rmvs real(DP), dimension(:, :), allocatable :: atide !! Encountering planet's tidal acceleration value contains procedure :: dealloc => rmvs_util_dealloc_interp !! Deallocates all allocatable arrays - final :: rmvs_util_final_interp !! Finalizes the RMVS interpolated system variables object - deallocates all allocatables + final :: rmvs_final_interp !! Finalizes the RMVS interpolated system variables object - deallocates all allocatables end type rmvs_interp @@ -55,7 +55,7 @@ module rmvs logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations contains procedure :: dealloc => rmvs_util_dealloc_cb !! Deallocates all allocatable arrays - final :: rmvs_util_final_cb !! Finalizes the RMVS central body object - deallocates all allocatables + final :: rmvs_final_cb !! Finalizes the RMVS central body object - deallocates all allocatables end type rmvs_cb @@ -87,7 +87,7 @@ module rmvs procedure :: sort => rmvs_util_sort_tp !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: rmvs_util_final_tp !! Finalizes the RMVS test particle object - deallocates all allocatables + final :: rmvs_final_tp !! Finalizes the RMVS test particle object - deallocates all allocatables end type rmvs_tp @@ -109,7 +109,7 @@ module rmvs procedure :: sort => rmvs_util_sort_pl !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: rmvs_util_final_pl !! Finalizes the RMVS massive body object - deallocates all allocatables + final :: rmvs_final_pl !! Finalizes the RMVS massive body object - deallocates all allocatables end type rmvs_pl interface @@ -206,30 +206,30 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps end subroutine rmvs_util_fill_tp - module subroutine rmvs_util_final_cb(self) + module subroutine rmvs_final_cb(self) implicit none type(rmvs_cb), intent(inout) :: self !! RMVS central body object - end subroutine rmvs_util_final_cb + end subroutine rmvs_final_cb - module subroutine rmvs_util_final_interp(self) + module subroutine rmvs_final_interp(self) implicit none type(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object - end subroutine rmvs_util_final_interp + end subroutine rmvs_final_interp - module subroutine rmvs_util_final_pl(self) + module subroutine rmvs_final_pl(self) implicit none type(rmvs_pl), intent(inout) :: self !! RMVS massive body object - end subroutine rmvs_util_final_pl + end subroutine rmvs_final_pl - module subroutine rmvs_util_final_system(self) + module subroutine rmvs_final_system(self) implicit none type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object - end subroutine rmvs_util_final_system + end subroutine rmvs_final_system - module subroutine rmvs_util_final_tp(self) + module subroutine rmvs_final_tp(self) implicit none type(rmvs_tp), intent(inout) :: self !! RMVS test particle object - end subroutine rmvs_util_final_tp + end subroutine rmvs_final_tp module subroutine rmvs_util_resize_pl(self, nnew) implicit none diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 09159afb5..d39eeeddc 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -182,7 +182,7 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) end subroutine rmvs_util_fill_pl - module subroutine rmvs_util_final_cb(self) + module subroutine rmvs_final_cb(self) !! author: David A. Minton !! !! Finalize the RMVS massive body object - deallocates all allocatables @@ -193,10 +193,10 @@ module subroutine rmvs_util_final_cb(self) call self%dealloc() return - end subroutine rmvs_util_final_cb + end subroutine rmvs_final_cb - module subroutine rmvs_util_final_interp(self) + module subroutine rmvs_final_interp(self) !! author: David A. Minton !! !! Finalize the RMVS nbody system object - deallocates all allocatables @@ -207,10 +207,10 @@ module subroutine rmvs_util_final_interp(self) call self%dealloc() return - end subroutine rmvs_util_final_interp + end subroutine rmvs_final_interp - module subroutine rmvs_util_final_pl(self) + module subroutine rmvs_final_pl(self) !! author: David A. Minton !! !! Finalize the RMVS massive body object - deallocates all allocatables @@ -221,10 +221,10 @@ module subroutine rmvs_util_final_pl(self) call self%dealloc() return - end subroutine rmvs_util_final_pl + end subroutine rmvs_final_pl - module subroutine rmvs_util_final_system(self) + module subroutine rmvs_final_system(self) !! author: David A. Minton !! !! Finalize the RMVS nbody system object - deallocates all allocatables @@ -233,13 +233,13 @@ module subroutine rmvs_util_final_system(self) type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object if (allocated(self%vbeg)) deallocate(self%vbeg) - call whm_util_final_system(self%whm_nbody_system) + call whm_final_system(self%whm_nbody_system) return - end subroutine rmvs_util_final_system + end subroutine rmvs_final_system - module subroutine rmvs_util_final_tp(self) + module subroutine rmvs_final_tp(self) !! author: David A. Minton !! !! Finalize the RMVS test particle object - deallocates all allocatables @@ -250,7 +250,7 @@ module subroutine rmvs_util_final_tp(self) call self%dealloc() return - end subroutine rmvs_util_final_tp + end subroutine rmvs_final_tp module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 6347629b0..347096476 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -55,6 +55,7 @@ module swiftest procedure :: initialize => swiftest_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object procedure :: open => swiftest_io_netcdf_open !! Opens a NetCDF file and does the variable inquiries to activate variable ids procedure :: flush => swiftest_io_netcdf_flush !! Flushes a NetCDF file by closing it then opening it again + final :: swiftest_final_netcdf_parameters !! Finalizer will close the NetCDF file end type swiftest_netcdf_parameters @@ -65,7 +66,7 @@ module swiftest procedure :: get_index_values => swiftest_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) procedure :: make_index_map => swiftest_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 => swiftest_util_snapshot_system !! Takes a snapshot of the system for later file storage - final :: swiftest_util_final_storage + final :: swiftest_final_storage end type swiftest_storage @@ -88,7 +89,7 @@ module swiftest integer(I4B), dimension(:), allocatable :: child !! Index of children particles contains procedure :: dealloc => swiftest_util_dealloc_kin !! Deallocates all allocatable arrays - final :: swiftest_util_final_kin !! Finalizes the Swiftest kinship object - deallocates all allocatables + final :: swiftest_final_kin !! Finalizes the Swiftest kinship object - deallocates all allocatables end type swiftest_kinship @@ -1225,16 +1226,6 @@ module subroutine swiftest_util_dealloc_pl(self) class(swiftest_pl), intent(inout) :: self end subroutine swiftest_util_dealloc_pl - module subroutine swiftest_util_final_kin(self) - implicit none - type(swiftest_kinship), intent(inout) :: self !! Swiftest kinship object - end subroutine swiftest_util_final_kin - - module subroutine swiftest_util_final_system(self) - implicit none - class(swiftest_nbody_system), intent(inout) :: self - end subroutine swiftest_util_final_system - module subroutine swiftest_util_dealloc_tp(self) implicit none class(swiftest_tp), intent(inout) :: self @@ -1252,7 +1243,6 @@ module subroutine swiftest_util_fill_body(self, inserts, lfill_list) logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps end subroutine swiftest_util_fill_body - module subroutine swiftest_util_fill_pl(self, inserts, lfill_list) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object @@ -1321,11 +1311,6 @@ end subroutine swiftest_util_fill_arr_logical interface - module subroutine swiftest_util_final_storage(self) - implicit none - type(swiftest_storage(*)) :: self - end subroutine swiftest_util_final_storage - pure module subroutine swiftest_util_flatten_eucl_ij_to_k(n, i, j, k) !$omp declare simd(swiftest_util_flatten_eucl_ij_to_k) implicit none @@ -1859,4 +1844,68 @@ subroutine make_impactors_pl(self, idx) end subroutine make_impactors_pl + subroutine swiftest_final_kin(self) + !! author: David A. Minton + !! + !! Finalize the swiftest kinship object - deallocates all allocatables + implicit none + ! Argument + type(swiftest_kinship), intent(inout) :: self !! SyMBA kinship object + + call self%dealloc() + + return + end subroutine swiftest_final_kin + + + subroutine swiftest_final_netcdf_parameters(self) + !! author: David A. Minton + !! + !! Finalize the NetCDF by closing the file + implicit none + ! Arguments + type(swiftest_netcdf_parameters), intent(inout) :: self + + call self%close() + + return + end subroutine swiftest_final_netcdf_parameters + + + subroutine swiftest_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer for the storage data type + implicit none + ! Arguments + type(swiftest_storage(*)) :: self + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + end subroutine swiftest_final_storage + + + subroutine swiftest_final_system(self) + !! author: David A. Minton + !! + !! Finalize the swiftest nbody system object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + + if (allocated(self%cb)) deallocate(self%cb) + if (allocated(self%pl)) deallocate(self%pl) + if (allocated(self%tp)) deallocate(self%tp) + if (allocated(self%tp_discards)) deallocate(self%tp_discards) + if (allocated(self%pl_discards)) deallocate(self%pl_discards) + + return + end subroutine swiftest_final_system + + end module swiftest diff --git a/src/swiftest/swiftest_obl.f90 b/src/swiftest/swiftest_obl.f90 index 3d3109d8c..bb785232b 100644 --- a/src/swiftest/swiftest_obl.f90 +++ b/src/swiftest/swiftest_obl.f90 @@ -65,7 +65,7 @@ module subroutine swiftest_obl_acc_pl(self, system) if (self%nbody == 0) return associate(pl => self, npl => self%nbody, cb => system%cb) - call obl_acc_body(pl, system) + call swiftest_obl_acc_body(pl, system) cb%aobl(:) = 0.0_DP do i = npl, 1, -1 if (pl%lmask(i)) cb%aobl(:) = cb%aobl(:) - pl%Gmass(i) * pl%aobl(:, i) / cb%Gmass @@ -99,7 +99,7 @@ module subroutine swiftest_obl_acc_tp(self, system) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody, cb => system%cb) - call obl_acc_body(tp, system) + call swiftest_obl_acc_body(tp, system) if (system%lbeg) then aoblcb = cb%aoblbeg else diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 3326f96c8..8393b1d70 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -176,7 +176,7 @@ module subroutine swiftest_util_append_arr_kin(arr, source, nold, nsrc, lsource_ if (.not.allocated(arr)) then allocate(arr(nold+nnew)) else - call util_resize(arr, nold + nnew) + call swiftest_util_resize(arr, nold + nnew) end if arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) @@ -1114,42 +1114,6 @@ module subroutine swiftest_util_fill_tp(self, inserts, lfill_list) end subroutine swiftest_util_fill_tp - module subroutine swiftest_util_final_storage(self) - !! author: David A. Minton - !! - !! Finalizer for the storage data type - implicit none - ! Arguments - type(swiftest_storage(*)) :: self - ! Internals - integer(I4B) :: i - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) - end do - - return - end subroutine swiftest_util_final_storage - - - module subroutine swiftest_util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the swiftest nbody system object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - - if (allocated(self%cb)) deallocate(self%cb) - if (allocated(self%pl)) deallocate(self%pl) - if (allocated(self%tp)) deallocate(self%tp) - if (allocated(self%tp_discards)) deallocate(self%tp_discards) - if (allocated(self%pl_discards)) deallocate(self%pl_discards) - - return - end subroutine swiftest_util_final_system - - pure module subroutine swiftest_util_flatten_eucl_ij_to_k(n, i, j, k) !! author: Jacob R. Elliott and David A. Minton !! diff --git a/src/symba/symba_module.f90 b/src/symba/symba_module.f90 index fcd934c1a..f8d8db5ec 100644 --- a/src/symba/symba_module.f90 +++ b/src/symba/symba_module.f90 @@ -49,7 +49,7 @@ module symba procedure :: sort => symba_util_sort_pl !! Sorts body arrays by a sortable componen procedure :: rearrange => symba_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => symba_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: symba_util_final_pl !! Finalizes the SyMBA massive body object - deallocates all allocatables + final :: symba_final_pl !! Finalizes the SyMBA massive body object - deallocates all allocatables end type symba_pl @@ -70,7 +70,7 @@ module symba procedure :: sort => symba_util_sort_tp !! Sorts body arrays by a sortable componen procedure :: rearrange => symba_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => symba_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: symba_util_final_tp !! Finalizes the SyMBA test particle object - deallocates all allocatables + final :: symba_final_tp !! Finalizes the SyMBA test particle object - deallocates all allocatables end type symba_tp @@ -79,7 +79,7 @@ module symba contains procedure :: encounter_check => symba_encounter_check_list_plpl !! Checks if massive bodies are going through close encounters with each other procedure :: kick => symba_kick_list_plpl !! Kick barycentric velocities of active massive bodies within SyMBA recursion - final :: symba_util_final_list_plpl !! Finalizes the SyMBA test particle object - deallocates all allocatables + final :: symba_final_list_plpl !! Finalizes the SyMBA test particle object - deallocates all allocatables end type symba_list_plpl @@ -88,7 +88,7 @@ module symba contains procedure :: encounter_check => symba_encounter_check_list_pltp !! Checks if massive bodies are going through close encounters with test particles procedure :: kick => symba_kick_list_pltp !! Kick barycentric velocities of active test particles within SyMBA recursion - final :: symba_util_final_list_pltp !! Finalizes the SyMBA test particle object - deallocates all allocatables + final :: symba_final_list_pltp !! Finalizes the SyMBA test particle object - deallocates all allocatables end type symba_list_pltp @@ -101,7 +101,7 @@ module symba 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 - final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables + final :: symba_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system interface @@ -346,31 +346,6 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_util_flatten_eucl_plpl - module subroutine symba_util_final_list_plpl(self) - implicit none - type(symba_list_plpl), intent(inout) :: self !! SyMBA encounter list object - end subroutine symba_util_final_list_plpl - - module subroutine symba_util_final_list_pltp(self) - implicit none - type(symba_list_pltp), intent(inout) :: self !! SyMBA encounter list object - end subroutine symba_util_final_list_pltp - - module subroutine symba_util_final_pl(self) - implicit none - type(symba_pl), intent(inout) :: self !! SyMBA massive body object - end subroutine symba_util_final_pl - - module subroutine symba_util_final_system(self) - implicit none - type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - end subroutine symba_util_final_system - - module subroutine symba_util_final_tp(self) - implicit none - type(symba_tp), intent(inout) :: self !! SyMBA test particle object - end subroutine symba_util_final_tp - end interface interface @@ -433,4 +408,79 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_tp end interface + + contains + + + subroutine symba_final_list_plpl(self) + !! author: David A. Minton + !! + !! Finalize the pl-tp list - deallocates all allocatables + implicit none + type(symba_list_plpl), intent(inout) :: self !! SyMBA encounter list object + + call self%dealloc() + + return + end subroutine symba_final_list_plpl + + + subroutine symba_final_list_pltp(self) + !! author: David A. Minton + !! + !! Finalize the pl-tp list - deallocates all allocatables + implicit none + type(symba_list_pltp), intent(inout) :: self !! SyMBA encounter list object + + call self%dealloc() + + return + end subroutine symba_final_list_pltp + + + subroutine symba_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA massive body object - deallocates all allocatables + implicit none + ! Argument + type(symba_pl), intent(inout) :: self !! SyMBA massive body object + + call self%dealloc() + + return + end subroutine symba_final_pl + + + subroutine symba_final_system(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA nbody system object - deallocates all allocatables + implicit none + ! Argument + type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + + if (allocated(self%pl_adds)) deallocate(self%pl_adds) + if (allocated(self%pltp_encounter)) deallocate(self%pltp_encounter) + if (allocated(self%plpl_encounter)) deallocate(self%plpl_encounter) + if (allocated(self%plpl_collision)) deallocate(self%plpl_collision) + + call helio_final_system(self%helio_nbody_system) + + return + end subroutine symba_final_system + + + subroutine symba_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA test particleobject - deallocates all allocatables + implicit none + ! Argument + type(symba_tp), intent(inout) :: self !! SyMBA test particle object + + call self%dealloc() + + return + end subroutine symba_final_tp end module symba \ No newline at end of file diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 6b91857a5..a374f9540 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -25,17 +25,8 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) select type(source) class is (symba_pl) associate(nold => self%nbody, nsrc => source%nbody) - call swiftest_util_append(self%lcollision, source%lcollision, nold, nsrc, lsource_mask) - call swiftest_util_append(self%lencounter, source%lencounter, nold, nsrc, lsource_mask) - call swiftest_util_append(self%lmtiny, source%lmtiny, nold, nsrc, lsource_mask) - call swiftest_util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) - call swiftest_util_append(self%ntpenc, source%ntpenc, nold, nsrc, lsource_mask) call swiftest_util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) call swiftest_util_append(self%levelm, source%levelm, nold, nsrc, lsource_mask) - call swiftest_util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) - call swiftest_util_append(self%peri, source%peri, nold, nsrc, lsource_mask) - call swiftest_util_append(self%atp, source%atp, nold, nsrc, lsource_mask) - call swiftest_util_append(self%kin, source%kin, nold, nsrc, lsource_mask) call swiftest_util_append_pl(self, source, lsource_mask) ! Note: helio_pl does not have its own append method, so we skip back to the base class end associate @@ -183,79 +174,6 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) end subroutine symba_util_fill_tp - module subroutine symba_util_final_list_plpl(self) - !! author: David A. Minton - !! - !! Finalize the pl-tp list - deallocates all allocatables - implicit none - type(symba_list_plpl), intent(inout) :: self !! SyMBA encounter list object - - call self%dealloc() - - return - end subroutine symba_util_final_list_plpl - - - module subroutine symba_util_final_list_pltp(self) - !! author: David A. Minton - !! - !! Finalize the pl-tp list - deallocates all allocatables - implicit none - type(symba_list_pltp), intent(inout) :: self !! SyMBA encounter list object - - call self%dealloc() - - return - end subroutine symba_util_final_list_pltp - - - module subroutine symba_util_final_pl(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA massive body object - deallocates all allocatables - implicit none - ! Argument - type(symba_pl), intent(inout) :: self !! SyMBA massive body object - - call self%dealloc() - - return - end subroutine symba_util_final_pl - - - module subroutine symba_util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA nbody system object - deallocates all allocatables - implicit none - ! Argument - type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - - if (allocated(self%pl_adds)) deallocate(self%pl_adds) - if (allocated(self%pltp_encounter)) deallocate(self%pltp_encounter) - if (allocated(self%plpl_encounter)) deallocate(self%plpl_encounter) - if (allocated(self%plpl_collision)) deallocate(self%plpl_collision) - - call helio_util_final_system(self%helio_nbody_system) - - return - end subroutine symba_util_final_system - - - module subroutine symba_util_final_tp(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA test particleobject - deallocates all allocatables - implicit none - ! Argument - type(symba_tp), intent(inout) :: self !! SyMBA test particle object - - call self%dealloc() - - return - end subroutine symba_util_final_tp - - module subroutine symba_util_flatten_eucl_plpl(self, param) !! author: Jacob R. Elliott and David A. Minton !! @@ -529,7 +447,6 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_pl - module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! diff --git a/src/whm/whm_module.f90 b/src/whm/whm_module.f90 index 7b09bbfbc..c3f2ce96f 100644 --- a/src/whm/whm_module.f90 +++ b/src/whm/whm_module.f90 @@ -51,7 +51,7 @@ module whm procedure :: spill => whm_util_spill_pl !!"Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) procedure :: setup => whm_setup_pl !! Constructor method - Allocates space for the input number of bodiess procedure :: step => whm_step_pl !! Steps the body forward one stepsize - final :: whm_util_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables + final :: whm_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables end type whm_pl @@ -65,7 +65,7 @@ module whm procedure :: accel => whm_kick_getacch_tp !! Compute heliocentric accelerations of test particles procedure :: kick => whm_kick_vh_tp !! Kick heliocentric velocities of test particles procedure :: step => whm_step_tp !! Steps the particle forward one stepsize - final :: whm_util_final_tp !! Finalizes the WHM test particle object - deallocates all allocatables + final :: whm_final_tp !! Finalizes the WHM test particle object - deallocates all allocatables end type whm_tp !> An abstract class for the WHM integrator nbody system @@ -74,7 +74,7 @@ module whm !> Replace the abstract procedures with concrete ones procedure :: initialize => whm_setup_initialize_system !! Performs WHM-specific initilization steps, like calculating the Jacobi masses procedure :: step => whm_step_system !! Advance the WHM nbody system forward in time by one step - final :: whm_util_final_system !! Finalizes the WHM system object - deallocates all allocatables + final :: whm_final_system !! Finalizes the WHM system object - deallocates all allocatables end type whm_nbody_system interface @@ -224,21 +224,6 @@ module subroutine whm_util_dealloc_pl(self) class(whm_pl), intent(inout) :: self !! WHM massive body object end subroutine whm_util_dealloc_pl - module subroutine whm_util_final_pl(self) - implicit none - type(whm_pl), intent(inout) :: self !! WHM massive body object - end subroutine whm_util_final_pl - - module subroutine whm_util_final_system(self) - implicit none - type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - end subroutine whm_util_final_system - - module subroutine whm_util_final_tp(self) - implicit none - type(whm_tp), intent(inout) :: self !! WHM test particle object - end subroutine whm_util_final_tp - module subroutine whm_util_spill_pl(self, discards, lspill_list, ldestructive) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object @@ -285,4 +270,49 @@ module subroutine whm_util_sort_rearrange_pl(self, ind) end subroutine whm_util_sort_rearrange_pl end interface + contains + + + + subroutine whm_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the WHM massive body object - deallocates all allocatables + implicit none + ! Argument + type(whm_pl), intent(inout) :: self !! WHM massive body object + + call self%dealloc() + + return + end subroutine whm_final_pl + + + subroutine whm_final_system(self) + !! author: David A. Minton + !! + !! Finalize the WHM nbody system object - deallocates all allocatables + implicit none + ! Arguments + type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object + + call swiftest_final_system(self) + + return + end subroutine whm_final_system + + + subroutine whm_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the WHM test particle object - deallocates all allocatables + implicit none + ! Arguments + type(whm_tp), intent(inout) :: self !! WHM test particle object + + call self%dealloc() + + return + end subroutine whm_final_tp + end module whm diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 6d49c818f..28c61f437 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -95,48 +95,6 @@ module subroutine whm_util_fill_pl(self, inserts, lfill_list) end subroutine whm_util_fill_pl - module subroutine whm_util_final_pl(self) - !! author: David A. Minton - !! - !! Finalize the WHM massive body object - deallocates all allocatables - implicit none - ! Argument - type(whm_pl), intent(inout) :: self !! WHM massive body object - - call self%dealloc() - - return - end subroutine whm_util_final_pl - - - module subroutine whm_util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the WHM nbody system object - deallocates all allocatables - implicit none - ! Arguments - type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - - call swiftest_util_final_system(self) - - return - end subroutine whm_util_final_system - - - module subroutine whm_util_final_tp(self) - !! author: David A. Minton - !! - !! Finalize the WHM test particle object - deallocates all allocatables - implicit none - ! Arguments - type(whm_tp), intent(inout) :: self !! WHM test particle object - - call self%dealloc() - - return - end subroutine whm_util_final_tp - - module subroutine whm_util_resize_pl(self, nnew) !! author: David A. Minton !!