diff --git a/src/api.F90 b/src/api.F90 index 04bb2b1e97..4a2dc8b681 100644 --- a/src/api.F90 +++ b/src/api.F90 @@ -214,8 +214,6 @@ contains legendre_to_tabular = .true. legendre_to_tabular_points = 33 n_batch_interval = 1 - n_filters = 0 - n_meshes = 0 n_particles = 0 n_source_points = 0 n_state_points = 0 @@ -742,103 +740,26 @@ contains use trigger_header use volume_header - integer :: i ! Loop Index - - ! Deallocate cells, surfaces, materials - if (allocated(cells)) deallocate(cells) - if (allocated(universes)) deallocate(universes) - if (allocated(lattices)) deallocate(lattices) - if (allocated(surfaces)) deallocate(surfaces) - if (allocated(materials)) deallocate(materials) - if (allocated(plots)) deallocate(plots) - if (allocated(volume_calcs)) deallocate(volume_calcs) - - ! Deallocate geometry debugging information - if (allocated(overlap_check_cnt)) deallocate(overlap_check_cnt) - - ! Deallocate cross section data, listings, and cache - if (allocated(nuclides)) then - ! First call the clear routines - do i = 1, size(nuclides) - call nuclides(i) % clear() - end do - deallocate(nuclides) - end if - if (allocated(libraries)) deallocate(libraries) - - if (allocated(res_scat_nuclides)) deallocate(res_scat_nuclides) - - if (allocated(nuclides_MG)) deallocate(nuclides_MG) - - if (allocated(macro_xs)) deallocate(macro_xs) - - if (allocated(sab_tables)) deallocate(sab_tables) - - ! Deallocate external source - if (allocated(external_source)) deallocate(external_source) - - ! Deallocate k and entropy - if (allocated(k_generation)) deallocate(k_generation) - if (allocated(entropy)) deallocate(entropy) - if (allocated(entropy_p)) deallocate(entropy_p) - - ! Deallocate tally-related arrays - if (allocated(global_tallies)) deallocate(global_tallies) - if (allocated(meshes)) deallocate(meshes) - if (allocated(filters)) deallocate(filters) - if (allocated(tallies)) deallocate(tallies) - - ! Deallocate fission and source bank and entropy -!$omp parallel - if (allocated(fission_bank)) deallocate(fission_bank) - if (allocated(tally_derivs)) deallocate(tally_derivs) -!$omp end parallel -#ifdef _OPENMP - if (allocated(master_fission_bank)) deallocate(master_fission_bank) -#endif - if (allocated(source_bank)) deallocate(source_bank) - - ! Deallocate array of work indices - if (allocated(work_index)) deallocate(work_index) - - if (allocated(energy_bins)) deallocate(energy_bins) - if (allocated(energy_bin_avg)) deallocate(energy_bin_avg) + call free_memory_geometry() + call free_memory_surfaces() + call free_memory_material() + call free_memory_plot() + call free_memory_volume() + call free_memory_simulation() + call free_memory_nuclide() + call free_memory_settings() + call free_memory_mgxs() + call free_memory_sab() + call free_memory_source() + call free_memory_mesh() + call free_memory_tally() + call free_memory_tally_filter() + call free_memory_tally_derivative() + call free_memory_bank() ! Deallocate CMFD call deallocate_cmfd(cmfd) - ! Deallocate tally node lists - call active_analog_tallies % clear() - call active_tracklength_tallies % clear() - call active_current_tallies % clear() - call active_collision_tallies % clear() - call active_surface_tallies % clear() - call active_tallies % clear() - - ! Deallocate track_identifiers - if (allocated(track_identifiers)) deallocate(track_identifiers) - - ! Deallocate dictionaries - call cell_dict % clear() - call universe_dict % clear() - call lattice_dict % clear() - call surface_dict % clear() - call material_dict % clear() - call mesh_dict % clear() - call filter_dict % clear() - call tally_dict % clear() - call plot_dict % clear() - call nuclide_dict % clear() - call sab_dict % clear() - call library_dict % clear() - - ! Clear statepoint and sourcepoint batch set - call statepoint_batch % clear() - call sourcepoint_batch % clear() - - ! Deallocate ufs - if (allocated(source_frac)) deallocate(source_frac) - end subroutine free_memory end module openmc_api diff --git a/src/bank_header.F90 b/src/bank_header.F90 index f20c67385d..961824a406 100644 --- a/src/bank_header.F90 +++ b/src/bank_header.F90 @@ -29,4 +29,23 @@ module bank_header !$omp threadprivate(fission_bank, n_bank) +contains + +!=============================================================================== +! FREE_MEMORY_BANK deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_bank() + + ! Deallocate fission and source bank and entropy +!$omp parallel + if (allocated(fission_bank)) deallocate(fission_bank) +!$omp end parallel +#ifdef _OPENMP + if (allocated(master_fission_bank)) deallocate(master_fission_bank) +#endif + if (allocated(source_bank)) deallocate(source_bank) + + end subroutine free_memory_bank + end module bank_header diff --git a/src/geometry_header.F90 b/src/geometry_header.F90 index c277d85828..5a5cf2c26b 100644 --- a/src/geometry_header.F90 +++ b/src/geometry_header.F90 @@ -402,4 +402,24 @@ contains end subroutine get_temperatures +!=============================================================================== +! FREE_MEMORY_GEOMETRY deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_geometry() + + n_cells = 0 + n_universes = 0 + n_lattices = 0 + + if (allocated(cells)) deallocate(cells) + if (allocated(universes)) deallocate(universes) + if (allocated(lattices)) deallocate(lattices) + + call cell_dict % clear() + call universe_dict % clear() + call lattice_dict % clear() + + end subroutine free_memory_geometry + end module geometry_header diff --git a/src/material_header.F90 b/src/material_header.F90 index f80c36b5cc..e55272ccee 100644 --- a/src/material_header.F90 +++ b/src/material_header.F90 @@ -212,4 +212,14 @@ contains if (allocated(this % names)) deallocate(this % names) end subroutine material_assign_sab_tables +!=============================================================================== +! FREE_MEMORY_MATERIAL deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_material() + n_materials = 0 + if (allocated(materials)) deallocate(materials) + call material_dict % clear() + end subroutine free_memory_material + end module material_header diff --git a/src/mesh_header.F90 b/src/mesh_header.F90 index 1bef22181f..a7aa31b055 100644 --- a/src/mesh_header.F90 +++ b/src/mesh_header.F90 @@ -13,6 +13,7 @@ module mesh_header implicit none private + public :: free_memory_mesh public :: openmc_extend_meshes !=============================================================================== @@ -546,6 +547,16 @@ contains call close_group(mesh_group) end subroutine regular_to_hdf5 +!=============================================================================== +! FREE_MEMORY_MESH deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_mesh() + n_meshes = 0 + if (allocated(meshes)) deallocate(meshes) + call mesh_dict % clear() + end subroutine free_memory_mesh + !=============================================================================== ! C API FUNCTIONS !=============================================================================== diff --git a/src/mgxs_header.F90 b/src/mgxs_header.F90 index a00a3756dc..b282397245 100644 --- a/src/mgxs_header.F90 +++ b/src/mgxs_header.F90 @@ -3551,4 +3551,15 @@ contains end subroutine find_angle +!=============================================================================== +! FREE_MEMORY_MGXS deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_mgxs() + if (allocated(nuclides_MG)) deallocate(nuclides_MG) + if (allocated(macro_xs)) deallocate(macro_xs) + if (allocated(energy_bins)) deallocate(energy_bins) + if (allocated(energy_bin_avg)) deallocate(energy_bin_avg) + end subroutine free_memory_mgxs + end module mgxs_header diff --git a/src/nuclide_header.F90 b/src/nuclide_header.F90 index 1ed2fee9e0..efef69535c 100644 --- a/src/nuclide_header.F90 +++ b/src/nuclide_header.F90 @@ -742,4 +742,28 @@ contains end subroutine nuclide_init_grid +!=============================================================================== +! FREE_MEMORY_NUCLIDE deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_nuclide() + integer :: i + + ! Deallocate cross section data, listings, and cache + if (allocated(nuclides)) then + ! First call the clear routines + do i = 1, size(nuclides) + call nuclides(i) % clear() + end do + deallocate(nuclides) + end if + n_nuclides = 0 + + if (allocated(libraries)) deallocate(libraries) + + call nuclide_dict % clear() + call library_dict % clear() + + end subroutine free_memory_nuclide + end module nuclide_header diff --git a/src/plot_header.F90 b/src/plot_header.F90 index 06b4919ad5..1091bd73a8 100644 --- a/src/plot_header.F90 +++ b/src/plot_header.F90 @@ -60,4 +60,16 @@ module plot_header ! Dictionary that maps user IDs to indices in 'plots' type(DictIntInt) :: plot_dict +contains + +!=============================================================================== +! FREE_MEMORY_PLOT deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_plot() + n_plots = 0 + if (allocated(plots)) deallocate(plots) + call plot_dict % clear() + end subroutine free_memory_plot + end module plot_header diff --git a/src/sab_header.F90 b/src/sab_header.F90 index 8e783a741e..6dd617790b 100644 --- a/src/sab_header.F90 +++ b/src/sab_header.F90 @@ -1,5 +1,6 @@ module sab_header + use, intrinsic :: ISO_C_BINDING use, intrinsic :: ISO_FORTRAN_ENV use algorithm, only: find, sort @@ -80,7 +81,7 @@ module sab_header ! S(a,b) tables type(SAlphaBeta), allocatable, target :: sab_tables(:) - integer :: n_sab_tables + integer(C_INT), bind(C) :: n_sab_tables type(DictCharInt) :: sab_dict contains @@ -359,4 +360,14 @@ contains call close_group(kT_group) end subroutine salphabeta_from_hdf5 +!=============================================================================== +! FREE_MEMORY_SAB deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_sab() + n_sab_tables = 0 + if (allocated(sab_tables)) deallocate(sab_tables) + call sab_dict % clear() + end subroutine free_memory_sab + end module sab_header diff --git a/src/settings.F90 b/src/settings.F90 index 10b7ea958f..7e81872a01 100644 --- a/src/settings.F90 +++ b/src/settings.F90 @@ -138,4 +138,18 @@ module settings ! No reduction at end of batch logical :: reduce_tallies = .true. +contains + +!=============================================================================== +! FREE_MEMORY_SETTINGS deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_settings() + if (allocated(res_scat_nuclides)) deallocate(res_scat_nuclides) + if (allocated(track_identifiers)) deallocate(track_identifiers) + + call statepoint_batch % clear() + call sourcepoint_batch % clear() + end subroutine free_memory_settings + end module settings diff --git a/src/simulation_header.F90 b/src/simulation_header.F90 index 3918307a14..cfb75b4492 100644 --- a/src/simulation_header.F90 +++ b/src/simulation_header.F90 @@ -79,4 +79,17 @@ contains gen = gen_per_batch*(current_batch - 1) + current_gen end function overall_generation +!=============================================================================== +! FREE_MEMORY_SIMULATION deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_simulation() + if (allocated(overlap_check_cnt)) deallocate(overlap_check_cnt) + if (allocated(k_generation)) deallocate(k_generation) + if (allocated(entropy)) deallocate(entropy) + if (allocated(entropy_p)) deallocate(entropy_p) + if (allocated(source_frac)) deallocate(source_frac) + if (allocated(work_index)) deallocate(work_index) + end subroutine free_memory_simulation + end module simulation_header diff --git a/src/source_header.F90 b/src/source_header.F90 index fa489853e9..c664316c7c 100644 --- a/src/source_header.F90 +++ b/src/source_header.F90 @@ -16,6 +16,7 @@ module source_header implicit none private + public :: free_memory_source integer :: n_accept = 0 ! Number of samples accepted integer :: n_reject = 0 ! Number of samples rejected @@ -293,6 +294,15 @@ contains end function sample +!=============================================================================== +! FREE_MEMORY_SOURCE deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_source() + n_sources = 0 + if (allocated(external_source)) deallocate(external_source) + end subroutine free_memory_source + !=============================================================================== ! C API FUNCTIONS !=============================================================================== diff --git a/src/surface_header.F90 b/src/surface_header.F90 index d1c0452335..ed4ef86e09 100644 --- a/src/surface_header.F90 +++ b/src/surface_header.F90 @@ -1060,4 +1060,14 @@ contains end associate end function quadric_normal +!=============================================================================== +! FREE_MEMORY_SURFACES deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_surfaces() + n_surfaces = 0 + if (allocated(surfaces)) deallocate(surfaces) + call surface_dict % clear() + end subroutine free_memory_surfaces + end module surface_header diff --git a/src/tallies/tally_derivative_header.F90 b/src/tallies/tally_derivative_header.F90 index 004db98bad..fcf4a203b9 100644 --- a/src/tallies/tally_derivative_header.F90 +++ b/src/tallies/tally_derivative_header.F90 @@ -9,6 +9,7 @@ module tally_derivative_header implicit none private + public :: free_memory_tally_derivative !=============================================================================== ! TALLYDERIVATIVE describes a first-order derivative that can be applied to @@ -88,4 +89,14 @@ contains end subroutine from_xml +!=============================================================================== +! FREE_MEMORY_TALLY_DERIVATIVE deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_tally_derivative() +!$omp parallel + if (allocated(tally_derivs)) deallocate(tally_derivs) +!$omp end parallel + end subroutine free_memory_tally_derivative + end module tally_derivative_header diff --git a/src/tallies/tally_filter_header.F90 b/src/tallies/tally_filter_header.F90 index fa229d471c..9ece9116ab 100644 --- a/src/tallies/tally_filter_header.F90 +++ b/src/tallies/tally_filter_header.F90 @@ -13,6 +13,7 @@ module tally_filter_header implicit none private + public :: free_memory_tally_filter public :: openmc_extend_filters public :: openmc_filter_get_id public :: openmc_filter_set_id @@ -129,6 +130,16 @@ contains class(TallyFilter), intent(inout) :: this end subroutine filter_initialize +!=============================================================================== +! FREE_MEMORY_TALLY_FILTER deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_tally_filter() + n_filters = 0 + if (allocated(filters)) deallocate(filters) + call filter_dict % clear() + end subroutine free_memory_tally_filter + !=============================================================================== ! C API FUNCTIONS !=============================================================================== diff --git a/src/tallies/tally_header.F90 b/src/tallies/tally_header.F90 index f053e6cac8..a1ba6288d6 100644 --- a/src/tallies/tally_header.F90 +++ b/src/tallies/tally_header.F90 @@ -19,6 +19,7 @@ module tally_header implicit none private public :: configure_tallies + public :: free_memory_tally public :: openmc_extend_tallies public :: openmc_get_tally public :: openmc_tally_get_id @@ -387,6 +388,26 @@ contains end subroutine configure_tallies +!=============================================================================== +! FREE_MEMORY_TALLY deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_tally() + n_tallies = 0 + if (allocated(tallies)) deallocate(tallies) + call tally_dict % clear() + + if (allocated(global_tallies)) deallocate(global_tallies) + + ! Deallocate tally node lists + call active_analog_tallies % clear() + call active_tracklength_tallies % clear() + call active_current_tallies % clear() + call active_collision_tallies % clear() + call active_surface_tallies % clear() + call active_tallies % clear() + end subroutine free_memory_tally + !=============================================================================== ! C API FUNCTIONS !=============================================================================== diff --git a/src/volume_header.F90 b/src/volume_header.F90 index 13c3299bb6..59a579a5fb 100644 --- a/src/volume_header.F90 +++ b/src/volume_header.F90 @@ -58,4 +58,12 @@ contains call get_node_value(node_vol, "samples", this % samples) end subroutine volume_from_xml +!=============================================================================== +! FREE_MEMORY_VOLUME deallocates global arrays defined in this module +!=============================================================================== + + subroutine free_memory_volume() + if (allocated(volume_calcs)) deallocate(volume_calcs) + end subroutine free_memory_volume + end module volume_header