crp/OpenMC
1
0
Fork 0
mirror of https://github.com/openmc-dev/openmc.git synced 2026-07-27 05:35:49 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

Refactored to use new list, dictionary, and set implementations. Closes #56 on github. Closes #31 on github.

Browse source
This commit is contained in:
Paul Romano 2013-01-27 15:25:55 -05:00
parent 2c2429a14b
commit d27dbe3c01
14 changed files with 200 additions and 1642 deletions
Download patch file Download diff file Expand all files Collapse all files

22
src/DEPENDENCIES
View file

@ -1,13 +1,12 @@
ace.o: ace_header.o
ace.o: constants.o
ace.o: datatypes.o
ace.o: datatypes_header.o
ace.o: endf.o
ace.o: error.o
ace.o: fission.o
ace.o: global.o
ace.o: material_header.o
ace.o: output.o
ace.o: set_header.o
ace.o: string.o
ace_header.o: constants.o
@ -39,7 +38,6 @@ cmfd_execute.o: timing.o
cmfd_header.o: constants.o
cmfd_input.o: cmfd_message_passing.o
cmfd_input.o: datatypes.o
cmfd_input.o: error.o
cmfd_input.o: global.o
cmfd_input.o: mesh_header.o
@ -117,17 +115,14 @@ cross_section.o: material_header.o
cross_section.o: random_lcg.o
cross_section.o: search.o
datatypes.o: datatypes_header.o
doppler.o: constants.o
endf.o: constants.o
endf.o: string.o
energy_grid.o: constants.o
energy_grid.o: datatypes.o
energy_grid.o: datatypes_header.o
energy_grid.o: global.o
energy_grid.o: list_header.o
energy_grid.o: output.o
error.o: global.o
@ -159,7 +154,6 @@ fixed_source.o: tally.o
fixed_source.o: timing.o
geometry.o: constants.o
geometry.o: datatypes.o
geometry.o: error.o
geometry.o: geometry_header.o
geometry.o: global.o
@ -172,8 +166,8 @@ global.o: ace_header.o
global.o: bank_header.o
global.o: cmfd_header.o
global.o: constants.o
global.o: datatypes.o
global.o: datatypes_header.o
global.o: dict_header.o
global.o: list_header.o
global.o: geometry_header.o
global.o: material_header.o
global.o: mesh_header.o
@ -198,8 +192,7 @@ hdf5_interface.o: tally_header.o
initialize.o: ace.o
initialize.o: bank_header.o
initialize.o: constants.o
initialize.o: datatypes.o
initialize.o: datatypes_header.o
initialize.o: dict_header.o
initialize.o: energy_grid.o
initialize.o: error.o
initialize.o: geometry.o
@ -218,8 +211,7 @@ initialize.o: timing.o
input_xml.o: cmfd_input.o
input_xml.o: constants.o
input_xml.o: datatypes.o
input_xml.o: datatypes_header.o
input_xml.o: dict_header.o
input_xml.o: error.o
input_xml.o: geometry_header.o
input_xml.o: global.o
@ -262,7 +254,6 @@ mesh.o: search.o
output.o: ace_header.o
output.o: constants.o
output.o: datatypes.o
output.o: endf.o
output.o: geometry_header.o
output.o: global.o
@ -342,7 +333,6 @@ string.o: global.o
tally.o: ace_header.o
tally.o: constants.o
tally.o: datatypes_header.o
tally.o: error.o
tally.o: global.o
tally.o: math.o

2
src/OBJECTS
View file

@ -15,8 +15,6 @@ cmfd_prod_operator.o \
cmfd_snes_solver.o \
constants.o \
cross_section.o \
datatypes.o \
datatypes_header.o \
dict_header.o \
doppler.o \
eigenvalue.o \

32
src/ace.F90
View file

@ -3,15 +3,13 @@ module ace
use ace_header, only: Nuclide, Reaction, SAlphaBeta, XsListing, &
DistEnergy
use constants
use datatypes, only: dict_create, dict_add_key, dict_get_key, &
dict_has_key, dict_delete, dict_keys
use datatypes_header, only: DictionaryCI, ListKeyValueCI
use endf, only: reaction_name
use error, only: fatal_error, warning
use fission, only: nu_total
use global
use material_header, only: Material
use output, only: write_message
use set_header, only: SetChar
use string, only: str_to_int, str_to_real, lower_case, to_str
implicit none
@ -41,10 +39,10 @@ contains
integer :: i_sab ! index in sab_tables
character(12) :: name ! name of isotope, e.g. 92235.03c
character(12) :: alias ! alias of nuclide, e.g. U-235.03c
type(Material), pointer :: mat => null()
type(Nuclide), pointer :: nuc => null()
type(Material), pointer :: mat => null()
type(Nuclide), pointer :: nuc => null()
type(SAlphaBeta), pointer :: sab => null()
type(DictionaryCI), pointer :: already_read => null()
type(SetChar) :: already_read
! allocate arrays for ACE table storage and cross section cache
allocate(nuclides(n_nuclides_total))
@ -54,8 +52,6 @@ contains
! ==========================================================================
! READ ALL ACE CROSS SECTION TABLES
call dict_create(already_read)
! Loop over all files
do i = 1, n_materials
mat => materials(i)
@ -63,9 +59,9 @@ contains
do j = 1, mat % n_nuclides
name = mat % names(j)
if (.not. dict_has_key(already_read, name)) then
i_listing = dict_get_key(xs_listing_dict, name)
i_nuclide = dict_get_key(nuclide_dict, name)
if (.not. already_read % contains(name)) then
i_listing = xs_listing_dict % get_key(name)
i_nuclide = nuclide_dict % get_key(name)
name = xs_listings(i_listing) % name
alias = xs_listings(i_listing) % alias
@ -78,30 +74,28 @@ contains
call read_ace_table(i_nuclide, i_listing)
! Add name and alias to dictionary
call dict_add_key(already_read, name, 0)
call dict_add_key(already_read, alias, 0)
call already_read % add(name)
call already_read % add(alias)
end if
end do
if (mat % has_sab_table) then
name = mat % sab_name
if (.not. dict_has_key(already_read, name)) then
i_listing = dict_get_key(xs_listing_dict, name)
i_sab = dict_get_key(sab_dict, name)
if (.not. already_read % contains(name)) then
i_listing = xs_listing_dict % get_key(name)
i_sab = sab_dict % get_key(name)
! Read the ACE table into the appropriate entry on the sab_tables
! array
call read_ace_table(i_sab, i_listing)
! Add name to dictionary
call dict_add_key(already_read, name, 0)
call already_read % add(name)
end if
end if
end do
call dict_delete(already_read)
! ==========================================================================
! ASSIGN S(A,B) TABLES TO SPECIFIC NUCLIDES WITHIN MATERIALS

