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

Merge pull request #921 from amandalund/new_dict

Browse source 
Dictionary rewrite
This commit is contained in:
Paul Romano 2017-10-11 14:07:38 -05:00 • committed by GitHub
commit 49b5322314
22 changed files with 658 additions and 544 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/cmfd_input.F90
View file

@ -369,7 +369,7 @@ contains
m % volume_frac = ONE/real(product(m % dimension),8)
! Add mesh to dictionary
call mesh_dict % add_key(m % id, i_start)
call mesh_dict % set(m % id, i_start)
! Determine number of filters
energy_filters = check_for_node(node_mesh, "energy")
@ -432,7 +432,7 @@ contains
end if
filt % current = .true.
! Add filter to dictionary
call filter_dict % add_key(filt % id, i_filt)
call filter_dict % set(filt % id, i_filt)
end select
! Initialize filters

767
src/dict_header.F90
View file

@ -7,438 +7,535 @@ module dict_header
! pairs. This data structure is used to provide lookup features, e.g. cells and
! surfaces by name.
!
! The original version was roughly based on capabilities in the 'flibs' open
! source package. However, it was rewritten from scratch so that it could be
! used stand-alone without relying on the implementation of lists. As with
! lists, it was considered writing a single dictionary used unlimited
! polymorphism, but again compiler support is spotty and doesn't always prevent
! duplication of code.
! The implementation is based on Algorithm D from Knuth Vol. 3 Sec. 6.4 (open
! addressing with double hashing). Hash table sizes M are chosen such that M
! and M - 2 are twin primes, which helps reduce clustering. The sequence of
! twin primes used for the table sizes comes from
! https://github.com/anholt/hash_table/blob/master/hash_table.c. These values
! were selected so that the table would grow by approximately a factor of two
! each time the maximum load factor is exceeded. An upper limit is placed on
! the load factor to prevent exponential performance degradation as the number
! of entries approaches the number of buckets.
!===============================================================================
implicit none
integer, parameter, private :: HASH_SIZE = 4993
integer, parameter, private :: HASH_MULTIPLIER = 31
integer, parameter, private :: DICT_NULL = -huge(0)
integer, parameter :: DICT_KEY_LENGTH = 255
integer, parameter :: EMPTY = -huge(0)
integer, parameter, private :: DELETED = -huge(0) + 1
integer, parameter, private :: KEY_CHAR_LENGTH = 255
integer, parameter, private :: TABLE_SIZES(30) = &
[5, 7, 13, 19, 43, 73, 151, 283, 571, 1153, 2269, 4519, 9013, 18043, &
36109, 72091, 144409, 288361, 576883, 1153459, 2307163, 4613893, &
9227641, 18455029, 36911011, 73819861, 147639589, 295279081, &
590559793, 1181116273]
real(8), parameter, private :: MAX_LOAD_FACTOR = 0.65
!===============================================================================
! ELEMKEYVALUE* contains (key,value) pairs and a pointer to the next (key,value)
! pair
! DICTENTRY* contains (key,value) pairs.
!===============================================================================
type ElemKeyValueCI
type(ElemKeyValueCI), pointer :: next => null()
character(len=DICT_KEY_LENGTH) :: key
integer :: value
end type ElemKeyValueCI
type DictEntryII
integer :: key = EMPTY
integer :: value = EMPTY
end type DictEntryII
type ElemKeyValueII
type(ElemKeyValueII), pointer :: next => null()
integer :: key
integer :: value
end type ElemKeyValueII
type DictEntryCI
character(len=KEY_CHAR_LENGTH) :: key
integer :: value = EMPTY
end type DictEntryCI
!===============================================================================
! HASHLIST* types contain a single pointer to a linked list of (key,value)
! pairs. This type is necesssary so that the Dict types can be dynamically
! allocated.
! BUCKET* contains an allocatable DictEntry object for storing a (key,value)
! pair and the hash value for fast comparisons. Integer (key,value) pairs are
! stored directly in the hash table since their memory requirement is small.
!===============================================================================
type, private :: HashListCI
type(ElemKeyValueCI), pointer :: list => null()
end type HashListCI
type, private :: HashListII
type(ElemKeyValueII), pointer :: list => null()
end type HashListII
type, private :: BucketCI
type(DictEntryCI), allocatable :: entry
integer :: hash = EMPTY
end type BucketCI
!===============================================================================
! DICT* is a dictionary of (key,value) pairs with convenience methods as
! type-bound procedures. DictCharInt has character(*) keys and integer values,
! and DictIntInt has integer keys and values.
! type-bound procedures. DictIntInt has integer keys and values, and
! DictCharInt has character(*) keys and integer values.
!===============================================================================
type, public :: DictCharInt
private
type(HashListCI), pointer :: table(:) => null()
contains
procedure :: add_key => dict_add_key_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
type, public :: DictIntInt
private
type(HashListII), pointer :: table(:) => null()
integer, private :: entries = 0
integer, private :: capacity = 0
type(DictEntryII), allocatable, private :: table(:)
contains
procedure :: add_key => dict_add_key_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
procedure :: set => set_ii
procedure :: get => get_ii
procedure :: has => has_ii
procedure :: remove => remove_ii
procedure :: next_entry => next_entry_ii
procedure :: clear => clear_ii
procedure :: size => size_ii
procedure, private :: get_entry => get_entry_ii
procedure, private :: resize => resize_ii
end type DictIntInt
type, public :: DictCharInt
integer, private :: entries = 0
integer, private :: capacity = 0
type(BucketCI), allocatable, private :: table(:)
contains
procedure :: set => set_ci
procedure :: get => get_ci
procedure :: has => has_ci
procedure :: remove => remove_ci
procedure :: next_entry => next_entry_ci
procedure :: clear => clear_ci
procedure :: size => size_ci
procedure, private :: get_entry => get_entry_ci
procedure, private :: resize => resize_ci
end type DictCharInt
contains
!===============================================================================
! DICT_ADD_KEY adds a (key,value) entry to a dictionary. If the key is already
! in the dictionary, the value is replaced by the new specified value.
! GET_ENTRY returns the index of the (key,value) pair in the table for a given
! key. This method is private.
!===============================================================================
subroutine dict_add_key_ci(this, key, value)
function get_entry_ii(this, key) result(i)
class(DictCharInt) :: this
character(*), intent(in) :: key
integer, intent(in) :: value
class(DictIntInt) :: this
integer, intent(in) :: key
integer :: i
integer :: hash
type(ElemKeyValueCI), pointer :: elem => null()
type(ElemKeyValueCI), pointer :: new_elem => null()
integer :: c
elem => this % get_elem(key)
if (associated(elem)) then
elem % value = value
else
! Get hash
hash = dict_hash_key_ci(key)
! Create new element
allocate(new_elem)
new_elem % key = key
new_elem % value = value
! Add element to front of list
new_elem % next => this % table(hash) % list
this % table(hash) % list => new_elem
if (.not. allocated(this % table)) then
allocate(this % table(TABLE_SIZES(1)))
this % capacity = TABLE_SIZES(1)
end if
end subroutine dict_add_key_ci
hash = hash_ii(key)
i = 1 + mod(hash, this % capacity)
c = 2 + mod(hash, this % capacity - 2)
subroutine dict_add_key_ii(this, key, value)
do
if (this % table(i) % key == key .or. &
this % table(i) % key == EMPTY) exit
class(DictIntInt) :: this
i = 1 + mod(i + c - 1, this % capacity)
end do
end function get_entry_ii
function get_entry_ci(this, key) result(i)
class(DictCharInt) :: this
character(*), intent(in) :: key
integer :: i
integer :: hash
integer :: c
if (.not. allocated(this % table)) then
allocate(this % table(TABLE_SIZES(1)))
this % capacity = TABLE_SIZES(1)
end if
hash = hash_ci(key)
i = 1 + mod(hash, this % capacity)
c = 2 + mod(hash, this % capacity - 2)
do
if (this % table(i) % hash == hash) then
if (allocated(this % table(i) % entry)) then
if (this % table(i) % entry % key == key) exit
end if
end if
if (this % table(i) % hash == EMPTY) exit
i = 1 + mod(i + c - 1, this % capacity)
end do
end function get_entry_ci
!===============================================================================
! RESIZE allocates a new hash table to accomodate the number of entries and
! reinserts all of the entries into the new table. This method is private.
!===============================================================================
subroutine resize_ii(this)
class(DictIntInt) :: this
type(DictEntryII), allocatable :: table(:)
integer :: new_size
integer :: i
do i = 1, size(TABLE_SIZES)
if (TABLE_SIZES(i) > this % capacity) exit
end do
new_size = TABLE_SIZES(i)
call move_alloc(this % table, table)
allocate(this % table(new_size))
this % capacity = new_size
this % entries = 0
! Rehash each entry into the new table
do i = 1, size(table)
if (table(i) % key /= EMPTY .and. table(i) % key /= DELETED) then
call this % set(table(i) % key, table(i) % value)
end if
end do
deallocate(table)
end subroutine resize_ii
subroutine resize_ci(this)
class(DictCharInt) :: this
type(BucketCI), allocatable :: table(:)
integer :: new_size
integer :: i
do i = 1, size(TABLE_SIZES)
if (TABLE_SIZES(i) > this % capacity) exit
end do
new_size = TABLE_SIZES(i)
call move_alloc(this % table, table)
allocate(this % table(new_size))
this % capacity = new_size
this % entries = 0
! Rehash each entry into the new table
do i = 1, size(table)
if (table(i) % hash /= EMPTY .and. table(i) % hash /= DELETED) then
call this % set(table(i) % entry % key, table(i) % entry % value)
end if
end do
deallocate(table)
end subroutine resize_ci
!===============================================================================
! SET adds a (key,value) entry to a dictionary. If the key is already in the
! dictionary, the value is replaced by the new specified value.
!===============================================================================
subroutine set_ii(this, key, value)
class(DictIntInt) :: this
integer, intent(in) :: key
integer, intent(in) :: value
integer :: hash
type(ElemKeyValueII), pointer :: elem => null()
type(ElemKeyValueII), pointer :: new_elem => null()
integer :: i
integer :: c
elem => this % get_elem(key)
if (associated(elem)) then
elem % value = value
else
! Get hash
hash = dict_hash_key_ii(key)
! Create new element
allocate(new_elem)
new_elem % key = key
new_elem % value = value
! Add element to front of list
new_elem % next => this % table(hash) % list
this % table(hash) % list => new_elem
if (.not. allocated(this % table)) then
allocate(this % table(TABLE_SIZES(1)))
this % capacity = TABLE_SIZES(1)
else if (real(this % entries + 1, 8) / this % capacity > MAX_LOAD_FACTOR) then
call this % resize()
end if
end subroutine dict_add_key_ii
hash = hash_ii(key)
i = 1 + mod(hash, this % capacity)
c = 2 + mod(hash, this % capacity - 2)
!===============================================================================
! DICT_GET_ELEM returns a pointer to the (key,value) pair for a given key. This
! method is private.
!===============================================================================
do
if (this % table(i) % key == EMPTY .or. &
this % table(i) % key == DELETED) then
this % table(i) % key = key
this % table(i) % value = value
this % entries = this % entries + 1
exit
else if (this % table(i) % key == key) then
this % table(i) % value = value
exit
end if
function dict_get_elem_ci(this, key) result(elem)
class(DictCharInt) :: this
character(*), intent(in) :: key
type(ElemKeyValueCI), pointer :: elem
integer :: hash
! Check for dictionary not being allocated
if (.not. associated(this % table)) then
allocate(this % table(HASH_SIZE))
end if
hash = dict_hash_key_ci(key)
elem => this % table(hash) % list
do while (associated(elem))
if (elem % key == key) exit
elem => elem % next
i = 1 + mod(i + c - 1, this % capacity)
end do
end function dict_get_elem_ci
end subroutine set_ii
function dict_get_elem_ii(this, key) result(elem)
subroutine set_ci(this, key, value)
class(DictIntInt) :: this
integer, intent(in) :: key
type(ElemKeyValueII), pointer :: elem
integer :: hash
! Check for dictionary not being allocated
if (.not. associated(this % table)) then
allocate(this % table(HASH_SIZE))
end if
hash = dict_hash_key_ii(key)
elem => this % table(hash) % list
do while (associated(elem))
if (elem % key == key) exit
elem => elem % next
end do
end function dict_get_elem_ii
!===============================================================================
! DICT_GET_KEY returns the value matching a given key. If the dictionary does
! not contain the key, the value DICT_NULL is returned.
!===============================================================================
function dict_get_key_ci(this, key) result(value)
class(DictCharInt) :: this
class(DictCharInt) :: this
character(*), intent(in) :: key
integer :: value
integer, intent(in) :: value
type(ElemKeyValueCI), pointer :: elem
integer :: hash
integer :: i
integer :: c
elem => this % get_elem(key)
if (associated(elem)) then
value = elem % value
else
value = DICT_NULL
if (.not. allocated(this % table)) then
allocate(this % table(TABLE_SIZES(1)))
this % capacity = TABLE_SIZES(1)
else if (real(this % entries + 1, 8) / this % capacity > MAX_LOAD_FACTOR) then
call this % resize()
end if
end function dict_get_key_ci
hash = hash_ci(key)
i = 1 + mod(hash, this % capacity)
c = 2 + mod(hash, this % capacity - 2)
function dict_get_key_ii(this, key) result(value)
do
if (this % table(i) % hash == EMPTY .or. &
this % table(i) % hash == DELETED) then
if (.not. allocated(this % table(i) % entry)) then
allocate(this % table(i) % entry)
end if
this % table(i) % hash = hash
this % table(i) % entry % key = key
this % table(i) % entry % value = value
this % entries = this % entries + 1
exit
else if (this % table(i) % hash == hash .and. &
this % table(i) % entry % key == key) then
this % table(i) % entry % value = value
exit
end if
i = 1 + mod(i + c - 1, this % capacity)
end do
end subroutine set_ci
!===============================================================================
! GET returns the value matching a given key. If the dictionary does not contain
! the key, the value EMPTY is returned.
!===============================================================================
function get_ii(this, key) result(value)
class(DictIntInt) :: this
integer, intent(in) :: key
integer :: value
type(ElemKeyValueII), pointer :: elem
integer :: i
elem => this % get_elem(key)
i = this % get_entry(key)
value = this % table(i) % value
if (associated(elem)) then
value = elem % value
end function get_ii
function get_ci(this, key) result(value)
class(DictCharInt) :: this
character(*), intent(in) :: key
integer :: value
integer :: i
i = this % get_entry(key)
if (allocated(this % table(i) % entry)) then
value = this % table(i) % entry % value
else
value = DICT_NULL
value = EMPTY
end if
end function dict_get_key_ii
end function get_ci
!===============================================================================
! DICT_HAS_KEY determines whether a dictionary has a (key,value) pair with a
! given key.
! HAS determines whether a dictionary has a (key,value) pair with a given key.
!===============================================================================
function dict_has_key_ci(this, key) result(has)
class(DictCharInt) :: this
character(*), intent(in) :: key
logical :: has
type(ElemKeyValueCI), pointer :: elem
elem => this % get_elem(key)
has = associated(elem)
end function dict_has_key_ci
function dict_has_key_ii(this, key) result(has)
function has_ii(this, key) result(has)
class(DictIntInt) :: this
integer, intent(in) :: key
logical :: has
type(ElemKeyValueII), pointer :: elem
integer :: i
elem => this % get_elem(key)
has = associated(elem)
i = this % get_entry(key)
has = (this % table(i) % key /= EMPTY)
end function dict_has_key_ii
end function has_ii
!===============================================================================
! DICT_HASH_KEY returns the hash value for a given key
!===============================================================================
function dict_hash_key_ci(key) result(val)
function has_ci(this, key) result(has)
class(DictCharInt) :: this
character(*), intent(in) :: key
integer :: val
logical :: has
integer :: i
val = 0
i = this % get_entry(key)
has = (this % table(i) % hash /= EMPTY)
do i = 1, len_trim(key)
val = HASH_MULTIPLIER * val + ichar(key(i:i))
end do
end function has_ci
! Added the absolute val on val-1 since the sum in the do loop is
! susceptible to integer overflow
val = 1 + mod(abs(val-1), HASH_SIZE)
!===============================================================================
! REMOVE deletes a (key,value) entry from a dictionary.
!===============================================================================
end function dict_hash_key_ci
function dict_hash_key_ii(key) result(val)
subroutine remove_ii(this, key)
class(DictIntInt) :: this
integer, intent(in) :: key
integer :: val
val = 0
! Added the absolute val on val-1 since the sum in the do loop is
! susceptible to integer overflow
val = 1 + mod(abs(key-1), HASH_SIZE)
end function dict_hash_key_ii
!===============================================================================
! DICT_KEYS returns a pointer to a linked list of all (key,value) pairs
!===============================================================================
function dict_keys_ci(this) result(keys)
class(DictCharInt) :: this
type(ElemKeyValueCI), pointer :: keys
integer :: i
type(ElemKeyValueCI), pointer :: current => null()
type(ElemKeyValueCI), pointer :: elem => null()
keys => null()
do i = 1, size(this % table)
! Get pointer to start of bucket i
elem => this % table(i) % list
do while (associated(elem))
! Allocate (key,value) pair
if (.not. associated(keys)) then
allocate(keys)
current => keys
else
allocate(current % next)
current => current % next
end if
! Copy (key,value) pair
current % key = elem % key
current % value = elem % value
! Move to next element in bucket i
elem => elem % next
end do
end do
end function dict_keys_ci
function dict_keys_ii(this) result(keys)
class(DictIntInt) :: this
type(ElemKeyValueII), pointer :: keys
integer :: i
type(ElemKeyValueII), pointer :: current => null()
type(ElemKeyValueII), pointer :: elem => null()
keys => null()
do i = 1, size(this % table)
! Get pointer to start of bucket i
elem => this % table(i) % list
do while (associated(elem))
! Allocate (key,value) pair
if (.not. associated(keys)) then
allocate(keys)
current => keys
else
allocate(current % next)
current => current % next
end if
! Copy (key,value) pair
current % key = elem % key
current % value = elem % value
! Move to next element in bucket i
elem => elem % next
end do
end do
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)
i = this % get_entry(key)
if (this % table(i) % key /= EMPTY) then
this % table(i) % key = DELETED
this % table(i) % value = EMPTY
this % entries = this % entries - 1
end if
end subroutine dict_clear_ci
end subroutine remove_ii
subroutine dict_clear_ii(this)
subroutine remove_ci(this, key)
class(DictCharInt) :: this
character(*), intent(in) :: key
integer :: i
i = this % get_entry(key)
if (this % table(i) % hash /= EMPTY) then
this % table(i) % hash = DELETED
if (allocated(this % table(i) % entry)) then
deallocate(this % table(i) % entry)
end if
this % entries = this % entries - 1
end if
end subroutine remove_ci
!===============================================================================
! NEXT_ENTRY finds the next (key,value) pair. The value of current_entry is
! updated with the (key,value) pair, and the value of i is updated with the
! index of the entry in the table. Passing in i = 0 will locate the first entry
! in the dictionary. If there are no more entries, i will be set to 0.
!===============================================================================
subroutine next_entry_ii(this, current_entry, i)
class(DictIntInt) :: this
type(DictEntryII), intent(inout) :: current_entry
integer, intent(inout) :: i
if (.not. allocated(this % table)) return
do
i = i + 1
if (i > size(this % table)) then
i = 0
exit
else if (this % table(i) % key /= EMPTY .and. &
this % table(i) % key /= DELETED) then
current_entry = this % table(i)
exit
end if
end do
end subroutine next_entry_ii
subroutine next_entry_ci(this, current_entry, i)
class(DictCharInt) :: this
type(DictEntryCI), intent(inout) :: current_entry
integer, intent(inout) :: i
if (.not. allocated(this % table)) return
do
i = i + 1
if (i > size(this % table)) then
i = 0
exit
else if (this % table(i) % hash /= EMPTY .and. &
this % table(i) % hash /= DELETED) then
current_entry = this % table(i) % entry
exit
end if
end do
end subroutine next_entry_ci
!===============================================================================
! CLEAR deletes and deallocates the dictionary item
!===============================================================================
subroutine clear_ii(this)
class(DictIntInt) :: this
if (allocated(this % table)) deallocate(this % table)
this % entries = 0
this % capacity = 0
end subroutine clear_ii
subroutine clear_ci(this)
class(DictCharInt) :: this
if (allocated(this % table)) deallocate(this % table)
this % entries = 0
this % capacity = 0
end subroutine clear_ci
!===============================================================================
! SIZE returns the number of entries in the dictionary
!===============================================================================
pure function size_ii(this) result(size)
class(DictIntInt), intent(in) :: this
integer :: size
size = this % entries
end function size_ii
pure function size_ci(this) result(size)
class(DictCharInt), intent(in) :: this
integer :: size
size = this % entries
end function size_ci
!===============================================================================
! HASH returns the hash value for a given key
!===============================================================================
pure function hash_ii(key) result(hash)
integer, intent(in) :: key
integer :: hash
hash = abs(key - 1)
end function hash_ii
pure function hash_ci(key) result(hash)
character(*), intent(in) :: key
integer :: hash
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
hash = 0
end subroutine dict_clear_ii
do i = 1, len_trim(key)
hash = 31 * hash + ichar(key(i:i))
end do
hash = abs(hash - 1)
end function hash_ci
end module dict_header

