diff --git a/src/ace.F90 b/src/ace.F90 index de7fd16ad1..4492d6b8b9 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -165,6 +165,10 @@ contains if (allocated(mat % sab_names)) deallocate(mat % sab_names) end do MATERIAL_LOOP2 + + ! Avoid some valgrind leak errors + call already_read % clear() + end subroutine read_xs !=============================================================================== diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 8506352bb1..d075c22889 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -16,6 +16,10 @@ module ace_header integer, allocatable :: type(:) ! type of distribution integer, allocatable :: location(:) ! location of each table real(8), allocatable :: data(:) ! angular distribution data + + ! Type-Bound procedures + contains + procedure :: clear => distangle_clear ! Deallocates DistAngle end type DistAngle !=============================================================================== @@ -31,6 +35,10 @@ module ace_header ! For reactions that may have multiple energy distributions such as (n.2n), ! this pointer allows multiple laws to be stored type(DistEnergy), pointer :: next => null() + + ! Type-Bound procedures + contains + procedure :: clear => distenergy_clear ! Deallocates DistEnergy end type DistEnergy !=============================================================================== @@ -48,7 +56,11 @@ 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 + procedure :: clear => reaction_clear ! Deallocates Reaction end type Reaction !=============================================================================== @@ -64,6 +76,10 @@ module ace_header logical :: multiply_smooth ! multiply by smooth cross section? real(8), allocatable :: energy(:) ! incident energies real(8), allocatable :: prob(:,:,:) ! actual probabibility tables + + ! Type-Bound procedures + contains + procedure :: clear => urrdata_clear ! Deallocates UrrData end type UrrData !=============================================================================== @@ -121,7 +137,10 @@ module ace_header ! Reactions integer :: n_reaction ! # of reactions type(Reaction), pointer :: reactions(:) => null() - + + ! Type-Bound procedures + contains + procedure :: clear => nuclide_clear ! Deallocates Nuclide end type Nuclide !=============================================================================== @@ -216,4 +235,129 @@ module ace_header real(8) :: kappa_fission ! macroscopic energy-released from fission end type MaterialMacroXS + contains + +!=============================================================================== +! DISTANGLE_CLEAR resets and deallocates data in Reaction. +!=============================================================================== + + subroutine distangle_clear(this) + + class(DistAngle), intent(inout) :: this ! The DistAngle object to clear + + if (allocated(this % energy)) & + deallocate(this % energy, this % type, this % location, this % data) + + end subroutine distangle_clear + +!=============================================================================== +! DISTENERGY_CLEAR resets and deallocates data in DistEnergy. +!=============================================================================== + + recursive subroutine distenergy_clear(this) + + class(DistEnergy), intent(inout) :: this ! The DistEnergy object to clear + + ! Clear p_valid + call this % p_valid % clear() + + if (allocated(this % data)) & + deallocate(this % data) + + if (associated(this % next)) then + ! recursively clear this item + call this % next % clear() + deallocate(this % next) + end if + + end subroutine distenergy_clear + +!=============================================================================== +! REACTION_CLEAR resets and deallocates data in Reaction. +!=============================================================================== + + subroutine reaction_clear(this) + + class(Reaction), intent(inout) :: this ! The Reaction object to clear + + if (allocated(this % sigma)) & + deallocate(this % sigma) + + if (associated(this % edist)) then + call this % edist % clear() + deallocate(this % edist) + end if + + call this % adist % clear() + + end subroutine reaction_clear + +!=============================================================================== +! URRDATA_CLEAR resets and deallocates data in Reaction. +!=============================================================================== + + subroutine urrdata_clear(this) + + class(UrrData), intent(inout) :: this ! The UrrData object to clear + + if (allocated(this % energy)) & + deallocate(this % energy, this % prob) + + end subroutine urrdata_clear + +!=============================================================================== +! NUCLIDE_CLEAR resets and deallocates data in Nuclide. +!=============================================================================== + + subroutine nuclide_clear(this) + + class(Nuclide), intent(inout) :: this ! The Nuclide object to clear + + integer :: i ! Loop counter + + if (allocated(this % grid_index)) & + deallocate(this % grid_index) + + if (allocated(this % energy)) & + deallocate(this % total, this % elastic, this % fission, & + this % nu_fission, this % absorption) + if (allocated(this % heating)) & + deallocate(this % heating) + + if (allocated(this % index_fission)) & + deallocate(this % index_fission) + + if (allocated(this % nu_t_data)) & + deallocate(this % nu_t_data) + + if (allocated(this % nu_p_data)) & + deallocate(this % nu_p_data) + + if (allocated(this % nu_d_data)) & + deallocate(this % nu_d_data) + + if (allocated(this % nu_d_precursor_data)) & + deallocate(this % nu_d_precursor_data) + + if (associated(this % nu_d_edist)) then + do i = 1, size(this % nu_d_edist) + call this % nu_d_edist(i) % clear() + end do + deallocate(this % nu_d_edist) + end if + + 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() + end do + deallocate(this % reactions) + end if + + end subroutine nuclide_clear + end module ace_header diff --git a/src/dict_header.F90 b/src/dict_header.F90 index 6c40482a38..7da2015fd3 100644 --- a/src/dict_header.F90 +++ b/src/dict_header.F90 @@ -64,10 +64,10 @@ module dict_header type(HashListCI), pointer :: table(:) => null() contains procedure :: add_key => dict_add_key_ci - procedure :: delete => dict_delete_ci 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 @@ -76,10 +76,10 @@ module dict_header type(HashListII), pointer :: table(:) => null() contains procedure :: add_key => dict_add_key_ii - procedure :: delete => dict_delete_ii 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 @@ -150,54 +150,6 @@ contains end subroutine dict_add_key_ii -!=============================================================================== -! DICT_DELETE deletes all (key,value) pairs from the dictionary -!=============================================================================== - - subroutine dict_delete_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)) - next => current % next - deallocate(current) - current => next - end do - nullify(this % table(i) % list) - end do - end if - - end subroutine dict_delete_ci - - subroutine dict_delete_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)) - next => current % next - deallocate(current) - current => next - end do - nullify(this % table(i) % list) - end do - end if - - end subroutine dict_delete_ii - !=============================================================================== ! DICT_GET_ELEM returns a pointer to the (key,value) pair for a given key. This ! method is private. @@ -429,4 +381,64 @@ contains end function dict_keys_ii +!=============================================================================== +! DICT_CLEAR Deletes and deallocates the dictionary item +!=============================================================================== + + 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/endf_header.F90 b/src/endf_header.F90 index a8bdd1a9a4..337045c2b4 100644 --- a/src/endf_header.F90 +++ b/src/endf_header.F90 @@ -13,6 +13,28 @@ module endf_header integer :: n_pairs ! # of pairs of (x,y) values real(8), allocatable :: x(:) ! values of abscissa real(8), allocatable :: y(:) ! values of ordinate + + ! Type-Bound procedures + contains + procedure :: clear => Tab1_clear ! deallocates a Tab1 Object. end type Tab1 + + contains + +!=============================================================================== +! TAB1_CLEAR deallocates the items in Tab1 +!=============================================================================== + + subroutine tab1_clear(this) + + class(Tab1), intent(inout) :: this ! The Tab1 to clear + + if (allocated(this % nbt)) & + deallocate(this % nbt, this % int) + + if (allocated(this % x)) & + deallocate(this % x, this % y) + + end subroutine tab1_clear end module endf_header diff --git a/src/global.F90 b/src/global.F90 index 87e07de261..005426211b 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -371,11 +371,14 @@ module global contains !=============================================================================== -! FREE_MEMORY deallocates all global allocatable arrays in the program +! FREE_MEMORY deallocates and clears all global allocatable arrays in the +! program !=============================================================================== subroutine free_memory() - + + integer :: i ! Loop Index + ! Deallocate cells, surfaces, materials if (allocated(cells)) deallocate(cells) if (allocated(universes)) deallocate(universes) @@ -385,14 +388,27 @@ contains if (allocated(plots)) deallocate(plots) ! Deallocate cross section data, listings, and cache - if (allocated(nuclides)) deallocate(nuclides) + 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(sab_tables)) deallocate(sab_tables) if (allocated(xs_listings)) deallocate(xs_listings) if (allocated(micro_xs)) deallocate(micro_xs) ! 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 @@ -411,7 +427,20 @@ contains call active_tracklength_tallies % clear() 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/initialize.F90 b/src/initialize.F90 index 944f842745..83946165d3 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -400,7 +400,7 @@ contains index_cell_in_univ(i_univ) = index_cell_in_univ(i_univ) + 1 univ % cells(index_cell_in_univ(i_univ)) = i end do - + end subroutine prepare_universes !=============================================================================== diff --git a/src/tally_header.F90 b/src/tally_header.F90 index 3761c351da..41c5d79715 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