3
src/cmfd_input.F90
View file

@ -188,7 +188,6 @@ contains
subroutine create_cmfd_tally()
use datatypes, only: dict_add_key, dict_get_key
use error, only: fatal_error, warning
use global
use mesh_header, only: StructuredMesh
@ -330,7 +329,7 @@ contains
m % volume_frac = ONE/real(product(m % dimension),8)
! Add mesh to dictionary
call dict_add_key(mesh_dict, m % id, n_user_meshes + 1)
call mesh_dict % add_key(m % id, n_user_meshes + 1)
! allocate tallies
if (.not. allocated(tallies)) allocate(tallies(n_tallies))

1098
src/datatypes.F90
View file

File diff suppressed because it is too large Load diff

113
src/datatypes_header.F90
View file

@ -1,113 +0,0 @@
module datatypes_header
!===============================================================================
! DATATYPES_HEADER module contains the derived types for (key,value) pairs,
! lists, and dictionaries. It would be nice to add sets as well. This module
! could be made a LOT cleaner by using unlimited polymorphism, but we will wait
! on that since compiler support is still limited (namely gfortran which doesn't
! support it yet)
!===============================================================================
implicit none
!===============================================================================
! KEYVALUECI stores the (key,value) pair for a dictionary where the key is a
! string and the value is an integer. Note that we need to store the key in
! addition to the value for collision resolution.
!===============================================================================
! Key length for dictionary
integer, parameter :: DICT_KEY_LENGTH = 255
type KeyValueCI
character(len=DICT_KEY_LENGTH) :: key
integer :: value
end type KeyValueCI
!===============================================================================
! KEYVALUEII stores the (key,value) pair for a dictionary where the key is an
! integer and the value is an integer. Note that we need to store the key in
! addition to the value for collision resolution.
!===============================================================================
type KeyValueII
integer :: key
integer :: value
end type KeyValueII
!===============================================================================
! LISTKEYVALUECI stores a linked list of (key,value) pairs where the key is a
! character and the value is an integer
!===============================================================================
type ListKeyValueCI
type(ListKeyValueCI), pointer :: next => null()
type(KeyValueCI) :: data
end type ListKeyValueCI
!===============================================================================
! LISTKEYVALUEII stores a linked list of (key,value) pairs where the key is a
! character and the value is an integer
!===============================================================================
type ListKeyValueII
type(ListKeyValueII), pointer :: next => null()
type(KeyValueII) :: data
end type ListKeyValueII
!===============================================================================
! LISTREAL stores a linked list of real values. This is used for constructing a
! unionized energy grid.
!===============================================================================
type ListReal
type(ListReal), pointer :: next => null()
real(8) :: data
end type ListReal
!===============================================================================
! LISTINT stores a linked list of integer values.
!===============================================================================
type ListInt
type(ListInt), pointer :: next => null()
integer :: data
end type ListInt
!===============================================================================
! HASHLISTCI - Since it's not possible to directly do an array of pointers, this
! derived type provides a pointer
!===============================================================================
type HashListCI
type(ListKeyValueCI), pointer :: list => null()
end type HashListCI
!===============================================================================
! HASHLISTII - Since it's not possible to directly do an array of pointers, this
! derived type provides a pointer
!===============================================================================
type HashListII
type(ListKeyValueII), pointer :: list => null()
end type HashListII
!===============================================================================
! DICTIONARYCI provides a dictionary data structure of (key,value) pairs where
! the keys are strings and values are integers.
!===============================================================================
type DictionaryCI
type(HashListCI), pointer :: table(:) => null()
end type DictionaryCI
!===============================================================================
! DICTIONARYII provides a dictionary data structure of (key,value) pairs where
! the keys and values are both integers.
!===============================================================================
type DictionaryII
type(HashListII), pointer :: table(:) => null()
end type DictionaryII
end module datatypes_header

34
src/energy_grid.F90
View file

@ -1,11 +1,8 @@
module energy_grid
use constants, only: MAX_LINE_LEN
use datatypes, only: list_insert, list_size, list_delete, &
dict_create, dict_get_key, dict_has_key, &
dict_add_key, dict_delete
use datatypes_header, only: ListReal, DictionaryCI
use global
use list_header, only: ListElemReal
use output, only: write_message
contains
@ -20,10 +17,10 @@ contains
subroutine unionized_grid()
integer :: i ! index in nuclides array
type(ListReal), pointer :: list => null()
type(ListReal), pointer :: current => null()
type(Nuclide), pointer :: nuc => null()
integer :: i ! index in nuclides array
type(ListElemReal), pointer :: list => null()
type(ListElemReal), pointer :: current => null()
type(Nuclide), pointer :: nuc => null()
message = "Creating unionized energy grid..."
call write_message(5)
@ -34,8 +31,15 @@ contains
call add_grid_points(list, nuc % energy)
end do
! determine size of list
n_grid = 0
current => list
do while (associated(current))
n_grid = n_grid + 1
current => current % next
end do
! create allocated array from linked list
n_grid = list_size(list)
allocate(e_grid(n_grid))
current => list
do i = 1, n_grid
@ -44,7 +48,7 @@ contains
end do
! delete linked list and dictionary
call list_delete(list)
! call list_delete(list)
! Set pointers to unionized energy grid for each nuclide
call grid_pointers()
@ -58,16 +62,16 @@ contains
subroutine add_grid_points(list, energy)
type(ListReal), pointer :: list
type(ListElemReal), pointer :: list
real(8), intent(in) :: energy(:)
integer :: i ! index in energy array
integer :: n ! size of energy array
real(8) :: E ! actual energy value
type(ListReal), pointer :: current => null()
type(ListReal), pointer :: previous => null()
type(ListReal), pointer :: head => null()
type(ListReal), pointer :: tmp => null()
type(ListElemReal), pointer :: current => null()
type(ListElemReal), pointer :: previous => null()
type(ListElemReal), pointer :: head => null()
type(ListElemReal), pointer :: tmp => null()
i = 1
n = size(energy)

