From a078373b94ac83d7dbd89dfb5736f1afa92e6271 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 13 Oct 2021 17:31:25 -0400 Subject: [PATCH 1/5] Added deallocators and finalizers in order to track down memory leak. All allocatables are now explicitly deallocated on finalization. --- src/drift/drift.f90 | 5 + src/encounter/encounter_check.f90 | 2 +- src/encounter/encounter_util.f90 | 68 +++++++++++ src/helio/helio_drift.f90 | 3 +- src/helio/helio_util.f90 | 46 ++++++++ src/io/io.f90 | 4 +- src/modules/encounter_classes.f90 | 38 ++++-- src/modules/helio_classes.f90 | 18 +++ src/modules/rmvs_classes.f90 | 56 +++++++++ src/modules/swiftest_classes.f90 | 37 +++++- src/modules/symba_classes.f90 | 116 +++++++++++++++---- src/modules/whm_classes.f90 | 26 ++++- src/netcdf/netcdf.f90 | 27 ++++- src/rmvs/rmvs_setup.f90 | 15 +-- src/rmvs/rmvs_util.f90 | 141 ++++++++++++++++++++++ src/setup/setup.f90 | 43 +------ src/symba/symba_setup.f90 | 23 +--- src/symba/symba_util.f90 | 186 ++++++++++++++++++++++++++++++ src/util/util_dealloc.f90 | 108 +++++++++++++++++ src/whm/whm_setup.f90 | 8 -- src/whm/whm_util.f90 | 63 ++++++++++ 21 files changed, 908 insertions(+), 125 deletions(-) create mode 100644 src/helio/helio_util.f90 create mode 100644 src/util/util_dealloc.f90 diff --git a/src/drift/drift.f90 b/src/drift/drift.f90 index eca05b01b..a5b7631c9 100644 --- a/src/drift/drift.f90 +++ b/src/drift/drift.f90 @@ -39,6 +39,8 @@ module subroutine drift_body(self, system, param, dt) end if end associate + deallocate(iflag) + return end subroutine drift_body @@ -77,12 +79,15 @@ module subroutine drift_all(mu, x, v, n, param, dt, lmask, iflag) else where(lmask(1:n)) dtp(1:n) = dt end if + !$omp simd do i = 1, n if (lmask(i)) call drift_one(mu(i), x(1,i), x(2,i), x(3,i), v(1,i), v(2,i), v(3,i), dtp(i), iflag(i)) end do !$omp end simd + deallocate(dtp) + return end subroutine drift_all diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index f6fee0652..4cc53d082 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -403,6 +403,7 @@ subroutine encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, lvdotr, call encounter_check_all(nenc, index1, index2, x, v, x, v, renc, renc, dt, lencounter, lvdotr) call encounter_check_reduce_broadphase(npl, nenc, index1, index2, lencounter, lvdotr) + deallocate(lencounter) end if return @@ -837,7 +838,6 @@ module subroutine encounter_check_collapse_ragged_list(ragged_list, n1, nenc, in end associate if (nenc == 0) return - allocate(index1(nenc)) allocate(index2(nenc)) if (present(lvdotr)) allocate(lvdotr(nenc)) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index f018d2de3..c6dc03d7b 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -62,6 +62,74 @@ module subroutine encounter_util_copy_list(self, source) end subroutine encounter_util_copy_list + module subroutine encounter_util_dealloc_aabb(self) + !! author: David A. Minton + !! + !! Deallocates all allocatables + implicit none + ! Arguments + class(encounter_bounding_box_1D), intent(inout) :: self + + if (allocated(self%ind)) deallocate(self%ind) + if (allocated(self%ibeg)) deallocate(self%ibeg) + if (allocated(self%iend)) deallocate(self%iend) + + return + end subroutine encounter_util_dealloc_aabb + + + module subroutine encounter_util_dealloc_list(self) + !! author: David A. Minton + !! + !! Deallocates all allocatables + implicit none + ! Arguments + class(encounter_list), intent(inout) :: self + + if (allocated(self%lvdotr)) deallocate(self%lvdotr) + if (allocated(self%status)) deallocate(self%status) + if (allocated(self%index1)) deallocate(self%index1) + if (allocated(self%index2)) deallocate(self%index2) + if (allocated(self%id1)) deallocate(self%id1) + if (allocated(self%id2)) deallocate(self%id2) + if (allocated(self%x1)) deallocate(self%x1) + if (allocated(self%x2)) deallocate(self%x2) + if (allocated(self%v1)) deallocate(self%v1) + if (allocated(self%v2)) deallocate(self%v2) + if (allocated(self%t)) deallocate(self%t) + + return + 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_list(self) + !! author: David A. Minton + !! + !! Finalize the encounter list - deallocates all allocatables + implicit none + ! Arguments + type(encounter_list), intent(inout) :: self + + call self%dealloc() + + return + end subroutine encounter_util_final_list + + module subroutine encounter_util_resize_list(self, nnew) !! author: David A. Minton !! diff --git a/src/helio/helio_drift.f90 b/src/helio/helio_drift.f90 index 4ccb56d98..a6eeafeea 100644 --- a/src/helio/helio_drift.f90 +++ b/src/helio/helio_drift.f90 @@ -19,7 +19,7 @@ module subroutine helio_drift_body(self, system, param, dt) integer(I4B) :: i !! Loop counter real(DP) :: rmag, vmag2, energy integer(I4B), dimension(:),allocatable :: iflag !! Vectorized error code flag - real(DP), dimension(:), allocatable :: dtp, mu + real(DP), dimension(:), allocatable :: mu if (self%nbody == 0) return @@ -37,6 +37,7 @@ module subroutine helio_drift_body(self, system, param, dt) end if end associate + deallocate(iflag, mu) return end subroutine helio_drift_body diff --git a/src/helio/helio_util.f90 b/src/helio/helio_util.f90 new file mode 100644 index 000000000..71b0f9b20 --- /dev/null +++ b/src/helio/helio_util.f90 @@ -0,0 +1,46 @@ +submodule(helio_classes) 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 self%dealloc() + + 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/io/io.f90 b/src/io/io.f90 index f0ff6f55c..8d0b624cc 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -304,7 +304,7 @@ module subroutine io_dump_system(self, param) call self%tp%write_frame(dump_param%nciu, dump_param) call dump_param%nciu%close() ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - call param%nciu%sync() + call param%nciu%flush(param) end if idx = idx + 1 @@ -2130,8 +2130,6 @@ module subroutine io_write_frame_system(self, param) end select lfirst = .false. - else - !call param%nciu%open(param) end if end if diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 6576efbf6..4965f14f1 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -23,12 +23,14 @@ module encounter_classes real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter real(DP), dimension(:), allocatable :: t !! Time of encounter contains - procedure :: setup => encounter_setup_list !! A constructor that sets the number of encounters and allocates and initializes all arrays - procedure :: append => encounter_util_append_list !! Appends elements from one structure to another - procedure :: copy => encounter_util_copy_list !! Copies elements from the source encounter list into self. - procedure :: spill => encounter_util_spill_list !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - procedure :: resize => encounter_util_resize_list !! Checks the current size of the encounter list against the required size and extends it by a factor of 2 more than requested if it is too small. - procedure :: write => encounter_io_write_list !! Write close encounter data to output binary file + procedure :: setup => encounter_setup_list !! A constructor that sets the number of encounters and allocates and initializes all arrays + procedure :: append => encounter_util_append_list !! Appends elements from one structure to another + procedure :: copy => encounter_util_copy_list !! Copies elements from the source encounter list into self. + procedure :: dealloc => encounter_util_dealloc_list !! Deallocates all allocatables + procedure :: spill => encounter_util_spill_list !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: resize => encounter_util_resize_list !! Checks the current size of the encounter list against the required size and extends it by a factor of 2 more than requested if it is too small. + procedure :: write => encounter_io_write_list !! Write close encounter data to output binary file + final :: encounter_util_final_list !! Finalize the encounter list - deallocates all allocatables end type encounter_list type encounter_bounding_box_1D @@ -38,6 +40,8 @@ module encounter_classes integer(I4B), dimension(:), allocatable :: iend !! Ending index for box 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 end type type encounter_bounding_box @@ -209,10 +213,30 @@ module subroutine encounter_util_copy_list(self, source) class(encounter_list), intent(in) :: source !! Source object to copy into end subroutine encounter_util_copy_list + module subroutine encounter_util_dealloc_aabb(self) + implicit none + class(encounter_bounding_box_1D), intent(inout) :: self !!Bounding box structure along a single dimension + end subroutine encounter_util_dealloc_aabb + + module subroutine encounter_util_dealloc_list(self) + implicit none + 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_list(self) + implicit none + type(encounter_list), intent(inout) :: self !! Swiftest encounter list object + end subroutine encounter_util_final_list + module subroutine encounter_util_resize_list(self, nnew) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list - integer(I4B), intent(in) :: nnew !! New size of list needed + integer(I4B), intent(in) :: nnew !! New size of list needed end subroutine encounter_util_resize_list module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) diff --git a/src/modules/helio_classes.f90 b/src/modules/helio_classes.f90 index a74b609e1..2d15565b2 100644 --- a/src/modules/helio_classes.f90 +++ b/src/modules/helio_classes.f90 @@ -17,6 +17,7 @@ module helio_classes 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 end type helio_nbody_system !******************************************************************************************************************************** @@ -43,6 +44,7 @@ module helio_classes 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 end type helio_pl !******************************************************************************************************************************** @@ -59,6 +61,7 @@ module helio_classes 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 end type helio_tp interface @@ -213,6 +216,21 @@ module subroutine helio_step_tp(self, system, param, t, dt) real(DP), intent(in) :: dt !! Stepsizee end subroutine helio_step_tp + module subroutine helio_util_final_pl(self) + implicit none + type(helio_pl), intent(inout) :: self !! Helio massive body object + end subroutine helio_util_final_pl + + module subroutine helio_util_final_system(self) + implicit none + type(helio_nbody_system), intent(inout) :: self !! Helio nbody system object + end subroutine helio_util_final_system + + module subroutine helio_util_final_tp(self) + implicit none + type(helio_tp), intent(inout) :: self !! Helio test particle object + end subroutine helio_util_final_tp + end interface end module helio_classes diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs_classes.f90 index 7c89edbd6..ce8bc9718 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs_classes.f90 @@ -27,6 +27,7 @@ module rmvs_classes !> 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 end type rmvs_nbody_system type, private :: rmvs_interp @@ -34,6 +35,9 @@ module rmvs_classes real(DP), dimension(:, :), allocatable :: v !! interpolated heliocentric planet velocity for outer encounter real(DP), dimension(:, :), allocatable :: aobl !! Encountering planet's oblateness acceleration value 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 end type rmvs_interp !******************************************************************************************************************************** @@ -44,6 +48,9 @@ module rmvs_classes type(rmvs_interp), dimension(:), allocatable :: outer !! interpolated heliocentric central body position for outer encounters type(rmvs_interp), dimension(:), allocatable :: inner !! interpolated heliocentric central body position for inner encounters 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 end type rmvs_cb !******************************************************************************************************************************** @@ -72,11 +79,13 @@ module rmvs_classes !! if the test particle is undergoing a close encounter or not procedure :: setup => rmvs_setup_tp !! Constructor method - Allocates space for the input number of bodiess procedure :: append => rmvs_util_append_tp !! Appends elements from one structure to another + procedure :: dealloc => rmvs_util_dealloc_tp !! Deallocates all allocatable arrays procedure :: fill => rmvs_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: resize => rmvs_util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. 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 end type rmvs_tp !******************************************************************************************************************************** @@ -95,11 +104,13 @@ module rmvs_classes contains procedure :: setup => rmvs_setup_pl !! Constructor method - Allocates space for the input number of bodiess procedure :: append => rmvs_util_append_pl !! Appends elements from one structure to another + procedure :: dealloc => rmvs_util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => rmvs_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: resize => rmvs_util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. 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 end type rmvs_pl interface @@ -178,6 +189,26 @@ module subroutine rmvs_util_append_tp(self, source, lsource_mask) logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to end subroutine rmvs_util_append_tp + module subroutine rmvs_util_dealloc_cb(self) + implicit none + class(rmvs_cb), intent(inout) :: self !! RMVS central body object + end subroutine rmvs_util_dealloc_cb + + module subroutine rmvs_util_dealloc_interp(self) + implicit none + class(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + end subroutine rmvs_util_dealloc_interp + + module subroutine rmvs_util_dealloc_pl(self) + implicit none + class(rmvs_pl), intent(inout) :: self !! RMVS massive body object + end subroutine rmvs_util_dealloc_pl + + module subroutine rmvs_util_dealloc_tp(self) + implicit none + class(rmvs_tp), intent(inout) :: self !! RMVS test particle object + end subroutine rmvs_util_dealloc_tp + module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) use swiftest_classes, only : swiftest_body implicit none @@ -194,6 +225,31 @@ 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) + implicit none + type(rmvs_cb), intent(inout) :: self !! RMVS central body object + end subroutine rmvs_util_final_cb + + module subroutine rmvs_util_final_interp(self) + implicit none + type(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + end subroutine rmvs_util_final_interp + + module subroutine rmvs_util_final_pl(self) + implicit none + type(rmvs_pl), intent(inout) :: self !! RMVS massive body object + end subroutine rmvs_util_final_pl + + module subroutine rmvs_util_final_system(self) + implicit none + type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object + end subroutine rmvs_util_final_system + + module subroutine rmvs_util_final_tp(self) + implicit none + type(rmvs_tp), intent(inout) :: self !! RMVS test particle object + end subroutine rmvs_util_final_tp + module subroutine rmvs_util_resize_pl(self, nnew) implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index dfa6b4dea..e49895433 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -78,6 +78,7 @@ module swiftest_classes integer(I4B) :: discard_body_id_varid !! NetCDF ID for the id of the other body involved in the discard contains procedure :: close => netcdf_close !! Closes an open NetCDF file + procedure :: flush => netcdf_flush !! Flushes the current buffer to disk by closing and re-opening the file. procedure :: initialize => netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object procedure :: open => netcdf_open !! Opens a NetCDF file procedure :: sync => netcdf_sync !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) @@ -303,6 +304,7 @@ module swiftest_classes procedure :: setup => setup_body !! A constructor that sets the number of bodies and allocates all allocatable arrays procedure :: accel_user => user_kick_getacch_body !! Add user-supplied heliocentric accelerations to planets procedure :: append => util_append_body !! Appends elements from one structure to another + procedure :: dealloc => util_dealloc_body !! Deallocates all allocatable arrays procedure :: fill => util_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: resize => util_resize_body !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: set_ir3 => util_set_ir3h !! Sets the inverse heliocentric radius term (1/rh**3) @@ -352,6 +354,7 @@ module swiftest_classes procedure :: vh2vb => util_coord_vh2vb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) procedure :: vb2vh => util_coord_vb2vh_pl !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) procedure :: xh2xb => util_coord_xh2xb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position only) + procedure :: dealloc => util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: resize => util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: set_beg_end => util_set_beg_end_pl !! Sets the beginning and ending positions and velocities of planets. @@ -391,6 +394,7 @@ module swiftest_classes procedure :: vb2vh => util_coord_vb2vh_tp !! Convert test particles from barycentric to heliocentric coordinates (velocity only) procedure :: vh2vb => util_coord_vh2vb_tp !! Convert test particles from heliocentric to barycentric coordinates (velocity only) procedure :: xh2xb => util_coord_xh2xb_tp !! Convert test particles from heliocentric to barycentric coordinates (position only) + procedure :: dealloc => util_dealloc_tp !! Deallocates all allocatable arrays procedure :: fill => util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: get_peri => util_peri_tp !! Determine system pericenter passages for test particles procedure :: resize => util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. @@ -449,6 +453,7 @@ module swiftest_classes procedure :: initialize => setup_initialize_system !! Initialize the system from input files procedure :: init_particle_info => setup_initialize_particle_info_system !! Initialize the system from input files procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. + procedure :: dealloc => util_dealloc_system !! Deallocates all allocatable components of the system procedure :: set_msys => util_set_msys !! Sets the value of msys from the masses of system bodies. procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum procedure :: rescale => util_rescale_system !! Rescales the system into a new set of units @@ -946,11 +951,17 @@ module subroutine netcdf_close(self) class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset end subroutine netcdf_close + module subroutine netcdf_flush(self, param) + implicit none + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine netcdf_flush + module function netcdf_get_old_t_final_system(self, param) result(old_t_final) implicit none - class(swiftest_nbody_system), intent(in) :: self - class(swiftest_parameters), intent(inout) :: param - real(DP) :: old_t_final + class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP) :: old_t_final !! Final time from last run end function netcdf_get_old_t_final_system module subroutine netcdf_initialize_output(self, param) @@ -1306,6 +1317,26 @@ module subroutine util_copy_particle_info_arr(source, dest, idx) integer(I4B), dimension(:), intent(in), optional :: idx !! Optional array of indices to draw the source object end subroutine util_copy_particle_info_arr + module subroutine util_dealloc_body(self) + implicit none + class(swiftest_body), intent(inout) :: self + end subroutine util_dealloc_body + + module subroutine util_dealloc_pl(self) + implicit none + class(swiftest_pl), intent(inout) :: self + end subroutine util_dealloc_pl + + module subroutine util_dealloc_system(self) + implicit none + class(swiftest_nbody_system), intent(inout) :: self + end subroutine util_dealloc_system + + module subroutine util_dealloc_tp(self) + implicit none + class(swiftest_tp), intent(inout) :: self + end subroutine util_dealloc_tp + module subroutine util_exit(code) implicit none integer(I4B), intent(in) :: code !! Failure exit code diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 1c3605953..87aa91cae 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -34,6 +34,9 @@ module symba_classes integer(I4B) :: parent !! Index of parent particle integer(I4B) :: nchild !! number of children in merger list integer(I4B), dimension(:), allocatable :: child !! Index of children particles + contains + procedure :: dealloc => symba_util_dealloc_kin !! Deallocates all allocatable arrays + final :: symba_util_final_kin !! Finalizes the SyMBA kinship object - deallocates all allocatables end type symba_kinship !******************************************************************************************************************************** @@ -76,6 +79,7 @@ module symba_classes procedure :: accel => symba_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies procedure :: setup => symba_setup_pl !! Constructor method - Allocates space for the input number of bodies procedure :: append => symba_util_append_pl !! Appends elements from one structure to another + procedure :: dealloc => symba_util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => symba_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: get_peri => symba_util_peri_pl !! Determine system pericenter passages for massive bodies procedure :: rearray => symba_util_rearray_pl !! Clean up the massive body structures to remove discarded bodies and add new bodies @@ -85,14 +89,17 @@ module symba_classes 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 end type symba_pl type, extends(symba_pl) :: symba_merger integer(I4B), dimension(:), allocatable :: ncomp contains procedure :: append => symba_util_append_merger !! Appends elements from one structure to another + procedure :: dealloc => symba_util_dealloc_merger !! Deallocates all allocatable arrays procedure :: resize => symba_util_resize_merger !! Checks the current size of a SyMBA merger list against the requested size and resizes it if it is too small. procedure :: setup => symba_setup_merger !! Constructor method - Allocates space for the input number of bodies + final :: symba_util_final_merger !! Finalizes the SyMBA merger object - deallocates all allocatables end type symba_merger !******************************************************************************************************************************** @@ -109,11 +116,13 @@ module symba_classes procedure :: accel => symba_kick_getacch_tp !! Compute heliocentric accelerations of test particles procedure :: setup => symba_setup_tp !! Constructor method - Allocates space for the input number of bodies procedure :: append => symba_util_append_tp !! Appends elements from one structure to another + procedure :: dealloc => symba_util_dealloc_tp !! Deallocates all allocatable arrays procedure :: fill => symba_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: resize => symba_util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. 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 end type symba_tp !******************************************************************************************************************************** @@ -123,13 +132,15 @@ module symba_classes type, extends(encounter_list) :: symba_encounter integer(I4B), dimension(:), allocatable :: level !! encounter recursion level contains - procedure :: collision_check => symba_collision_check_encounter !! Checks if a test particle is going to collide with a massive body - procedure :: encounter_check => symba_encounter_check !! Checks if massive bodies are going through close encounters with each other - procedure :: kick => symba_kick_encounter !! Kick barycentric velocities of active test particles within SyMBA recursion - procedure :: setup => symba_setup_encounter_list !! A constructor that sets the number of encounters and allocates and initializes all arrays - procedure :: copy => symba_util_copy_encounter_list !! Copies elements from the source encounter list into self. - procedure :: spill => symba_util_spill_encounter_list !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - procedure :: append => symba_util_append_encounter_list !! Appends elements from one structure to another + procedure :: collision_check => symba_collision_check_encounter !! Checks if a test particle is going to collide with a massive body + procedure :: encounter_check => symba_encounter_check !! Checks if massive bodies are going through close encounters with each other + procedure :: kick => symba_kick_encounter !! Kick barycentric velocities of active test particles within SyMBA recursion + procedure :: setup => symba_setup_encounter_list !! A constructor that sets the number of encounters and allocates and initializes all arrays + procedure :: copy => symba_util_copy_encounter_list !! Copies elements from the source encounter list into self. + procedure :: dealloc => symba_util_dealloc_encounter_list !! Deallocates all allocatable arrays + procedure :: spill => symba_util_spill_encounter_list !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: append => symba_util_append_encounter_list !! Appends elements from one structure to another + final :: symba_util_final_encounter_list !! Finalizes the SyMBA test particle object - deallocates all allocatables end type symba_encounter !******************************************************************************************************************************** @@ -164,13 +175,15 @@ module symba_classes integer(I4B) :: irec !! System recursion level integer(I4B) :: collision_counter !! Counter for number of collisions over total simulation contains - procedure :: write_discard => symba_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA - procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps - procedure :: step => symba_step_system !! Advance the SyMBA nbody system forward in time by one step - procedure :: interp => symba_step_interp_system !! Perform an interpolation step on the SymBA nbody system - procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level - procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary - procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step + procedure :: write_discard => symba_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA + procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps + procedure :: step => symba_step_system !! Advance the SyMBA nbody system forward in time by one step + procedure :: interp => symba_step_interp_system !! Perform an interpolation step on the SymBA nbody system + procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level + procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary + procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step + procedure :: dealloc => symba_util_dealloc_system !! Deallocates all allocatable arrays + final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system interface @@ -319,13 +332,6 @@ module function symba_collision_casemerge(system, param, colliders, frag) result integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casemerge - module subroutine symba_util_flatten_eucl_plpl(self, param) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_util_flatten_eucl_plpl - module subroutine symba_util_set_renc(self, scale) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object @@ -521,6 +527,36 @@ module subroutine symba_util_copy_encounter_list(self, source) class(symba_encounter), intent(inout) :: self !! Encounter list class(encounter_list), intent(in) :: source !! Source object to copy into end subroutine symba_util_copy_encounter_list + + module subroutine symba_util_dealloc_encounter_list(self) + implicit none + class(symba_encounter), intent(inout) :: self !! SyMBA encounter list + end subroutine symba_util_dealloc_encounter_list + + module subroutine symba_util_dealloc_kin(self) + implicit none + class(symba_kinship), intent(inout) :: self !! SyMBA kinship object + end subroutine symba_util_dealloc_kin + + module subroutine symba_util_dealloc_merger(self) + implicit none + class(symba_merger), intent(inout) :: self !! SyMBA body merger object + end subroutine symba_util_dealloc_merger + + module subroutine symba_util_dealloc_system(self) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + end subroutine symba_util_dealloc_system + + module subroutine symba_util_dealloc_pl(self) + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + end subroutine symba_util_dealloc_pl + + module subroutine symba_util_dealloc_tp(self) + implicit none + class(symba_tp), intent(inout) :: self !! SyMBA test particle object + end subroutine symba_util_dealloc_tp end interface interface util_fill @@ -549,6 +585,43 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps end subroutine symba_util_fill_tp + module subroutine symba_util_flatten_eucl_plpl(self, param) + use swiftest_classes, only : swiftest_parameters + implicit none + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine symba_util_flatten_eucl_plpl + + module subroutine symba_util_final_encounter_list(self) + implicit none + type(symba_encounter), intent(inout) :: self !! SyMBA encounter list object + end subroutine symba_util_final_encounter_list + + module subroutine symba_util_final_kin(self) + implicit none + type(symba_kinship), intent(inout) :: self !! SyMBA kinship object + end subroutine symba_util_final_kin + + module subroutine symba_util_final_merger(self) + implicit none + type(symba_merger), intent(inout) :: self !! SyMBA merger object + end subroutine symba_util_final_merger + + 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 + module subroutine symba_util_peri_pl(self, system, param) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none @@ -570,7 +643,6 @@ module subroutine symba_util_reset_kinship(self, idx) integer(I4B), dimension(:), intent(in) :: idx !! Index array of bodies to reset integer(I4B) :: i, j end subroutine symba_util_reset_kinship - end interface interface util_resize diff --git a/src/modules/whm_classes.f90 b/src/modules/whm_classes.f90 index 3cad184dd..066975d41 100644 --- a/src/modules/whm_classes.f90 +++ b/src/modules/whm_classes.f90 @@ -39,6 +39,7 @@ module whm_classes procedure :: accel => whm_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies procedure :: kick => whm_kick_vh_pl !! Kick heliocentric velocities of massive bodies procedure :: append => whm_util_append_pl !! Appends elements from one structure to another + procedure :: dealloc => whm_util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => whm_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: resize => whm_util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: set_ir3 => whm_util_set_ir3j !! Sets both the heliocentric and jacobi inverse radius terms (1/rj**3 and 1/rh**3) @@ -48,6 +49,7 @@ module whm_classes 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 end type whm_pl !******************************************************************************************************************************** @@ -64,6 +66,7 @@ module whm_classes 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 end type whm_tp !******************************************************************************************************************************** @@ -73,8 +76,9 @@ module whm_classes type, extends(swiftest_nbody_system) :: whm_nbody_system contains !> Replace the abstract procedures with concrete ones - procedure :: initialize => whm_setup_initialize_system ! Performs WHM-specific initilization steps, like calculating the Jacobi masses + 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 end type whm_nbody_system interface @@ -235,6 +239,26 @@ module subroutine whm_util_append_pl(self, source, lsource_mask) logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to end subroutine whm_util_append_pl + module subroutine whm_util_dealloc_pl(self) + implicit none + 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) use swiftest_classes, only : swiftest_body implicit none diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 39df30d61..9e2f1c895 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -19,6 +19,7 @@ subroutine check(status) return end subroutine check + module subroutine netcdf_close(self) !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton !! @@ -32,6 +33,24 @@ module subroutine netcdf_close(self) return end subroutine netcdf_close + + module subroutine netcdf_flush(self, param) + !! author: David A. Minton + !! + !! Flushes the current buffer to disk by closing and re-opening the file. + !! + implicit none + ! Arguments + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + + call self%close() + call self%open(param) + + return + end subroutine netcdf_flush + + module function netcdf_get_old_t_final_system(self, param) result(old_t_final) !! author: David A. Minton !! @@ -462,6 +481,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) end function netcdf_read_frame_system + module subroutine netcdf_read_hdr_system(self, iu, param) !! author: David A. Minton !! @@ -506,6 +526,7 @@ module subroutine netcdf_read_hdr_system(self, iu, param) return end subroutine netcdf_read_hdr_system + module subroutine netcdf_read_particle_info_base(self, iu, ind) !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton !! @@ -619,10 +640,10 @@ module subroutine netcdf_read_particle_info_base(self, iu, ind) call check( nf90_get_var(iu%ncid, iu%discard_vhz_varid, self%info%discard_vh(3), start=[idslot]) ) end select - !call check( nf90_set_fill(iu%ncid, old_mode, old_mode) ) return end subroutine netcdf_read_particle_info_base + module subroutine netcdf_sync(self) !! author: David A. Minton !! @@ -637,6 +658,7 @@ module subroutine netcdf_sync(self) return end subroutine netcdf_sync + module subroutine netcdf_write_frame_base(self, iu, param) !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton !! @@ -736,6 +758,7 @@ module subroutine netcdf_write_frame_base(self, iu, param) return end subroutine netcdf_write_frame_base + module subroutine netcdf_write_frame_system(self, iu, param) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! @@ -754,6 +777,7 @@ module subroutine netcdf_write_frame_system(self, iu, param) return end subroutine netcdf_write_frame_system + module subroutine netcdf_write_particle_info_base(self, iu) !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton !! @@ -914,5 +938,4 @@ module subroutine netcdf_write_hdr_system(self, iu, param) return end subroutine netcdf_write_hdr_system - end submodule s_netcdf \ No newline at end of file diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 index e59202cd9..ff083815a 100644 --- a/src/rmvs/rmvs_setup.f90 +++ b/src/rmvs/rmvs_setup.f90 @@ -19,12 +19,6 @@ module subroutine rmvs_setup_pl(self, n, param) !> Call allocation method for parent class associate(pl => self) call whm_setup_pl(pl, n, param) - if (n < 0) return - - if (allocated(pl%outer)) deallocate(pl%outer) - if (allocated(pl%inner)) deallocate(pl%inner) - if (allocated(pl%nenc)) deallocate(pl%nenc) - if (n == 0) return allocate(pl%outer(0:NTENC)) @@ -153,9 +147,7 @@ module subroutine rmvs_setup_tp(self, n, param) call setup_tp(self, n, param) if (n < 0) return - if (allocated(self%lperi)) deallocate(self%lperi) - if (allocated(self%plperP)) deallocate(self%plperP) - if (allocated(self%plencP)) deallocate(self%plencP) + call self%dealloc() if (n == 0) return @@ -163,10 +155,7 @@ module subroutine rmvs_setup_tp(self, n, param) allocate(self%plperP(n)) allocate(self%plencP(n)) - if (self%lplanetocentric) then - if (allocated(self%xheliocentric)) deallocate(self%xheliocentric) - allocate(self%xheliocentric(NDIM, n)) - end if + if (self%lplanetocentric) allocate(self%xheliocentric(NDIM, n)) self%lperi(:) = .false. diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index c3dd4eddc..5e8fbbb3e 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -66,6 +66,77 @@ module subroutine rmvs_util_append_tp(self, source, lsource_mask) end subroutine rmvs_util_append_tp + module subroutine rmvs_util_dealloc_cb(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Argument + class(rmvs_cb), intent(inout) :: self !! RMVS central body object + + if (allocated(self%outer)) deallocate(self%outer) + if (allocated(self%inner)) deallocate(self%inner) + + return + end subroutine rmvs_util_dealloc_cb + + + module subroutine rmvs_util_dealloc_interp(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Argument + class(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + + if (allocated(self%x)) deallocate(self%x) + if (allocated(self%v)) deallocate(self%v) + if (allocated(self%aobl)) deallocate(self%aobl) + if (allocated(self%atide)) deallocate(self%atide) + + return + end subroutine rmvs_util_dealloc_interp + + + module subroutine rmvs_util_dealloc_pl(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Argumente + class(rmvs_pl), intent(inout) :: self !! RMVS massive body object + + if (allocated(self%outer)) deallocate(self%outer) + if (allocated(self%inner)) deallocate(self%inner) + if (allocated(self%nenc)) deallocate(self%nenc) + if (allocated(self%planetocentric)) deallocate(self%planetocentric) + + call whm_util_dealloc_pl(self) + + return + end subroutine rmvs_util_dealloc_pl + + + module subroutine rmvs_util_dealloc_tp(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Argument + class(rmvs_tp), intent(inout) :: self !! RMVS test particle object + + if (allocated(self%lperi)) deallocate(self%lperi) + if (allocated(self%plperP)) deallocate(self%plperP) + if (allocated(self%plencP)) deallocate(self%plencP) + if (allocated(self%xheliocentric)) deallocate(self%xheliocentric) + call self%cb_heliocentric%dealloc() + + call util_dealloc_tp(self) + + return + end subroutine rmvs_util_dealloc_tp + + module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) !! author: David A. Minton !! @@ -104,6 +175,76 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) end subroutine rmvs_util_fill_pl + module subroutine rmvs_util_final_cb(self) + !! author: David A. Minton + !! + !! Finalize the RMVS massive body object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_cb), intent(inout) :: self !! RMVS central body object + + call self%dealloc() + + return + end subroutine rmvs_util_final_cb + + + module subroutine rmvs_util_final_interp(self) + !! author: David A. Minton + !! + !! Finalize the RMVS nbody system object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_interp), intent(inout) :: self !! RMVS nbody system object + + call self%dealloc() + + return + end subroutine rmvs_util_final_interp + + + module subroutine rmvs_util_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the RMVS massive body object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_pl), intent(inout) :: self !! RMVS massive body object + + call self%dealloc() + + return + end subroutine rmvs_util_final_pl + + + module subroutine rmvs_util_final_system(self) + !! author: David A. Minton + !! + !! Finalize the RMVS nbody system object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object + + call self%dealloc() + + return + end subroutine rmvs_util_final_system + + + module subroutine rmvs_util_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the RMVS test particle object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_tp), intent(inout) :: self !! RMVS test particle object + + call self%dealloc() + + return + end subroutine rmvs_util_final_tp + + module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) !! author: David A. Minton !! diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 1bc780ecc..a2aaa0d23 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -176,28 +176,7 @@ module subroutine setup_body(self, n, param) self%lfirst = .true. - if (allocated(self%info)) deallocate(self%info) - if (allocated(self%id)) deallocate(self%id) - if (allocated(self%status)) deallocate(self%status) - if (allocated(self%ldiscard)) deallocate(self%ldiscard) - if (allocated(self%lmask)) deallocate(self%lmask) - if (allocated(self%mu)) deallocate(self%mu) - if (allocated(self%xh)) deallocate(self%xh) - if (allocated(self%vh)) deallocate(self%vh) - if (allocated(self%xb)) deallocate(self%xb) - if (allocated(self%vb)) deallocate(self%vb) - if (allocated(self%ah)) deallocate(self%ah) - if (allocated(self%aobl)) deallocate(self%aobl) - if (allocated(self%agr)) deallocate(self%lmask) - if (allocated(self%atide)) deallocate(self%lmask) - if (allocated(self%ir3h)) deallocate(self%ir3h) - if (allocated(self%a)) deallocate(self%a) - if (allocated(self%e)) deallocate(self%e) - if (allocated(self%e)) deallocate(self%e) - if (allocated(self%inc)) deallocate(self%inc) - if (allocated(self%capom)) deallocate(self%capom) - if (allocated(self%omega)) deallocate(self%omega) - if (allocated(self%capm)) deallocate(self%capm) + call self%dealloc() self%nbody = n if (n == 0) return @@ -275,20 +254,6 @@ module subroutine setup_pl(self, n, param) !> Call allocation method for parent class !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure call setup_body(self, n, param) - if (n < 0) return - - if (allocated(self%mass)) deallocate(self%mass) - if (allocated(self%Gmass)) deallocate(self%Gmass) - if (allocated(self%rhill)) deallocate(self%rhill) - if (allocated(self%renc)) deallocate(self%renc) - if (allocated(self%radius)) deallocate(self%radius) - if (allocated(self%density)) deallocate(self%density) - if (allocated(self%rot)) deallocate(self%rot) - if (allocated(self%Ip)) deallocate(self%Ip) - if (allocated(self%k2)) deallocate(self%k2) - if (allocated(self%Q)) deallocate(self%Q) - if (allocated(self%tlag)) deallocate(self%tlag) - if (n == 0) return allocate(self%mass(n)) @@ -344,12 +309,6 @@ module subroutine setup_tp(self, n, param) !> Call allocation method for parent class !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure call setup_body(self, n, param) - if (n < 0) return - - if (allocated(self%isperi)) deallocate(self%isperi) - if (allocated(self%peri)) deallocate(self%peri) - if (allocated(self%atp)) deallocate(self%atp) - if (n == 0) return allocate(self%isperi(n)) diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index 1c8879747..19bc742ed 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -72,20 +72,6 @@ module subroutine symba_setup_pl(self, n, param) !> Call allocation method for parent class. In this case, helio_pl does not have its own setup method so we use the base method for swiftest_pl call setup_pl(self, n, param) - if (n < 0) return - - if (allocated(self%lcollision)) deallocate(self%lcollision) - if (allocated(self%lencounter)) deallocate(self%lencounter) - if (allocated(self%lmtiny)) deallocate(self%lmtiny) - if (allocated(self%nplenc)) deallocate(self%nplenc) - if (allocated(self%ntpenc)) deallocate(self%ntpenc) - if (allocated(self%levelg)) deallocate(self%levelg) - if (allocated(self%levelm)) deallocate(self%levelm) - if (allocated(self%isperi)) deallocate(self%isperi) - if (allocated(self%peri)) deallocate(self%peri) - if (allocated(self%atp)) deallocate(self%atp) - if (allocated(self%kin)) deallocate(self%kin) - if (n == 0) return allocate(self%lcollision(n)) @@ -128,7 +114,7 @@ module subroutine symba_setup_encounter_list(self, n) call encounter_setup_list(self, n) if (n < 0) return - if (allocated(self%level)) deallocate(self%level) + call self%dealloc() if (n ==0) return @@ -154,13 +140,6 @@ module subroutine symba_setup_tp(self, n, param) !> Call allocation method for parent class. In this case, helio_tp does not have its own setup method so we use the base method for swiftest_tp call setup_tp(self, n, param) - if (n < 0) return - - if (allocated(self%nplenc)) deallocate(self%nplenc) - if (allocated(self%levelg)) deallocate(self%levelg) - if (allocated(self%levelm)) deallocate(self%levelm) - if (allocated(self%info)) deallocate(self%info) - if (n == 0) return allocate(self%nplenc(n)) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 656aed3f8..445b672e0 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -181,6 +181,113 @@ module subroutine symba_util_copy_encounter_list(self, source) end subroutine symba_util_copy_encounter_list + module subroutine symba_util_dealloc_encounter_list(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Argumentse + class(symba_encounter), intent(inout) :: self !! SyMBA encounter list + + if (allocated(self%level)) deallocate(self%level) + + return + end subroutine symba_util_dealloc_encounter_list + + + module subroutine symba_util_dealloc_kin(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Arguments + class(symba_kinship), intent(inout) :: self !! SyMBA kinship object + + if (allocated(self%child)) deallocate(self%child) + + return + end subroutine symba_util_dealloc_kin + + + module subroutine symba_util_dealloc_merger(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Arguments + class(symba_merger), intent(inout) :: self !! SyMBA body merger object + + if (allocated(self%ncomp)) deallocate(self%ncomp) + + call symba_util_dealloc_pl(self) + + return + end subroutine symba_util_dealloc_merger + + + module subroutine symba_util_dealloc_system(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Arguments + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + + if (allocated(self%pl_adds)) deallocate(self%pl_adds) + if (allocated(self%pltpenc_list)) deallocate(self%pltpenc_list) + if (allocated(self%plplenc_list)) deallocate(self%plplenc_list) + if (allocated(self%plplcollision_list)) deallocate(self%plplcollision_list) + + call util_dealloc_system(self) + + return + end subroutine symba_util_dealloc_system + + + module subroutine symba_util_dealloc_pl(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Arguments + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + + if (allocated(self%lcollision)) deallocate(self%lcollision) + if (allocated(self%lencounter)) deallocate(self%lencounter) + if (allocated(self%lmtiny)) deallocate(self%lmtiny) + if (allocated(self%nplenc)) deallocate(self%nplenc) + if (allocated(self%ntpenc)) deallocate(self%ntpenc) + if (allocated(self%levelg)) deallocate(self%levelg) + if (allocated(self%levelm)) deallocate(self%levelm) + if (allocated(self%isperi)) deallocate(self%isperi) + if (allocated(self%peri)) deallocate(self%peri) + if (allocated(self%atp)) deallocate(self%atp) + if (allocated(self%kin)) deallocate(self%kin) + + call util_dealloc_pl(self) + + return + end subroutine symba_util_dealloc_pl + + + module subroutine symba_util_dealloc_tp(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Arguments + class(symba_tp), intent(inout) :: self !! SyMBA test particle object + + if (allocated(self%nplenc)) deallocate(self%nplenc) + if (allocated(self%levelg)) deallocate(self%levelg) + if (allocated(self%levelm)) deallocate(self%levelm) + + call util_dealloc_tp(self) + + return + end subroutine symba_util_dealloc_tp + + module subroutine symba_util_fill_arr_kin(keeps, inserts, lfill_list) !! author: David A. Minton !! @@ -317,6 +424,85 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) end subroutine symba_util_flatten_eucl_plpl + module subroutine symba_util_final_encounter_list(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA encounter list object - deallocates all allocatables + implicit none + ! Argument + type(symba_encounter), intent(inout) :: self !! SyMBA encounter list object + + call self%dealloc() + + return + end subroutine symba_util_final_encounter_list + + module subroutine symba_util_final_kin(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA kinship object - deallocates all allocatables + implicit none + ! Argument + type(symba_kinship), intent(inout) :: self !! SyMBA kinship object + + call self%dealloc() + + return + end subroutine symba_util_final_kin + + module subroutine symba_util_final_merger(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA merger object - deallocates all allocatables + implicit none + ! Argument + type(symba_merger), intent(inout) :: self !! SyMBA merger object + + call self%dealloc() + + return + end subroutine symba_util_final_merger + + 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 + + call self%dealloc() + + 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_peri_pl(self, system, param) !! author: David A. Minton !! diff --git a/src/util/util_dealloc.f90 b/src/util/util_dealloc.f90 new file mode 100644 index 000000000..636a20317 --- /dev/null +++ b/src/util/util_dealloc.f90 @@ -0,0 +1,108 @@ +submodule (swiftest_classes) s_util_dealloc + use swiftest +contains + + module subroutine util_dealloc_body(self) + !! author: David A. Minton + !! + !! Finalize the swiftest body object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_body), intent(inout) :: self + + if (allocated(self%info)) deallocate(self%info) + if (allocated(self%id)) deallocate(self%id) + if (allocated(self%status)) deallocate(self%status) + if (allocated(self%ldiscard)) deallocate(self%ldiscard) + if (allocated(self%lmask)) deallocate(self%lmask) + if (allocated(self%mu)) deallocate(self%mu) + if (allocated(self%xh)) deallocate(self%xh) + if (allocated(self%vh)) deallocate(self%vh) + if (allocated(self%xb)) deallocate(self%xb) + if (allocated(self%vb)) deallocate(self%vb) + if (allocated(self%ah)) deallocate(self%ah) + if (allocated(self%aobl)) deallocate(self%aobl) + if (allocated(self%agr)) deallocate(self%lmask) + if (allocated(self%atide)) deallocate(self%lmask) + if (allocated(self%ir3h)) deallocate(self%ir3h) + if (allocated(self%a)) deallocate(self%a) + if (allocated(self%e)) deallocate(self%e) + if (allocated(self%e)) deallocate(self%e) + if (allocated(self%inc)) deallocate(self%inc) + if (allocated(self%capom)) deallocate(self%capom) + if (allocated(self%omega)) deallocate(self%omega) + if (allocated(self%capm)) deallocate(self%capm) + + return + end subroutine util_dealloc_body + + + module subroutine util_dealloc_pl(self) + !! author: David A. Minton + !! + !! Finalize the swiftest massive body object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + + if (allocated(self%mass)) deallocate(self%mass) + if (allocated(self%Gmass)) deallocate(self%Gmass) + if (allocated(self%rhill)) deallocate(self%rhill) + if (allocated(self%renc)) deallocate(self%renc) + if (allocated(self%radius)) deallocate(self%radius) + if (allocated(self%density)) deallocate(self%density) + if (allocated(self%rot)) deallocate(self%rot) + if (allocated(self%Ip)) deallocate(self%Ip) + if (allocated(self%k2)) deallocate(self%k2) + if (allocated(self%Q)) deallocate(self%Q) + if (allocated(self%tlag)) deallocate(self%tlag) + if (allocated(self%k_plpl)) deallocate(self%k_plpl) + + call util_dealloc_body(self) + + return + end subroutine util_dealloc_pl + + + module subroutine util_dealloc_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 + + call self%pl%dealloc() + call self%tp%dealloc() + call self%tp_discards%dealloc() + call self%pl_discards%dealloc() + + 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 util_dealloc_system + + + module subroutine util_dealloc_tp(self) + !! author: David A. Minton + !! + !! Finalize the swiftest test particle object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + + if (allocated(self%isperi)) deallocate(self%isperi) + if (allocated(self%peri)) deallocate(self%peri) + if (allocated(self%atp)) deallocate(self%atp) + if (allocated(self%k_pltp)) deallocate(self%k_pltp) + + call util_dealloc_body(self) + + return + end subroutine util_dealloc_tp + +end submodule s_util_dealloc \ No newline at end of file diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 index 60be140fd..5c672abd0 100644 --- a/src/whm/whm_setup.f90 +++ b/src/whm/whm_setup.f90 @@ -16,14 +16,6 @@ module subroutine whm_setup_pl(self, n, param) !> Call allocation method for parent class call setup_pl(self, n, param) - if (n < 0) return - - if (allocated(self%eta)) deallocate(self%eta) - if (allocated(self%muj)) deallocate(self%muj) - if (allocated(self%xj)) deallocate(self%xj) - if (allocated(self%vj)) deallocate(self%vj) - if (allocated(self%ir3j)) deallocate(self%ir3j) - if (n == 0) return allocate(self%eta(n)) diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index e48607229..04ccbba58 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -32,6 +32,27 @@ module subroutine whm_util_append_pl(self, source, lsource_mask) return end subroutine whm_util_append_pl + + module subroutine whm_util_dealloc_pl(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Arguments + class(whm_pl), intent(inout) :: self !! WHM massive body object + + if (allocated(self%eta)) deallocate(self%eta) + if (allocated(self%muj)) deallocate(self%muj) + if (allocated(self%xj)) deallocate(self%xj) + if (allocated(self%vj)) deallocate(self%vj) + if (allocated(self%ir3j)) deallocate(self%ir3j) + + call util_dealloc_pl(self) + + return + end subroutine whm_util_dealloc_pl + + module subroutine whm_util_fill_pl(self, inserts, lfill_list) !! author: David A. Minton !! @@ -67,6 +88,48 @@ 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 self%dealloc() + + 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 !! From c3ef15854e87ef88ac28c79ee84d463747ac5352 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 13 Oct 2021 18:55:09 -0400 Subject: [PATCH 2/5] Fixed some issue involving uninitialized variables --- src/discard/discard.f90 | 2 +- src/symba/symba_encounter_check.f90 | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 2ee3dafec..ad5b73426 100644 --- a/src/discard/discard.f90 +++ b/src/discard/discard.f90 @@ -76,9 +76,9 @@ module subroutine discard_tp(self, system, param) integer(I4B) :: npl, ntp associate(tp => self, cb => system%cb, pl => system%pl) - if ((ntp == 0) .or. (npl ==0)) return ntp = tp%nbody npl = pl%nbody + if ((ntp == 0) .or. (npl ==0)) return if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. & (param%rmaxu >= 0.0_DP) .or. ((param%qmin >= 0.0_DP) .and. (param%qmin_coord == "BARY"))) then diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index c36cb7004..cc1b9f66d 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -25,7 +25,8 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l type(interaction_timer), save :: itimer logical, save :: lfirst = .true. type(walltimer) :: timer - + + lany_encounter = .false. if (self%nbody == 0) return associate(pl => self, plplenc_list => system%plplenc_list) @@ -200,7 +201,8 @@ module function symba_encounter_check_tp(self, param, system, dt, irec) result(l real(DP) :: rshell_irec logical, dimension(:), allocatable :: lvdotr integer(I4B), dimension(:), allocatable :: index1, index2 - + + lany_encounter = .false. if (self%nbody == 0) return associate(tp => self, ntp => self%nbody, pl => system%pl, npl => system%pl%nbody) From aa37c3dcbc86052dc3ceb990ab66398f58b78d2c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 13 Oct 2021 18:59:03 -0400 Subject: [PATCH 3/5] Fixed bad spill operation on the symba_kinship type --- src/symba/symba_util.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 445b672e0..f429b74b7 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1102,6 +1102,7 @@ module subroutine symba_util_spill_arr_kin(keeps, discards, lspill_list, ldestru logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not ! Internals integer(I4B) :: nspill, nkeep, nlist + type(symba_kinship), dimension(:), allocatable :: tmp nkeep = count(.not.lspill_list(:)) nspill = count(lspill_list(:)) @@ -1118,7 +1119,9 @@ module subroutine symba_util_spill_arr_kin(keeps, discards, lspill_list, ldestru discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) if (ldestructive) then if (nkeep > 0) then - keeps(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) else deallocate(keeps) end if From 22a2bb83f52af7a7d75bbc5e029565c19b6d37b0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 13 Oct 2021 19:01:31 -0400 Subject: [PATCH 4/5] Fixed bad dealloc call that causes a crash when system particle types are not allocated --- src/util/util_dealloc.f90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/util/util_dealloc.f90 b/src/util/util_dealloc.f90 index 636a20317..bd648212e 100644 --- a/src/util/util_dealloc.f90 +++ b/src/util/util_dealloc.f90 @@ -72,11 +72,6 @@ module subroutine util_dealloc_system(self) ! Argument class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - call self%pl%dealloc() - call self%tp%dealloc() - call self%tp_discards%dealloc() - call self%pl_discards%dealloc() - if (allocated(self%cb)) deallocate(self%cb) if (allocated(self%pl)) deallocate(self%pl) if (allocated(self%tp)) deallocate(self%tp) From dc3a9f91453cdc21d2979e042a14ac6b13eed43e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 13 Oct 2021 22:36:07 -0400 Subject: [PATCH 5/5] Changed the way chunking is done for netcdf files attempting to get memory growth under control --- src/netcdf/netcdf.f90 | 82 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 72 insertions(+), 10 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 080676e4e..2c6a57288 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -99,11 +99,14 @@ module subroutine netcdf_initialize_output(self, param) logical :: fileExists character(len=STRMAX) :: errmsg integer(I4B) :: storage, ndims, i - integer(I4B), parameter :: chunk = 2048 + integer(I4B) :: time_chunk, id_chunk dfill = ieee_value(dfill, IEEE_QUIET_NAN) sfill = ieee_value(sfill, IEEE_QUIET_NAN) + time_chunk = param%istep_out / param%istep_dump + id_chunk = param%maxid + ! Check if the file exists, and if it does, delete it inquire(file=param%outfile, exist=fileExists) if (fileExists) then @@ -127,80 +130,146 @@ module subroutine netcdf_initialize_output(self, param) !! Define the variables call check( nf90_def_var(self%ncid, TIME_DIMNAME, self%out_type, self%time_dimid, self%time_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%time_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, ID_DIMNAME, NF90_INT, self%id_dimid, self%id_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%id_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, NPL_VARNAME, NF90_INT, self%time_dimid, self%npl_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%npl_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, NTP_VARNAME, NF90_INT, self%time_dimid, self%ntp_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%ntp_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, NAME_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], self%name_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%name_varid, NF90_CHUNKED, [NAMELEN, id_chunk]) ) call check( nf90_def_var(self%ncid, PTYPE_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], self%ptype_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%ptype_varid, NF90_CHUNKED, [NAMELEN, id_chunk]) ) if ((param%out_form == XV) .or. (param%out_form == XVEL)) then call check( nf90_def_var(self%ncid, XHX_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%xhx_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%xhx_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, XHY_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%xhy_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%xhy_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, XHZ_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%xhz_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%xhz_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, VHX_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%vhx_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%vhx_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, VHY_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%vhy_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%vhy_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, VHZ_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%vhz_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%vhz_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) end if if ((param%out_form == EL) .or. (param%out_form == XVEL)) then call check( nf90_def_var(self%ncid, A_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%a_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%a_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, E_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%e_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%e_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, INC_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%inc_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%inc_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, CAPOM_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%capom_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%capom_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, OMEGA_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%omega_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%omega_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, CAPM_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%capm_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%capm_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) end if call check( nf90_def_var(self%ncid, GMASS_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Gmass_varid) ) - if (param%lrhill_present) call check( nf90_def_var(self%ncid, RHILL_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%rhill_varid) ) - if (param%lclose) call check( nf90_def_var(self%ncid, RADIUS_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%radius_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%Gmass_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) + if (param%lrhill_present) then + call check( nf90_def_var(self%ncid, RHILL_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%rhill_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%rhill_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) + end if + if (param%lclose) then + call check( nf90_def_var(self%ncid, RADIUS_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%radius_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%radius_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) + end if if (param%lrotation) then call check( nf90_def_var(self%ncid, IP1_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Ip1_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%Ip1_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, IP2_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Ip2_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%Ip2_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, IP3_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Ip3_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%Ip3_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, ROTX_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%rotx_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%rotx_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, ROTY_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%roty_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%roty_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, ROTZ_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%rotz_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%rotz_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) end if if (param%ltides) then call check( nf90_def_var(self%ncid, K2_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%k2_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%k2_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) call check( nf90_def_var(self%ncid, Q_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Q_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%Q_varid, NF90_CHUNKED, [id_chunk, time_chunk]) ) end if if (param%lenergy) then call check( nf90_def_var(self%ncid, KE_ORB_VARNAME, self%out_type, self%time_dimid, self%KE_orb_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%KE_orb_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, KE_SPIN_VARNAME, self%out_type, self%time_dimid, self%KE_spin_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%KE_spin_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, PE_VARNAME, self%out_type, self%time_dimid, self%PE_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%PE_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, L_ORBX_VARNAME, self%out_type, self%time_dimid, self%L_orbx_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%L_orbx_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, L_ORBY_VARNAME, self%out_type, self%time_dimid, self%L_orby_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%L_orby_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, L_ORBZ_VARNAME, self%out_type, self%time_dimid, self%L_orbz_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%L_orbz_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, L_SPINX_VARNAME, self%out_type, self%time_dimid, self%L_spinx_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%L_spinx_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, L_SPINY_VARNAME, self%out_type, self%time_dimid, self%L_spiny_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%L_spiny_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, L_SPINZ_VARNAME, self%out_type, self%time_dimid, self%L_spinz_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%L_spinz_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, L_ESCAPEX_VARNAME, self%out_type, self%time_dimid, self%L_escapex_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%L_escapex_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, L_ESCAPEY_VARNAME, self%out_type, self%time_dimid, self%L_escapey_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%L_escapey_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, L_ESCAPEZ_VARNAME, self%out_type, self%time_dimid, self%L_escapez_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%L_escapez_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, ECOLLISIONS_VARNAME, self%out_type, self%time_dimid, self%Ecollisions_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%Ecollisions_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, EUNTRACKED_VARNAME, self%out_type, self%time_dimid, self%Euntracked_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%Euntracked_varid, NF90_CHUNKED, [time_chunk]) ) call check( nf90_def_var(self%ncid, GMESCAPE_VARNAME, self%out_type, self%time_dimid, self%GMescape_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%GMescape_varid, NF90_CHUNKED, [time_chunk]) ) end if call check( nf90_def_var(self%ncid, STATUS_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], self%status_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%status_varid, NF90_CHUNKED, [NAMELEN, id_chunk]) ) call check( nf90_def_var(self%ncid, ORIGIN_TYPE_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], self%origin_type_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%origin_type_varid, NF90_CHUNKED, [NAMELEN, id_chunk]) ) call check( nf90_def_var(self%ncid, ORIGIN_TIME_VARNAME, self%out_type, self%id_dimid, self%origin_time_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%origin_time_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, COLLISION_ID_VARNAME, self%out_type, self%id_dimid, self%collision_id_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%collision_id_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, ORIGIN_XHX_VARNAME, self%out_type, self%id_dimid, self%origin_xhx_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%origin_xhx_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, ORIGIN_XHY_VARNAME, self%out_type, self%id_dimid, self%origin_xhy_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%origin_xhy_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, ORIGIN_XHZ_VARNAME, self%out_type, self%id_dimid, self%origin_xhz_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%origin_xhz_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, ORIGIN_VHX_VARNAME, self%out_type, self%id_dimid, self%origin_vhx_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%origin_vhx_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, ORIGIN_VHY_VARNAME, self%out_type, self%id_dimid, self%origin_vhy_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%origin_vhy_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, ORIGIN_VHZ_VARNAME, self%out_type, self%id_dimid, self%origin_vhz_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%origin_vhz_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, DISCARD_TIME_VARNAME, self%out_type, self%id_dimid, self%discard_time_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%discard_time_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, DISCARD_XHX_VARNAME, self%out_type, self%id_dimid, self%discard_xhx_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%discard_xhx_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, DISCARD_XHY_VARNAME, self%out_type, self%id_dimid, self%discard_xhy_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%discard_xhy_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, DISCARD_XHZ_VARNAME, self%out_type, self%id_dimid, self%discard_xhz_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%discard_xhz_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, DISCARD_VHX_VARNAME, self%out_type, self%id_dimid, self%discard_vhx_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%discard_vhx_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, DISCARD_VHY_VARNAME, self%out_type, self%id_dimid, self%discard_vhy_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%discard_vhy_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, DISCARD_VHZ_VARNAME, self%out_type, self%id_dimid, self%discard_vhz_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%discard_vhz_varid, NF90_CHUNKED, [id_chunk]) ) call check( nf90_def_var(self%ncid, DISCARD_BODY_ID_VARNAME, NF90_INT, self%id_dimid, self%discard_body_id_varid) ) + call check( nf90_def_var_chunking(self%ncid, self%discard_body_id_varid, NF90_CHUNKED, [id_chunk]) ) ! Set fill mode to NaN for all variables call check( nf90_inquire(self%ncid, nVariables=nvar) ) @@ -216,13 +285,6 @@ module subroutine netcdf_initialize_output(self, param) case(NF90_CHAR) call check( nf90_def_var_fill(self%ncid, varid, 0, 0) ) end select - - select case(vartype) - case(NF90_CHAR) - call check( nf90_def_var_chunking(self%ncid, varid, NF90_CHUNKED, [NAMELEN, chunk]) ) - case default - call check( nf90_def_var_chunking(self%ncid, varid, NF90_CHUNKED, [(chunk, i = 1, ndims)]) ) - end select end do ! Take the file out of define mode