crp/OpenMC
1
0
Fork 0
mirror of https://github.com/openmc-dev/openmc.git synced 2026-07-28 14:15:42 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 5

Changed line width to 80. Developers should set fill-column to 80 on emacs.

Browse source
This commit is contained in:
Paul Romano 2011-07-20 21:45:23 -04:00
parent 75d778fdf3
commit c4825c2efb
20 changed files with 826 additions and 885 deletions
Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -1,5 +1,6 @@
# Compiled objects and modules
*.o
*.mod
*.log
# emacs backups
*~

198
src/ace.f90
View file

@ -1,13 +1,13 @@
module ace
use global
use output, only: error, message
use string, only: lower_case
use fileio, only: read_line, read_data, skip_lines
use string, only: split_string
use output, only: error, message
use string, only: lower_case
use fileio, only: read_line, read_data, skip_lines
use string, only: split_string
use data_structures, only: dict_create, dict_add_key, dict_has_key, &
& dict_get_key, dict_delete
use endf, only: reaction_name
use endf, only: reaction_name
integer :: NXS(16) ! Descriptors for ACE XSS tables
integer :: JXS(32) ! Pointers into ACE XSS tables
@ -20,10 +20,10 @@ module ace
contains
!=====================================================================
! READ_XS reads all the cross sections for the problem and stores them
! in xs_continuous and xs_thermal arrays
!=====================================================================
!===============================================================================
! READ_XS reads all the cross sections for the problem and stores them in
! xs_continuous and xs_thermal arrays
!===============================================================================
subroutine read_xs()
@ -43,8 +43,8 @@ contains
call dict_create(ace_dict)
! determine how many continuous-energy tables and how many S(a,b)
! thermal scattering tables there are
! determine how many continuous-energy tables and how many S(a,b) thermal
! scattering tables there are
index_continuous = 0
index_thermal = 0
do i = 1, n_materials
@ -109,11 +109,11 @@ contains
end subroutine read_xs
!=====================================================================
! READ_ACE_CONTINUOUS reads in a single ACE continuous-energy neutron
! cross section table. This routine reads the header data and then
! calls appropriate subroutines to parse the actual data.
!=====================================================================
!===============================================================================
! READ_ACE_CONTINUOUS reads in a single ACE continuous-energy neutron cross
! section table. This routine reads the header data and then calls appropriate
! subroutines to parse the actual data.
!===============================================================================
subroutine read_ACE_continuous(index_table, index)
@ -224,18 +224,16 @@ contains
end subroutine read_ACE_continuous
!=====================================================================
! READ_ESZ - reads through the ESZ block. This block contains the
! energy grid, total xs, absorption xs, elastic scattering xs, and
! heating numbers.
!=====================================================================
!===============================================================================
! READ_ESZ - reads through the ESZ block. This block contains the energy grid,
! total xs, absorption xs, elastic scattering xs, and heating numbers.
!===============================================================================
subroutine read_esz(table)
type(AceContinuous), pointer :: table
integer :: NE ! number of energy points for total and elastic
! cross sections
integer :: NE ! number of energy points for total and elastic cross sections
! determine number of energy points
NE = NXS(3)
@ -248,11 +246,10 @@ contains
allocate(table%sigma_el(NE))
allocate(table%heating(NE))
! read data from XSS -- right now the total, absorption and
! elastic scattering are read in to these special arrays, but in
! reality, it should be necessary to only store elastic scattering
! and possibly total cross-section for total material xs
! generation.
! read data from XSS -- right now the total, absorption and elastic
! scattering are read in to these special arrays, but in reality, it should
! be necessary to only store elastic scattering and possibly total
! cross-section for total material xs generation.
XSS_index = 1
table%energy = get_real(NE)
table%sigma_t = get_real(NE)
@ -262,11 +259,11 @@ contains
end subroutine read_esz
!=====================================================================
! READ_NU_DATA reads data given on the number of neutrons emitted from
! fission as a function of the incoming energy of a neutron. This data
! may be broken down into prompt and delayed neutrons emitted as well.
!=====================================================================
!===============================================================================
! READ_NU_DATA reads data given on the number of neutrons emitted from fission
! as a function of the incoming energy of a neutron. This data may be broken
! down into prompt and delayed neutrons emitted as well.
!===============================================================================
subroutine read_nu_data(table)
@ -294,13 +291,13 @@ contains
JXS24 = JXS(24)
if (JXS2 == 0) then
! =============================================================
! =======================================================================
! NO PROMPT/TOTAL NU DATA
table % nu_t_type = NU_NONE
table % nu_p_type = NU_NONE
elseif (XSS(JXS2) > 0) then
! =============================================================
! =======================================================================
! PROMPT OR TOTAL NU DATA
KNU = JXS2
LNU = int(XSS(KNU))
@ -317,8 +314,7 @@ contains
table % nu_t_type = NU_TABULAR
table % nu_p_type = NU_NONE
! determine number of interpolation regions and number of
! energies
! determine number of interpolation regions and number of energies
NR = int(XSS(KNU+1))
NE = int(XSS(KNU+2+2*NR))
length = 2 + 2*NR + 2*NE
@ -327,14 +323,14 @@ contains
! allocate space for nu data storage
allocate(table % nu_t_data(length))
! read data -- for polynomial, this is the number of
! coefficients and the coefficients themselves, and for
! tabular, this is interpolation data and tabular E/nu
! read data -- for polynomial, this is the number of coefficients and the
! coefficients themselves, and for tabular, this is interpolation data
! and tabular E/nu
XSS_index = KNU + 1
table % nu_t_data = get_real(length)
elseif (XSS(JXS2) < 0) then
! =============================================================
! =======================================================================
! PROMPT AND TOTAL NU DATA -- read prompt data first
KNU = JXS2 + 1
LNU = XSS(KNU)
@ -349,8 +345,7 @@ contains
! Tabular data
table % nu_p_type = NU_TABULAR
! determine number of interpolation regions and number of
! energies
! determine number of interpolation regions and number of energies
NR = XSS(KNU+1)
NE = XSS(KNU+2+2*NR)
length = 2 + 2*NR + 2*NE
@ -377,8 +372,7 @@ contains
! Tabular data
table % nu_t_type = NU_TABULAR
! determine number of interpolation regions and number of
! energies
! determine number of interpolation regions and number of energies
NR = int(XSS(KNU+1))
NE = int(XSS(KNU+2+2*NR))
length = 2 + 2*NR + 2*NE
@ -393,7 +387,7 @@ contains
end if
if (JXS24 > 0) then
! =============================================================
! =======================================================================
! DELAYED NU DATA
table % nu_d_type = NU_TABULAR
@ -411,7 +405,7 @@ contains
XSS_index = KNU + 1
table % nu_d_data = get_real(length)
! =============================================================
! =======================================================================
! DELAYED NEUTRON ENERGY DISTRIBUTION
! Allocate space for secondary energy distribution
@ -470,7 +464,7 @@ contains
table % nu_d_edist(i) % data = get_real(length)
end do
! =============================================================
! =======================================================================
! DELAYED NEUTRON PRECUSOR YIELDS AND CONSTANTS
! determine length of all precursor constants/yields/interp data
@ -495,11 +489,11 @@ contains
end subroutine read_nu_data
!=====================================================================
!===============================================================================
! READ_REACTIONS - Get the list of reaction MTs for this cross-section
! table. The MT values are somewhat arbitrary. Also read in Q-values,
! neutron multiplicities, and cross-sections.
!=====================================================================
! table. The MT values are somewhat arbitrary. Also read in Q-values, neutron
! multiplicities, and cross-sections.
!===============================================================================
subroutine read_reactions(table)
@ -522,8 +516,8 @@ contains
JXS7 = JXS(7)
NMT = NXS(4)
! allocate array of reactions. Add one since we need to include an
! elastic scattering channel
! allocate array of reactions. Add one since we need to include an elastic
! scattering channel
table%n_reaction = NMT + 1
allocate(table%reactions(NMT+1))
@ -559,10 +553,10 @@ contains
end subroutine read_reactions
!=====================================================================
! READ_ANGULAR_DIST parses the angular distribution for each reaction
! with secondary neutrons
!=====================================================================
!===============================================================================
! READ_ANGULAR_DIST parses the angular distribution for each reaction with
! secondary neutrons
!===============================================================================
subroutine read_angular_dist(table)
@ -582,21 +576,20 @@ contains
JXS8 = JXS(8)
JXS9 = JXS(9)
! loop over all reactions with secondary neutrons -- NXS(5) does
! not include elastic scattering
! loop over all reactions with secondary neutrons -- NXS(5) does not include
! elastic scattering
do i = 1, NXS(5) + 1
rxn => table%reactions(i)
! find location of angular distribution
LOCB = XSS(JXS8 + i - 1)
if (LOCB == -1) then
! Angular distribution data are specified through LAWi = 44
! in the DLW block
! Angular distribution data are specified through LAWi = 44 in the DLW
! block
cycle
elseif (LOCB == 0) then
! No angular distribution data are given for this reaction,
! isotropic scattering is asssumed (in CM if TY < 0 and in
! LAB if TY > 0)
! No angular distribution data are given for this reaction, isotropic
! scattering is asssumed (in CM if TY < 0 and in LAB if TY > 0)
cycle
end if
rxn % has_angle_dist = .true.
@ -635,15 +628,14 @@ contains
! allocate angular distribution data and read
allocate(rxn % adist % data(length))
! read angular distribution -- currently this does not actually
! parse the angular distribution tables for each incoming
! energy, that must be done on-the-fly
! read angular distribution -- currently this does not actually parse the
! angular distribution tables for each incoming energy, that must be done
! on-the-fly
LC = rxn % adist % location(1)
XSS_index = JXS9 + abs(LC) - 1
rxn % adist % data = get_real(length)
! change location pointers since they are currently relative to
! JXS(9)
! change location pointers since they are currently relative to JXS(9)
LC = abs(rxn % adist % location(1))
rxn % adist % location = abs(rxn % adist % location) - LC
@ -651,10 +643,10 @@ contains
end subroutine read_angular_dist
!=====================================================================
! READ_ENERGY_DIST parses the secondary energy distribution for each
! reaction with seconary neutrons (except elastic scattering)
!=====================================================================
!===============================================================================
! READ_ENERGY_DIST parses the secondary energy distribution for each reaction
! with seconary neutrons (except elastic scattering)
!===============================================================================
subroutine read_energy_dist(table)
@ -731,11 +723,10 @@ contains
end subroutine read_energy_dist
!=====================================================================
! LENGTH_ENERGY_DIST determines how many values are contained in an
! LDAT energy distribution array based on the secondary energy law and
! location in XSS
!=====================================================================
!===============================================================================
! LENGTH_ENERGY_DIST determines how many values are contained in an LDAT energy
! distribution array based on the secondary energy law and location in XSS
!===============================================================================
function length_energy_dist(loc, law, LOCC, lid) result(length)
@ -873,10 +864,9 @@ contains
end function length_energy_dist
!=====================================================================
! READ_UNR_RES reads in unresolved resonance probability tables if
! present.
!=====================================================================
!===============================================================================
! READ_UNR_RES reads in unresolved resonance probability tables if present.
!===============================================================================
subroutine read_unr_res(table)
@ -930,11 +920,11 @@ contains
end subroutine read_unr_res
!=====================================================================
! READ_ACE_THERMAL reads in a single ACE thermal scattering S(a,b)
! table. This routine in particular reads the header data and then
! calls read_thermal_data to parse the actual data blocks.
!=====================================================================
!===============================================================================
! READ_ACE_THERMAL reads in a single ACE thermal scattering S(a,b) table. This
! routine in particular reads the header data and then calls read_thermal_data
! to parse the actual data blocks.
!===============================================================================
subroutine read_ACE_thermal(index_table, index)
@ -1040,12 +1030,12 @@ contains
end subroutine read_ACE_thermal
!=====================================================================
! READ_THERMAL_DATA reads elastic and inelastic cross sections and
! corresponding secondary energy/angle distributions derived from
! experimental S(a,b) data. Namely, in MCNP language, this routine
! reads the ITIE, ITCE, ITXE, and ITCA blocks.
!=====================================================================
!===============================================================================
! READ_THERMAL_DATA reads elastic and inelastic cross sections and corresponding
! secondary energy/angle distributions derived from experimental S(a,b)
! data. Namely, in MCNP language, this routine reads the ITIE, ITCE, ITXE, and
! ITCA blocks.
!===============================================================================
subroutine read_thermal_data(table)
@ -1130,10 +1120,10 @@ contains
end subroutine read_thermal_data
!=====================================================================
! GET_INT returns an array of integers read from the current position
! in the XSS array
!=====================================================================
!===============================================================================
! GET_INT returns an array of integers read from the current position in the XSS
! array
!===============================================================================
function get_int(n_values) result(array)
@ -1145,10 +1135,10 @@ contains
end function get_int
!=====================================================================
! GET_REAL returns an array of real(8)s read from the current position
! in the XSS array
!=====================================================================
!===============================================================================
! GET_REAL returns an array of real(8)s read from the current position in the
! XSS array
!===============================================================================
function get_real(n_values) result(array)
@ -1160,9 +1150,9 @@ contains
end function get_real
!=====================================================================
!===============================================================================
! GET_MACRO_XS
!=====================================================================
!===============================================================================
function get_macro_xs(p, mat, MT) result(xs)