5
src/geometry.F90
View file

@ -1,7 +1,6 @@
module geometry
use constants
use datatypes, only: dict_get_key
use error, only: fatal_error
use geometry_header, only: Cell, Surface, Universe, Lattice
use global
@ -264,7 +263,7 @@ contains
! forward slightly so that if the mesh boundary is on the surface, it is
! still processed
if (associated(active_current_tallies)) then
if (active_current_tallies % size() > 0) then
! TODO: Find a better solution to score surface currents than
! physically moving the particle forward slightly
@ -298,7 +297,7 @@ contains
! particle to change -- artificially move the particle slightly back in
! case the surface crossing in coincident with a mesh boundary
if (associated(active_current_tallies)) then
if (active_current_tallies % size() > 0) then
p % coord0 % xyz = p % coord0 % xyz - TINY_BIT * p % coord0 % uvw
call score_surface_current()
p % coord0 % xyz = p % coord0 % xyz + TINY_BIT * p % coord0 % uvw

40
src/global.F90
View file

@ -5,8 +5,8 @@ module global
use bank_header, only: Bank
use cmfd_header
use constants
use datatypes, only: list_delete
use datatypes_header, only: DictionaryII, DictionaryCI, ListInt
use dict_header, only: DictCharInt, DictIntInt
use list_header, only: ListInt
use geometry_header, only: Cell, Universe, Lattice, Surface
use material_header, only: Material
use mesh_header, only: StructuredMesh
@ -54,13 +54,13 @@ module global
! These dictionaries provide a fast lookup mechanism -- the key is the
! user-specified identifier and the value is the index in the corresponding
! array
type(DictionaryII), pointer :: cell_dict => null()
type(DictionaryII), pointer :: universe_dict => null()
type(DictionaryII), pointer :: lattice_dict => null()
type(DictionaryII), pointer :: surface_dict => null()
type(DictionaryII), pointer :: material_dict => null()
type(DictionaryII), pointer :: mesh_dict => null()
type(DictionaryII), pointer :: tally_dict => null()
type(DictIntInt) :: cell_dict
type(DictIntInt) :: universe_dict
type(DictIntInt) :: lattice_dict
type(DictIntInt) :: surface_dict
type(DictIntInt) :: material_dict
type(DictIntInt) :: mesh_dict
type(DictIntInt) :: tally_dict
! ============================================================================
! CROSS SECTION RELATED VARIABLES
@ -79,9 +79,9 @@ module global
integer :: n_listings ! Number of listings in cross_sections.xml
! Dictionaries to look up cross sections and listings
type(DictionaryCI), pointer :: nuclide_dict => null()
type(DictionaryCI), pointer :: sab_dict => null()
type(DictionaryCI), pointer :: xs_listing_dict => null()
type(DictCharInt) :: nuclide_dict
type(DictCharInt) :: sab_dict
type(DictCharInt) :: xs_listing_dict
! Unionized energy grid
integer :: grid_method ! how to treat the energy grid
@ -148,10 +148,10 @@ module global
!=============================================================================
! ACTIVE TALLY-RELATED VARIABLES
type(ListInt), pointer :: active_analog_tallies => null()
type(ListInt), pointer :: active_tracklength_tallies => null()
type(ListInt), pointer :: active_current_tallies => null()
type(ListInt), pointer :: active_tallies => null()
type(ListInt) :: active_analog_tallies
type(ListInt) :: active_tracklength_tallies
type(ListInt) :: active_current_tallies
type(ListInt) :: active_tallies
! ============================================================================
! EIGENVALUE SIMULATION VARIABLES
@ -417,10 +417,10 @@ contains
call deallocate_cmfd(cmfd)
! Deallocate tally node lists
call list_delete(active_analog_tallies)
call list_delete(active_tracklength_tallies)
call list_delete(active_current_tallies)
call list_delete(active_tallies)
call active_analog_tallies % clear()
call active_tracklength_tallies % clear()
call active_current_tallies % clear()
call active_tallies % clear()
end subroutine free_memory

96
src/initialize.F90
View file

