Create mat_nuclide_index as part of simulation_init

src/input_xml.F90

@@ -2450,17 +2450,6 @@ contains
     n_nuclides = index_nuclide
     n_sab_tables = index_sab
 
-    ! Create direct address tables for tally optimization purposes
-    do i = 1, n_materials
-      mat => materials(i)
-      allocate(mat % mat_nuclide_index(n_nuclides))
-      mat % mat_nuclide_index(:) = 0
-
-      do j = 1, mat % n_nuclides
-        mat % mat_nuclide_index(mat % nuclide(j)) = j
-      end do
-    end do
-
     ! Close materials XML file
     call doc % clear()
 

src/material_header.F90

@@ -69,6 +69,7 @@ module material_header
 
   contains
     procedure :: set_density => material_set_density
+    procedure :: init_nuclide_index => material_init_nuclide_index
     procedure :: assign_sab_tables => material_assign_sab_tables
   end type Material
 
@@ -85,8 +86,8 @@ contains
 ! MATERIAL_SET_DENSITY sets the total density of a material in atom/b-cm.
 !===============================================================================
 
-  function material_set_density(m, density) result(err)
-    class(Material), intent(inout) :: m
+  function material_set_density(this, density) result(err)
+    class(Material), intent(inout) :: this
     real(8), intent(in) :: density
     integer :: err
 
@@ -94,23 +95,23 @@ contains
     real(8) :: sum_percent
     real(8) :: awr
 
-    if (allocated(m % atom_density)) then
+    if (allocated(this % atom_density)) then
       ! Set total density based on value provided
-      m % density = density
+      this % density = density
 
       ! Determine normalized atom percents
-      sum_percent = sum(m % atom_density)
-      m % atom_density(:) = m % atom_density / sum_percent
+      sum_percent = sum(this % atom_density)
+      this % atom_density(:) = this % atom_density / sum_percent
 
       ! Recalculate nuclide atom densities based on given density
-      m % atom_density(:) = density * m % atom_density
+      this % atom_density(:) = density * this % atom_density
 
       ! Calculate density in g/cm^3.
-      m % density_gpcc = ZERO
-      do i = 1, m % n_nuclides
-        awr = nuclides(m % nuclide(i)) % awr
-        m % density_gpcc = m % density_gpcc &
-             + m % atom_density(i) * awr * MASS_NEUTRON / N_AVOGADRO
+      this % density_gpcc = ZERO
+      do i = 1, this % n_nuclides
+        awr = nuclides(this % nuclide(i)) % awr
+        this % density_gpcc = this % density_gpcc &
+             + this % atom_density(i) * awr * MASS_NEUTRON / N_AVOGADRO
       end do
       err = 0
     else
@@ -119,6 +120,28 @@ contains
     end if
   end function material_set_density
 
+!===============================================================================
+! INIT_NUCLIDE_INDEX creates a mapping from indices in the global nuclides(:)
+! array to the Material % nuclides array
+!===============================================================================
+
+  subroutine material_init_nuclide_index(this)
+    class(Material), intent(inout) :: this
+
+    integer :: i
+
+    ! Allocate nuclide index array and set to zeros
+    if (allocated(this % mat_nuclide_index)) &
+         deallocate(this % mat_nuclide_index)
+    allocate(this % mat_nuclide_index(n_nuclides))
+    this % mat_nuclide_index(:) = 0
+
+    ! Assign entries in the index array
+    do i = 1, this % n_nuclides
+      this % mat_nuclide_index(this % nuclide(i)) = i
+    end do
+  end subroutine material_init_nuclide_index
+
 !===============================================================================
 ! ASSIGN_SAB_TABLES assigns S(alpha,beta) tables to specific nuclides within
 ! materials so the code knows when to apply bound thermal scattering data

src/simulation.F90

@@ -18,6 +18,7 @@ module simulation
 #endif
   use error,           only: fatal_error
   use geometry_header, only: n_cells
+  use material_header, only: n_materials, materials
   use message_passing
   use mgxs_header,     only: energy_bins, energy_bin_avg
   use nuclide_header,  only: micro_xs, n_nuclides
@@ -401,6 +402,7 @@ contains
 !===============================================================================
 
   subroutine openmc_simulation_init() bind(C)
+    integer :: i
 
     ! Skip if simulation has already been initialized
     if (simulation_initialized) return
@@ -418,6 +420,11 @@ contains
     ! Allocate tally results arrays if they're not allocated yet
     call configure_tallies()
 
+    ! Set up material nuclide index mapping
+    do i = 1, n_materials
+      call materials(i) % init_nuclide_index()
+    end do
+
 !$omp parallel
     ! Allocate array for microscopic cross section cache
     allocate(micro_xs(n_nuclides))
@@ -459,8 +466,8 @@ contains
 
   subroutine openmc_simulation_finalize() bind(C)
 
+    integer    :: i       ! loop index
 #ifdef MPI
-    integer    :: i       ! loop index for tallies
     integer    :: n       ! size of arrays
     integer    :: mpi_err  ! MPI error code
     integer(8) :: temp
@@ -470,9 +477,14 @@ contains
     ! Skip if simulation was never run
     if (.not. simulation_initialized) return
 
-    ! Stop active batch timer
+    ! Stop active batch timer and start finalization timer
     call time_active % stop()
+    call time_finalize % start()
 
+    ! Free up simulation-specific memory
+    do i = 1, n_materials
+      deallocate(materials(i) % mat_nuclide_index)
+    end do
 !$omp parallel
     deallocate(micro_xs, filter_matches)
 !$omp end parallel
@@ -480,9 +492,6 @@ contains
     ! Increment total number of generations
     total_gen = total_gen + current_batch*gen_per_batch
 
-    ! Start finalization timer
-    call time_finalize % start()
-
 #ifdef MPI
     ! Broadcast tally results so that each process has access to results
     if (allocated(tallies)) then