22
src/cross_section.f90
View file

@ -1,19 +1,19 @@
module cross_section
use global
use string, only: split_string
use string, only: split_string
use data_structures, only: dict_create, dict_add_key, dict_get_key
use output, only: error, message
use types, only: xsData
use output, only: error, message
use types, only: xsData
implicit none
contains
!=====================================================================
! READ_XSDATA reads the data in a SERPENT xsdata file and builds a
! dictionary to find cross-section information later on.
!=====================================================================
!===============================================================================
! READ_XSDATA reads the data in a SERPENT xsdata file and builds a dictionary to
! find cross-section information later on.
!===============================================================================
subroutine read_xsdata(path)
@ -118,10 +118,10 @@ contains
end subroutine read_xsdata
!=====================================================================
! MATERIAL_TOTAL_XS calculates the total macroscopic cross section of
! each material for use in sampling path lengths
!=====================================================================
!===============================================================================
! MATERIAL_TOTAL_XS calculates the total macroscopic cross section of each
! material for use in sampling path lengths
!===============================================================================
subroutine material_total_xs()

207
src/data_structures.f90
View file

@ -1,18 +1,16 @@
module data_structures
!=====================================================================
!===============================================================================
! DATA_STRUCTURES module
!
! This module implements a dictionary that has (key,value) pairs. This
! data structure is used to provide lookup features, e.g. cells and
! surfaces by name.
! This module implements a dictionary that has (key,value) pairs. This data
! structure is used to provide lookup features, e.g. cells and surfaces by name.
!
! The original version from the 'flibs' open source package
! implemented another derived type called DICT_DATA that has been
! replaced here by a simple integer in ListData. If used in the
! original form , the dictionary can store derived types (changes made
! to ListData, dict_create, dict_add_key, and dict_get_key).
!=====================================================================
! The original version from the 'flibs' open source package implemented another
! derived type called DICT_DATA that has been replaced here by a simple integer
! in ListData. If used in the original form , the dictionary can store derived
! types (changes made to ListData, dict_create, dict_add_key, and dict_get_key).
!===============================================================================
use types
@ -22,11 +20,11 @@ module data_structures
integer, parameter :: multiplier = 31
integer, parameter :: DICT_NULL = 0
!=====================================================================
! LIST Interfaces -- these allow one to use a single subroutine or
! function for various types of lists, namely those consisting of
! integers, reals, or (key,value) pairs.
!=====================================================================
!===============================================================================
! LIST Interfaces -- these allow one to use a single subroutine or function for
! various types of lists, namely those consisting of integers, reals, or
! (key,value) pairs.
!===============================================================================
interface list_create
module procedure list_real_create, list_int_create
@ -53,10 +51,10 @@ module data_structures
module procedure list_kvci_del_element, list_kvii_del_element
end interface
!=====================================================================
! DICTIONARY Interfaces -- these allow one to use a single subroutine
! or function for dictionaries with varying types of (key,value) pairs
!=====================================================================
!===============================================================================
! DICTIONARY Interfaces -- these allow one to use a single subroutine or
! function for dictionaries with varying types of (key,value) pairs
!===============================================================================
interface dict_create
module procedure dict_ci_create, dict_ii_create
@ -88,9 +86,9 @@ module data_structures
contains
!=====================================================================
!===============================================================================
! LIST_INT_CREATE creates and initializes a list of integers
!=====================================================================
!===============================================================================
subroutine list_int_create(list, data)
@ -103,9 +101,9 @@ contains
end subroutine list_int_create
!=====================================================================
!===============================================================================
! LIST_REAL_CREATE creates and initializes a list of real(8)s
!=====================================================================
!===============================================================================
subroutine list_real_create(list, data)
@ -118,9 +116,9 @@ contains
end subroutine list_real_create
!=====================================================================
!===============================================================================
! LIST_KVCI_CREATE creates and initializes a list of (key,value) pairs
!=====================================================================
!===============================================================================
subroutine list_kvci_create(list, data)
@ -133,9 +131,9 @@ contains
end subroutine list_kvci_create
!=====================================================================
!===============================================================================
! LIST_KVII_CREATE creates and initializes a list of (key,value) pairs
!=====================================================================
!===============================================================================
subroutine list_kvii_create(list, data)
@ -148,9 +146,9 @@ contains
end subroutine list_kvii_create
!=====================================================================
!===============================================================================
! LIST_INT_DELETE deallocates all data in a list of integers
!=====================================================================
!===============================================================================
subroutine list_int_delete(list)
@ -167,9 +165,9 @@ contains
end subroutine list_int_delete
!=====================================================================
!===============================================================================
! LIST_REAL_DELETE deallocates all data in a list of real(8)s
!=====================================================================
!===============================================================================
subroutine list_real_delete(list)
@ -186,9 +184,9 @@ contains
end subroutine list_real_delete
!=====================================================================
!===============================================================================
! LIST_KVCI_DELETE deallocates all data in a list of (key,value) pairs
!=====================================================================
!===============================================================================
subroutine list_kvci_delete(list)
@ -205,9 +203,9 @@ contains
end subroutine list_kvci_delete
!=====================================================================
!===============================================================================
! LIST_KVII_DELETE deallocates all data in a list of (key,value) pairs
!=====================================================================
!===============================================================================
subroutine list_kvii_delete(list)
@ -224,9 +222,9 @@ contains
end subroutine list_kvii_delete
!=====================================================================
!===============================================================================
! LIST_INT_SIZE counts the number of items in a list of integers
!=====================================================================
!===============================================================================
function list_int_size(list) result(n)
@ -247,9 +245,9 @@ contains
end function list_int_size
!=====================================================================
!===============================================================================
! LIST_REAL_SIZE counts the number of items in a list of real(8)s
!=====================================================================
!===============================================================================
function list_real_size(list) result(n)
@ -270,10 +268,10 @@ contains
end function list_real_size
!=====================================================================
!===============================================================================
! LIST_KVCI_SIZE counts the number of items in a list of (key,value)
! pairs
!=====================================================================
!===============================================================================
function list_kvci_size(list) result(n)
@ -294,10 +292,9 @@ contains
end function list_kvci_size
!=====================================================================
! LIST_KVII_SIZE counts the number of items in a list of (key,value)
! pairs
!=====================================================================
!===============================================================================
! LIST_KVII_SIZE counts the number of items in a list of (key,value) pairs
!===============================================================================
function list_kvii_size(list) result(n)
@ -318,13 +315,13 @@ contains
end function list_kvii_size
!=====================================================================
!===============================================================================
! LIST_INT_INSERT inserts a new element
! Arguments:
! elem Element in the linked list after
! which to insert the new element
! data The data for the new element
!=====================================================================
!===============================================================================
subroutine list_int_insert(elem, data)
@ -341,13 +338,13 @@ contains
end subroutine list_int_insert
!=====================================================================
!===============================================================================
! LIST_REAL_INSERT inserts a new element
! Arguments:
! elem Element in the linked list after
! which to insert the new element
! data The data for the new element
!=====================================================================
!===============================================================================
subroutine list_real_insert(elem, data)
@ -364,13 +361,13 @@ contains
end subroutine list_real_insert
!=====================================================================
!===============================================================================
! LIST_KVCI_INSERT inserts a new element
! Arguments:
! elem Element in the linked list after
! which to insert the new element
! data The data for the new element
!=====================================================================
!===============================================================================
subroutine list_kvci_insert(elem, data)
@ -387,13 +384,13 @@ contains
end subroutine list_kvci_insert
!=====================================================================
!===============================================================================
! LIST_KVII_INSERT inserts a new element
! Arguments:
! elem Element in the linked list after
! which to insert the new element
! data The data for the new element
!=====================================================================
!===============================================================================
subroutine list_kvii_insert(elem, data)
@ -410,12 +407,12 @@ contains
end subroutine list_kvii_insert
!=====================================================================
!===============================================================================
! LIST_INT_INSERT_HEAD inserts a new element before the first element
! Arguments:
! list Start of the list
! data The data for the new element
!=====================================================================
!===============================================================================
subroutine list_int_insert_head(list, data)
@ -432,12 +429,12 @@ contains
end subroutine list_int_insert_head
!=====================================================================
!===============================================================================
! LIST_REAL_INSERT_HEAD inserts a new element before the first element
! Arguments:
! list Start of the list
! data The data for the new element
!=====================================================================
!===============================================================================
subroutine list_real_insert_head(list, data)
@ -454,12 +451,12 @@ contains
end subroutine list_real_insert_head
!=====================================================================
!===============================================================================
! LIST_KVCI_INSERT_HEAD inserts a new element before the first element
! Arguments:
! list Start of the list
! data The data for the new element
!=====================================================================
!===============================================================================
subroutine list_kvci_insert_head(list, data)
@ -476,12 +473,12 @@ contains
end subroutine list_kvci_insert_head
!=====================================================================
!===============================================================================
! LIST_KVII_INSERT_HEAD inserts a new element before the first element
! Arguments:
! list Start of the list
! data The data for the new element
!=====================================================================
!===============================================================================
subroutine list_kvii_insert_head(list, data)
@ -498,12 +495,12 @@ contains
end subroutine list_kvii_insert_head
!=====================================================================
!===============================================================================
! LIST_INT_DEL_ELEMENT deletes an element from the list
! Arguments:
! list Header of the list
! elem Element in the linked list to be removed
!=====================================================================
!===============================================================================
subroutine list_int_del_element(list, elem)
@ -532,12 +529,12 @@ contains
end subroutine list_int_del_element
!=====================================================================
!===============================================================================
! LIST_REAL_DEL_ELEMENT deletes an element from the list
! Arguments:
! list Header of the list
! elem Element in the linked list to be removed
!=====================================================================
!===============================================================================
subroutine list_real_del_element(list, elem)
@ -566,12 +563,12 @@ contains
end subroutine list_real_del_element
!=====================================================================
!===============================================================================
! LIST_KVCI_DEL_ELEMENT deletes an element from the list
! Arguments:
! list Header of the list
! elem Element in the linked list to be removed
!=====================================================================
!===============================================================================
subroutine list_kvci_del_element(list, elem)
@ -600,12 +597,12 @@ contains
end subroutine list_kvci_del_element
!=====================================================================
!===============================================================================
! LIST_KVII_DEL_ELEMENT deletes an element from the list
! Arguments:
! list Header of the list
! elem Element in the linked list to be removed
!=====================================================================
!===============================================================================
subroutine list_kvii_del_element(list, elem)
@ -634,9 +631,9 @@ contains
end subroutine list_kvii_del_element
!=====================================================================
!===============================================================================
! DICT_CI_CREATE creates and initializes a dictionary
!=====================================================================
!===============================================================================
subroutine dict_ci_create(dict)
@ -653,9 +650,9 @@ contains
end subroutine dict_ci_create
!=====================================================================
!===============================================================================
! DICT_II_CREATE creates and initializes a dictionary
!=====================================================================
!===============================================================================
subroutine dict_ii_create(dict)
@ -672,9 +669,9 @@ contains
end subroutine dict_ii_create
!=====================================================================
!===============================================================================
! DICT_CI_DELETE destroys an entire dictionary
!=====================================================================
!===============================================================================
subroutine dict_ci_delete(dict)
@ -692,9 +689,9 @@ contains
end subroutine dict_ci_delete
!=====================================================================
!===============================================================================
! DICT_II_DELETE destroys an entire dictionary
!=====================================================================
!===============================================================================
subroutine dict_ii_delete(dict)
@ -712,7 +709,7 @@ contains
end subroutine dict_ii_delete
!=====================================================================
!===============================================================================
! DICT_CI_ADD_KEY add a new keys
! Arguments:
! dict Pointer to the dictionary
@ -721,7 +718,7 @@ contains
! Note:
! If the key already exists, the
! key's value is simply replaced
!=====================================================================
!===============================================================================
subroutine dict_ci_add_key(dict, key, value)
@ -750,7 +747,7 @@ contains
end subroutine dict_ci_add_key
!=====================================================================
!===============================================================================
! DICT_II_ADD_KEY add a new keys
! Arguments:
! dict Pointer to the dictionary
@ -759,7 +756,7 @@ contains
! Note:
! If the key already exists, the
! key's value is simply replaced
!=====================================================================
!===============================================================================
subroutine dict_ii_add_key(dict, key, value)
@ -788,12 +785,12 @@ contains
end subroutine dict_ii_add_key
!=====================================================================
!===============================================================================
! DICT_CI_DELETE_KEY deletes a key-value pair from the dictionary
! Arguments:
! dict Dictionary in question
! key Key to be removed
!=====================================================================
!===============================================================================
subroutine dict_ci_delete_key(dict, key)
@ -812,12 +809,12 @@ contains
end subroutine dict_ci_delete_key
!=====================================================================
!===============================================================================
! DICT_II_DELETE_KEY deletes a key-value pair from the dictionary
! Arguments:
! dict Dictionary in question
! key Key to be removed
!=====================================================================
!===============================================================================
subroutine dict_ii_delete_key(dict, key)
@ -836,12 +833,12 @@ contains
end subroutine dict_ii_delete_key
!=====================================================================
!===============================================================================
! DICT_CI_GET_KEY gets the value belonging to a key
! Arguments:
! dict Pointer to the dictionary
! key Key for which the values are sought
!=====================================================================
!===============================================================================
function dict_ci_get_key(dict, key) result(value)
@ -862,12 +859,12 @@ contains
end function dict_ci_get_key
!=====================================================================
!===============================================================================
! DICT_II_GET_KEY gets the value belonging to a key
! Arguments:
! dict Pointer to the dictionary
! key Key for which the values are sought
!=====================================================================
!===============================================================================
function dict_ii_get_key(dict, key) result(value)
@ -888,12 +885,12 @@ contains
end function dict_ii_get_key
!=====================================================================
!===============================================================================
! DICT_CI_HAS_KEY checks if the dictionary has a particular key
! Arguments:
! dict Pointer to the dictionary
! key Key to be sought
!=====================================================================
!===============================================================================
function dict_ci_has_key(dict, key) result(has)
@ -909,12 +906,12 @@ contains
end function dict_ci_has_key
!=====================================================================
!===============================================================================
! DICT_II_HAS_KEY checks if the dictionary has a particular key
! Arguments:
! dict Pointer to the dictionary
! key Key to be sought
!=====================================================================
!===============================================================================
function dict_ii_has_key(dict, key) result(has)
@ -930,12 +927,12 @@ contains
end function dict_ii_has_key
!=====================================================================
!===============================================================================
! DICT_CI_GET_ELEM finds the element with a particular key
! Arguments:
! dict Pointer to the dictionary
! key Key to be sought
!=====================================================================
!===============================================================================
function dict_ci_get_elem(dict, key) result(elem)
@ -957,12 +954,12 @@ contains
end function dict_ci_get_elem
!=====================================================================
!===============================================================================
! DICT_II_GET_ELEM finds the element with a particular key
! Arguments:
! dict Pointer to the dictionary
! key Key to be sought
!=====================================================================
!===============================================================================
function dict_ii_get_elem(dict, key) result(elem)
@ -984,11 +981,11 @@ contains
end function dict_ii_get_elem
!=====================================================================
!===============================================================================
! DICT_CI_HASHKEY determine the hash value from the string
! Arguments:
! key String to be examined
!=====================================================================
!===============================================================================
function dict_ci_hashkey(key) result(val)
@ -1010,11 +1007,11 @@ contains
end function dict_ci_hashkey
!=====================================================================
!===============================================================================
! DICT_II_HASHKEY determine the hash value from the string
! Arguments:
! key String to be examined
!=====================================================================
!===============================================================================
function dict_ii_hashkey(key) result(val)
@ -1032,9 +1029,9 @@ contains
end function dict_ii_hashkey
!=====================================================================
!===============================================================================
! DICT_CI_KEYS
!=====================================================================
!===============================================================================
function dict_ci_keys(dict) result(head)
@ -1064,9 +1061,9 @@ contains
end function dict_ci_keys
!=====================================================================
!===============================================================================
! DICT_II_KEYS
!=====================================================================
!===============================================================================
function dict_ii_keys(dict) result(head)