@ -3,9 +3,7 @@ module initialize
use ace, only: read_xs
use bank_header, only: Bank
use constants
use datatypes, only: dict_create, dict_get_key, dict_has_key, &
dict_keys
use datatypes_header, only: ListKeyValueII, DictionaryII
use dict_header, only: DictIntInt, ElemKeyValueII
use energy_grid, only: unionized_grid
use error, only: fatal_error
use geometry, only: neighbor_lists
@ -68,9 +66,6 @@ contains
call header("INITIALIZATION", level=1)
end if
! set up dictionaries
call create_dictionaries()
! Read XML input files
call read_input_xml()
@ -344,31 +339,6 @@ contains
end subroutine read_command_line
!===============================================================================
! CREATE_DICTIONARIES initializes the various dictionary variables. It would be
! nice to avoid this and just have a check at the beginning of
! dictionary_add_key.
!===============================================================================
subroutine create_dictionaries()
! Create all global dictionaries
call dict_create(cell_dict)
call dict_create(universe_dict)
call dict_create(lattice_dict)
call dict_create(surface_dict)
call dict_create(material_dict)
call dict_create(mesh_dict)
call dict_create(tally_dict)
call dict_create(xs_listing_dict)
call dict_create(nuclide_dict)
call dict_create(sab_dict)
! Create special dictionary used in input_xml
call dict_create(cells_in_univ_dict)
end subroutine create_dictionaries
!===============================================================================
! PREPARE_UNIVERSES allocates the universes array and determines the cells array
! for each universe.
@ -381,7 +351,7 @@ contains
integer :: n_cells_in_univ ! number of cells in a universe
integer, allocatable :: index_cell_in_univ(:) ! the index in the univ%cells
! array for each universe
type(ListKeyValueII), pointer :: key_list => null()
type(ElemKeyValueII), pointer :: pair_list => null()
type(Universe), pointer :: univ => null()
type(Cell), pointer :: c => null()
@ -392,25 +362,25 @@ contains
! pairs are the id of the universe and the index in the array. In
! cells_in_univ_dict, it's the id of the universe and the number of cells.
key_list => dict_keys(universe_dict)
do while (associated(key_list))
pair_list => universe_dict % keys()
do while (associated(pair_list))
! find index of universe in universes array
i_univ = key_list % data % value
i_univ = pair_list % value
univ => universes(i_univ)
univ % id = key_list % data % key
univ % id = pair_list % key
! check for lowest level universe
if (univ % id == 0) BASE_UNIVERSE = i_univ
! find cell count for this universe
n_cells_in_univ = dict_get_key(cells_in_univ_dict, univ % id)
n_cells_in_univ = cells_in_univ_dict % get_key(univ % id)
! allocate cell list for universe
allocate(univ % cells(n_cells_in_univ))
univ % n_cells = n_cells_in_univ
! move to next universe
key_list => key_list % next
pair_list => pair_list % next
end do
! Also allocate a list for keeping track of where cells have been assigned
@ -423,7 +393,7 @@ contains
c => cells(i)
! get pointer to corresponding universe
i_univ = dict_get_key(universe_dict, c % universe)
i_univ = universe_dict % get_key(c % universe)
univ => universes(i_univ)
! increment the index for the cells array within the Universe object and
@ -461,8 +431,8 @@ contains
do j = 1, c % n_surfaces
id = c % surfaces(j)
if (id < OP_DIFFERENCE) then
if (dict_has_key(surface_dict, abs(id))) then
i_array = dict_get_key(surface_dict, abs(id))
if (surface_dict % has_key(abs(id))) then
i_array = surface_dict % get_key(abs(id))
c % surfaces(j) = sign(i_array, id)
else
message = "Could not find surface " // trim(to_str(abs(id))) // &
@ -476,8 +446,8 @@ contains
! ADJUST UNIVERSE INDEX FOR EACH CELL
id = c % universe
if (dict_has_key(universe_dict, id)) then
c % universe = dict_get_key(universe_dict, id)
if (universe_dict % has_key(id)) then
c % universe = universe_dict % get_key(id)
else
message = "Could not find universe " // trim(to_str(id)) // &
" specified on cell " // trim(to_str(c % id))
@ -491,9 +461,9 @@ contains
if (id == MATERIAL_VOID) then
c % type = CELL_NORMAL
elseif (id /= 0) then
if (dict_has_key(material_dict, id)) then
if (material_dict % has_key(id)) then
c % type = CELL_NORMAL
c % material = dict_get_key(material_dict, id)
c % material = material_dict % get_key(id)
else
message = "Could not find material " // trim(to_str(id)) // &
" specified on cell " // trim(to_str(c % id))
@ -501,12 +471,12 @@ contains
end if
else
id = c % fill
if (dict_has_key(universe_dict, id)) then
if (universe_dict % has_key(id)) then
c % type = CELL_FILL
c % fill = dict_get_key(universe_dict, id)
elseif (dict_has_key(lattice_dict, id)) then
c % fill = universe_dict % get_key(id)
elseif (lattice_dict % has_key(id)) then
c % type = CELL_LATTICE
c % fill = dict_get_key(lattice_dict, id)
c % fill = lattice_dict % get_key(id)
else
message = "Specified fill " // trim(to_str(id)) // " on cell " // &
trim(to_str(c % id)) // " is neither a universe nor a lattice."
@ -523,8 +493,8 @@ contains
do j = 1, l % n_x
do k = 1, l % n_y
id = l % element(j,k)
if (dict_has_key(universe_dict, id)) then
l % element(j,k) = dict_get_key(universe_dict, id)
if (universe_dict % has_key(id)) then
l % element(j,k) = universe_dict % get_key(id)
else
message = "Invalid universe number " // trim(to_str(id)) &
// " specified on lattice " // trim(to_str(l % id))
@ -547,8 +517,8 @@ contains
do k = 1, t % filters(j) % n_bins
id = t % filters(j) % int_bins(k)
if (dict_has_key(cell_dict, id)) then
t % filters(j) % int_bins(k) = dict_get_key(cell_dict, id)
if (cell_dict % has_key(id)) then
t % filters(j) % int_bins(k) = cell_dict % get_key(id)
else
message = "Could not find cell " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
@ -560,8 +530,8 @@ contains
do k = 1, t % filters(j) % n_bins
id = t % filters(j) % int_bins(k)
if (dict_has_key(surface_dict, id)) then
t % filters(j) % int_bins(k) = dict_get_key(surface_dict, id)
if (surface_dict % has_key(id)) then
t % filters(j) % int_bins(k) = surface_dict % get_key(id)
else
message = "Could not find surface " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
@ -573,8 +543,8 @@ contains
do k = 1, t % filters(j) % n_bins
id = t % filters(j) % int_bins(k)
if (dict_has_key(universe_dict, id)) then
t % filters(j) % int_bins(k) = dict_get_key(universe_dict, id)
if (universe_dict % has_key(id)) then
t % filters(j) % int_bins(k) = universe_dict % get_key(id)
else
message = "Could not find universe " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
@ -586,8 +556,8 @@ contains
do k = 1, t % filters(j) % n_bins
id = t % filters(j) % int_bins(k)
if (dict_has_key(material_dict, id)) then
t % filters(j) % int_bins(k) = dict_get_key(material_dict, id)
if (material_dict % has_key(id)) then
t % filters(j) % int_bins(k) = material_dict % get_key(id)
else
message = "Could not find material " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
@ -598,8 +568,8 @@ contains
case (FILTER_MESH)
id = t % filters(j) % int_bins(1)
if (dict_has_key(mesh_dict, id)) then
t % filters(j) % int_bins(1) = dict_get_key(mesh_dict, id)
if (mesh_dict % has_key(id)) then
t % filters(j) % int_bins(1) = mesh_dict % get_key(id)
else
message = "Could not find mesh " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
@ -641,7 +611,7 @@ contains
sum_percent = ZERO
do j = 1, mat % n_nuclides
! determine atomic weight ratio
index_list = dict_get_key(xs_listing_dict, mat % names(j))
index_list = xs_listing_dict % get_key(mat % names(j))
awr = xs_listings(index_list) % awr
! if given weight percent, convert all values so that they are divided
@ -663,7 +633,7 @@ contains
if (.not. density_in_atom) then
sum_percent = ZERO
do j = 1, mat % n_nuclides
index_list = dict_get_key(xs_listing_dict, mat % names(j))
index_list = xs_listing_dict % get_key(mat % names(j))
awr = xs_listings(index_list) % awr
x = mat % atom_density(j)
sum_percent = sum_percent + x*awr

82
src/input_xml.F90
View file

