Remove set_header.F90 and list_header.F90

This commit is contained in:
Paul Romano 2019-01-29 07:07:23 -06:00
parent d790cdfb46
commit f890ba518a
5 changed files with 1 additions and 438 deletions

View file

@ -318,7 +318,6 @@ add_library(libopenmc SHARED
src/hdf5_interface.F90
src/initialize.F90
src/input_xml.F90
src/list_header.F90
src/material_header.F90
src/math.F90
src/mesh_header.F90
@ -333,7 +332,6 @@ add_library(libopenmc SHARED
src/random_lcg.F90
src/reaction_header.F90
src/relaxng
src/set_header.F90
src/settings.F90
src/simulation_header.F90
src/simulation.F90

View file

@ -21,7 +21,6 @@ module input_xml
use photon_header
use random_lcg, only: prn
use surface_header
use set_header, only: SetChar
use settings
use stl_vector, only: VectorInt, VectorReal, VectorChar
use string, only: to_lower, to_str, str_to_int, str_to_real, &

View file

@ -1,311 +0,0 @@
module list_header
!===============================================================================
! LIST_HEADER module
!
! This module contains a linked list structure with convenience methods such as
! append, contains, remove, index, get_item, size, etc. This is an updated
! implementation with type-bound procedures (F2003).
!===============================================================================
use constants, only: ERROR_INT, ERROR_REAL, MAX_WORD_LEN
implicit none
!===============================================================================
! LISTELEM* types hold one piece of data and a pointer to the next piece of data
!===============================================================================
type :: ListElemChar
character(MAX_WORD_LEN) :: data
type(ListElemChar), pointer :: next => null()
type(ListElemChar), pointer :: prev => null()
end type ListElemChar
!===============================================================================
! LIST* types contain the linked list with convenience methods. We originally
! considered using unlimited polymorphism to provide a single type, but compiler
! support is still spotty, and in many cases it doesn't prevent duplication of
! code. For the time being, a separate derived type exists for each datatype.
!===============================================================================
type, public :: ListChar
private
integer :: count = 0 ! Number of elements in list
! Used in get_item for fast sequential lookups
integer :: last_index = huge(0)
type(ListElemChar), pointer :: last_elem => null()
! Pointers to beginning and end of list
type(ListElemChar), public, pointer :: head => null()
type(ListElemChar), public, pointer :: tail => null()
contains
procedure :: append => list_append_char ! Add item to end of list
procedure :: clear => list_clear_char ! Remove all items
procedure :: contains => list_contains_char ! Does list contain?
procedure :: get_item => list_get_item_char ! Get i-th item in list
procedure :: index => list_index_char ! Determine index of given item
procedure :: insert => list_insert_char ! Insert item in i-th position
procedure :: remove => list_remove_char ! Remove specified item
procedure :: size => list_size_char ! Size of list
end type ListChar
contains
!===============================================================================
! LIST_APPEND appends an item to the end of the list. If the list is empty, it
! becomes the first item.
!===============================================================================
subroutine list_append_char(this, data)
class(ListChar) :: this
character(*) :: data
type(ListElemChar), pointer :: elem
! Create element and set dat
allocate(elem)
elem % data = data
if (.not. associated(this % head)) then
! If list is empty, set head and tail to new element
this % head => elem
this % tail => elem
else
! Otherwise append element at end of list
this % tail % next => elem
elem % prev => this % tail
this % tail => this % tail % next
end if
this % count = this % count + 1
end subroutine list_append_char
!===============================================================================
! LIST_CLEAR removes all elements from the list
!===============================================================================
subroutine list_clear_char(this)
class(ListChar) :: this
type(ListElemChar), pointer :: current => null()
type(ListElemChar), pointer :: next => null()
if (this % count > 0) then
current => this % head
do while (associated(current))
! Set pointer to next element
next => current % next
! Deallocate memory for current element
deallocate(current)
! Move to next element
current => next
end do
nullify(this % head)
nullify(this % tail)
this % count = 0
end if
end subroutine list_clear_char
!===============================================================================
! LIST_CONTAINS determines whether the list contains a specified item. Since it
! relies on the index method, it is O(n).
!===============================================================================
function list_contains_char(this, data) result(in_list)
class(ListChar) :: this
character(*) :: data
logical :: in_list
in_list = (this % index(data) > 0)
end function list_contains_char
!===============================================================================
! LIST_GET_ITEM returns the item in the list at position 'i_list'. If the index
! is out of bounds, an error code is returned.
! ===============================================================================
function list_get_item_char(this, i_list) result(data)
class(ListChar) :: this
integer :: i_list
character(MAX_WORD_LEN) :: data
integer :: last_index
if (i_list < 1 .or. i_list > this % count) then
! Check for index out of bounds
data = ""
elseif (i_list == 1) then
data = this % head % data
this % last_index = 1
this % last_elem => this % head
elseif (i_list == this % count) then
data = this % tail % data
this % last_index = this % count
this % last_elem => this % tail
else
if (i_list < this % last_index) then
this % last_index = 1
this % last_elem => this % head
end if
do last_index = this % last_index + 1, i_list
this % last_elem => this % last_elem % next
this % last_index = last_index
end do
data = this % last_elem % data
end if
end function list_get_item_char
!===============================================================================
! LIST_INDEX determines the first index in the list that contains 'data'. If
! 'data' is not present in the list, the return value is -1.
!===============================================================================
function list_index_char(this, data) result(i_list)
class(ListChar) :: this
character(*) :: data
integer :: i_list
type(ListElemChar), pointer :: elem
i_list = 0
elem => this % head
do while (associated(elem))
i_list = i_list + 1
if (data == elem % data) exit
elem => elem % next
end do
! Check if we reached the end of the list
if (.not. associated(elem)) i_list = -1
end function list_index_char
!===============================================================================
! LIST_INSERT inserts 'data' at index 'i_list' within the list. If 'i_list'
! exceeds the size of the list, the data is appends at the end of the list.
!===============================================================================
subroutine list_insert_char(this, i_list, data)
class(ListChar) :: this
integer :: i_list
character(*) :: data
integer :: i
type(ListElemChar), pointer :: elem => null()
type(ListElemChar), pointer :: new_elem => null()
if (i_list > this % count) then
! Check whether specified index is greater than number of elements -- if
! so, just append it to the end of the list
call this % append(data)
else if (i_list == 1) then
! Check for new head element
allocate(new_elem)
new_elem % data = data
new_elem % next => this % head
this % head => new_elem
this % count = this % count + 1
else
! Default case with new element somewhere in middle of list
if (i_list >= this % last_index) then
i = this % last_index
elem => this % last_elem
else
i = 0
elem => this % head
end if
do while (associated(elem))
if (i == i_list) then
! Allocate new element
allocate(new_elem)
new_elem % data = data
! Put it before the i-th element
new_elem % prev => elem % prev
new_elem % next => elem
new_elem % prev % next => new_elem
new_elem % next % prev => new_elem
this % count = this % count + 1
this % last_index = i_list
this % last_elem => new_elem
exit
end if
i = i + 1
elem => elem % next
end do
end if
end subroutine list_insert_char
!===============================================================================
! LIST_REMOVE removes the first item in the list that contains 'data'. If 'data'
! is not in the list, no action is taken.
!===============================================================================
subroutine list_remove_char(this, data)
class(ListChar) :: this
character(*) :: data
type(ListElemChar), pointer :: elem => null()
elem => this % head
do while (associated(elem))
! Check for matching data
if (elem % data == data) then
! Determine whether the current element is the head, tail, or a middle
! element
if (associated(elem, this % head)) then
this % head => elem % next
if (associated(elem, this % tail)) nullify(this % tail)
if (associated(this % head)) nullify(this % head % prev)
deallocate(elem)
else if (associated(elem, this % tail)) then
this % tail => elem % prev
deallocate(this % tail % next)
else
elem % prev % next => elem % next
elem % next % prev => elem % prev
deallocate(elem)
end if
! Decrease count and exit
this % count = this % count - 1
exit
end if
! Advance pointers
elem => elem % next
end do
end subroutine list_remove_char
!===============================================================================
! LIST_SIZE returns the number of elements in the list
!===============================================================================
function list_size_char(this) result(size)
class(ListChar) :: this
integer :: size
size = this % count
end function list_size_char
end module list_header

View file

@ -5,14 +5,11 @@ module nuclide_header
use algorithm, only: sort, find, binary_search
use constants
use dict_header, only: DictIntInt
use endf, only: reaction_name, is_fission, is_disappearance, &
is_inelastic_scatter
use endf, only: is_fission, is_disappearance
use endf_header, only: Function1D, Polynomial, Tabulated1D
use error
use hdf5_interface
use message_passing
use random_lcg, only: prn, future_prn, prn_set_stream
use reaction_header, only: Reaction
use settings
use stl_vector, only: VectorInt, VectorReal
@ -66,9 +63,6 @@ module nuclide_header
! Fission information
integer, allocatable :: index_fission(:) ! indices in reactions
! Multipole data
logical :: mp_present = .false.
! Reactions
type(Reaction), allocatable :: reactions(:)

View file

@ -1,117 +0,0 @@
module set_header
!===============================================================================
! SET_HEADER module
!
! This module provides an implementation of sets based on the list
! implementation in list_header. The underlying datatype is a list, so adding an
! element just checks if the element is already in the list, and if not it's
! added. This results in much worse performance than an implementation based on
! hash tables or binary trees, but for our purposes, we don't expect to have
! gigantic sets where performance is critical.
!===============================================================================
use constants, only: MAX_WORD_LEN
use list_header
implicit none
!===============================================================================
! SET contains a list of elements and methods to add, remove, and perform other
! basic tasks.
!===============================================================================
type :: SetChar
private
type(ListChar) :: elements
contains
procedure :: add => set_add_char
procedure :: clear => set_clear_char
procedure :: contains => set_contains_char
procedure :: get_item => set_get_item_char
procedure :: remove => set_remove_char
procedure :: size => set_size_char
end type SetChar
contains
!===============================================================================
! SET_ADD adds an item to a set if it is not already present in the set
!===============================================================================
subroutine set_add_char(this, data)
class(SetChar) :: this
character(*) :: data
if (.not. this % elements % contains(data)) then
call this % elements % append(data)
end if
end subroutine set_add_char
!===============================================================================
! SET_CLEAR removes all items in a set
!===============================================================================
subroutine set_clear_char(this)
class(SetChar) :: this
call this % elements % clear()
end subroutine set_clear_char
!===============================================================================
! SET_CONTAINS determines if a specified item is in a set
!===============================================================================
function set_contains_char(this, data) result(in_set)
class(SetChar) :: this
character(*) :: data
logical :: in_set
in_set = this % elements % contains(data)
end function set_contains_char
!===============================================================================
! SET_GET_ITEM returns the i-th item in the set
!===============================================================================
function set_get_item_char(this, i_list) result(data)
class(SetChar) :: this
integer :: i_list
character(MAX_WORD_LEN) :: data
data = this % elements % get_item(i_list)
end function set_get_item_char
!===============================================================================
! SET_REMOVE removes the specified item from the set. If it is not in the set,
! no action is taken.
!===============================================================================
subroutine set_remove_char(this, data)
class(SetChar) :: this
character(*) :: data
call this % elements % remove(data)
end subroutine set_remove_char
!===============================================================================
! SET_SIZE returns the number of elements in the set
!===============================================================================
function set_size_char(this) result(size)
class(SetChar) :: this
integer :: size
size = this % elements % size()
end function set_size_char
end module set_header