4
src/endf.f90
View file

@ -4,9 +4,9 @@ module endf
contains
!=====================================================================
!===============================================================================
! REACTION_NAME gives the name of the reaction for a given MT value
!=====================================================================
!===============================================================================
function reaction_name(MT) result(string)

43
src/energy_grid.f90
View file

@ -7,13 +7,13 @@ module energy_grid
contains
!=====================================================================
! UNIONIZED_GRID creates a single unionized energy grid combined from
! each nuclide of each material. Right now, the grid for each nuclide
! is added into a linked list one at a time with an effective
! insertion sort. Could be done with a hash for all energy points and
! then a quicksort at the end (what hash function to use?)
!=====================================================================
!===============================================================================
! UNIONIZED_GRID creates a single unionized energy grid combined from each
! nuclide of each material. Right now, the grid for each nuclide is added into a
! linked list one at a time with an effective insertion sort. Could be done with
! a hash for all energy points and then a quicksort at the end (what hash
! function to use?)
!===============================================================================
subroutine unionized_grid()
@ -58,10 +58,10 @@ contains
end subroutine unionized_grid
!=====================================================================
! ADD_GRID_POINTS adds energy points from the 'energy' array into a
! linked list of points already stored from previous arrays.
!=====================================================================
!===============================================================================
! ADD_GRID_POINTS adds energy points from the 'energy' array into a linked list
! of points already stored from previous arrays.
!===============================================================================
subroutine add_grid_points(list, energy, n_energy)
@ -78,8 +78,8 @@ contains
index = 1
! if the original list is empty, we need to allocate the first
! element and store first energy point
! if the original list is empty, we need to allocate the first element and
! store first energy point
if (list_size(list) == 0) then
allocate(list)
current => list
@ -100,8 +100,8 @@ contains
E = energy(index)
do while (index <= n_energy)
! If we've reached the end of the grid energy list, add the
! remaining energy points to the end
! If we've reached the end of the grid energy list, add the remaining
! energy points to the end
if (.not. associated(current)) then
! finish remaining energies
do while (index <= n_energy)
@ -134,8 +134,8 @@ contains
E = energy(index)
elseif (E == current%data) then
! found the exact same energy, no need to store duplicates
! so just skip and move to next index
! found the exact same energy, no need to store duplicates so just
! skip and move to next index
index = index + 1
E = energy(index)
else
@ -145,16 +145,15 @@ contains
end do
! It's possible that an element was inserted at the front of the
! list, so we need to move the list pointer back to the start of
! the list
! It's possible that an element was inserted at the front of the list, so we
! need to move the list pointer back to the start of the list
list => head
end subroutine add_grid_points
!=====================================================================
!===============================================================================
! ORIGINAL_INDICES
!=====================================================================
!===============================================================================
subroutine original_indices()

211
src/fileio.f90
View file

@ -16,12 +16,11 @@ module fileio
integer, allocatable :: index_cell_in_univ(:)
!=====================================================================
! READ_DATA interface allows data to be read with one function
! regardless of whether it is integer or real data. E.g. NXS and JXS
! can be read with the integer version and XSS can be read with the
! real version
!=====================================================================
!===============================================================================
! READ_DATA interface allows data to be read with one function regardless of
! whether it is integer or real data. E.g. NXS and JXS can be read with the
! integer version and XSS can be read with the real version
!===============================================================================
interface read_data
module procedure read_data_int, read_data_real
@ -29,9 +28,9 @@ module fileio
contains
!=====================================================================
!===============================================================================
! READ_COMMAND_LINE reads all parameters from the command line
!=====================================================================
!===============================================================================
subroutine read_command_line()
@ -54,9 +53,9 @@ contains
msg = "Input file '" // trim(path_input) // "' does not exist!"
call error(msg)
elseif (readable(1:3) == 'NO') then
! Need to explicitly check for a NO status -- Intel compiler
! looks at file attributes only if the file is open on a
! unit. Therefore, it will always return UNKNOWN
! Need to explicitly check for a NO status -- Intel compiler looks at
! file attributes only if the file is open on a unit. Therefore, it will
! always return UNKNOWN
msg = "Input file '" // trim(path_input) // "' is not readable! &
&Change file permissions with chmod command."
call error(msg)
@ -64,11 +63,10 @@ contains
end subroutine read_command_line
!=====================================================================
! READ_COUNT makes a first pass through the input file to determine
! how many cells, universes, surfaces, materials, sources, etc there
! are in the problem.
!=====================================================================
!===============================================================================
! READ_COUNT makes a first pass through the input file to determine how many
! cells, universes, surfaces, materials, sources, etc there are in the problem.
!===============================================================================
subroutine read_count(filename)
@ -115,9 +113,9 @@ contains
case ('cell')
n_cells = n_cells + 1
! 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
! 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 = str_to_int(words(3))
if (.not. dict_has_key(ucount_dict, universe_num)) then
n_universes = n_universes + 1
@ -137,17 +135,17 @@ contains
case ('lattice')
n_lattices = n_lattices + 1
! For lattices, 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
! For lattices, 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 = str_to_int(words(2))
call dict_add_key(lattice_dict, universe_num, n_lattices)
end select
end do
! Check to make sure there are cells, surface, and materials
! defined for the problem
! Check to make sure there are cells, surface, and materials defined for the
! problem
if (n_cells == 0) then
msg = "No cells specified!"
close(UNIT=in)
@ -172,8 +170,8 @@ contains
allocate(materials(n_materials))
allocate(tallies(n_tallies))
! Also allocate a list for keeping track of where cells have been
! assigned in each universe
! Also allocate a list for keeping track of where cells have been assigned
! in each universe
allocate(index_cell_in_univ(n_universes))
index_cell_in_univ = 0
@ -184,11 +182,10 @@ contains
call dict_create(material_dict)
call dict_create(tally_dict)
! We also need to allocate the cell count lists for each
! universe. The logic for this is a little more convoluted. In
! universe_dict, the (key,value) pairs are the uid of the universe
! and the index in the array. In ucount_dict, it's the uid of the
! universe and the number of cells.
! We also need to allocate the cell count lists for each universe. The logic
! for this is a little more convoluted. In universe_dict, the (key,value)
! pairs are the uid of the universe and the index in the array. In
! ucount_dict, it's the uid of the universe and the number of cells.
key_list => dict_keys(universe_dict)
do while (associated(key_list))
@ -213,11 +210,10 @@ contains
end subroutine read_count
!=====================================================================
! READ_INPUT takes a second pass through the input file and parses all
! the data on each line, calling the appropriate subroutine for each
! type of data item.
!=====================================================================
!===============================================================================
! READ_INPUT takes a second pass through the input file and parses all the data
! on each line, calling the appropriate subroutine for each type of data item.
!===============================================================================
subroutine read_input(filename)
@ -323,13 +319,13 @@ contains
end subroutine read_input
!=====================================================================
! ADJUST_INDICES changes the values for 'surfaces' for each cell and
! the material index assigned to each to the indices in the surfaces
! and material array rather than the unique IDs assigned to each
! surface and material. Also assigns boundary conditions to surfaces
! based on those read into the bc_dict dictionary
!=====================================================================
!===============================================================================
! ADJUST_INDICES changes the values for 'surfaces' for each cell and the
! material index assigned to each to the indices in the surfaces and material
! array rather than the unique IDs assigned to each surface and material. Also
! assigns boundary conditions to surfaces based on those read into the bc_dict
! dictionary
!===============================================================================
subroutine adjust_indices()
@ -398,10 +394,10 @@ contains
end subroutine adjust_indices
!=====================================================================
! BUILD_UNIVERSE determines what level each universe is at and
! determines what the parent cell of each cell in a subuniverse is.
!=====================================================================
!===============================================================================
! BUILD_UNIVERSE determines what level each universe is at and determines what
! the parent cell of each cell in a subuniverse is.
!===============================================================================
recursive subroutine build_universe(univ, parent, level)
@ -458,9 +454,9 @@ contains
end subroutine build_universe
!=====================================================================
!===============================================================================
! READ_CELL parses the data on a cell card.
!=====================================================================
!===============================================================================
subroutine read_cell(index, words, n_words)
@ -552,9 +548,9 @@ contains
end subroutine read_cell
!=====================================================================
!===============================================================================
! READ_SURFACE parses the data on a surface card.
!=====================================================================
!===============================================================================
subroutine read_surface(index, words, n_words)
@ -641,11 +637,11 @@ contains
end subroutine read_surface
!=====================================================================
! READ_BC creates a dictionary whose (key,value) pairs are the uids of
! surfaces and specified boundary conditions, respectively. This is
! later used in adjust_indices to set the surface boundary conditions.
!=====================================================================
!===============================================================================
! READ_BC creates a dictionary whose (key,value) pairs are the uids of surfaces
! and specified boundary conditions, respectively. This is later used in
! adjust_indices to set the surface boundary conditions.
!===============================================================================
subroutine read_bc(words, n_words)
@ -684,9 +680,9 @@ contains
end subroutine read_bc
!=====================================================================
!===============================================================================
! READ_LATTICE parses the data on a lattice entry.
!=====================================================================
!===============================================================================
subroutine read_lattice(index, words, n_words)
@ -770,9 +766,9 @@ contains
end subroutine read_lattice
!=====================================================================
!===============================================================================
! READ_SOURCE parses the data on a source entry.
!=====================================================================
!===============================================================================
subroutine read_source(words, n_words)
@ -811,9 +807,9 @@ contains
end subroutine read_source
!=====================================================================
!===============================================================================
! READ_TALLY
!=====================================================================
!===============================================================================
subroutine read_tally(index, words, n_words)
@ -850,7 +846,7 @@ contains
select case (trim(word))
case ('reaction')
! ==========================================================
! ====================================================================
! READ REACTION LIST
! Determine how many reactions are listed
@ -882,7 +878,7 @@ contains
end if
case ('cell')
! ==========================================================
! ====================================================================
! READ CELL LIST
! Determine how many reactions are listed
@ -914,7 +910,7 @@ contains
end if
case ('energy')
! ==========================================================
! ====================================================================
! READ ENERGY LIST
! Determine how many energies are listed
@ -966,10 +962,10 @@ contains
end subroutine read_tally
!=====================================================================
! READ_MATERIAL parses a material card. Note that atom percents and
! densities are normalized in a separate routine
!=====================================================================
!===============================================================================
! READ_MATERIAL parses a material card. Note that atom percents and densities
! are normalized in a separate routine
!===============================================================================
subroutine read_material(index, words, n_words)
@ -1019,10 +1015,9 @@ contains
end subroutine read_material
!=====================================================================
! NORMALIZE_AO normalizes the atom or weight percentages for each
! material
!=====================================================================
!===============================================================================
! NORMALIZE_AO normalizes the atom or weight percentages for each material
!===============================================================================
subroutine normalize_ao()
@ -1040,13 +1035,12 @@ contains
type(xsData), pointer :: iso => null()
type(Material), pointer :: mat => null()
! first find the index in the xsdata array for each isotope in
! each material
! first find the index in the xsdata array for each isotope in each material
do i = 1, n_materials
mat => materials(i)
! Check to make sure either all atom percents or all weight
! percents are given
! Check to make sure either all atom percents or all weight percents are
! given
if (.not. (all(mat%atom_percent > ZERO) .or. &
& all(mat%atom_percent < ZERO))) then
msg = "Cannot mix atom and weight percents in material " // &
@ -1067,23 +1061,22 @@ contains
! determine atomic weight ratio
awr = xsdatas(index) % awr
! if given weight percent, convert all values so that they
! are divided by awr. thus, when a sum is done over the
! values, it's actually sum(w/awr)
! if given weight percent, convert all values so that they are divided
! by awr. thus, when a sum is done over the values, it's actually
! sum(w/awr)
if (.not. percent_in_atom) then
mat % atom_percent(j) = -mat % atom_percent(j) / awr
end if
end do
! determine normalized atom percents. if given atom percents,
! this is straightforward. if given weight percents, the value
! is w/awr and is divided by sum(w/awr)
! determine normalized atom percents. if given atom percents, this is
! straightforward. if given weight percents, the value is w/awr and is
! divided by sum(w/awr)
sum_percent = sum(mat%atom_percent)
mat % atom_percent = mat % atom_percent / sum_percent
! Change density in g/cm^3 to atom/b-cm. Since all values are
! now in atom percent, the sum needs to be re-evaluated as
! 1/sum(x*awr)
! Change density in g/cm^3 to atom/b-cm. Since all values are now in atom
! percent, the sum needs to be re-evaluated as 1/sum(x*awr)
if (.not. density_in_atom) then
sum_percent = ZERO
do j = 1, mat % n_isotopes
@ -1100,10 +1093,10 @@ contains
end subroutine normalize_ao
!=====================================================================
! READ_XS_LIBRARY parses the data on a xs_library card. This card
! specifies what cross section library should be used by default
!=====================================================================
!===============================================================================
! READ_XS_LIBRARY parses the data on a xs_library card. This card specifies what
! cross section library should be used by default
!===============================================================================
subroutine read_xs_library(words, n_words)
@ -1112,12 +1105,11 @@ contains
end subroutine read_xs_library
!=====================================================================
! READ_CRITICALITY parses the data on a criticality card. This card
! specifies that the problem at hand is a criticality calculation and
! gives the number of cycles, inactive cycles, and particles per
! cycle.
!=====================================================================
!===============================================================================
! READ_CRITICALITY parses the data on a criticality card. This card specifies
! that the problem at hand is a criticality calculation and gives the number of
! cycles, inactive cycles, and particles per cycle.
!===============================================================================
subroutine read_criticality(words, n_words)
@ -1152,9 +1144,9 @@ contains
end subroutine read_criticality
!=====================================================================
!===============================================================================
! READ_LINE reads a line from a file open on a unit
!=====================================================================
!===============================================================================
subroutine read_line(unit, line, ioError)
@ -1166,12 +1158,11 @@ contains
end subroutine read_line
!=====================================================================
! GET_NEXT_LINE reads the next line to the file connected on the
! specified unit including any continuation lines. If a line ends in
! an ampersand, the next line is read and its words are appended to
! the final array
!=====================================================================
!===============================================================================
! GET_NEXT_LINE reads the next line to the file connected on the specified unit
! including any continuation lines. If a line ends in an ampersand, the next
! line is read and its words are appended to the final array
!===============================================================================
subroutine get_next_line(unit, words, n, ioError)
@ -1214,9 +1205,9 @@ contains
end subroutine get_next_line
!=====================================================================
!===============================================================================
! SKIP_LINES skips 'n_lines' lines from a file open on a unit
!=====================================================================
!===============================================================================
subroutine skip_lines(unit, n_lines, ioError)
@ -1233,9 +1224,9 @@ contains
end subroutine skip_lines
!=====================================================================
!===============================================================================
! READ_DATA_INT reads integer data into an array from a file open
!=====================================================================
!===============================================================================
subroutine read_data_int(unit, array, n, lines, words_per_line)
@ -1261,9 +1252,9 @@ contains
end subroutine read_data_int
!=====================================================================
!===============================================================================
! READ_DATA_REAL reads real(8) data into an array from a file open
!=====================================================================
!===============================================================================
subroutine read_data_real(unit, array, n, lines, words_per_line)