@ -2,9 +2,7 @@ module input_xml
use cmfd_input, only: configure_cmfd
use constants
use datatypes, only: dict_add_key, dict_has_key, dict_get_key, &
dict_keys
use datatypes_header, only: ListKeyValueCI
use dict_header, only: DictIntInt, ElemKeyValueCI
use error, only: fatal_error, warning
use geometry_header, only: Cell, Surface, Lattice
use global
@ -18,8 +16,8 @@ module input_xml
implicit none
type(DictionaryII), pointer :: & ! used to count how many cells each
cells_in_univ_dict => null() ! universe contains
type(DictIntInt) :: cells_in_univ_dict ! used to count how many cells each
! universe contains
contains
@ -729,20 +727,20 @@ contains
end if
! Add cell to dictionary
call dict_add_key(cell_dict, c % id, i)
call cell_dict % add_key(c % id, i)
! For cells, we also need to check if there's a new universe --
! also for every cell add 1 to the count of cells for the
! specified universe
universe_num = cell_(i) % universe
if (.not. dict_has_key(cells_in_univ_dict, universe_num)) then
if (.not. cells_in_univ_dict % has_key(universe_num)) then
n_universes = n_universes + 1
n_cells_in_univ = 1
call dict_add_key(universe_dict, universe_num, n_universes)
call universe_dict % add_key(universe_num, n_universes)
else
n_cells_in_univ = 1 + dict_get_key(cells_in_univ_dict, universe_num)
n_cells_in_univ = 1 + cells_in_univ_dict % get_key(universe_num)
end if
call dict_add_key(cells_in_univ_dict, universe_num, n_cells_in_univ)
call cells_in_univ_dict % add_key(universe_num, n_cells_in_univ)
end do
@ -861,7 +859,7 @@ contains
end select
! Add surface to dictionary
call dict_add_key(surface_dict, s % id, i)
call surface_dict % add_key(s % id, i)
end do
@ -929,7 +927,7 @@ contains
end do
! Add lattice to dictionary
call dict_add_key(lattice_dict, l % id, i)
call lattice_dict % add_key(l % id, i)
end do
@ -1081,7 +1079,7 @@ contains
mat % names(j) = name
! Check that this nuclide is listed in the cross_sections.xml file
if (.not. dict_has_key(xs_listing_dict, name)) then
if (.not. xs_listing_dict % has_key(name)) then
message = "Could not find nuclide " // trim(name) // &
" in cross_sections.xml file!"
call fatal_error()
@ -1096,20 +1094,20 @@ contains
end if
! Find xs_listing and set the name/alias according to the listing
index_list = dict_get_key(xs_listing_dict, name)
index_list = xs_listing_dict % get_key(name)
name = xs_listings(index_list) % name
alias = xs_listings(index_list) % alias
! If this nuclide hasn't been encountered yet, we need to add its name
! and alias to the nuclide_dict
if (.not. dict_has_key(nuclide_dict, name)) then
if (.not. nuclide_dict % has_key(name)) then
index_nuclide = index_nuclide + 1
mat % nuclide(j) = index_nuclide
call dict_add_key(nuclide_dict, name, index_nuclide)
call dict_add_key(nuclide_dict, alias, index_nuclide)
call nuclide_dict % add_key(name, index_nuclide)
call nuclide_dict % add_key(alias, index_nuclide)
else
mat % nuclide(j) = dict_get_key(nuclide_dict, name)
mat % nuclide(j) = nuclide_dict % get_key(name)
end if
! Check if no atom/weight percents were specified or if both atom and
@ -1156,7 +1154,7 @@ contains
mat % sab_name = name
! Check that this nuclide is listed in the cross_sections.xml file
if (.not. dict_has_key(xs_listing_dict, name)) then
if (.not. xs_listing_dict % has_key(name)) then
message = "Could not find S(a,b) table " // trim(name) // &
" in cross_sections.xml file!"
call fatal_error()
@ -1165,20 +1163,20 @@ contains
! Find index in xs_listing and set the name and alias according to the
! listing
index_list = dict_get_key(xs_listing_dict, name)
index_list = xs_listing_dict % get_key(name)
name = xs_listings(index_list) % name
alias = xs_listings(index_list) % alias
! If this S(a,b) table hasn't been encountered yet, we need to add its
! name and alias to the sab_dict
if (.not. dict_has_key(sab_dict, name)) then
if (.not. sab_dict % has_key(name)) then
index_sab = index_sab + 1
mat % sab_table = index_sab
call dict_add_key(sab_dict, name, index_sab)
call dict_add_key(sab_dict, alias, index_sab)
call sab_dict % add_key(name, index_sab)
call sab_dict % add_key(alias, index_sab)
else
mat % sab_table = dict_get_key(sab_dict, name)
mat % sab_table = sab_dict % get_key(name)
end if
elseif (size(material_(i) % sab) > 1) then
@ -1187,7 +1185,7 @@ contains
end if
! Add material to dictionary
call dict_add_key(material_dict, mat % id, i)
call material_dict % add_key(mat % id, i)
end do
! Set total number of nuclides and S(a,b) tables
@ -1226,7 +1224,7 @@ contains
character(MAX_LINE_LEN) :: filename
character(MAX_WORD_LEN) :: word
character(MAX_WORD_LEN) :: score_name
type(ListKeyValueCI), pointer :: key_list => null()
type(ElemKeyValueCI), pointer :: pair_list => null()
type(TallyObject), pointer :: t => null()
type(StructuredMesh), pointer :: m => null()
type(TallyFilter), allocatable :: filters(:) ! temporary filters
@ -1395,7 +1393,7 @@ contains
m % volume_frac = ONE/real(product(m % dimension),8)
! Add mesh to dictionary
call dict_add_key(mesh_dict, m % id, i)
call mesh_dict % add_key(m % id, i)
end do
! ==========================================================================
@ -1536,8 +1534,8 @@ contains
id = int(str_to_int(tally_(i) % filter(j) % bins(1)),4)
! Get pointer to mesh
if (dict_has_key(mesh_dict, id)) then
i_mesh = dict_get_key(mesh_dict, id)
if (mesh_dict % has_key(id)) then
i_mesh = mesh_dict % get_key(id)
m => meshes(i_mesh)
else
message = "Could not find mesh " // trim(to_str(id)) // &
@ -1639,26 +1637,26 @@ contains
else
if (default_xs == '') then
! No default cross section specified, search through nuclides
key_list => dict_keys(nuclide_dict)
do while (associated(key_list))
if (starts_with(key_list % data % key, &
pair_list => nuclide_dict % keys()
do while (associated(pair_list))
if (starts_with(pair_list % key, &
tally_(i) % nuclides(j))) then
word = key_list % data % key
word = pair_list % key
exit
end if
! Advance to next
key_list => key_list % next
pair_list => pair_list % next
end do
! Check if no nuclide was found
if (.not. associated(key_list)) then
if (.not. associated(pair_list)) then
message = "Could not find the nuclide " // trim(&
tally_(i) % nuclides(j)) // " specified in tally " &
// trim(to_str(t % id)) // " in any material."
call fatal_error()
end if
deallocate(key_list)
deallocate(pair_list)
else
! Set nuclide to default xs
word = trim(tally_(i) % nuclides(j)) // "." // default_xs
@ -1666,14 +1664,14 @@ contains
end if
! Check to make sure nuclide specified is in problem
if (.not. dict_has_key(nuclide_dict, word)) then
if (.not. nuclide_dict % has_key(word)) then
message = "The nuclide " // trim(word) // " from tally " // &
trim(to_str(t % id)) // " is not present in any material."
call fatal_error()
end if
! Set bin to index in nuclides array
t % nuclide_bins(j) = dict_get_key(nuclide_dict, word)
t % nuclide_bins(j) = nuclide_dict % get_key(word)
end do
! Set number of nuclide bins
@ -2178,7 +2176,7 @@ contains
if (pl % color_by == PLOT_COLOR_CELLS) then
if (dict_has_key(cell_dict, col_id)) then
if (cell_dict % has_key(col_id)) then
pl % colors(col_id) % rgb = plot_(i) % col_spec_(j) % rgb
else
message = "Could not find cell " // trim(to_str(col_id)) // &
@ -2188,7 +2186,7 @@ contains
else if (pl % color_by == PLOT_COLOR_MATS) then
if (dict_has_key(material_dict, col_id)) then
if (material_dict % has_key(col_id)) then
pl % colors(col_id) % rgb = plot_(i) % col_spec_(j) % rgb
else
message = "Could not find material " // trim(to_str(col_id)) // &
@ -2334,8 +2332,8 @@ contains
end if
! create dictionary entry for both name and alias
call dict_add_key(xs_listing_dict, listing % name, i)
call dict_add_key(xs_listing_dict, listing % alias, i)
call xs_listing_dict % add_key(listing % name, i)
call xs_listing_dict % add_key(listing % alias, i)
end do
end subroutine read_cross_sections_xml

3
src/output.F90
View file

@ -4,7 +4,6 @@ module output
use ace_header, only: Nuclide, Reaction, UrrData
use constants
use datatypes, only: dict_get_key
use endf, only: reaction_name
use geometry_header, only: Cell, Universe, Surface, BASE_UNIVERSE
use global
@ -346,7 +345,7 @@ contains
write(unit_,*) 'Cell ' // to_str(c % id)
! Find index in cells array and write
index_cell = dict_get_key(cell_dict, c % id)
index_cell = cell_dict % get_key(c % id)
write(unit_,*) ' Array Index = ' // to_str(index_cell)
! Write what universe this cell is in

8
src/physics.F90
View file

@ -100,7 +100,7 @@ contains
end do
! Score track-length tallies
if (associated(active_tracklength_tallies)) &
if (active_tracklength_tallies % size() > 0) &
call score_tracklength_tally(distance)
! Score track-length estimate of k-eff
@ -193,8 +193,7 @@ contains
! since the direction of the particle will change and we need to use the
! pre-collision direction to figure out what mesh surfaces were crossed
if (associated(active_current_tallies)) &
call score_surface_current()
if (active_current_tallies % size() > 0) call score_surface_current()
! Sample nuclide/reaction for the material the particle is in
call sample_reaction()
@ -218,8 +217,7 @@ contains
! occurred rather than before because we need information on the outgoing
! energy for any tallies with an outgoing energy filter
if (associated(active_analog_tallies)) &
call score_analog_tally()
if (active_analog_tallies % size() > 0) call score_analog_tally()
! Reset banked weight during collision
p % n_bank = 0

304
src/tally.F90
View file

@ -2,7 +2,6 @@ module tally
use ace_header, only: Reaction
use constants
use datatypes_header, only: ListInt
use error, only: fatal_error
use global
use math, only: t_percentile, calc_pn
@ -35,6 +34,8 @@ contains
subroutine score_analog_tally()
integer :: i
integer :: i_tally
integer :: j ! loop index for scoring bins
integer :: k ! loop index for nuclide bins
integer :: n ! loop index for scattering order
@ -52,31 +53,25 @@ contains
real(8) :: macro_scatt ! material macro scatt xs
logical :: found_bin ! scoring bin found?
type(TallyObject), pointer :: t => null()
type(ListInt), pointer :: curr_ptr => null()
! Copy particle's pre- and post-collision weight and angle
last_wgt = p % last_wgt
wgt = p % wgt
mu = p % mu
! set current pointer to active analog tallies
curr_ptr => active_analog_tallies
! A loop over all tallies is necessary because we need to simultaneously
! determine different filter bins for the same tally in order to score to it
TALLY_LOOP: do while (associated(curr_ptr))
t => tallies(analog_tallies(curr_ptr % data))
TALLY_LOOP: do i = 1, active_analog_tallies % size()
! Get index of tally and pointer to tally
i_tally = active_analog_tallies % get_item(i)
t => tallies(analog_tallies(i_tally))
! =======================================================================
! DETERMINE SCORING BIN COMBINATION
call get_scoring_bins(analog_tallies(curr_ptr % data), found_bin)
if (.not. found_bin) then
curr_ptr => curr_ptr % next
cycle
end if
call get_scoring_bins(analog_tallies(i_tally), found_bin)
if (.not. found_bin) cycle
! =======================================================================
! CALCULATE RESULTS AND ACCUMULATE TALLY
@ -370,16 +365,11 @@ contains
if (assume_separate) exit TALLY_LOOP
! select next active tally
curr_ptr => curr_ptr % next
end do TALLY_LOOP
! Reset tally map positioning
position = 0
nullify(curr_ptr)
end subroutine score_analog_tally
!===============================================================================
@ -446,6 +436,8 @@ contains
real(8), intent(in) :: distance
integer :: i
integer :: i_tally
integer :: j ! loop index for scoring bins
integer :: k ! loop index for nuclide bins
integer :: l ! loop index for nuclides in material
@ -462,39 +454,33 @@ contains
real(8) :: atom_density ! atom density of single nuclide in atom/b-cm
logical :: found_bin ! scoring bin found?
type(TallyObject), pointer :: t => null()
type(Material), pointer :: mat => null()
type(ListInt), pointer :: curr_ptr => null()
type(Reaction), pointer :: rxn => null()
type(Material), pointer :: mat => null()
type(Reaction), pointer :: rxn => null()
! Determine track-length estimate of flux
flux = p % wgt * distance
! set current pointer to active tracklength tallies
curr_ptr => active_tracklength_tallies
! A loop over all tallies is necessary because we need to simultaneously
! determine different filter bins for the same tally in order to score to it
TALLY_LOOP: do while (associated(curr_ptr))
t => tallies(tracklength_tallies(curr_ptr % data))
TALLY_LOOP: do i = 1, active_tracklength_tallies % size()
! Get index of tally and pointer to tally
i_tally = active_tracklength_tallies % get_item(i)
t => tallies(tracklength_tallies(i_tally))
! Check if this tally has a mesh filter -- if so, we treat it separately
! since multiple bins can be scored to with a single track
if (t % find_filter(FILTER_MESH) > 0) then
call score_tl_on_mesh(tracklength_tallies(curr_ptr % data), distance)
curr_ptr => curr_ptr % next ! select next tally
call score_tl_on_mesh(tracklength_tallies(i_tally), distance)
cycle
end if
! =======================================================================
! DETERMINE SCORING BIN COMBINATION
call get_scoring_bins(tracklength_tallies(curr_ptr % data), found_bin)
if (.not. found_bin) then
curr_ptr => curr_ptr % next
cycle
end if
call get_scoring_bins(tracklength_tallies(i_tally), found_bin)
if (.not. found_bin) cycle
! =======================================================================
! CALCULATE RESULTS AND ACCUMULATE TALLY
@ -507,7 +493,7 @@ contains
filter_index = sum((t % matching_bins - 1) * t % stride) + 1
if (t % all_nuclides) then
call score_all_nuclides(tracklength_tallies(curr_ptr % data), flux, &
call score_all_nuclides(tracklength_tallies(i_tally), flux, &
filter_index)
else
@ -728,16 +714,11 @@ contains
if (assume_separate) exit TALLY_LOOP
! select next active tally
curr_ptr => curr_ptr % next
end do TALLY_LOOP
! Reset tally map positioning
position = 0
nullify(curr_ptr)
end subroutine score_tracklength_tally
!===============================================================================
@ -1387,6 +1368,8 @@ contains
subroutine score_surface_current()
integer :: i
integer :: i_tally
integer :: j ! loop indices
integer :: k ! loop indices
integer :: ijk0(3) ! indices of starting coordinates
@ -1409,18 +1392,15 @@ contains
logical :: z_same ! same starting/ending z index (k)
type(TallyObject), pointer :: t => null()
type(StructuredMesh), pointer :: m => null()
type(ListInt), pointer :: curr_ptr => null()
! set current pointer to active current tallies
curr_ptr => active_current_tallies
TALLY_LOOP: do while (associated(curr_ptr))
TALLY_LOOP: do i = 1, active_current_tallies % size()
! Copy starting and ending location of particle
xyz0 = p % last_xyz
xyz1 = p % coord0 % xyz
! Get pointer to tally
t => tallies(current_tallies(curr_ptr % data))
i_tally = active_current_tallies % get_item(i)
t => tallies(current_tallies(i_tally))
! Get index for mesh and surface filters
i_filter_mesh = t % find_filter(FILTER_MESH)
@ -1435,7 +1415,6 @@ contains
! intersects with mesh
if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then
if (.not. mesh_intersects(m, xyz0, xyz1)) then
curr_ptr => curr_ptr % next ! select next tally
cycle
end if
end if
@ -1443,7 +1422,6 @@ contains
! Calculate number of surface crossings
n_cross = sum(abs(ijk1 - ijk0))
if (n_cross == 0) then
curr_ptr => curr_ptr % next ! select next tally
cycle
end if
@ -1457,7 +1435,6 @@ contains
! check if energy of the particle is within energy bins
if (p % E < t % filters(j) % real_bins(1) .or. &
p % E > t % filters(j) % real_bins(n + 1)) then
curr_ptr => curr_ptr % next ! select next tally
cycle
end if
@ -1500,7 +1477,6 @@ contains
end if
end do
end if
curr_ptr => curr_ptr % next ! select next tally
cycle
elseif (x_same .and. z_same) then
! Only y crossings
@ -1529,7 +1505,6 @@ contains
end if
end do
end if
curr_ptr => curr_ptr % next ! select next tally
cycle
elseif (y_same .and. z_same) then
! Only x crossings
@ -1558,7 +1533,6 @@ contains
end if
end do
end if
curr_ptr => curr_ptr % next ! select next tally
cycle
end if
@ -1686,13 +1660,8 @@ contains
xyz0 = xyz0 + distance * uvw
end do
! select next active tally
curr_ptr => curr_ptr % next
end do TALLY_LOOP
nullify(curr_ptr)
end subroutine score_surface_current
!===============================================================================
@ -1757,7 +1726,7 @@ contains
subroutine synchronize_tallies()
type(ListInt), pointer :: curr_ptr => null()
integer :: i
#ifdef MPI
! Combine tally results onto master process
@ -1774,10 +1743,8 @@ contains
! Accumulate on master only unless run is not reduced then do it on all
if (master .or. (.not. reduce_tallies)) then
! Accumulate results for each tally
curr_ptr => active_tallies
do while(associated(curr_ptr))
call accumulate_tally(tallies(curr_ptr % data))
curr_ptr => curr_ptr % next
do i = 1, active_tallies % size()
call accumulate_tally(tallies(active_tallies % get_item(i)))
end do
if (run_mode == MODE_EIGENVALUE) then
@ -1792,8 +1759,6 @@ contains
call accumulate_result(global_tallies)
end if
if (associated(curr_ptr)) nullify(curr_ptr)
end subroutine synchronize_tallies
!===============================================================================
@ -1803,6 +1768,7 @@ contains
#ifdef MPI
subroutine reduce_tally_results()
integer :: i
integer :: n ! number of filter bins
integer :: m ! number of score bins
integer :: n_bins ! total number of bins
@ -1810,11 +1776,9 @@ contains
real(8) :: global_temp(N_GLOBAL_TALLIES)
real(8) :: dummy ! temporary receive buffer for non-root reduces
type(TallyObject), pointer :: t => null()
type(ListInt), pointer :: curr_ptr => null()
curr_ptr => active_tallies
do while(associated(curr_ptr))
t => tallies(curr_ptr % data)
do i = 1, active_tallies % size()
t => tallies(active_tallies % get_item(i))
m = t % total_score_bins
n = t % total_filter_bins
@ -1842,7 +1806,6 @@ contains
end if
deallocate(tally_temp)
curr_ptr => curr_ptr % next
end do
! Copy global tallies into array to be reduced
@ -1874,8 +1837,6 @@ contains
0, MPI_COMM_WORLD, mpi_err)
end if
if (associated(curr_ptr)) nullify(curr_ptr)
end subroutine reduce_tally_results
#endif
@ -1987,125 +1948,26 @@ contains
subroutine setup_active_usertallies()
integer :: i ! loop counter
type(ListInt), pointer :: curr_ptr ! pointer to current list node
type(ListInt), pointer :: tall_ptr ! pointer to active tallies only
!============================================================
! TALLIES
! traverse to end of tally list
tall_ptr => active_tallies
do while(associated(tall_ptr))
tall_ptr => tall_ptr % next
end do
!============================================================
! ANALOG TALLIES
! check to see if analog tallies have already been allocated
curr_ptr => null()
if (associated(active_analog_tallies)) then
! traverse to the end of the linked list
curr_ptr => active_analog_tallies
do while(associated(curr_ptr))
curr_ptr => curr_ptr % next
end do
end if
integer :: i ! loop counter
! append all analog tallies
do i = n_user_analog_tallies,1,-1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_analog_tallies
active_analog_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = analog_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = 1, n_user_analog_tallies
call active_analog_tallies % append(i)
call active_tallies % append(analog_tallies(i))
end do
!============================================================
! TRACKLENGTH TALLIES
! check to see if tracklength tallies have already been allocated
curr_ptr => null()
if (associated(active_tracklength_tallies)) then
! traverse to the end of the linked list
curr_ptr => active_tracklength_tallies
do while(associated(curr_ptr))
curr_ptr => curr_ptr % next
end do
end if
! append all tracklength tallies
do i = n_user_tracklength_tallies,1,-1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_tracklength_tallies
active_tracklength_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = tracklength_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = 1, n_user_tracklength_tallies
call active_tracklength_tallies % append(i)
call active_tallies % append(tracklength_tallies(i))
end do
!============================================================
! CURRENT TALLIES
! check to see if current tallies have already been allocated
curr_ptr => null()
if (associated(active_current_tallies)) then
! traverse to the end of the linked list
curr_ptr => active_current_tallies
do while(associated(curr_ptr))
curr_ptr => curr_ptr % next
end do
end if
! append all current tallies
do i = n_user_current_tallies,1,-1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_current_tallies
active_current_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = current_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = 1, n_user_current_tallies
call active_current_tallies % append(i)
call active_tallies % append(current_tallies(i))
end do
! nullify the temporary pointer
if (associated(curr_ptr)) nullify(curr_ptr)
end subroutine setup_active_usertallies
!===============================================================================
@ -2114,91 +1976,49 @@ contains
subroutine setup_active_cmfdtallies()
integer :: i ! loop counter
type(ListInt), pointer :: curr_ptr ! pointer to current list node
type(ListInt), pointer :: tall_ptr ! pointer to active tallies only
integer :: i ! loop counter
! check to see if actives tallies has been allocated
tall_ptr => active_tallies
if (associated(active_tallies)) then
message = 'Active tallies should not exist before CMFD tallies!'
if (active_tallies % size() > 0) then
message = "Active tallies should not exist before CMFD tallies!"
call fatal_error()
end if
! check to see if analog tallies have already been allocated
curr_ptr => null()
if (associated(active_analog_tallies)) then
if (active_analog_tallies % size() > 0) then
message = 'Active analog tallies should not exist before CMFD tallies!'
call fatal_error()
end if
do i = n_cmfd_analog_tallies + n_user_analog_tallies, n_user_analog_tallies + 1, -1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_analog_tallies
active_analog_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = analog_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = n_user_analog_tallies + 1, &
n_user_analog_tallies + n_cmfd_analog_tallies
call active_analog_tallies % append(i)
call active_tallies % append(analog_tallies(i))
end do
! check to see if tracklength tallies have already been allocated
curr_ptr => null()
if (associated(active_tracklength_tallies)) then
message = 'Active tracklength tallies should not exist before CMFD tallies!'
if (active_tracklength_tallies % size() > 0) then
message = "Active tracklength tallies should not exist before CMFD &
&tallies!"
call fatal_error()
end if
do i = n_cmfd_tracklength_tallies + n_user_tracklength_tallies, n_user_tracklength_tallies + 1, -1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_tracklength_tallies
active_tracklength_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = tracklength_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = n_user_tracklength_tallies + 1, &
n_user_tracklength_tallies + n_cmfd_tracklength_tallies
call active_tracklength_tallies % append(i)
call active_tallies % append(tracklength_tallies(i))
end do
! check to see if current tallies have already been allocated
curr_ptr => null()
if (associated(active_current_tallies)) then
message = 'Active current tallies should not exist before CMFD tallies!'
if (active_current_tallies % size() > 0) then
message = "Active current tallies should not exist before CMFD tallies!"
call fatal_error()
end if
do i = n_cmfd_current_tallies + n_user_current_tallies, &
n_user_current_tallies + 1, -1
! allocate node
allocate(curr_ptr)
! set the tally index
curr_ptr % data = i
curr_ptr % next => active_current_tallies
active_current_tallies => curr_ptr
! set indices in active tallies
allocate(tall_ptr)
tall_ptr % data = current_tallies(i)
tall_ptr % next => active_tallies
active_tallies => tall_ptr
do i = n_user_current_tallies + 1, &
n_user_current_tallies + n_cmfd_current_tallies
call active_current_tallies % append(i)
call active_tallies % append(current_tallies(i))
end do
end subroutine setup_active_cmfdtallies