12
src/geometry.F90
View file

@ -1249,8 +1249,8 @@ contains
class(Lattice), pointer :: lat ! pointer to current lattice
! Don't research places already checked
if (found(universe_dict % get_key(univ % id), map)) then
count = counts(universe_dict % get_key(univ % id), map)
if (found(universe_dict % get(univ % id), map)) then
count = counts(universe_dict % get(univ % id), map)
return
end if
@ -1258,8 +1258,8 @@ contains
! Count = 1, then quit
if (univ % id == univ_id) then
count = 1
counts(universe_dict % get_key(univ % id), map) = 1
found(universe_dict % get_key(univ % id), map) = .true.
counts(universe_dict % get(univ % id), map) = 1
found(universe_dict % get(univ % id), map) = .true.
return
end if
@ -1355,8 +1355,8 @@ contains
end if
end do
counts(universe_dict % get_key(univ % id), map) = count
found(universe_dict % get_key(univ % id), map) = .true.
counts(universe_dict % get(univ % id), map) = count
found(universe_dict % get(univ % id), map) = .true.
end function count_target

9
src/geometry_header.F90
View file

@ -374,10 +374,11 @@ contains
end if
i_material = cells(i) % material(j)
associate (mat => materials(i_material))
NUC_NAMES_LOOP: do k = 1, size(mat % names)
! Get index in nuc_temps array
i_nuclide = nuclide_dict % get_key(to_lower(mat % names(k)))
i_nuclide = nuclide_dict % get(to_lower(mat % names(k)))
! Add temperature if it hasn't already been added
if (find(nuc_temps(i_nuclide), temperature) == -1) then
@ -388,7 +389,7 @@ contains
if (present(sab_temps) .and. mat % n_sab > 0) then
SAB_NAMES_LOOP: do k = 1, size(mat % sab_names)
! Get index in nuc_temps array
i_sab = sab_dict % get_key(to_lower(mat % sab_names(k)))
i_sab = sab_dict % get(to_lower(mat % sab_names(k)))
! Add temperature if it hasn't already been added
if (find(sab_temps(i_sab), temperature) == -1) then
@ -433,8 +434,8 @@ contains
integer(C_INT) :: err
if (allocated(cells)) then
if (cell_dict % has_key(id)) then
index = cell_dict % get_key(id)
if (cell_dict % has(id)) then
index = cell_dict % get(id)
err = 0
else
err = E_INVALID_ID