147
src/geometry.f90
View file

@ -9,9 +9,9 @@ module geometry
contains
!=====================================================================
!===============================================================================
! CELL_CONTAINS determines whether a given point is inside a cell
!=====================================================================
!===============================================================================
function cell_contains(c, p) result(in_cell)
@ -51,8 +51,7 @@ contains
expression(i) = 1
cycle
elseif (surf_num == -current_surface) then
! particle is on specified surface, but heading other
! direction
! particle is on specified surface, but heading other direction
expression(i) = 0
cycle
end if
@ -68,8 +67,8 @@ contains
end do
! TODO: Need to replace this with a 'lgeval' like subroutine that
! can actually test expressions with unions and parentheses
! TODO: Need to replace this with a 'lgeval' like subroutine that can
! actually test expressions with unions and parentheses
if (all(expression == 1)) then
in_cell = .true.
else
@ -81,11 +80,11 @@ contains
end function cell_contains
!=====================================================================
! FIND_CELL determines what cell a source particle is in within a
! particular universe. If the base universe is passed, the particle
! should be found as long as it's within the geometry
!=====================================================================
!===============================================================================
! FIND_CELL determines what cell a source particle is in within a particular
! universe. If the base universe is passed, the particle should be found as long
! as it's within the geometry
!===============================================================================
recursive subroutine find_cell(univ, p, found)
@ -109,8 +108,8 @@ contains
c => cells(univ % cells(i))
if (cell_contains(c, p)) then
! If this cell contains a universe or lattice, search for
! the particle in that universe/lattice
! If this cell contains a universe or lattice, search for the particle
! in that universe/lattice
if (c % type == CELL_NORMAL) then
! set current pointers
found = .true.
@ -166,9 +165,9 @@ contains
end subroutine find_cell
!=====================================================================
!===============================================================================
! CROSS_SURFACE moves a particle into a new cell
!=====================================================================
!===============================================================================
subroutine cross_surface(p)
@ -199,8 +198,8 @@ contains
end if
if (p%surface > 0 .and. allocated(surf%neighbor_pos)) then
! If coming from negative side of surface, search all the
! neighboring cells on the positive side
! If coming from negative side of surface, search all the neighboring
! cells on the positive side
do i = 1, size(surf%neighbor_pos)
index_cell = surf%neighbor_pos(i)
c => cells(index_cell)
@ -222,8 +221,8 @@ contains
end if
end do
elseif (p%surface < 0 .and. allocated(surf%neighbor_neg)) then
! If coming from positive side of surface, search all the
! neighboring cells on the negative side
! If coming from positive side of surface, search all the neighboring
! cells on the negative side
do i = 1, size(surf%neighbor_neg)
index_cell = surf%neighbor_neg(i)
c => cells(index_cell)
@ -246,8 +245,7 @@ contains
end do
end if
! Couldn't find particle in neighboring cells, search through all
! cells
! Couldn't find particle in neighboring cells, search through all cells
do i = 1, size(cells)
c => cells(i)
if (cell_contains(c, p)) then
@ -265,9 +263,9 @@ contains
end subroutine cross_surface
!=====================================================================
!===============================================================================
! CROSS_LATTICE moves a particle into a new lattice element
!=====================================================================
!===============================================================================
subroutine cross_lattice(p)
@ -378,12 +376,11 @@ contains
end subroutine cross_lattice
!=====================================================================
! DIST_TO_BOUNDARY calculates the distance to the nearest boundary for
! a particle 'p' traveling in a certain direction. For a cell in a
! subuniverse that has a parent cell, also include the surfaces of the
! edge of the universe.
!=====================================================================
!===============================================================================
! DIST_TO_BOUNDARY calculates the distance to the nearest boundary for a
! particle 'p' traveling in a certain direction. For a cell in a subuniverse
! that has a parent cell, also include the surfaces of the edge of the universe.
!===============================================================================
subroutine dist_to_boundary(p, dist, surf, in_lattice)
@ -529,8 +526,8 @@ contains
elseif (on_surface) then
! particle is on the cylinder, thus one distance is
! positive/negative and the other is zero. The sign of
! k determines if we are facing in or out
! positive/negative and the other is zero. The sign of k
! determines if we are facing in or out
if (k >= ZERO) then
d = INFINITY
@ -539,18 +536,16 @@ contains
end if
elseif (c < ZERO) then
! particle is inside the cylinder, thus one distance
! must be negative and one must be positive. The
! positive distance will be the one with negative sign
! on sqrt(quad)
! particle is inside the cylinder, thus one distance must be
! negative and one must be positive. The positive distance will
! be the one with negative sign on sqrt(quad)
d = (-k + sqrt(quad))/a
else
! particle is outside the cylinder, thus both
! distances are either positive or negative. If
! positive, the smaller distance is the one with
! positive sign on sqrt(quad)
! particle is outside the cylinder, thus both distances are
! either positive or negative. If positive, the smaller distance
! is the one with positive sign on sqrt(quad)
d = (-k - sqrt(quad))/a
if (d < ZERO) d = INFINITY
@ -580,8 +575,8 @@ contains
elseif (on_surface) then
! particle is on the cylinder, thus one distance is
! positive/negative and the other is zero. The sign of
! k determines if we are facing in or out
! positive/negative and the other is zero. The sign of k
! determines if we are facing in or out
if (k >= ZERO) then
d = INFINITY
@ -590,18 +585,16 @@ contains
end if
elseif (c < ZERO) then
! particle is inside the cylinder, thus one distance
! must be negative and one must be positive. The
! positive distance will be the one with negative sign
! on sqrt(quad)
! particle is inside the cylinder, thus one distance must be
! negative and one must be positive. The positive distance will
! be the one with negative sign on sqrt(quad)
d = (-k + sqrt(quad))/a
else
! particle is outside the cylinder, thus both
! distances are either positive or negative. If
! positive, the smaller distance is the one with
! positive sign on sqrt(quad)
! particle is outside the cylinder, thus both distances are
! either positive or negative. If positive, the smaller distance
! is the one with positive sign on sqrt(quad)
d = (-k - sqrt(quad))/a
if (d < ZERO) d = INFINITY
@ -631,8 +624,8 @@ contains
elseif (on_surface) then
! particle is on the cylinder, thus one distance is
! positive/negative and the other is zero. The sign of
! k determines if we are facing in or out
! positive/negative and the other is zero. The sign of k
! determines if we are facing in or out
if (k >= ZERO) then
d = INFINITY
@ -641,18 +634,16 @@ contains
end if
elseif (c < ZERO) then
! particle is inside the cylinder, thus one distance
! must be negative and one must be positive. The
! positive distance will be the one with negative sign
! on sqrt(quad)
! particle is inside the cylinder, thus one distance must be
! negative and one must be positive. The positive distance will
! be the one with negative sign on sqrt(quad)
d = (-k + sqrt(quad))/a
else
! particle is outside the cylinder, thus both
! distances are either positive or negative. If
! positive, the smaller distance is the one with
! positive sign on sqrt(quad)
! particle is outside the cylinder, thus both distances are
! either positive or negative. If positive, the smaller distance
! is the one with positive sign on sqrt(quad)
d = (-k - sqrt(quad))/a
if (d <= ZERO) d = INFINITY
@ -679,9 +670,9 @@ contains
d = INFINITY
elseif (on_surface) then
! particle is on the sphere, thus one distance is
! positive/negative and the other is zero. The sign of k
! determines if we are facing in or out
! particle is on the sphere, thus one distance is positive/negative
! and the other is zero. The sign of k determines if we are facing
! in or out
if (k >= ZERO) then
d = INFINITY
@ -690,18 +681,16 @@ contains
end if
elseif (c < ZERO) then
! particle is inside the sphere, thus one distance
! must be negative and one must be positive. The
! positive distance will be the one with negative sign
! on sqrt(quad)
! particle is inside the sphere, thus one distance must be negative
! and one must be positive. The positive distance will be the one
! with negative sign on sqrt(quad)
d = -k + sqrt(quad)
else
! particle is outside the sphere, thus both
! distances are either positive or negative. If
! positive, the smaller distance is the one with
! positive sign on sqrt(quad)
! particle is outside the sphere, thus both distances are either
! positive or negative. If positive, the smaller distance is the
! one with positive sign on sqrt(quad)
d = -k - sqrt(quad)
if (d < ZERO) d = INFINITY
@ -766,11 +755,11 @@ contains
end subroutine dist_to_boundary
!=====================================================================
! SENSE determines whether a point is on the 'positive' or 'negative'
! side of a surface. This routine is crucial for determining what cell
! a particular point is in.
!=====================================================================
!===============================================================================
! SENSE determines whether a point is on the 'positive' or 'negative' side of a
! surface. This routine is crucial for determining what cell a particular point
! is in.
!===============================================================================
function sense(surf, xyz) result(s)
@ -918,10 +907,10 @@ contains
end function sense
!=====================================================================
! NEIGHBOR_LISTS builds a list of neighboring cells to each surface to
! speed up searches when a cell boundary is crossed.
!=====================================================================
!===============================================================================
! NEIGHBOR_LISTS builds a list of neighboring cells to each surface to speed up
! searches when a cell boundary is crossed.
!===============================================================================
subroutine neighbor_lists()

