diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 003db99c92..c63e075ee8 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -56,7 +56,7 @@ module ace_header logical :: has_angle_dist ! Angle distribution present? logical :: has_energy_dist ! Energy distribution present? type(DistAngle) :: adist ! Secondary angular distribution - type(DistEnergy), pointer :: edist ! Secondary energy distribution + type(DistEnergy), pointer :: edist => null() ! Secondary energy distribution ! Type-Bound procedures contains @@ -346,10 +346,11 @@ module ace_header deallocate(this % nu_d_edist) end if - if (associated(this % urr_data)) & + if (associated(this % urr_data)) then call this % urr_data % clear() deallocate(this % urr_data) - + end if + if (associated(this % reactions)) then do i = 1, size(this % reactions) call this % reactions(i) % clear() diff --git a/src/dict_header.F90 b/src/dict_header.F90 index 0c8c07da76..a0eea0e2ea 100644 --- a/src/dict_header.F90 +++ b/src/dict_header.F90 @@ -68,6 +68,7 @@ module dict_header procedure :: get_key => dict_get_key_ci procedure :: has_key => dict_has_key_ci procedure :: keys => dict_keys_ci + procedure :: clear => dict_clear_ci procedure, private :: get_elem => dict_get_elem_ci end type DictCharInt @@ -80,6 +81,7 @@ module dict_header procedure :: get_key => dict_get_key_ii procedure :: has_key => dict_has_key_ii procedure :: keys => dict_keys_ii + procedure :: clear => dict_clear_ii procedure, private :: get_elem => dict_get_elem_ii end type DictIntInt @@ -428,5 +430,65 @@ contains end do end function dict_keys_ii + +!=============================================================================== +! DICT_DELETE deletes all (key,value) pairs from the dictionary +!=============================================================================== + + subroutine dict_clear_ci(this) + + class(DictCharInt) :: this + + integer :: i + type(ElemKeyValueCI), pointer :: current + type(ElemKeyValueCI), pointer :: next + + if (associated(this % table)) then + do i = 1, size(this % table) + current => this % table(i) % list + do while (associated(current)) + if (associated(current % next)) then + next => current % next + else + nullify(next) + end if + deallocate(current) + current => next + end do + if (associated(this % table(i) % list)) & + nullify(this % table(i) % list) + end do + deallocate(this % table) + end if + + end subroutine dict_clear_ci + + subroutine dict_clear_ii(this) + + class(DictIntInt) :: this + + integer :: i + type(ElemKeyValueII), pointer :: current + type(ElemKeyValueII), pointer :: next + + if (associated(this % table)) then + do i = 1, size(this % table) + current => this % table(i) % list + do while (associated(current)) + if (associated(current % next)) then + next => current % next + else + nullify(next) + end if + deallocate(current) + current => next + end do + if (associated(this % table(i) % list)) & + nullify(this % table(i) % list) + end do + deallocate(this % table) + end if + + end subroutine dict_clear_ii end module dict_header diff --git a/src/global.F90 b/src/global.F90 index 1228c1eea8..005426211b 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -401,7 +401,14 @@ contains ! Deallocate tally-related arrays if (allocated(meshes)) deallocate(meshes) - if (allocated(tallies)) deallocate(tallies) + if (allocated(tallies)) then + ! First call the clear routines + do i = 1, size(tallies) + call tallies(i) % clear() + end do + ! Now deallocate the tally array + deallocate(tallies) + end if if (allocated(tally_maps)) deallocate(tally_maps) ! Deallocate energy grid @@ -421,6 +428,19 @@ contains call active_current_tallies % clear() call active_tallies % clear() + ! 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 tally_dict % clear() + call plot_dict % clear() + call nuclide_dict % clear() + call sab_dict % clear() + call xs_listing_dict % clear() + end subroutine free_memory end module global diff --git a/src/tally_header.F90 b/src/tally_header.F90 index 3761c351da..a35ceac518 100644 --- a/src/tally_header.F90 +++ b/src/tally_header.F90 @@ -55,6 +55,10 @@ module tally_header integer :: n_bins = 0 integer, allocatable :: int_bins(:) real(8), allocatable :: real_bins(:) ! Only used for energy filters + + ! Type-Bound procedures + contains + procedure :: clear => TallyFilter_clear ! Deallocates TallyFilter end type TallyFilter !=============================================================================== @@ -119,7 +123,78 @@ module tally_header ! Number of realizations of tally random variables integer :: n_realizations = 0 - + + ! Type-Bound procedures + contains + procedure :: clear => TallyObject_clear ! Deallocates TallyObject end type TallyObject + + contains + +!=============================================================================== +! TALLYFILTER_CLEAR deallocates a TallyFilter element and sets it to its as +! initialized state. +!=============================================================================== + + subroutine TallyFilter_clear(this) + class(TallyFilter), intent(inout) :: this ! The TallyFilter to be cleared + + this % type = NONE + this % n_bins = 0 + if (allocated(this % int_bins)) & + deallocate(this % int_bins) + if (allocated(this % real_bins)) & + deallocate(this % real_bins) + + end subroutine TallyFilter_clear + +!=============================================================================== +! TALLYOBJECT_CLEAR deallocates a TallyObject element and sets it to its as +! initialized state. +!=============================================================================== + + subroutine TallyObject_clear(this) + class(TallyObject), intent(inout) :: this ! The TallyObject to be cleared + + integer :: i ! Loop Index + + ! This routine will go through each item in TallyObject and set the value + ! to its default, as-initialized values, including deallocations. + this % label = "" + + if (allocated(this % filters)) then + do i = 1, size(this % filters) + call this % filters(i) % clear() + end do + deallocate(this % filters) + end if + + if (allocated(this % matching_bins)) & + deallocate(this % matching_bins) + if (allocated(this % stride)) & + deallocate(this % stride) + + this % find_filter = 0 + + this % n_nuclide_bins = 0 + if (allocated(this % nuclide_bins)) & + deallocate(this % nuclide_bins) + this % all_nuclides = .false. + + this % n_score_bins = 0 + if (allocated(this % score_bins)) & + deallocate(this % score_bins) + if (allocated(this % scatt_order)) & + deallocate(this % scatt_order) + this % n_user_score_bins = 0 + + if (allocated(this % results)) & + deallocate(this % results) + + this % reset = .false. + + this % n_realizations = 0 + + end subroutine TallyObject_clear end module tally_header