1
src/initialize.F90
View file

@ -9,7 +9,6 @@ module initialize
use bank_header, only: Bank
use constants
use dict_header, only: DictIntInt, ElemKeyValueII
use set_header, only: SetInt
use error, only: fatal_error, warning
use geometry_header, only: Cell, Universe, Lattice, RectLattice, HexLattice,&

232
src/input_xml.F90
View file

@ -6,7 +6,7 @@ module input_xml
use cmfd_input, only: configure_cmfd
use cmfd_header, only: cmfd_mesh
use constants
use dict_header, only: DictIntInt, DictCharInt, ElemKeyValueCI
use dict_header, only: DictIntInt, DictCharInt, DictEntryCI
use distribution_multivariate
use distribution_univariate
use endf, only: reaction_name
@ -477,15 +477,15 @@ contains
call m % from_xml(node_mesh_list(i))
! Add mesh to dictionary
call mesh_dict % add_key(m % id, i_start + i - 1)
call mesh_dict % set(m % id, i_start + i - 1)
end associate
end do
! Shannon Entropy mesh
if (check_for_node(root, "entropy_mesh")) then
call get_node_value(root, "entropy_mesh", temp_int)
if (mesh_dict % has_key(temp_int)) then
index_entropy_mesh = mesh_dict % get_key(temp_int)
if (mesh_dict % has(temp_int)) then
index_entropy_mesh = mesh_dict % get(temp_int)
else
call fatal_error("Mesh " // to_str(temp_int) // " specified for &
&Shannon entropy does not exist.")
@ -533,8 +533,8 @@ contains
! Uniform fission source weighting mesh
if (check_for_node(root, "ufs_mesh")) then
call get_node_value(root, "ufs_mesh", temp_int)
if (mesh_dict % has_key(temp_int)) then
index_ufs_mesh = mesh_dict % get_key(temp_int)
if (mesh_dict % has(temp_int)) then
index_ufs_mesh = mesh_dict % get(temp_int)
else
call fatal_error("Mesh " // to_str(temp_int) // " specified for &
&uniform fission site method does not exist.")
@ -1044,7 +1044,7 @@ contains
end if
! Check to make sure 'id' hasn't been used
if (surface_dict % has_key(s%id)) then
if (surface_dict % has(s%id)) then
call fatal_error("Two or more surfaces use the same unique ID: " &
// to_str(s%id))
end if
@ -1175,7 +1175,7 @@ contains
&"' specified on surface " // trim(to_str(s%id)))
end select
! Add surface to dictionary
call surface_dict % add_key(s%id, i)
call surface_dict % set(s%id, i)
end do
! Check to make sure a boundary condition was applied to at least one
@ -1201,7 +1201,7 @@ contains
&interior surface.")
end if
else
surf % i_periodic = surface_dict % get_key(surf % i_periodic)
surf % i_periodic = surface_dict % get(surf % i_periodic)
end if
type is (SurfaceYPlane)
@ -1215,7 +1215,7 @@ contains
&interior surface.")
end if
else
surf % i_periodic = surface_dict % get_key(surf % i_periodic)
surf % i_periodic = surface_dict % get(surf % i_periodic)
end if
type is (SurfaceZPlane)
@ -1229,7 +1229,7 @@ contains
&interior surface.")
end if
else
surf % i_periodic = surface_dict % get_key(surf % i_periodic)
surf % i_periodic = surface_dict % get(surf % i_periodic)
end if
type is (SurfacePlane)
@ -1238,7 +1238,7 @@ contains
&periodic boundary condition on surface " // &
trim(to_str(surf % id)) // ".")
else
surf % i_periodic = surface_dict % get_key(surf % i_periodic)
surf % i_periodic = surface_dict % get(surf % i_periodic)
end if
class default
@ -1315,7 +1315,7 @@ contains
end if
! Check to make sure 'id' hasn't been used
if (cell_dict % has_key(c % id)) then
if (cell_dict % has(c % id)) then
call fatal_error("Two or more cells use the same unique ID: " &
// to_str(c % id))
end if
@ -1390,8 +1390,8 @@ contains
do j = 1, tokens % size()
id = tokens % data(j)
if (id < OP_UNION) then
if (surface_dict % has_key(abs(id))) then
k = surface_dict % get_key(abs(id))
if (surface_dict % has(abs(id))) then
k = surface_dict % get(abs(id))
tokens % data(j) = sign(k, id)
end if
end if
@ -1511,21 +1511,21 @@ contains
end if
! Add cell to dictionary
call cell_dict % add_key(c % id, i)
call cell_dict % set(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
univ_id = c % universe
if (.not. cells_in_univ_dict % has_key(univ_id)) then
if (.not. cells_in_univ_dict % has(univ_id)) then
n_universes = n_universes + 1
n_cells_in_univ = 1
call universe_dict % add_key(univ_id, n_universes)
call universe_dict % set(univ_id, n_universes)
call univ_ids % push_back(univ_id)
else
n_cells_in_univ = 1 + cells_in_univ_dict % get_key(univ_id)
n_cells_in_univ = 1 + cells_in_univ_dict % get(univ_id)
end if
call cells_in_univ_dict % add_key(univ_id, n_cells_in_univ)
call cells_in_univ_dict % set(univ_id, n_cells_in_univ)
end do
@ -1559,7 +1559,7 @@ contains
end if
! Check to make sure 'id' hasn't been used
if (lattice_dict % has_key(lat % id)) then
if (lattice_dict % has(lat % id)) then
call fatal_error("Two or more lattices use the same unique ID: " &
// to_str(lat % id))
end if
@ -1669,7 +1669,7 @@ contains
end if
! Add lattice to dictionary
call lattice_dict % add_key(lat % id, i)
call lattice_dict % set(lat % id, i)
end select
end do RECT_LATTICES
@ -1691,7 +1691,7 @@ contains
end if
! Check to make sure 'id' hasn't been used
if (lattice_dict % has_key(lat % id)) then
if (lattice_dict % has(lat % id)) then
call fatal_error("Two or more lattices use the same unique ID: " &
// to_str(lat % id))
end if
@ -1856,7 +1856,7 @@ contains
end if
! Add lattice to dictionary
call lattice_dict % add_key(lat % id, n_rlats + i)
call lattice_dict % set(lat % id, n_rlats + i)
end select
end do HEX_LATTICES
@ -1871,7 +1871,7 @@ contains
u % id = univ_ids % data(i)
! Allocate cell list
n_cells_in_univ = cells_in_univ_dict % get_key(u % id)
n_cells_in_univ = cells_in_univ_dict % get(u % id)
allocate(u % cells(n_cells_in_univ))
u % cells(:) = 0
@ -1890,7 +1890,7 @@ contains
do i = 1, n_cells
! Get index in universes array
j = universe_dict % get_key(cells(i) % universe)
j = universe_dict % get(cells(i) % universe)
! Set the first zero entry in the universe cells array to the index in the
! global cells array
@ -2007,14 +2007,14 @@ contains
! Creating dictionary that maps the name of the material to the entry
do i = 1, size(libraries)
do j = 1, size(libraries(i) % materials)
call library_dict % add_key(to_lower(libraries(i) % materials(j)), i)
call library_dict % set(to_lower(libraries(i) % materials(j)), i)
end do
end do
! Check that 0K nuclides are listed in the cross_sections.xml file
if (allocated(res_scat_nuclides)) then
do i = 1, size(res_scat_nuclides)
if (.not. library_dict % has_key(to_lower(res_scat_nuclides(i)))) then
if (.not. library_dict % has(to_lower(res_scat_nuclides(i)))) then
call fatal_error("Could not find resonant scatterer " &
// trim(res_scat_nuclides(i)) // " in cross_sections.xml file!")
end if
@ -2102,7 +2102,7 @@ contains
end if
! Check to make sure 'id' hasn't been used
if (material_dict % has_key(mat % id)) then
if (material_dict % has(mat % id)) then
call fatal_error("Two or more materials use the same unique ID: " &
// to_str(mat % id))
end if
@ -2311,11 +2311,11 @@ contains
ALL_NUCLIDES: do j = 1, mat % n_nuclides
! Check that this nuclide is listed in the cross_sections.xml file
name = trim(names % data(j))
if (.not. library_dict % has_key(to_lower(name))) then
if (.not. library_dict % has(to_lower(name))) then
call fatal_error("Could not find nuclide " // trim(name) &
// " in cross_sections data file!")
end if
i_library = library_dict % get_key(to_lower(name))
i_library = library_dict % get(to_lower(name))
if (run_CE) then
! Check to make sure cross-section is continuous energy neutron table
@ -2327,13 +2327,13 @@ contains
! If this nuclide hasn't been encountered yet, we need to add its name
! and alias to the nuclide_dict
if (.not. nuclide_dict % has_key(to_lower(name))) then
if (.not. nuclide_dict % has(to_lower(name))) then
index_nuclide = index_nuclide + 1
mat % nuclide(j) = index_nuclide
call nuclide_dict % add_key(to_lower(name), index_nuclide)
call nuclide_dict % set(to_lower(name), index_nuclide)
else
mat % nuclide(j) = nuclide_dict % get_key(to_lower(name))
mat % nuclide(j) = nuclide_dict % get(to_lower(name))
end if
! Copy name and atom/weight percent
@ -2406,14 +2406,14 @@ contains
end if
! Check that this nuclide is listed in the cross_sections.xml file
if (.not. library_dict % has_key(to_lower(name))) then
if (.not. library_dict % has(to_lower(name))) then
call fatal_error("Could not find S(a,b) table " // trim(name) &
// " in cross_sections.xml file!")
end if
! Find index in xs_listing and set the name and alias according to the
! listing
i_library = library_dict % get_key(to_lower(name))
i_library = library_dict % get(to_lower(name))
if (run_CE) then
! Check to make sure cross-section is continuous energy neutron table
@ -2425,19 +2425,19 @@ contains
! 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. sab_dict % has_key(to_lower(name))) then
if (.not. sab_dict % has(to_lower(name))) then
index_sab = index_sab + 1
mat % i_sab_tables(j) = index_sab
call sab_dict % add_key(to_lower(name), index_sab)
call sab_dict % set(to_lower(name), index_sab)
else
mat % i_sab_tables(j) = sab_dict % get_key(to_lower(name))
mat % i_sab_tables(j) = sab_dict % get(to_lower(name))
end if
end do
end if
end if
! Add material to dictionary
call material_dict % add_key(mat % id, i)
call material_dict % set(mat % id, i)
end do
! Set total number of nuclides and S(a,b) tables
@ -2463,6 +2463,7 @@ contains
integer :: filter_id ! user-specified identifier for filter
integer :: i_filt ! index in filters array
integer :: i_filter_mesh ! index of mesh filter
integer :: i_elem ! index of entry in dictionary
integer :: n ! size of arrays in mesh specification
integer :: n_words ! number of words read
integer :: n_filter ! number of filters
@ -2500,8 +2501,7 @@ contains
type(XMLNode), allocatable :: node_filt_list(:)
type(XMLNode), allocatable :: node_trigger_list(:)
type(XMLNode), allocatable :: node_deriv_list(:)
type(ElemKeyValueCI), pointer :: scores
type(ElemKeyValueCI), pointer :: next
type(DictEntryCI) :: elem
! Check if tallies.xml exists
filename = trim(path_input) // "tallies.xml"
@ -2557,7 +2557,7 @@ contains
call m % from_xml(node_mesh_list(i))
! Add mesh to dictionary
call mesh_dict % add_key(m % id, i_start + i - 1)
call mesh_dict % set(m % id, i_start + i - 1)
end do
! We only need the mesh info for plotting
@ -2586,7 +2586,7 @@ contains
call tally_derivs(i) % from_xml(node_deriv_list(i))
! Update tally derivative dictionary
call tally_deriv_dict % add_key(tally_derivs(i) % id, i)
call tally_deriv_dict % set(tally_derivs(i) % id, i)
end do
! ==========================================================================
@ -2612,7 +2612,7 @@ contains
end if
! Check to make sure 'id' hasn't been used
if (filter_dict % has_key(filter_id)) then
if (filter_dict % has(filter_id)) then
call fatal_error("Two or more filters use the same unique ID: " &
// to_str(filter_id))
end if
@ -2682,7 +2682,7 @@ contains
end if
! Check to make sure 'id' hasn't been used
if (tally_dict % has_key(t % id)) then
if (tally_dict % has(t % id)) then
call fatal_error("Two or more tallies use the same unique ID: " &
// to_str(t % id))
end if
@ -2717,8 +2717,8 @@ contains
do j = 1, n_filter
! Get pointer to filter
if (filter_dict % has_key(temp_filter(j))) then
i_filt = filter_dict % get_key(temp_filter(j))
if (filter_dict % has(temp_filter(j))) then
i_filt = filter_dict % get(temp_filter(j))
f => filters(i_filt)
else
call fatal_error("Could not find filter " &
@ -2774,14 +2774,14 @@ contains
word = to_lower(sarray(j))
! Search through nuclides
if (.not. nuclide_dict % has_key(word)) then
if (.not. nuclide_dict % has(word)) then
call fatal_error("Could not find the nuclide " &
// trim(word) // " specified in tally " &
// trim(to_str(t % id)) // " in any material.")
end if
! Set bin to index in nuclides array
t % nuclide_bins(j) = nuclide_dict % get_key(word)
t % nuclide_bins(j) = nuclide_dict % get(word)
end do
! Set number of nuclide bins
@ -2819,7 +2819,7 @@ contains
score_name = trim(sarray(j))
! Append the score to the list of possible trigger scores
if (trigger_on) call trigger_scores % add_key(trim(score_name), j)
if (trigger_on) call trigger_scores % set(trim(score_name), j)
do imomstr = 1, size(MOMENT_STRS)
if (starts_with(score_name,trim(MOMENT_STRS(imomstr)))) then
@ -3399,15 +3399,7 @@ contains
score_name = trim(to_lower(sarray(j)))
if (score_name == "all") then
scores => trigger_scores % keys()
do while (associated(scores))
next => scores % next
deallocate(scores)
scores => next
t % n_triggers = t % n_triggers + 1
end do
t % n_triggers = t % n_triggers + trigger_scores % size()
else
t % n_triggers = t % n_triggers + 1
end if
@ -3466,16 +3458,19 @@ contains
! Expand "all" to include TriggerObjects for each score in tally
if (score_name == "all") then
scores => trigger_scores % keys()
! Loop over all tally scores
do while (associated(scores))
score_name = trim(scores % key)
i_elem = 0
do
! Move to next score
call trigger_scores % next_entry(elem, i_elem)
if (i_elem == 0) exit
score_name = trim(elem % key)
! Store the score name and index in the trigger
t % triggers(trig_ind) % score_name = trim(score_name)
t % triggers(trig_ind) % score_index = &
trigger_scores % get_key(trim(score_name))
t % triggers(trig_ind) % score_name = score_name
t % triggers(trig_ind) % score_index = elem % value
! Set the trigger convergence threshold type
select case (temp_str)
@ -3493,11 +3488,6 @@ contains
! Store the trigger convergence threshold
t % triggers(trig_ind) % threshold = threshold
! Move to next score
next => scores % next
deallocate(scores)
scores => next
! Increment the overall trigger index
trig_ind = trig_ind + 1
end do
@ -3508,7 +3498,7 @@ contains
! Store the score name and index
t % triggers(trig_ind) % score_name = trim(score_name)
t % triggers(trig_ind) % score_index = &
trigger_scores % get_key(trim(score_name))
trigger_scores % get(trim(score_name))
! Check if an invalid score was set for the trigger
if (t % triggers(trig_ind) % score_index == 0) then
@ -3585,7 +3575,7 @@ contains
end if
! Add tally to dictionary
call tally_dict % add_key(t % id, i)
call tally_dict % set(t % id, i)
end associate
end do READ_TALLIES
@ -3657,7 +3647,7 @@ contains
end if
! Check to make sure 'id' hasn't been used
if (plot_dict % has_key(pl % id)) then
if (plot_dict % has(pl % id)) then
call fatal_error("Two or more plots use the same unique ID: " &
// to_str(pl % id))
end if
@ -3842,8 +3832,8 @@ contains
! Add RGB
if (pl % color_by == PLOT_COLOR_CELLS) then
if (cell_dict % has_key(col_id)) then
col_id = cell_dict % get_key(col_id)
if (cell_dict % has(col_id)) then
col_id = cell_dict % get(col_id)
call get_node_array(node_col, "rgb", pl % colors(col_id) % rgb)
else
call fatal_error("Could not find cell " // trim(to_str(col_id)) &
@ -3852,8 +3842,8 @@ contains
else if (pl % color_by == PLOT_COLOR_MATS) then
if (material_dict % has_key(col_id)) then
col_id = material_dict % get_key(col_id)
if (material_dict % has(col_id)) then
col_id = material_dict % get(col_id)
call get_node_array(node_col, "rgb", pl % colors(col_id) % rgb)
else
call fatal_error("Could not find material " &
@ -3957,8 +3947,8 @@ contains
end if
! Check if the specified tally mesh exists
if (mesh_dict % has_key(meshid)) then
pl % meshlines_mesh => meshes(mesh_dict % get_key(meshid))
if (mesh_dict % has(meshid)) then
pl % meshlines_mesh => meshes(mesh_dict % get(meshid))
if (meshes(meshid) % type /= LATTICE_RECT) then
call fatal_error("Non-rectangular mesh specified in &
&meshlines for plot " // trim(to_str(pl % id)))
@ -4017,8 +4007,8 @@ contains
if (pl % color_by == PLOT_COLOR_CELLS) then
if (cell_dict % has_key(col_id)) then
iarray(j) = cell_dict % get_key(col_id)
if (cell_dict % has(col_id)) then
iarray(j) = cell_dict % get(col_id)
else
call fatal_error("Could not find cell " &
// trim(to_str(col_id)) // " specified in the mask in &
@ -4027,8 +4017,8 @@ contains
else if (pl % color_by == PLOT_COLOR_MATS) then
if (material_dict % has_key(col_id)) then
iarray(j) = material_dict % get_key(col_id)
if (material_dict % has(col_id)) then
iarray(j) = material_dict % get(col_id)
else
call fatal_error("Could not find material " &
// trim(to_str(col_id)) // " specified in the mask in &
@ -4056,7 +4046,7 @@ contains
end if
! Add plot to dictionary
call plot_dict % add_key(pl % id, i)
call plot_dict % set(pl % id, i)
end do READ_PLOTS
@ -4437,8 +4427,8 @@ contains
name = materials(i) % names(j)
if (.not. already_read % contains(name)) then
i_library = library_dict % get_key(to_lower(name))
i_nuclide = nuclide_dict % get_key(to_lower(name))
i_library = library_dict % get(to_lower(name))
i_nuclide = nuclide_dict % get(to_lower(name))
call write_message('Reading ' // trim(name) // ' from ' // &
trim(libraries(i_library) % path), 6)
@ -4497,8 +4487,8 @@ contains
name = materials(i) % sab_names(j)
if (.not. already_read % contains(name)) then
i_library = library_dict % get_key(to_lower(name))
i_sab = sab_dict % get_key(to_lower(name))
i_library = library_dict % get(to_lower(name))
i_sab = sab_dict % get(to_lower(name))
call write_message('Reading ' // trim(name) // ' from ' // &
trim(libraries(i_library) % path), 6)
@ -4663,12 +4653,12 @@ contains
! ADJUST UNIVERSE INDEX FOR EACH CELL
associate (c => cells(i))
id = c%universe
if (universe_dict%has_key(id)) then
c%universe = universe_dict%get_key(id)
id = c % universe
if (universe_dict % has(id)) then
c % universe = universe_dict % get(id)
else
call fatal_error("Could not find universe " // trim(to_str(id)) &
&// " specified on cell " // trim(to_str(c%id)))
&// " specified on cell " // trim(to_str(c % id)))
end if
! =======================================================================
@ -4676,11 +4666,11 @@ contains
if (c % material(1) == NONE) then
id = c % fill
if (universe_dict % has_key(id)) then
if (universe_dict % has(id)) then
c % type = FILL_UNIVERSE
c % fill = universe_dict % get_key(id)
elseif (lattice_dict % has_key(id)) then
lid = lattice_dict % get_key(id)
c % fill = universe_dict % get(id)
elseif (lattice_dict % has(id)) then
lid = lattice_dict % get(id)
c % type = FILL_LATTICE
c % fill = lid
else
@ -4693,9 +4683,9 @@ contains
id = c % material(j)
if (id == MATERIAL_VOID) then
c % type = FILL_MATERIAL
else if (material_dict % has_key(id)) then
else if (material_dict % has(id)) then
c % type = FILL_MATERIAL
c % material(j) = material_dict % get_key(id)
c % material(j) = material_dict % get(id)
else
call fatal_error("Could not find material " // trim(to_str(id)) &
// " specified on cell " // trim(to_str(c % id)))
@ -4709,41 +4699,41 @@ contains
! ADJUST UNIVERSE INDICES FOR EACH LATTICE
do i = 1, n_lattices
lat => lattices(i)%obj
lat => lattices(i) % obj
select type (lat)
type is (RectLattice)
do m = 1, lat%n_cells(3)
do k = 1, lat%n_cells(2)
do j = 1, lat%n_cells(1)
id = lat%universes(j,k,m)
if (universe_dict%has_key(id)) then
lat%universes(j,k,m) = universe_dict%get_key(id)
do m = 1, lat % n_cells(3)
do k = 1, lat % n_cells(2)
do j = 1, lat % n_cells(1)
id = lat % universes(j,k,m)
if (universe_dict % has(id)) then
lat % universes(j,k,m) = universe_dict % get(id)
else
call fatal_error("Invalid universe number " &
&// trim(to_str(id)) // " specified on lattice " &
&// trim(to_str(lat%id)))
&// trim(to_str(lat % id)))
end if
end do
end do
end do
type is (HexLattice)
do m = 1, lat%n_axial
do k = 1, 2*lat%n_rings - 1
do j = 1, 2*lat%n_rings - 1
if (j + k < lat%n_rings + 1) then
do m = 1, lat % n_axial
do k = 1, 2*lat % n_rings - 1
do j = 1, 2*lat % n_rings - 1
if (j + k < lat % n_rings + 1) then
cycle
else if (j + k > 3*lat%n_rings - 1) then
else if (j + k > 3*lat % n_rings - 1) then
cycle
end if
id = lat%universes(j, k, m)
if (universe_dict%has_key(id)) then
lat%universes(j, k, m) = universe_dict%get_key(id)
id = lat % universes(j, k, m)
if (universe_dict % has(id)) then
lat % universes(j, k, m) = universe_dict % get(id)
else
call fatal_error("Invalid universe number " &
&// trim(to_str(id)) // " specified on lattice " &
&// trim(to_str(lat%id)))
&// trim(to_str(lat % id)))
end if
end do
end do
@ -4751,13 +4741,13 @@ contains
end select
if (lat%outer /= NO_OUTER_UNIVERSE) then
if (universe_dict%has_key(lat%outer)) then
lat%outer = universe_dict%get_key(lat%outer)
if (lat % outer /= NO_OUTER_UNIVERSE) then
if (universe_dict % has(lat % outer)) then
lat % outer = universe_dict % get(lat % outer)
else
call fatal_error("Invalid universe number " &
&// trim(to_str(lat%outer)) &
&// " specified on lattice " // trim(to_str(lat%id)))
&// trim(to_str(lat % outer)) &
&// " specified on lattice " // trim(to_str(lat % id)))
end if
end if

12
src/material_header.F90
View file

@ -277,8 +277,8 @@ contains
integer(C_INT) :: err
if (allocated(materials)) then
if (material_dict % has_key(id)) then
index = material_dict % get_key(id)
if (material_dict % has(id)) then
index = material_dict % get(id)
err = 0
else
err = E_INVALID_ID
@ -345,7 +345,7 @@ contains
call move_alloc(FROM=new_p0, TO=m % p0)
! Append new nuclide/density
k = nuclide_dict % get_key(to_lower(name_))
k = nuclide_dict % get(to_lower(name_))
m % nuclide(n + 1) = k
m % atom_density(n + 1) = density
m % density = m % density + density
@ -415,7 +415,7 @@ contains
if (index >= 1 .and. index <= n_materials) then
materials(index) % id = id
call material_dict % add_key(id, index)
call material_dict % set(id, index)
err = 0
else
err = E_OUT_OF_BOUNDS
@ -469,12 +469,12 @@ contains
call c_f_pointer(name(i), string, [10])
name_ = to_lower(to_f_string(string))
if (.not. nuclide_dict % has_key(name_)) then
if (.not. nuclide_dict % has(name_)) then
err = openmc_load_nuclide(string)
if (err < 0) return
end if
m % nuclide(i) = nuclide_dict % get_key(name_)
m % nuclide(i) = nuclide_dict % get(name_)
m % atom_density(i) = density(i)
end do
m % n_nuclides = n

2
src/mesh_header.F90
View file

@ -61,7 +61,7 @@ contains
call get_node_value(node, "id", this % id)
! Check to make sure 'id' hasn't been used
if (mesh_dict % has_key(this % id)) then
if (mesh_dict % has(this % id)) then
call fatal_error("Two or more meshes use the same unique ID: " &
// to_str(this % id))
end if

3
src/mgxs_data.F90
View file

@ -26,7 +26,6 @@ contains
subroutine read_mgxs()
integer :: i ! index in materials array
integer :: j ! index over nuclides in material
integer :: i_xsdata ! index in <xsdata> list
integer :: i_nuclide ! index in nuclides array
character(20) :: name ! name of library to load
integer :: representation ! Data representation
@ -36,7 +35,6 @@ contains
integer(HID_T) :: file_id
integer(HID_T) :: xsdata_group
logical :: file_exists
type(DictCharInt) :: xsdata_dict
type(VectorReal), allocatable :: temps(:)
character(MAX_WORD_LEN) :: word
integer, allocatable :: array(:)
@ -86,7 +84,6 @@ contains
name = mat % names(j)
if (.not. already_read % contains(name)) then
i_xsdata = xsdata_dict % get_key(to_lower(name))
i_nuclide = mat % nuclide(j)
call write_message("Loading " // trim(name) // " data...", 6)

14
src/nuclide_header.F90
View file

@ -581,7 +581,7 @@ contains
do i = 1, size(this % reactions)
call MTs % push_back(this % reactions(i) % MT)
call this % reaction_index % add_key(this % reactions(i) % MT, i)
call this % reaction_index % set(this % reactions(i) % MT, i)
associate (rx => this % reactions(i))
! Skip total inelastic level scattering, gas production cross sections
@ -862,8 +862,8 @@ contains
name_ = to_f_string(name)
if (allocated(nuclides)) then
if (nuclide_dict % has_key(to_lower(name_))) then
index = nuclide_dict % get_key(to_lower(name_))
if (nuclide_dict % has(to_lower(name_))) then
index = nuclide_dict % get(to_lower(name_))
err = 0
else
err = E_DATA
@ -895,8 +895,8 @@ contains
name_ = to_f_string(name)
err = 0
if (.not. nuclide_dict % has_key(to_lower(name_))) then
if (library_dict % has_key(to_lower(name_))) then
if (.not. nuclide_dict % has(to_lower(name_))) then
if (library_dict % has(to_lower(name_))) then
! allocate extra space in nuclides array
n = n_nuclides
allocate(new_nuclides(n + 1))
@ -904,7 +904,7 @@ contains
call move_alloc(FROM=new_nuclides, TO=nuclides)
n = n + 1
i_library = library_dict % get_key(to_lower(name_))
i_library = library_dict % get(to_lower(name_))
! Open file and make sure version is sufficient
file_id = file_open(libraries(i_library) % path, 'r')
@ -919,7 +919,7 @@ contains
call file_close(file_id)
! Add entry to nuclide dictionary
call nuclide_dict % add_key(to_lower(name_), n)
call nuclide_dict % set(to_lower(name_), n)
n_nuclides = n
! Assign resonant scattering data

20
src/tallies/tally.F90
View file

@ -5,6 +5,7 @@ module tally
use algorithm, only: binary_search
use constants
use cross_section, only: multipole_deriv_eval
use dict_header, only: EMPTY
use error, only: fatal_error
use geometry_header
use math, only: t_percentile, calc_pn, calc_rn
@ -246,8 +247,7 @@ contains
! multiplicities of one.
score = p % last_wgt * flux
else
m = nuclides(p % event_nuclide) % reaction_index % &
get_key(p % event_MT)
m = nuclides(p % event_nuclide) % reaction_index % get(p % event_MT)
! Get yield and apply to score
associate (rxn => nuclides(p % event_nuclide) % reactions(m))
@ -273,8 +273,7 @@ contains
! multiplicities of one.
score = p % last_wgt * flux
else
m = nuclides(p%event_nuclide)%reaction_index% &
get_key(p % event_MT)
m = nuclides(p % event_nuclide) % reaction_index % get(p % event_MT)
! Get yield and apply to score
associate (rxn => nuclides(p % event_nuclide) % reactions(m))
@ -300,8 +299,7 @@ contains
! multiplicities of one.
score = p % last_wgt * flux
else
m = nuclides(p%event_nuclide)%reaction_index% &
get_key(p % event_MT)
m = nuclides(p % event_nuclide) % reaction_index % get(p % event_MT)
! Get yield and apply to score
associate (rxn => nuclides(p%event_nuclide)%reactions(m))
@ -1150,9 +1148,8 @@ contains
score = ZERO
if (i_nuclide > 0) then
if (nuclides(i_nuclide)%reaction_index%has_key(score_bin)) then
m = nuclides(i_nuclide)%reaction_index%get_key(score_bin)
m = nuclides(i_nuclide) % reaction_index % get(score_bin)
if (m /= EMPTY) then
! Retrieve temperature and energy grid index and interpolation
! factor
i_temp = micro_xs(i_nuclide) % index_temp
@ -1190,9 +1187,8 @@ contains
! Get index in nuclides array
i_nuc = materials(p % material) % nuclide(l)
if (nuclides(i_nuc)%reaction_index%has_key(score_bin)) then
m = nuclides(i_nuc)%reaction_index%get_key(score_bin)
m = nuclides(i_nuc) % reaction_index % get(score_bin)
if (m /= EMPTY) then
! Retrieve temperature and energy grid index and
! interpolation factor
i_temp = micro_xs(i_nuc) % index_temp

10
src/tallies/tally_derivative_header.F90
View file

@ -1,7 +1,7 @@
module tally_derivative_header
use constants
use dict_header, only: DictIntInt
use dict_header, only: DictIntInt, EMPTY
use error, only: fatal_error
use nuclide_header, only: nuclide_dict
use string, only: to_str, to_lower
@ -40,6 +40,7 @@ contains
character(MAX_WORD_LEN) :: temp_str
character(MAX_WORD_LEN) :: word
integer :: val
! Copy the derivative id.
if (check_for_node(node, "id")) then
@ -56,7 +57,7 @@ contains
end if
! Make sure this id has not already been used.
if (tally_deriv_dict % has_key(this % id)) then
if (tally_deriv_dict % has(this % id)) then
call fatal_error("Two or more <derivative>'s use the same unique &
&ID: " // trim(to_str(this % id)))
end if
@ -74,12 +75,13 @@ contains
call get_node_value(node, "nuclide", word)
word = trim(to_lower(word))
if (.not. nuclide_dict % has_key(word)) then
val = nuclide_dict % get(word)
if (val == EMPTY) then
call fatal_error("Could not find the nuclide " &
// trim(word) // " specified in derivative " &
// trim(to_str(this % id)) // " in any material.")
end if
this % diff_nuclide = nuclide_dict % get_key(word)
this % diff_nuclide = val
case("temperature")
this % variable = DIFF_TEMPERATURE

15
src/tallies/tally_filter_cell.F90
View file

@ -5,6 +5,7 @@ module tally_filter_cell
use hdf5
use constants, only: ONE, MAX_LINE_LEN
use dict_header, only: EMPTY
use error, only: fatal_error
use hdf5_interface
use geometry_header
@ -55,11 +56,13 @@ contains
type(TallyFilterMatch), intent(inout) :: match
integer :: i
integer :: val
! Iterate over coordinate levels to see with cells match
do i = 1, p % n_coord
if (this % map % has_key(p % coord(i) % cell)) then
call match % bins % push_back(this % map % get_key(p % coord(i) % cell))
val = this % map % get(p % coord(i) % cell)
if (val /= EMPTY) then
call match % bins % push_back(val)
call match % weights % push_back(ONE)
end if
end do
@ -87,12 +90,14 @@ contains
class(CellFilter), intent(inout) :: this
integer :: i, id
integer :: val
! Convert ids to indices.
do i = 1, this % n_bins
id = this % cells(i)
if (cell_dict % has_key(id)) then
this % cells(i) = cell_dict % get_key(id)
val = cell_dict % get(id)
if (val /= EMPTY) then
this % cells(i) = val
else
call fatal_error("Could not find cell " // trim(to_str(id)) &
&// " specified on tally filter.")
@ -101,7 +106,7 @@ contains
! Generate mapping from cell indices to filter bins.
do i = 1, this % n_bins
call this % map % add_key(this % cells(i), i)
call this % map % set(this % cells(i), i)
end do
end subroutine initialize_cell

16
src/tallies/tally_filter_cellborn.F90
View file

@ -5,6 +5,7 @@ module tally_filter_cellborn
use hdf5
use constants, only: ONE, MAX_LINE_LEN
use dict_header, only: EMPTY
use error, only: fatal_error
use hdf5_interface
use geometry_header
@ -54,8 +55,11 @@ contains
integer, intent(in) :: estimator
type(TallyFilterMatch), intent(inout) :: match
if (this % map % has_key(p % cell_born)) then
call match % bins % push_back(this % map % get_key(p % cell_born))
integer :: val
val = this % map % get(p % cell_born)
if (val /= EMPTY) then
call match % bins % push_back(val)
call match % weights % push_back(ONE)
end if
@ -81,12 +85,14 @@ contains
class(CellbornFilter), intent(inout) :: this
integer :: i, id
integer :: val
! Convert ids to indices.
do i = 1, this % n_bins
id = this % cells(i)
if (cell_dict % has_key(id)) then
this % cells(i) = cell_dict % get_key(id)
val = cell_dict % get(id)
if (val /= EMPTY) then
this % cells(i) = val
else
call fatal_error("Could not find cell " // trim(to_str(id)) &
&// " specified on tally filter.")
@ -95,7 +101,7 @@ contains
! Generate mapping from cell indices to filter bins.
do i = 1, this % n_bins
call this % map % add_key(this % cells(i), i)
call this % map % set(this % cells(i), i)
end do
end subroutine initialize_cellborn

7
src/tallies/tally_filter_cellfrom.F90
View file

@ -5,6 +5,7 @@ module tally_filter_cellfrom
use hdf5
use constants, only: ONE, MAX_LINE_LEN
use dict_header, only: EMPTY
use error, only: fatal_error
use hdf5_interface
use geometry_header
@ -39,11 +40,13 @@ contains
type(TallyFilterMatch), intent(inout) :: match
integer :: i
integer :: val
! Starting one coordinate level deeper, find the next bin.
do i = 1, p % last_n_coord
if (this % map % has_key(p % last_cell(i))) then
call match % bins % push_back(this % map % get_key(p % last_cell(i)))
val = this % map % get(p % last_cell(i))
if (val /= EMPTY) then
call match % bins % push_back(val)
call match % weights % push_back(ONE)
exit
end if

9
src/tallies/tally_filter_distribcell.F90
View file

@ -5,6 +5,7 @@ module tally_filter_distribcell
use hdf5, only: HID_T
use constants
use dict_header, only: EMPTY
use error
use geometry_header
use hdf5_interface
@ -96,11 +97,13 @@ contains
class(DistribcellFilter), intent(inout) :: this
integer :: id
integer :: val
! Convert id to index.
id = this % cell
if (cell_dict % has_key(id)) then
this % cell = cell_dict % get_key(id)
val = cell_dict % get(id)
if (val /= EMPTY) then
this % cell = val
this % n_bins = cells(this % cell) % instances
else
call fatal_error("Could not find cell " // trim(to_str(id)) &
@ -159,7 +162,7 @@ contains
n = size(univ % cells)
! Write to the geometry stack
i_univ = universe_dict % get_key(univ % id)
i_univ = universe_dict % get(univ % id)
if (i_univ == root_universe) then
path = trim(path) // "u" // to_str(univ%id)
else

6
src/tallies/tally_filter_header.F90
View file

@ -204,7 +204,7 @@ contains
if (index >= 1 .and. index <= n_filters) then
if (allocated(filters(index) % obj)) then
filters(index) % obj % id = id
call filter_dict % add_key(id, index)
call filter_dict % set(id, index)
err = 0
else
@ -225,8 +225,8 @@ contains
integer(C_INT) :: err
if (allocated(filters)) then
if (filter_dict % has_key(id)) then
index = filter_dict % get_key(id)
if (filter_dict % has(id)) then
index = filter_dict % get(id)
err = 0
else
err = E_INVALID_ID

23
src/tallies/tally_filter_material.F90
View file

@ -5,7 +5,7 @@ module tally_filter_material
use hdf5, only: HID_T
use constants
use dict_header, only: DictIntInt
use dict_header, only: DictIntInt, EMPTY
use error
use hdf5_interface
use material_header, only: materials, material_dict
@ -56,10 +56,13 @@ contains
integer, intent(in) :: estimator
type(TallyFilterMatch), intent(inout) :: match
if (this % map % has_key(p % material)) then
call match % bins % push_back(this % map % get_key(p % material))
call match % weights % push_back(ONE)
end if
integer :: val
val = this % map % get(p % material)
if (val /= EMPTY) then
call match % bins % push_back(val)
call match % weights % push_back(ONE)
end if
end subroutine get_all_bins_material
@ -84,12 +87,14 @@ contains
class(MaterialFilter), intent(inout) :: this
integer :: i, id
integer :: val
! Convert ids to indices.
do i = 1, this % n_bins
id = this % materials(i)
if (material_dict % has_key(id)) then
this % materials(i) = material_dict % get_key(id)
val = material_dict % get(id)
if (val /= EMPTY) then
this % materials(i) = val
else
call fatal_error("Could not find material " // trim(to_str(id)) &
&// " specified on a tally filter.")
@ -98,7 +103,7 @@ contains
! Generate mapping from material indices to filter bins.
do i = 1, this % n_bins
call this % map % add_key(this % materials(i), i)
call this % map % set(this % materials(i), i)
end do
end subroutine initialize_material
@ -166,7 +171,7 @@ contains
! Generate mapping from material indices to filter bins.
call f % map % clear()
do i = 1, n
call f % map % add_key(f % materials(i), i)
call f % map % set(f % materials(i), i)
end do
class default

7
src/tallies/tally_filter_mesh.F90
View file

@ -5,6 +5,7 @@ module tally_filter_mesh
use hdf5
use constants
use dict_header, only: EMPTY
use error
use mesh_header, only: RegularMesh, meshes, n_meshes, mesh_dict
use hdf5_interface
@ -41,6 +42,7 @@ contains
integer :: i_mesh
integer :: id
integer :: n
integer :: val
n = node_word_count(node, "bins")
@ -51,8 +53,9 @@ contains
call get_node_value(node, "bins", id)
! Get pointer to mesh
if (mesh_dict % has_key(id)) then
i_mesh = mesh_dict % get_key(id)
val = mesh_dict % get(id)
if (val /= EMPTY) then
i_mesh = val
else
call fatal_error("Could not find mesh " // trim(to_str(id)) &
// " specified on filter.")

7
src/tallies/tally_filter_surface.F90
View file

@ -5,6 +5,7 @@ module tally_filter_surface
use hdf5
use constants, only: ONE, MAX_LINE_LEN
use dict_header, only: EMPTY
use error, only: fatal_error
use hdf5_interface
use surface_header
@ -84,12 +85,14 @@ contains
class(SurfaceFilter), intent(inout) :: this
integer :: i, id
integer :: val
! Convert ids to indices.
do i = 1, this % n_bins
id = this % surfaces(i)
if (surface_dict % has_key(id)) then
this % surfaces(i) = surface_dict % get_key(id)
val = surface_dict % get(id)
if (val /= EMPTY) then
this % surfaces(i) = val
else
call fatal_error("Could not find surface " // trim(to_str(id)) &
&// " specified on tally filter.")

16
src/tallies/tally_filter_universe.F90
View file

@ -5,6 +5,7 @@ module tally_filter_universe
use hdf5
use constants, only: ONE, MAX_LINE_LEN
use dict_header, only: EMPTY
use error, only: fatal_error
use hdf5_interface
use geometry_header
@ -54,12 +55,13 @@ contains
type(TallyFilterMatch), intent(inout) :: match
integer :: i
integer :: val
! Iterate over coordinate levels to see which universes match
do i = 1, p % n_coord
if (this % map % has_key(p % coord(i) % universe)) then
call match % bins % push_back(this % map % get_key(p % coord(i) &
% universe))
val = this % map % get(p % coord(i) % universe)
if (val /= EMPTY) then
call match % bins % push_back(val)
call match % weights % push_back(ONE)
end if
end do
@ -87,12 +89,14 @@ contains
class(UniverseFilter), intent(inout) :: this
integer :: i, id
integer :: val
! Convert ids to indices.
do i = 1, this % n_bins
id = this % universes(i)
if (universe_dict % has_key(id)) then
this % universes(i) = universe_dict % get_key(id)
val = universe_dict % get(id)
if (val /= EMPTY) then
this % universes(i) = val
else
call fatal_error("Could not find universe " // trim(to_str(id)) &
&// " specified on a tally filter.")
@ -101,7 +105,7 @@ contains
! Generate mapping from universe indices to filter bins.
do i = 1, this % n_bins
call this % map % add_key(this % universes(i), i)
call this % map % set(this % universes(i), i)
end do
end subroutine initialize_universe

10
src/tallies/tally_header.F90
View file

@ -455,8 +455,8 @@ contains
integer(C_INT) :: err
if (allocated(tallies)) then
if (tally_dict % has_key(id)) then
index = tally_dict % get_key(id)
if (tally_dict % has(id)) then
index = tally_dict % get(id)
err = 0
else
err = E_INVALID_ID
@ -592,7 +592,7 @@ contains
if (index >= 1 .and. index <= n_tallies) then
if (allocated(tallies(index) % obj)) then
tallies(index) % obj % id = id
call tally_dict % add_key(id, index)
call tally_dict % set(id, index)
err = 0
else
@ -633,8 +633,8 @@ contains
case ('total')
t % nuclide_bins(i) = -1
case default
if (nuclide_dict % has_key(nuclide_)) then
t % nuclide_bins(i) = nuclide_dict % get_key(nuclide_)
if (nuclide_dict % has(nuclide_)) then
t % nuclide_bins(i) = nuclide_dict % get(nuclide_)
else
err = E_DATA
call set_errmsg("Nuclide '" // trim(to_f_string(string)) // &