47
src/global.f90
View file

@ -270,9 +270,9 @@ module global
contains
!=====================================================================
!===============================================================================
! SET_DEFAULTS gives default values for many global parameters
!=====================================================================
!===============================================================================
subroutine set_defaults()
@ -290,10 +290,10 @@ contains
end subroutine set_defaults
!=====================================================================
! FREE_MEMORY deallocates all allocatable arrays in the program,
! namely the cells, surfaces, materials, and sources
!=====================================================================
!===============================================================================
! FREE_MEMORY deallocates all allocatable arrays in the program, namely the
! cells, surfaces, materials, and sources
!===============================================================================
subroutine free_memory()
@ -327,9 +327,9 @@ contains
end subroutine free_memory
!=====================================================================
!===============================================================================
! INT4_TO_STR converts an integer(4) to a string.
!=====================================================================
!===============================================================================
function int4_to_str(num) result(str)
@ -341,9 +341,9 @@ contains
end function int4_to_str
!=====================================================================
!===============================================================================
! INT8_TO_STR converts an integer(8) to a string.
!=====================================================================
!===============================================================================
function int8_to_str(num) result(str)
@ -355,9 +355,9 @@ contains
end function int8_to_str
!=====================================================================
!===============================================================================
! STR_TO_INT converts a string to an integer.
!=====================================================================
!===============================================================================
function str_to_int(str) result(num)
@ -380,16 +380,15 @@ contains
end function str_to_int
!=====================================================================
! STR_TO_REAL converts an arbitrary string to a real(8). Generally
! this function is intended for strings for which the exact format is
! not known. If the format of the number is known a priori, the
! appropriate format descriptor should be used in lieu of this routine
! because of the extra overhead.
!===============================================================================
! STR_TO_REAL converts an arbitrary string to a real(8). Generally this function
! is intended for strings for which the exact format is not known. If the format
! of the number is known a priori, the appropriate format descriptor should be
! used in lieu of this routine because of the extra overhead.
!
! Arguments:
! string = character(*) containing number to convert
!=====================================================================
!===============================================================================
function str_to_real(string) result(num)
@ -431,11 +430,11 @@ contains
end function str_to_real
!=====================================================================
! REAL_TO_STR converts a real(8) to a string based on how large the
! value is and how many significant digits are desired. By default,
! six significants digits are used.
!=====================================================================
!===============================================================================
! REAL_TO_STR converts a real(8) to a string based on how large the value is and
! how many significant digits are desired. By default, six significants digits
! are used.
!===============================================================================
function real_to_str(num, sig_digits) result(string)

8
src/logging.f90
View file

@ -6,9 +6,9 @@ module logging
contains
!=====================================================================
!===============================================================================
! CREATE_LOG creates a new log file (or overwrites the existing log)
!=====================================================================
!===============================================================================
subroutine create_log()
@ -31,9 +31,9 @@ contains
end subroutine create_log
!=====================================================================
!===============================================================================
! LOG_TALLIES
!=====================================================================
!===============================================================================
subroutine log_tallies()

31
src/main.f90
View file

@ -35,35 +35,34 @@ program main
! Print the OpenMC title and version/date/time information
if (master) call title()
! Initialize random number generator. The first argument corresponds
! to which random number generator to use- in this case one of the
! L'Ecuyer 63-bit RNGs.
! Initialize random number generator. The first argument corresponds to which
! random number generator to use- in this case one of the L'Ecuyer 63-bit
! RNGs.
call RN_init_problem(3, 0_8, 0_8, 0_8, 0)
! Set default values for settings
call set_defaults()
! Read input file -- make a first pass through the file to count
! cells, surfaces, etc in order to allocate arrays, then do a second
! pass to actually read values
! Read input file -- make a first pass through the file to count cells,
! surfaces, etc in order to allocate arrays, then do a second pass to actually
! read values
call read_count(path_input)
call read_input(path_input)
! determine at which level universes are and link cells to parenting
! cells
! determine at which level universes are and link cells to parenting cells
univ => universes(BASE_UNIVERSE)
call build_universe(univ, 0, 0)
! After reading input and basic geometry setup is complete, build
! lists of neighboring cells for efficient tracking
! After reading input and basic geometry setup is complete, build lists of
! neighboring cells for efficient tracking
call neighbor_lists()
! Read cross section summary file to determine what files contain
! cross-sections
call read_xsdata(path_xsdata)
! With the AWRs from the xsdata, change all material specifications
! so that they contain atom percents summing to 1
! With the AWRs from the xsdata, change all material specifications so that
! they contain atom percents summing to 1
call normalize_ao()
! Read ACE-format cross sections
@ -92,10 +91,10 @@ program main
contains
!=====================================================================
! RUN_PROBLEM encompasses all the main logic where iterations are
! performed over the cycles and histories.
!=====================================================================
!===============================================================================
! RUN_PROBLEM encompasses all the main logic where iterations are performed over
! the cycles and histories.
!===============================================================================
subroutine run_problem()

54
src/mpi_routines.f90
View file

@ -17,11 +17,11 @@ module mpi_routines
contains
!=====================================================================
! SETUP_MPI initilizes the Message Passing Interface (MPI) and
! determines the number of processors the problem is being run with as
! well as the rank of each processor.
!=====================================================================
!===============================================================================
! SETUP_MPI initilizes the Message Passing Interface (MPI) and determines the
! number of processors the problem is being run with as well as the rank of each
! processor.
!===============================================================================
subroutine setup_mpi()
@ -95,12 +95,11 @@ contains
end subroutine setup_mpi
!=====================================================================
! SYNCHRONIZE_BANK samples source sites from the fission sites that
! were accumulated during the cycle. This routine is what allows this
! Monte Carlo to scale to large numbers of processors where other
! codes cannot.
! =====================================================================
!===============================================================================
! SYNCHRONIZE_BANK samples source sites from the fission sites that were
! accumulated during the cycle. This routine is what allows this Monte Carlo to
! scale to large numbers of processors where other codes cannot.
!===============================================================================
subroutine synchronize_bank(i_cycle)
@ -138,8 +137,7 @@ contains
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
t0 = MPI_WTIME()
! Determine starting index for fission bank and total sites in
! fission bank
! Determine starting index for fission bank and total sites in fission bank
start = 0_8
call MPI_EXSCAN(n_bank, start, 1, MPI_INTEGER8, MPI_SUM, &
& MPI_COMM_WORLD, ierr)
@ -162,8 +160,7 @@ contains
call error(msg)
end if
! Make sure all processors start at the same point for random
! sampling
! Make sure all processors start at the same point for random sampling
call RN_init_particle(int(i_cycle,8))
! Skip ahead however many random numbers are needed
@ -183,15 +180,14 @@ contains
msg = "Sampling fission sites..."
call message(msg, 8)
! ================================================================
! ==========================================================================
! SAMPLE N_PARTICLES FROM FISSION BANK AND PLACE IN TEMP_SITES
do i = 1, n_bank
! If there are less than n_particles particles banked,
! automatically add int(n_particles/total) sites to
! temp_sites. For example, if you need 1000 and 300 were
! banked, this would add 3 source sites per banked site and the
! remaining 100 would be randomly sampled.
! If there are less than n_particles particles banked, automatically add
! int(n_particles/total) sites to temp_sites. For example, if you need
! 1000 and 300 were banked, this would add 3 source sites per banked site
! and the remaining 100 would be randomly sampled.
if (total < n_particles) then
do j = 1,int(n_particles/total)
! If index is within this node's range, add site to source
@ -207,8 +203,8 @@ contains
end if
end do
! Now that we've sampled sites, check where the boundaries of data
! are for the source bank
! Now that we've sampled sites, check where the boundaries of data are for
! the source bank
#ifdef MPI
start = 0_8
call MPI_EXSCAN(count, start, 1, MPI_INTEGER8, MPI_SUM, &
@ -229,15 +225,15 @@ contains
if (rank == n_procs - 1) then
if (total > n_particles) then
! If we have extra sites sampled, we will simply discard the
! extra ones on the last processor
! If we have extra sites sampled, we will simply discard the extra
! ones on the last processor
if (rank == n_procs - 1) then
count = count - send_to_right
end if
elseif (total < n_particles) then
! If we have too few sites, grab sites from the very end of
! the fission bank
! If we have too few sites, grab sites from the very end of the
! fission bank
sites_needed = n_particles - total
do i = 1, sites_needed
count = count + 1
@ -256,7 +252,7 @@ contains
msg = "Sending fission sites..."
call message(msg, 8)
! ================================================================
! ==========================================================================
! SEND BANK SITES TO NEIGHBORS
allocate(left_bank(abs(send_to_left)))
allocate(right_bank(abs(send_to_right)))
@ -285,7 +281,7 @@ contains
msg = "Constructing source bank..."
call message(msg, 8)
! ================================================================
! ==========================================================================
! RECONSTRUCT SOURCE BANK
if (send_to_left < 0 .and. send_to_right >= 0) then
i = -send_to_left ! size of first block

89
src/output.f90
View file

@ -13,11 +13,10 @@ module output
contains
!=====================================================================
! TITLE prints the main title banner as well as information about the
! program developers, version, and date/time which the problem was
! run.
!=====================================================================
!===============================================================================
! TITLE prints the main title banner as well as information about the program
! developers, version, and date/time which the problem was run.
!===============================================================================
subroutine title()
@ -52,10 +51,10 @@ contains
end subroutine title
!=====================================================================
! ECHO_INPUT displays summary information about the problem about to
! be run after reading all the input.
!=====================================================================
!===============================================================================
! ECHO_INPUT displays summary information about the problem about to be run
! after reading all the input.
!===============================================================================
subroutine echo_input()
@ -90,10 +89,10 @@ contains
end subroutine echo_input
!=====================================================================
! MESSAGE displays an informational message to the log file and the
! standard output stream.
!=====================================================================
!===============================================================================
! MESSAGE displays an informational message to the log file and the standard
! output stream.
!===============================================================================
subroutine message(msg, level)
@ -109,16 +108,16 @@ contains
if (.not. present(level) .or. level <= verbosity) then
n_lines = (len_trim(msg)-1)/79 + 1
do i = 1, n_lines
write(ou, fmt='(1X,A79)') msg(79*(i-1)+1:79*i)
write(ou, fmt='(1X,A)') trim(msg(79*(i-1)+1:79*i))
end do
end if
end subroutine message
!=====================================================================
! WARNING issues a warning to the user in the log file and the
! standard output stream.
!=====================================================================
!===============================================================================
! WARNING issues a warning to the user in the log file and the standard output
! stream.
!===============================================================================
subroutine warning(msg)
@ -143,11 +142,11 @@ contains
end subroutine warning
!=====================================================================
! ERROR alerts the user that an error has been encountered and
! displays a message about the particular problem. Errors are
! considered 'fatal' and hence the program is aborted.
!=====================================================================
!===============================================================================
! ERROR alerts the user that an error has been encountered and displays a
! message about the particular problem. Errors are considered 'fatal' and hence
! the program is aborted.
!===============================================================================
subroutine error(msg)
@ -176,10 +175,10 @@ contains
end subroutine error
!=====================================================================
! GET_TODAY determines the date and time at which the program began
! execution and returns it in a readable format
!=====================================================================
!===============================================================================
! GET_TODAY determines the date and time at which the program began execution
! and returns it in a readable format
!===============================================================================
subroutine get_today(today_date, today_time)
@ -218,9 +217,9 @@ contains
end subroutine get_today
!=====================================================================
!===============================================================================
! PRINT_PARTICLE displays the attributes of a particle
!=====================================================================
!===============================================================================
subroutine print_particle(p)
@ -282,9 +281,9 @@ contains
end subroutine print_particle
!=====================================================================
!===============================================================================
! PRINT_REACTION displays the attributes of a reaction
!=====================================================================
!===============================================================================
subroutine print_reaction(rxn)
@ -302,9 +301,9 @@ contains
end subroutine print_reaction
!=====================================================================
!===============================================================================
! PRINT_CELL displays the attributes of a cell
!=====================================================================
!===============================================================================
subroutine print_cell(c)
@ -363,9 +362,9 @@ contains
end subroutine print_cell
!=====================================================================
!===============================================================================
! PRINT_UNIVERSE displays the attributes of a universe
!=====================================================================
!===============================================================================
subroutine print_universe(univ)
@ -389,9 +388,9 @@ contains
end subroutine print_universe
!=====================================================================
!===============================================================================
! PRINT_LATTICE displays the attributes of a lattice
!=====================================================================
!===============================================================================
subroutine print_lattice(lat)
@ -408,9 +407,9 @@ contains
end subroutine print_lattice
!=====================================================================
!===============================================================================
! PRINT_SURFACE displays the attributes of a surface
!=====================================================================
!===============================================================================
subroutine print_surface(surf)
@ -481,9 +480,9 @@ contains
end subroutine print_surface
!=====================================================================
!===============================================================================
! PRINT_MATERIAL displays the attributes of a material
!=====================================================================
!===============================================================================
subroutine print_material(mat)
@ -511,9 +510,9 @@ contains
end subroutine print_material
!=====================================================================
!===============================================================================
! PRINT_TALLY displays the attributes of a tally
!=====================================================================
!===============================================================================
subroutine print_tally(tal)
@ -571,11 +570,11 @@ contains
end subroutine print_tally
!=====================================================================
!===============================================================================
! PRINT_SUMMARY displays the attributes of all cells, universes,
! surfaces and materials read in the input file. Very useful for
! debugging!
!=====================================================================
!===============================================================================
subroutine print_summary()

326
src/physics.f90
View file

@ -14,10 +14,9 @@ module physics
contains
!=====================================================================
! TRANSPORT encompasses the main logic for moving a particle through
! geometry.
!=====================================================================
!===============================================================================
! TRANSPORT encompasses the main logic for moving a particle through geometry.
!===============================================================================
subroutine transport(p)
@ -101,10 +100,10 @@ contains
end subroutine transport
!=====================================================================
! FIND_ENERGY_INDEX determines the index on the union energy grid and
! the interpolation factor for a particle at a certain energy
!=====================================================================
!===============================================================================
! FIND_ENERGY_INDEX determines the index on the union energy grid and the
! interpolation factor for a particle at a certain energy
!===============================================================================
subroutine find_energy_index(p)
@ -117,9 +116,8 @@ contains
! copy particle's energy
E = p % E
! if particle's energy is outside of energy grid range, set to
! first or last index. Otherwise, do a binary search through the
! union energy grid.
! if particle's energy is outside of energy grid range, set to first or last
! index. Otherwise, do a binary search through the union energy grid.
if (E < e_grid(1)) then
IE = 1
elseif (E > e_grid(n_grid)) then
@ -128,9 +126,8 @@ contains
IE = binary_search(e_grid, n_grid, E)
end if
! calculate the interpolation factor -- note this will be outside
! of [0,1) for a particle outside the energy range of the union
! grid
! calculate the interpolation factor -- note this will be outside of [0,1)
! for a particle outside the energy range of the union grid
interp = (E - e_grid(IE))/(e_grid(IE+1) - e_grid(IE))
! set particle attributes
@ -139,10 +136,10 @@ contains
end subroutine find_energy_index
!=====================================================================
! COLLISION samples a nuclide and reaction and then calls the
! appropriate routine for that reaction
!=====================================================================
!===============================================================================
! COLLISION samples a nuclide and reaction and then calls the appropriate
! routine for that reaction
!===============================================================================
subroutine collision(p)
@ -166,8 +163,8 @@ contains
density = cMaterial%atom_density
! calculate total cross-section for each nuclide at current energy
! in order to create discrete pdf for sampling nuclide
! calculate total cross-section for each nuclide at current energy in order
! to create discrete pdf for sampling nuclide
n_isotopes = cMaterial%n_isotopes
allocate(Sigma_rxn(n_isotopes))
do i = 1, n_isotopes
@ -210,9 +207,9 @@ contains
do i = 1, table%n_reaction
rxn => table%reactions(i)
! some materials have gas production cross sections with MT >
! 200 that are duplicates. Also MT=4 is total level inelastic
! scattering which should be skipped
! some materials have gas production cross sections with MT > 200 that
! are duplicates. Also MT=4 is total level inelastic scattering which
! should be skipped
if (rxn%MT >= 200 .or. rxn%MT == 4) cycle
! if energy is below threshold for this reaction, skip it
@ -266,11 +263,11 @@ contains
end subroutine collision
!=====================================================================
!===============================================================================
! ELASTIC_SCATTER treats the elastic scattering of a neutron with a
! target. Currently this assumes target-at-rest kinematics --
! obviously will need to be fixed
!=====================================================================
! target. Currently this assumes target-at-rest kinematics -- obviously will
! need to be fixed
!===============================================================================
subroutine elastic_scatter(p, table, rxn)
@ -341,12 +338,11 @@ contains
end subroutine elastic_scatter
!=====================================================================
! N_FISSION determines the average total, prompt, and delayed neutrons
! produced from fission and creates appropriate bank sites. This
! routine will not work with implicit absorption, namely sampling of
! the number of neutrons!
!=====================================================================
!===============================================================================
! N_FISSION determines the average total, prompt, and delayed neutrons produced
! from fission and creates appropriate bank sites. This routine will not work
! with implicit absorption, namely sampling of the number of neutrons!
!===============================================================================
subroutine n_fission(p, table, rxn)
@ -381,7 +377,7 @@ contains
! copy energy of neutron
E = p % E
! ================================================================
! ==========================================================================
! DETERMINE TOTAL NU
if (table % nu_t_type == NU_NONE) then
msg = "No neutron emission data for table: " // table % name
@ -397,9 +393,9 @@ contains
nu_total = nu_total + c * E**i
end do
elseif (table % nu_t_type == NU_TABULAR) then
! determine number of interpolation regions -- as far as I can
! tell, no nu data has multiple interpolation
! regions. Furthermore, it seems all are lin-lin.
! determine number of interpolation regions -- as far as I can tell, no
! nu data has multiple interpolation regions. Furthermore, it seems all
! are lin-lin.
NR = int(table % nu_t_data(1))
if (NR /= 0) then
msg = "Multiple interpolation regions not supported while &
@ -411,8 +407,8 @@ contains
loc = 2 + 2*NR
NE = int(table % nu_t_data(loc))
! do binary search over tabuled energies to determine
! appropriate index and interpolation factor
! do binary search over tabuled energies to determine appropriate index
! and interpolation factor
if (E < table % nu_t_data(loc+1)) then
j = 1
f = ZERO
@ -431,11 +427,11 @@ contains
& (table % nu_t_data(loc+j+1) - table % nu_t_data(loc+j))
end if
! ================================================================
! ==========================================================================
! DETERMINE PROMPT NU
if (table % nu_p_type == NU_NONE) then
! since no prompt or delayed data is present, this means all
! neutron emission is prompt
! since no prompt or delayed data is present, this means all neutron
! emission is prompt
nu_prompt = nu_total
elseif (table % nu_p_type == NU_POLYNOMIAL) then
! determine number of coefficients
@ -460,8 +456,8 @@ contains
loc = 2 + 2*NR
NE = int(table % nu_p_data(loc))
! do binary search over tabuled energies to determine
! appropriate index and interpolation factor
! do binary search over tabuled energies to determine appropriate index
! and interpolation factor
if (E < table % nu_p_data(loc+1)) then
j = 1
f = ZERO
@ -480,7 +476,7 @@ contains
& (table % nu_p_data(loc+j+1) - table % nu_p_data(loc+j))
end if
! ================================================================
! ==========================================================================
! DETERMINE DELAYED NU
if (table % nu_d_type == NU_NONE) then
nu_delay = ZERO
@ -497,8 +493,8 @@ contains
loc = 2 + 2*NR
NE = int(table % nu_d_data(loc))
! do binary search over tabuled energies to determine
! appropriate index and interpolation factor
! do binary search over tabuled energies to determine appropriate index
! and interpolation factor
if (E < table % nu_d_data(loc+1)) then
j = 1
f = ZERO
@ -541,7 +537,7 @@ contains
! sample between delayed and prompt neutrons
if (rang() < beta) then
! ==========================================================
! ====================================================================
! DELAYED NEUTRON SAMPLED
! sampled delayed precursor group
@ -598,7 +594,7 @@ contains
end do
else
! ==========================================================
! ====================================================================
! PROMPT NEUTRON SAMPLED
! sample from prompt neutron energy distribution
@ -633,11 +629,10 @@ contains
end subroutine n_fission
!=====================================================================
! INELASTIC_SCATTER handles all reactions with a single secondary
! neutron (other than fission), i.e. level scattering, (n,np), (n,na),
! etc.
!=====================================================================
!===============================================================================
! INELASTIC_SCATTER handles all reactions with a single secondary neutron (other
! than fission), i.e. level scattering, (n,np), (n,na), etc.
!===============================================================================
subroutine inelastic_scatter(p, table, rxn)
@ -673,8 +668,8 @@ contains
call sample_energy(rxn%edist, E_in, E)
end if
! if scattering system is in center-of-mass, transfer cosine of
! scattering angle and outgoing energy from CM to LAB
! if scattering system is in center-of-mass, transfer cosine of scattering
! angle and outgoing energy from CM to LAB
if (rxn % TY < 0) then
E_cm = E
@ -700,9 +695,9 @@ contains
end subroutine inelastic_scatter
!=====================================================================
!===============================================================================
! N_XN
!=====================================================================
!===============================================================================
subroutine n_xn(p, table, rxn)
@ -740,8 +735,8 @@ contains
call sample_energy(rxn%edist, E_in, E)
end if
! if scattering system is in center-of-mass, transfer cosine of
! scattering angle and outgoing energy from CM to LAB
! if scattering system is in center-of-mass, transfer cosine of scattering
! angle and outgoing energy from CM to LAB
if (rxn % TY < 0) then
E_cm = E
@ -773,10 +768,10 @@ contains
end subroutine n_xn
!=====================================================================
! N_ABSORPTION handles all absorbing reactions, i.e. (n,gamma), (n,p),
! (n,a), etc.
!=====================================================================
!===============================================================================
! N_ABSORPTION handles all absorbing reactions, i.e. (n,gamma), (n,p), (n,a),
! etc.
!===============================================================================
subroutine n_absorption(p)
@ -794,11 +789,11 @@ contains
end subroutine n_absorption
!=====================================================================
! SAMPLE_ANGLE samples the cosine of the angle between incident and
! exiting particle directions either from 32 equiprobable bins or from
! a tabular distribution.
!=====================================================================
!===============================================================================
! SAMPLE_ANGLE samples the cosine of the angle between incident and exiting
! particle directions either from 32 equiprobable bins or from a tabular
! distribution.
!===============================================================================
function sample_angle(rxn, E) result(mu)
@ -823,8 +818,8 @@ contains
real(8) :: p0,p1 ! probability distribution
character(250) :: msg ! error message
! check if reaction has angular distribution -- if not, sample
! outgoing angle isotropically
! check if reaction has angular distribution -- if not, sample outgoing
! angle isotropically
if (.not. rxn % has_angle_dist) then
mu = TWO * rang() - ONE
return
@ -833,9 +828,8 @@ contains
! determine number of incoming energies
n = rxn % adist % n_energy
! find energy bin and calculate interpolation factor -- if the
! energy is outside the range of the tabulated energies, choose
! the first or last bins
! find energy bin and calculate interpolation factor -- if the energy is
! outside the range of the tabulated energies, choose the first or last bins
if (E < rxn % adist % energy(1)) then
i = 1
r = ZERO
@ -851,8 +845,7 @@ contains
! Sample between the ith and (i+1)th bin
if (r > rang()) i = i + 1
! check whether this is a 32-equiprobable bin or a tabular
! distribution
! check whether this is a 32-equiprobable bin or a tabular distribution
loc = rxn % adist % location(i)
type = rxn % adist % type(i)
if (type == ANGLE_ISOTROPIC) then
@ -888,8 +881,8 @@ contains
mu = mu0 + (xi - c_k)/p0
elseif (interp == LINEAR_LINEAR) then
! Linear-linear interpolation -- not sure how you come about
! the formula given in the MCNP manual
! Linear-linear interpolation -- not sure how you come about the
! formula given in the MCNP manual
p1 = rxn % adist % data(loc + NP + k+1)
mu1 = rxn % adist % data(loc + k+1)
@ -918,12 +911,11 @@ contains
end function sample_angle
!=====================================================================
! ROTATE_ANGLE rotates direction cosines through a polar angle whose
! cosine is mu and through an azimuthal angle sampled uniformly. Note
! that this is done with direct sampling rather than rejection as is
! done in MCNP and SERPENT.
!=====================================================================
!===============================================================================
! ROTATE_ANGLE rotates direction cosines through a polar angle whose cosine is
! mu and through an azimuthal angle sampled uniformly. Note that this is done
! with direct sampling rather than rejection as is done in MCNP and SERPENT.
!===============================================================================
subroutine rotate_angle(u, v, w, mu)
@ -951,8 +943,8 @@ contains
a = sqrt(ONE - mu*mu)
b = sqrt(ONE - w0*w0)
! Need to treat special case where sqrt(1 - w**2) is close to zero
! by expanding about the v component rather than the w component
! Need to treat special case where sqrt(1 - w**2) is close to zero by
! expanding about the v component rather than the w component
if (b > 1e-10) then
u = mu*u0 + a*(u0*w0*cosphi - v0*sinphi)/b
v = mu*v0 + a*(v0*w0*cosphi + u0*sinphi)/b
@ -966,9 +958,9 @@ contains
end subroutine rotate_angle
!=====================================================================
!===============================================================================
! SAMPLE_ENERGY
!=====================================================================
!===============================================================================
subroutine sample_energy(edist, E_in, E_out, mu_out)
@ -1018,8 +1010,7 @@ contains
real(8) :: T ! nuclear temperature
character(250) :: msg ! error message
! TODO: If there are multiple scattering laws, sample scattering
! law
! TODO: If there are multiple scattering laws, sample scattering law
! Check for multiple interpolation regions
if (edist % n_interp > 0) then
@ -1031,11 +1022,11 @@ contains
! Determine which secondary energy distribution law to use
select case (edist % law)
case (1)
! =============================================================
! =======================================================================
! TABULAR EQUIPROBABLE ENERGY BINS
! read number of interpolation regions, incoming energies, and
! outgoing energies
! read number of interpolation regions, incoming energies, and outgoing
! energies
NR = edist % data(1)
NE = edist % data(2 + 2*NR)
NET = edist % data(3 + 2*NR + NE)
@ -1045,8 +1036,7 @@ contains
call error(msg)
end if
! determine index on incoming energy grid and interpolation
! factor
! determine index on incoming energy grid and interpolation factor
loc = 2 + 2*NR
i = binary_search(edist % data(loc+1), NE, E_in)
r = (E_in - edist%data(loc+i)) / &
@ -1056,8 +1046,8 @@ contains
xi1 = rang()
k = 1 + int(NET * xi1)
! Randomly select between the outgoing table for incoming
! energy E_i and E_(i+1)
! Randomly select between the outgoing table for incoming energy E_i and
! E_(i+1)
if (rang() < r) then
l = i + 1
else
@ -1073,7 +1063,7 @@ contains
! TODO: Add scaled interpolation
case (3)
! =============================================================
! =======================================================================
! INELASTIC LEVEL SCATTERING
E_cm = edist%data(2) * (E_in - edist%data(1))
@ -1081,7 +1071,7 @@ contains
E_out = E_cm
case (4)
! =============================================================
! =======================================================================
! CONTINUOUS TABULAR DISTRIBUTION
! read number of interpolation regions and incoming energies
@ -1093,9 +1083,9 @@ contains
call error(msg)
end if
! find energy bin and calculate interpolation factor -- if the
! energy is outside the range of the tabulated energies, choose
! the first or last bins
! find energy bin and calculate interpolation factor -- if the energy is
! outside the range of the tabulated energies, choose the first or last
! bins
loc = 2 + 2*NR
if (E_in < edist % data(loc+1)) then
i = 1
@ -1169,8 +1159,8 @@ contains
E_out = E_l_k + (xi1 - c_k)/p_l_k
elseif (INTT == LINEAR_LINEAR) then
! Linear-linear interpolation -- not sure how you come about
! the formula given in the MCNP manual
! Linear-linear interpolation -- not sure how you come about the
! formula given in the MCNP manual
E_l_k1 = edist % data(loc+k+1)
p_l_k1 = edist % data(loc+NP+k+1)
@ -1194,11 +1184,11 @@ contains
end if
case (5)
! =============================================================
! =======================================================================
! GENERAL EVAPORATION SPECTRUM
case (7)
! =============================================================
! =======================================================================
! MAXWELL FISSION SPECTRUM
! read number of interpolation regions and incoming energies
@ -1233,7 +1223,7 @@ contains
E_out = maxwell_spectrum(T)
case (9)
! =============================================================
! =======================================================================
! EVAPORATION SPECTRUM
! read number of interpolation regions and incoming energies
@ -1245,9 +1235,9 @@ contains
call error(msg)
end if
! find energy bin and calculate interpolation factor -- if the
! energy is outside the range of the tabulated energies, choose
! the first or last bins
! find energy bin and calculate interpolation factor -- if the energy is
! outside the range of the tabulated energies, choose the first or last
! bins
loc = 2 + 2*NR
if (E_in < edist % data(loc+1)) then
i = 1
@ -1270,8 +1260,8 @@ contains
loc = loc + NE
U = edist % data(loc + 1)
! sample outgoing energy based on evaporation spectrum
! probability density function
! sample outgoing energy based on evaporation spectrum probability
! density function
do
xi1 = rang()
xi2 = rang()
@ -1280,11 +1270,11 @@ contains
end do
case (11)
! =============================================================
! =======================================================================
! ENERGY-DEPENDENT WATT SPECTRUM
! read number of interpolation regions and incoming energies
! for parameter 'a'
! read number of interpolation regions and incoming energies for
! parameter 'a'
NR = edist % data(1)
NE = edist % data(2 + 2*NR)
if (NR > 0) then
@ -1312,8 +1302,8 @@ contains
Watt_a = edist%data(loc+i) + r * &
& (edist%data(loc+i+1) - edist%data(loc+i))
! read number of interpolation regions and incoming energies
! for parameter 'b'
! read number of interpolation regions and incoming energies for
! parameter 'b'
loc = loc + NE
NR = edist % data(loc + 1)
NE = edist % data(loc + 2 + 2*NR)
@ -1346,7 +1336,7 @@ contains
E_out = watt_spectrum(Watt_a, Watt_b)
case (44)
! =============================================================
! =======================================================================
! KALBACH-MANN CORRELATED SCATTERING
if (.not. present(mu_out)) then
@ -1363,9 +1353,9 @@ contains
call error(msg)
end if
! find energy bin and calculate interpolation factor -- if the
! energy is outside the range of the tabulated energies, choose
! the first or last bins
! find energy bin and calculate interpolation factor -- if the energy is
! outside the range of the tabulated energies, choose the first or last
! bins
loc = 2 + 2*NR
if (E_in < edist % data(loc+1)) then
i = 1
@ -1444,8 +1434,8 @@ contains
KM_A = edist % data(loc + 4*NP + k)
elseif (INTT == LINEAR_LINEAR) then
! Linear-linear interpolation -- not sure how you come about
! the formula given in the MCNP manual
! Linear-linear interpolation -- not sure how you come about the
! formula given in the MCNP manual
E_l_k1 = edist % data(loc+k+1)
p_l_k1 = edist % data(loc+NP+k+1)
@ -1489,7 +1479,7 @@ contains
end if
case (61)
! =============================================================
! =======================================================================
! CORRELATED ENERGY AND ANGLE DISTRIBUTION
if (.not. present(mu_out)) then
@ -1506,9 +1496,9 @@ contains
call error(msg)
end if
! find energy bin and calculate interpolation factor -- if the
! energy is outside the range of the tabulated energies, choose
! the first or last bins
! find energy bin and calculate interpolation factor -- if the energy is
! outside the range of the tabulated energies, choose the first or last
! bins
loc = 2 + 2*NR
if (E_in < edist % data(loc+1)) then
i = 1
@ -1583,8 +1573,8 @@ contains
E_out = E_l_k + (xi1 - c_k)/p_l_k
elseif (INTT == LINEAR_LINEAR) then
! Linear-linear interpolation -- not sure how you come about
! the formula given in the MCNP manual
! Linear-linear interpolation -- not sure how you come about the
! formula given in the MCNP manual
E_l_k1 = edist % data(loc+k+1)
p_l_k1 = edist % data(loc+NP+k+1)
@ -1638,8 +1628,8 @@ contains
mu_out = mu_k + (xi3 - c_k)/p_k
elseif (JJ == LINEAR_LINEAR) then
! Linear-linear interpolation -- not sure how you come about
! the formula given in the MCNP manual
! Linear-linear interpolation -- not sure how you come about the
! formula given in the MCNP manual
p_k1 = edist % data(loc + NP + k+1)
mu_k1 = edist % data(loc + k+1)
@ -1655,22 +1645,22 @@ contains
end if
case (66)
! =============================================================
! =======================================================================
! N-BODY PHASE SPACE DISTRIBUTION
case (67)
! =============================================================
! =======================================================================
! LABORATORY ENERGY-ANGLE LAW
end select
end subroutine sample_energy
!=====================================================================
! MAXWELL_SPECTRUM samples an energy from the Maxwell fission
! distribution based on a rejection sampling scheme. This is described
! in the MCNP manual volume I -- need to verify formula
!=====================================================================
!===============================================================================
! MAXWELL_SPECTRUM samples an energy from the Maxwell fission distribution based
! on a rejection sampling scheme. This is described in the MCNP manual volume I
! -- need to verify formula
!===============================================================================
function maxwell_spectrum(T) result(E_out)
@ -1696,12 +1686,12 @@ contains
end function maxwell_spectrum
!=====================================================================
! WATT_SPECTRUM samples the outgoing energy from a Watt
! energy-dependent fission spectrum. Although fitted parameters exist
! for many nuclides, generally the continuous tabular distributions
! (LAW 4) should be used in lieu of the Watt spectrum
!=====================================================================
!===============================================================================
! WATT_SPECTRUM samples the outgoing energy from a Watt energy-dependent fission
! spectrum. Although fitted parameters exist for many nuclides, generally the
! continuous tabular distributions (LAW 4) should be used in lieu of the Watt
! spectrum
!===============================================================================
function watt_spectrum(a, b) result(E_out)
@ -1722,11 +1712,10 @@ contains
end function watt_spectrum
!=====================================================================
! WIGNER samples a Wigner distribution of energy level spacings. Note
! that this scheme is C50 in the Monte Carlo Sampler from Los Alamos
! (LA-9721-MS).
!=====================================================================
!===============================================================================
! WIGNER samples a Wigner distribution of energy level spacings. Note that this
! scheme is C50 in the Monte Carlo Sampler from Los Alamos (LA-9721-MS).
!===============================================================================
function wigner(D_avg) result (D)
@ -1740,18 +1729,17 @@ contains
end function wigner
!=====================================================================
! CHI_SQUARED samples a chi-squared distribution with n degrees of
! freedom. The distribution of resonance widths in the unresolved
! region is given by a chi-squared distribution. For the special case
! of n=1, this is a Porter-Thomas distribution. This currently
! hardwires cases for n = 1 to 4, but could be made more general by
! treating all n odd with rule C64 and all n even with rule C45.
!=====================================================================
!===============================================================================
! CHI_SQUARED samples a chi-squared distribution with n degrees of freedom. The
! distribution of resonance widths in the unresolved region is given by a
! chi-squared distribution. For the special case of n=1, this is a Porter-Thomas
! distribution. This currently hardwires cases for n = 1 to 4, but could be made
! more general by treating all n odd with rule C64 and all n even with rule C45.
!===============================================================================
function chi_squared(n, G_avg) result(G)
real(8), intent(in) :: n ! number of degrees of freedom
integer, intent(in) :: n ! number of degrees of freedom
real(8), intent(in), optional :: G_avg ! average resonance width
real(8) :: G ! sampled random variable (or resonance width)
@ -1760,37 +1748,37 @@ contains
select case (n)
case (1)
! For this case, we get p(x) = c*x^(-1/2)*exp(-x). This can be
! sampled with rule C64
! For this case, we get p(x) = c*x^(-1/2)*exp(-x). This can be sampled
! with rule C64
r1 = rang()
r2 = rang()
y = cos(PI/2*r2)
x = -2*log(r1)*y*y
G = x * G_avg
case (2)
! This case corresponds to a simple exponential distribution
! p(x) = exp(-x) whose CDF can be directly inverted.
! This case corresponds to a simple exponential distribution p(x) =
! exp(-x) whose CDF can be directly inverted.
r1 = rang()
x = -log(r1)
case (3)
! For this case, we get p(x) = c*x^(1/2)*exp(-x). This can be
! sampled with rule C64
! For this case, we get p(x) = c*x^(1/2)*exp(-x). This can be sampled
! with rule C64
r1 = rang()
r2 = rang()
r3 = rang()
y = cos(PI/2*r2)
x = -2.0/3.0*(log(r1)*y*y + log(r3))
case (4)
! For this case, we get p(x) = c*x*exp(-x). This can be sampled
! with rule C45.
! For this case, we get p(x) = c*x*exp(-x). This can be sampled with rule
! C45.
r1 = rang()
r2 = rang()
x = -0.5*log(r1*r2)
end select
! If sampling a chi-squared distribution for a resonance width and
! the average resonance width has been given, return the sampled
! resonance width.
! If sampling a chi-squared distribution for a resonance width and the
! average resonance width has been given, return the sampled resonance
! width.
if (present(G_avg)) then
G = x * G_avg
else

30
src/score.f90
View file

@ -13,9 +13,9 @@ module score
contains
!=====================================================================
!===============================================================================
! CALCULATE_KEFF
!=====================================================================
!===============================================================================
subroutine calculate_keff(i_cycle)
@ -77,9 +77,9 @@ contains
end subroutine calculate_keff
!=====================================================================
!===============================================================================
! SCORE_TALLY
!=====================================================================
!===============================================================================
subroutine score_tally(p, flux)
@ -102,7 +102,7 @@ contains
type(Cell), pointer :: c => null()
type(Tally), pointer :: t => null()
! ================================================================
! ==========================================================================
! HANDLE LOCAL TALLIES
c => cells(p % cell)
@ -112,7 +112,7 @@ contains
do i = 1, size(c % tallies)
t => tallies(c % tallies(i))
! =============================================================
! =======================================================================
! DETERMINE ENERGY BIN
if (allocated(t % energies)) then
E = p % E
@ -125,7 +125,7 @@ contains
end if
end if
! =============================================================
! =======================================================================
! DETERMINE CELL BIN
type = t % cell_type
if (type == TALLY_SUM) then
@ -144,7 +144,7 @@ contains
call error(msg)
end if
! =============================================================
! =======================================================================
! DETERMINE REACTION BIN AND ADD VALUE TO SCORE
type = t % reaction_type
if (type == TALLY_FLUX) then
@ -186,13 +186,13 @@ contains
end if
end do
! ================================================================
! ==========================================================================
! HANDLE GLOBAL TALLIES
do i = 1, n_tallies_global
t => tallies_global(i)
! =============================================================
! =======================================================================
! DETERMINE ENERGY BIN
if (allocated(t % energies)) then
E = p % E
@ -208,7 +208,7 @@ contains
! Since it's a global tally, the cell bin is unity
c_bin = 1
! =============================================================
! =======================================================================
! DETERMINE REACTION BIN AND ADD VALUE TO SCORE
type = t % reaction_type
if (type == TALLY_FLUX) then
@ -251,17 +251,17 @@ contains
end do
! ================================================================
! ==========================================================================
! TODO: Add lattice tallies
! ================================================================
! ==========================================================================
! TODO: Add mesh tallies
end subroutine score_tally
!=====================================================================
!===============================================================================
! ADD_TO_SCORE
!=====================================================================
!===============================================================================
subroutine add_to_score(score, val)

13
src/search.f90
View file

@ -4,11 +4,10 @@ module search
contains
!=====================================================================
! BINARY_SEARCH performs a binary search of an array to find where a
! specific value lies in the array. This is used extensively for
! energy grid searching
!=====================================================================
!===============================================================================
! BINARY_SEARCH performs a binary search of an array to find where a specific
! value lies in the array. This is used extensively for energy grid searching
!===============================================================================
function binary_search(array, n, val) result(index)
@ -55,9 +54,9 @@ contains
end function binary_search
!=====================================================================
!===============================================================================
! INTERPOLATE
!=====================================================================
!===============================================================================
function interpolate(array, n, index, f) result(val)

19
src/source.f90
View file

@ -11,9 +11,9 @@ module source
contains
!=====================================================================
!===============================================================================
! INIT_SOURCE initializes particles in the source bank
!=====================================================================
!===============================================================================
subroutine init_source()
@ -33,8 +33,7 @@ contains
msg = 'Initializing source particles...'
call message(msg, 6)
! Determine maximum amount of particles to simulate on each
! processor
! Determine maximum amount of particles to simulate on each processor
maxwork = ceiling(real(n_particles)/n_procs,8)
! Allocate fission and source banks
@ -105,9 +104,9 @@ contains
end subroutine init_source
!=====================================================================
!===============================================================================
! GET_SOURCE_PARTICLE returns the next source particle
!=====================================================================
!===============================================================================
function get_source_particle() result(p)
@ -130,9 +129,9 @@ contains
end function get_source_particle
!=====================================================================
!===============================================================================
! ADD_BANK_SITES
!=====================================================================
!===============================================================================
subroutine add_bank_sites(p, table, n)
@ -154,9 +153,9 @@ contains
end subroutine add_bank_sites
!=====================================================================
!===============================================================================
! COPY_FROM_BANK
!=====================================================================
!===============================================================================
subroutine copy_from_bank(temp_bank, index, n_sites)

38
src/string.f90
View file

@ -7,15 +7,15 @@ module string
contains
!=====================================================================
! SPLIT_STRING takes a sentence and splits it into separate words much
! like the Python string.split() method.
!===============================================================================
! SPLIT_STRING takes a sentence and splits it into separate words much like the
! Python string.split() method.
!
! Arguments:
! string = input line
! words = array of words
! n = total number of words
!=====================================================================
!===============================================================================
subroutine split_string(string, words, n)
@ -59,17 +59,16 @@ contains
end subroutine split_string
!=====================================================================
! SPLIT_STRING_WL takes a string that includes logical expressions for
! a list of bounding surfaces in a cell and splits it into separate
! words. The characters (, ), :, and # count as separate words since
! they represent operators.
!===============================================================================
! SPLIT_STRING_WL takes a string that includes logical expressions for a list of
! bounding surfaces in a cell and splits it into separate words. The characters
! (, ), :, and # count as separate words since they represent operators.
!
! Arguments:
! string = input line
! words = array of words
! n = number of words
!=====================================================================
!===============================================================================
subroutine split_string_wl(string, words, n)
@ -119,15 +118,15 @@ contains
end do
end subroutine split_string_wl
!=====================================================================
! CONCATENATE takes an array of words and concatenates them
! together in one string with a single space between words
!===============================================================================
! CONCATENATE takes an array of words and concatenates them together in one
! string with a single space between words
!
! Arguments:
! words = array of words
! n_words = total number of words
! string = concatenated string
!=====================================================================
!===============================================================================
function concatenate(words, n_words) result(string)
@ -145,9 +144,9 @@ contains
end function concatenate
!=====================================================================
!===============================================================================
! LOWER_CASE converts a string to all lower case characters
!=====================================================================
!===============================================================================
elemental subroutine lower_case(word)
@ -163,10 +162,9 @@ contains
end subroutine lower_case
!=====================================================================
! IS_NUMBER determines whether a string of characters is all 0-9
! characters
!=====================================================================
!===============================================================================
! IS_NUMBER determines whether a string of characters is all 0-9 characters
!===============================================================================
function is_number(word) result(number)

207
src/types.f90
View file

@ -2,9 +2,9 @@ module types
implicit none
!=====================================================================
!===============================================================================
! UNIVERSE defines a geometry that fills all phase space
!=====================================================================
!===============================================================================
type Universe
integer :: uid ! Unique ID
@ -18,10 +18,10 @@ module types
integer, allocatable :: tallies(:)
end type Universe
!=====================================================================
! LATTICE is an ordered array of elements (either rectangular,
! hexagonal, or triangular)
!=====================================================================
!===============================================================================
! LATTICE is an ordered array of elements (either rectangular, hexagonal, or
! triangular)
!===============================================================================
type Lattice
integer :: uid ! Universe number for lattice
@ -37,10 +37,10 @@ module types
integer, allocatable :: tallies(:)
end type Lattice
!=====================================================================
! SURFACE type defines a first- or second-order surface that can be
! used to construct closed volumes (cells)
!=====================================================================
!===============================================================================
! SURFACE type defines a first- or second-order surface that can be used to
! construct closed volumes (cells)
!===============================================================================
type Surface
integer :: uid ! Unique ID
@ -52,9 +52,9 @@ module types
integer :: bc ! Boundary condition
end type Surface
!=====================================================================
!===============================================================================
! CELL defines a closed volume by its bounding surfaces
!=====================================================================
!===============================================================================
type Cell
integer :: uid ! Unique ID
@ -65,16 +65,16 @@ module types
integer :: material ! Material within cell (0 for universe)
integer :: n_surfaces ! Number of surfaces within
integer, allocatable :: &
& surfaces(:) ! List of surfaces bounding cell -- note
! that parentheses, union, etc operators
! will be listed here too
& surfaces(:) ! List of surfaces bounding cell -- note that
! parentheses, union, etc operators will be listed
! here too
integer, allocatable :: tallies(:)
end type Cell
!=====================================================================
! PARTICLE describes the state of a particle being transported through
! the geometry
!=====================================================================
!===============================================================================
! PARTICLE describes the state of a particle being transported through the
! geometry
!===============================================================================
type Particle
integer(8) :: uid ! Unique ID
@ -96,11 +96,11 @@ module types
integer :: n_coll ! # of collisions
end type Particle
!=====================================================================
! BANK is used for storing fission sites in criticality
! calculations. Since all the state information of a neutron is not
! needed, this type allows sites to be stored with less memory
!=====================================================================
!===============================================================================
! BANK is used for storing fission sites in criticality calculations. Since all
! the state information of a neutron is not needed, this type allows sites to be
! stored with less memory
!===============================================================================
type Bank
integer(8) :: uid ! Unique ID
@ -109,9 +109,9 @@ module types
real(8) :: E ! energy
end type Bank
!=====================================================================
!===============================================================================
! TALLYSCORE
!=====================================================================
!===============================================================================
type TallyScore
integer :: n_events
@ -119,9 +119,9 @@ module types
real(8) :: val_sq
end type TallyScore
!=====================================================================
!===============================================================================
! TALLY
!=====================================================================
!===============================================================================
type Tally
integer :: uid
@ -143,12 +143,11 @@ module types
type(TallyScore), allocatable :: score(:,:,:)
end type Tally
!=====================================================================
! ISOTOPE describes an isotope, e.g. U-235, within a material. Note
! that two separate variables must be used for the same isotope in two
! different materials since they will generally have different
! densities
!=====================================================================
!===============================================================================
! ISOTOPE describes an isotope, e.g. U-235, within a material. Note that two
! separate variables must be used for the same isotope in two different
! materials since they will generally have different densities
!===============================================================================
type Isotope
integer :: uid ! unique identifier
@ -157,9 +156,9 @@ module types
real(8) :: density ! density in atom/b-cm
end type Isotope
!=====================================================================
!===============================================================================
! MATERIAL describes a material by its constituent isotopes
!=====================================================================
!===============================================================================
type Material
integer :: uid
@ -173,21 +172,20 @@ module types
integer :: sab_table
end type Material
!=====================================================================
! EXTSOURCE describes an external source of neutrons for a
! fixed-source problem or for the starting source in a criticality
! problem
!=====================================================================
!===============================================================================
! EXTSOURCE describes an external source of neutrons for a fixed-source problem
! or for the starting source in a criticality problem
!===============================================================================
type ExtSource
integer :: type ! type of source, e.g. 'box' or 'cell'
real(8), allocatable :: values(:) ! values for particular source type
end type ExtSource
!=====================================================================
! ACEDISTANGLE contains data for a tabular secondary angle
! distribution whether it be tabular or 32 equiprobable cosine bins
!=====================================================================
!===============================================================================
! ACEDISTANGLE contains data for a tabular secondary angle distribution whether
! it be tabular or 32 equiprobable cosine bins
!===============================================================================
type AceDistAngle
integer :: n_energy ! # of incoming energies
@ -197,10 +195,10 @@ module types
real(8), allocatable :: data(:) ! angular distribution data
end type AceDistAngle
!=====================================================================
! ACEDISTENERGY contains data for a secondary energy distribution for
! all scattering laws
!=====================================================================
!===============================================================================
! ACEDISTENERGY contains data for a secondary energy distribution for all
! scattering laws
!===============================================================================
type AceDistEnergy
integer :: law ! secondary distribution law
@ -213,11 +211,10 @@ module types
real(8), allocatable :: data(:) ! energy distribution data
end type AceDistEnergy
!=====================================================================
! ACEREACTION contains the cross-section and secondary energy and
! angle distributions for a single reaction in a continuous-energy
! ACE-format table
!=====================================================================
!===============================================================================
! ACEREACTION contains the cross-section and secondary energy and angle
! distributions for a single reaction in a continuous-energy ACE-format table
!===============================================================================
type AceReaction
integer :: MT ! ENDF MT value
@ -231,11 +228,11 @@ module types
type(AceDistEnergy) :: edist ! Secondary energy distribution
end type AceReaction
!=====================================================================
! ACECONTINUOUS contains all the data for an ACE-format
! continuous-energy cross section. The ACE format (A Compact ENDF
! format) is used in MCNP and several other Monte Carlo codes.
!=====================================================================
!===============================================================================
! ACECONTINUOUS contains all the data for an ACE-format continuous-energy cross
! section. The ACE format (A Compact ENDF format) is used in MCNP and several
! other Monte Carlo codes.
!===============================================================================
type AceContinuous
character(20) :: name
@ -276,10 +273,10 @@ module types
end type AceContinuous
!=====================================================================
! ACETHERMAL contains S(a,b) data for thermal neutron scattering,
! typically off of light isotopes such as water, graphite, Be, etc
!=====================================================================
!===============================================================================
! ACETHERMAL contains S(a,b) data for thermal neutron scattering, typically off
! of light isotopes such as water, graphite, Be, etc
!===============================================================================
type AceThermal
character(20) :: name
@ -300,9 +297,9 @@ module types
real(8), allocatable :: elastic_mu(:,:)
end type AceThermal
!=====================================================================
!===============================================================================
! XSDATA contains data read in from a SERPENT xsdata file
!=====================================================================
!===============================================================================
type xsData
character(10) :: alias
@ -316,11 +313,11 @@ module types
character(100) :: path
end type xsData
!=====================================================================
! 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.
!=====================================================================
!===============================================================================
! 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 = 20
@ -330,87 +327,87 @@ module types
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.
!=====================================================================
!===============================================================================
! 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
!=====================================================================
!===============================================================================
! 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
!=====================================================================
!===============================================================================
! 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.
!=====================================================================
!===============================================================================
! 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
!=====================================================================
!===============================================================================
! 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
!=====================================================================
!===============================================================================
! 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.
!=====================================================================
!===============================================================================
! 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.
!=====================================================================
!===============================================================================
! 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()

16
src/unittest.f90
View file

@ -10,10 +10,10 @@ program unittest
contains
!=====================================================================
! TEST_ENERGY_GRID is a test of the energy grid unionization
! subroutine on a simplified set of data
!=====================================================================
!===============================================================================
! TEST_ENERGY_GRID is a test of the energy grid unionization subroutine on a
! simplified set of data
!===============================================================================
subroutine test_energy_grid()
@ -49,10 +49,10 @@ contains
end subroutine test_energy_grid
!=====================================================================
! TEST_MPI_BANK is a test of the derived datatype MPI_BANK that is
! used to send fission bank sites during synchronization
!=====================================================================
!===============================================================================
! TEST_MPI_BANK is a test of the derived datatype MPI_BANK that is used to send
! fission bank sites during synchronization
!===============================================================================
subroutine test_mpi_bank()