From 0c4856f378a064dd37dee9adc485c5183b4c48a4 Mon Sep 17 00:00:00 2001 From: Mikolaj-A-Kowalski Date: Fri, 25 Aug 2023 18:23:20 +0200 Subject: [PATCH 1/3] Remove CRLF line endings All files should now use UNIX convention. --- Geometry/coord_class.f90 | 938 +++++++++--------- .../angleLawENDF/tabularAngle_class.f90 | 424 ++++---- .../correlatedLawENDF_inter.f90 | 168 ++-- .../energyLawENDF/energyLawENDF_inter.f90 | 156 +-- .../releaseLawENDF/constantRelease_class.f90 | 150 +-- .../polynomialRelease_class.f90 | 206 ++-- .../releaseLawENDF/releaseLawENDF_inter.f90 | 82 +- SharedModules/universalVariables.f90 | 168 ++-- Tallies/TallyClerks/trackClerk_class.f90 | 584 +++++------ Tallies/TallyMaps/Tests/weightMap_test.f90 | 404 ++++---- Tallies/TallyMaps/weightMap_class.f90 | 564 +++++------ .../Tests/weightResponse_test.f90 | 166 ++-- .../TallyResponses/weightResponse_class.f90 | 208 ++-- Tallies/Tests/scoreMemory_test.f90 | 600 +++++------ Tallies/scoreMemory_class.f90 | 898 ++++++++--------- .../transportOperatorDT_class.f90 | 184 ++-- .../transportOperatorOLD_class.f90 | 860 ++++++++-------- .../transportOperatorST_class.f90 | 242 ++--- TransportOperator/transportOperator_inter.f90 | 286 +++--- Visualisation/visualiser_class.f90 | 788 +++++++-------- 20 files changed, 4038 insertions(+), 4038 deletions(-) diff --git a/Geometry/coord_class.f90 b/Geometry/coord_class.f90 index c4b2e8ca6..ed699ce67 100644 --- a/Geometry/coord_class.f90 +++ b/Geometry/coord_class.f90 @@ -1,469 +1,469 @@ -module coord_class - - use numPrecision - use universalVariables, only : HARDCODED_MAX_NEST, FP_REL_TOL - use genericProcedures, only : rotateVector, fatalError, numToChar - - implicit none - private - - !! - !! Co-ordinates in a single geometry level - !! - !! Co-ordinates are considered valid if: - !! * dir is normalised to 1.0 (norm2(dir) ~= 1.0) - !! * uniIdx, uniRootId & localID are set to +ve values - !! - !! Public Members: - !! r -> Position - !! dir -> Direction - !! isRotated -> Is rotated wrt previous (higher by 1) level - !! rotMat -> Rotation matrix wrt previous level - !! uniIdx -> Index of the occupied universe - !! uniRootID -> Location of the occupied universe in geometry graph - !! localID -> Local cell in the occupied universe - !! cellIdx -> Index of the occupied cell in cellShelf. 0 is cell is local to the universe - !! - !! Interface: - !! isValid -> True if co-ordinates are valid - !! display -> Print co-ordinates to the console - !! kill -> Return to uninitialised state - !! - type, public :: coord - real(defReal), dimension(3) :: r = ZERO - real(defReal), dimension(3) :: dir = ZERO - logical(defBool) :: isRotated = .false. - real(defReal), dimension(3,3) :: rotMat = ZERO - integer(shortInt) :: uniIdx = 0 - integer(shortInt) :: uniRootID = 0 - integer(shortInt) :: localID = 0 - integer(shortInt) :: cellIdx = 0 - contains - procedure :: isValid => isValid_coord - procedure :: display => display_coord - procedure :: kill => kill_coord - end type coord - - !! - !! List of co-ordinates at diffrent level of a geometry - !! - !! Specifies the position of a particle in space - !! - !! It can exist in the following states: - !! ABOVE GEOMETRY -> Nesting = 1. matIdx & uniqueID are < 0 (unassigned). Co-ordinates at - !! level 1 are reliable. - !! PLACED IN GEOMETRY -> Nesting >=1. matIdx is assigned. Coordinates up to nesting are realible - !! UNINITIALISED -> Is neither PLACED nor ABOVE - !! - !! NOTE: - !! moveGlobal resets regionID & matIdx to 0 - !! moveLocal leaves regionID & matIdx unchanged - !! - !! Public Members: - !! nesting -> Maximum currently occupied nexting level - !! lvl -> Coordinates at each level - !! matIdx -> Material index at the current position - !! uniqueID -> Unique cell ID at the current position - !! - !! Interface: - !! init -> Initialise and place ABOVE GEOMETRY, given position and - !! normalised direction - !! kill -> Return to uninitialised state - !! isPlaced -> True if co-ordinates are PLACED IN GEOMETRY - !! isAbove -> True of co-ordinates are ABOVE GEOMETRY - !! isUninitialised -> True if co-ordinates are UNINITIALISED - !! addLevel -> Increment number of occupied levels by 1. - !! decreaseLevel -> Decrease nesting to a lower level n. - !! takeAboveGeometry -> Change state to ABOVE GEOMETRY - !! moveGlobal -> Move point along direction ABOVE GEOMETRY - !! moveLocal -> Move point along direction above and including level n - !! rotate -> Rotate by the cosine of polar deflection mu, and azimuthal angle phi - !! cell -> Return cellIdx at the lowest level - !! assignPosition -> Set position and take ABOVE GEOMETRY - !! assignDirection -> Set direction and do not change coordList state - !! - type, public :: coordList - integer(shortInt) :: nesting = 0 - type(coord), dimension(HARDCODED_MAX_NEST) :: lvl - integer(shortInt) :: matIdx = -3 - integer(shortInt) :: uniqueId = -3 - contains - ! Build procedures - procedure :: init - procedure :: kill - - ! State enquiry procedures - procedure :: isPlaced - procedure :: isAbove - procedure :: isUninitialised - - ! Interface procedures - procedure :: addLevel - procedure :: decreaseLevel - procedure :: takeAboveGeom - procedure :: moveGlobal - procedure :: moveLocal - procedure :: rotate - procedure :: cell - procedure :: assignPosition - procedure :: assignDirection - - end type coordList - -contains - -!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> -!! coord Procedures -!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> - - !! - !! Returns .true. if coordinates are valid - !! - !! Args: - !! None - !! - !! Result: - !! True if coord is valid. See type doc-comment for definition of valid. - !! - elemental function isValid_coord(self) result(correct) - class(coord), intent(in) :: self - logical(defBool) :: correct - - ! Direction vector is normalised within floating point tolerance - correct = abs(norm2(self % dir) - ONE) < FP_REL_TOL - - correct = correct .and. self % uniIdx > 0 - correct = correct .and. self % localID > 0 - correct = correct .and. self % uniRootId > 0 - - end function isValid_coord - - !! - !! Print to screen contents of the coord - !! - subroutine display_coord(self) - class(coord), intent(in) :: self - - print *, "R: ", self % r - print *, "U: ", self % dir - print *, "UniIdx: ", numToChar(self % uniIDx), " LocalID: ", numToChar(self % localID), & - "UniRootId", numToChar(self % uniRootID) - - end subroutine display_coord - - !! - !! Return to uninitialised state - !! - elemental subroutine kill_coord(self) - class(coord), intent(inout) :: self - - self % r = ZERO - self % dir = ZERO - self % isRotated = .false. - self % rotMat = ZERO - self % uniIdx = 0 - self % uniRootID = 0 - self % localID = 0 - self % cellIdx = 0 - - end subroutine kill_coord - - -!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> -!! coordList Procedures -!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> - - !! - !! Initialise coordList - !! - !! Change state from UNINITIALISED to ABOVE GEOMETRY - !! - !! Args: - !! r [in] -> Position in level 1 - !! u [in] -> Normalised direction in level 1 (norm2(u)=1.0) - !! - !! NOTE: - !! Does not check if u is normalised! - !! - pure subroutine init(self, r, u) - class(coordList), intent(inout) :: self - real(defReal), dimension(3), intent(in) :: r - real(defReal), dimension(3), intent(in) :: u - - call self % takeAboveGeom() - - self % lvl(1) % r = r - self % lvl(1) % dir = u - self % nesting = 1 - - end subroutine init - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(coordList), intent(inout) :: self - - self % nesting = 0 - self % matIdx = -3 - self % uniqueID = -3 - - ! Kill coordinates - call self % lvl % kill() - - end subroutine kill - - !! - !! Return true if co-ordinates List is placed in geometry - !! - !! Args: - !! None - !! - !! Result: - !! True if co-ordinates are PLACED. - !! - elemental function isPlaced(self) result(isIt) - class(coordList), intent(in) :: self - logical(defBool) :: isIt - - isIt = (self % matIdx > 0) .and. (self % uniqueID > 0) .and. (self % nesting >= 1) - - end function isPlaced - - !! - !! Return true if co-ordinates are above geometry - !! - !! Args: - !! None - !! - !! Result: - !! True if co-ordinates are ABOVE GEOMETRY - !! - elemental function isAbove(self) result(isIt) - class(coordList), intent(in) :: self - logical(defBool) :: isIt - - isIt = (self % matIdx < 0) .and. (self % uniqueID < 0) .and. (self % nesting == 1) - - end function isAbove - - !! - !! Return true if coordinates are uninitialised - !! - !! Args: - !! None - !! - !! Result: - !! True if co-ordinates are UNINITIALISED - !! - elemental function isUninitialised(self) result(isIt) - class(coordList), intent(in) :: self - logical(defBool) :: isIt - - isIt = .not.( self % isPlaced() .or. self % isAbove() ) - - end function isUninitialised - - !! - !! Add another level of co-ordinates - !! - !! Simply increments nesting counter - !! - !! Args: - !! None - !! - pure subroutine addLevel(self) - class(coordList), intent(inout) :: self - - self % nesting = self % nesting + 1 - - end subroutine addLevel - - !! - !! Takes co-ordinates above the geometry - !! - !! State changes to ABOVE GEOMETRY - !! - !! Args: - !! None - !! - !! NOTE: - !! If called on UNINITIALISED may result in unnormalised direction at level 1! - !! - elemental subroutine takeAboveGeom(self) - class(coordList), intent(inout) :: self - - self % nesting = 1 - self % matIdx = -3 - self % uniqueID = -3 - - end subroutine takeAboveGeom - - !! - !! Decrease nestting to level n - !! - !! Args: - !! n [in] -> New nesting level - !! - !! Errors: - !! fatalError if n is -ve or larger then current nesting - !! - subroutine decreaseLevel(self, n) - class(coordList), intent(inout) :: self - integer(shortInt), intent(in) :: n - character(100),parameter :: Here = 'decreaseLevel (coord_class.f90)' - - if (n > self % nesting .or. n < 1) then - call fatalError(Here,'New nesting: '//numToChar(n)//' is invalid. Current nesting: '//& - numToChar(self % nesting)) - end if - - self % nesting = n - - end subroutine decreaseLevel - - !! - !! Move a point ABOVE the geometry - !! - !! Changes state to ABOVE GEOMETRY - !! - !! Args: - !! d [in] -> Distance (+ve or -ve) - !! - !! Errors: - !! If d < 0 then movment is backwards. - !! - elemental subroutine moveGlobal(self, d) - class(coordList), intent(inout) :: self - real(defReal), intent(in) :: d - - call self % takeAboveGeom() - self % lvl(1) % r = self % lvl(1) % r + d * self % lvl(1) % dir - - end subroutine moveGlobal - - !! - !! Move point inside the geometry - !! - !! Moves above and including level n - !! Does not change matIdx nor uniqueID - !! - !! Args: - !! d [in] -> Distance (+ve or -ve) - !! n [in] -> Nesting level - !! - !! Errors: - !! If d < 0.0 movment is backwards - !! - subroutine moveLocal(self, d, n) - class(coordList), intent(inout) :: self - real(defReal), intent(in) :: d - integer(shortInt), intent(in) :: n - integer(shortInt) :: i - - call self % decreaseLevel(n) - do i = 1 , n - self % lvl(i) % r = self % lvl(i) % r + d * self % lvl(i) % dir - end do - - end subroutine moveLocal - - !! - !! Rotate direction of the point - !! - !! Does not change the state of co-ordinates - !! - !! Args: - !! mu [in] -> Cosine of polar deflection angle <-1,1> - !! phi [in] -> Azimuthal deflection angle <0;2*pi> - !! - elemental subroutine rotate(self, mu, phi) - class(coordList), intent(inout) :: self - real(defReal), intent(in) :: mu - real(defReal), intent(in) :: phi - integer(shortInt) :: i - - ! Rotate directions in all nesting levels - self % lvl(1) % dir = rotateVector(self % lvl(1) % dir, mu, phi) - - ! Propagate rotation to lower levels - do i = 2, self % nesting - if (self % lvl(i) % isRotated) then - ! Note that rotation must be performed with the matrix - ! Deflections by mu & phi depend on coordinates - ! Deflection by the same my & phi may be diffrent at diffrent, rotated levels! - self % lvl(i) % dir = matmul(self % lvl(i) % rotMat, self % lvl(i-1) % dir) - - else - self % lvl(i) % dir = self % lvl(i-1) % dir - - end if - end do - - end subroutine rotate - - !! - !! Returns the index of the cell occupied at the lowest level - !! - !! Args: - !! None - !! - !! Result: - !! cellIdx at the lowest ocupied level - !! - elemental function cell(self)result(cellIdx) - class(coordList), intent(in) :: self - integer(shortInt) :: cellIdx - - cellIdx = self % lvl(max(self % nesting, 1)) % cellIdx - - end function cell - - !! - !! Take co-ordinates ABOVE GEOMETRY and assign new position - !! - !! Args: - !! r [in] -> New position at level 1 - !! - pure subroutine assignPosition(self, r) - class(coordList), intent(inout) :: self - real(defReal), dimension(3), intent(in) :: r - - call self % takeAboveGeom() - self % lvl(1) % r = r - - end subroutine assignPosition - - !! - !! Assign new direction - !! - !! Does not change the state of co-ordinates - !! - !! Args: - !! u [in] -> New normalised direction at level 1 - !! - !! NOTE: - !! Does not check if u is normalised! - !! - pure subroutine assignDirection(self, u) - class(coordList), intent(inout) :: self - real(defReal), dimension(3), intent(in) :: u - integer(shortInt) :: i - - ! Assign new direction in global frame - self % lvl(1) % dir = u - - ! Propage the change to lower levels - do i = 2, self % nesting - if(self % lvl(i) % isRotated) then - self % lvl(i) % dir = matmul(self % lvl(i) % rotMat, self % lvl(i-1) % dir) - - else - self % lvl(i) % dir = self % lvl(i-1) % dir - - end if - end do - - end subroutine assignDirection - -end module coord_class +module coord_class + + use numPrecision + use universalVariables, only : HARDCODED_MAX_NEST, FP_REL_TOL + use genericProcedures, only : rotateVector, fatalError, numToChar + + implicit none + private + + !! + !! Co-ordinates in a single geometry level + !! + !! Co-ordinates are considered valid if: + !! * dir is normalised to 1.0 (norm2(dir) ~= 1.0) + !! * uniIdx, uniRootId & localID are set to +ve values + !! + !! Public Members: + !! r -> Position + !! dir -> Direction + !! isRotated -> Is rotated wrt previous (higher by 1) level + !! rotMat -> Rotation matrix wrt previous level + !! uniIdx -> Index of the occupied universe + !! uniRootID -> Location of the occupied universe in geometry graph + !! localID -> Local cell in the occupied universe + !! cellIdx -> Index of the occupied cell in cellShelf. 0 is cell is local to the universe + !! + !! Interface: + !! isValid -> True if co-ordinates are valid + !! display -> Print co-ordinates to the console + !! kill -> Return to uninitialised state + !! + type, public :: coord + real(defReal), dimension(3) :: r = ZERO + real(defReal), dimension(3) :: dir = ZERO + logical(defBool) :: isRotated = .false. + real(defReal), dimension(3,3) :: rotMat = ZERO + integer(shortInt) :: uniIdx = 0 + integer(shortInt) :: uniRootID = 0 + integer(shortInt) :: localID = 0 + integer(shortInt) :: cellIdx = 0 + contains + procedure :: isValid => isValid_coord + procedure :: display => display_coord + procedure :: kill => kill_coord + end type coord + + !! + !! List of co-ordinates at diffrent level of a geometry + !! + !! Specifies the position of a particle in space + !! + !! It can exist in the following states: + !! ABOVE GEOMETRY -> Nesting = 1. matIdx & uniqueID are < 0 (unassigned). Co-ordinates at + !! level 1 are reliable. + !! PLACED IN GEOMETRY -> Nesting >=1. matIdx is assigned. Coordinates up to nesting are realible + !! UNINITIALISED -> Is neither PLACED nor ABOVE + !! + !! NOTE: + !! moveGlobal resets regionID & matIdx to 0 + !! moveLocal leaves regionID & matIdx unchanged + !! + !! Public Members: + !! nesting -> Maximum currently occupied nexting level + !! lvl -> Coordinates at each level + !! matIdx -> Material index at the current position + !! uniqueID -> Unique cell ID at the current position + !! + !! Interface: + !! init -> Initialise and place ABOVE GEOMETRY, given position and + !! normalised direction + !! kill -> Return to uninitialised state + !! isPlaced -> True if co-ordinates are PLACED IN GEOMETRY + !! isAbove -> True of co-ordinates are ABOVE GEOMETRY + !! isUninitialised -> True if co-ordinates are UNINITIALISED + !! addLevel -> Increment number of occupied levels by 1. + !! decreaseLevel -> Decrease nesting to a lower level n. + !! takeAboveGeometry -> Change state to ABOVE GEOMETRY + !! moveGlobal -> Move point along direction ABOVE GEOMETRY + !! moveLocal -> Move point along direction above and including level n + !! rotate -> Rotate by the cosine of polar deflection mu, and azimuthal angle phi + !! cell -> Return cellIdx at the lowest level + !! assignPosition -> Set position and take ABOVE GEOMETRY + !! assignDirection -> Set direction and do not change coordList state + !! + type, public :: coordList + integer(shortInt) :: nesting = 0 + type(coord), dimension(HARDCODED_MAX_NEST) :: lvl + integer(shortInt) :: matIdx = -3 + integer(shortInt) :: uniqueId = -3 + contains + ! Build procedures + procedure :: init + procedure :: kill + + ! State enquiry procedures + procedure :: isPlaced + procedure :: isAbove + procedure :: isUninitialised + + ! Interface procedures + procedure :: addLevel + procedure :: decreaseLevel + procedure :: takeAboveGeom + procedure :: moveGlobal + procedure :: moveLocal + procedure :: rotate + procedure :: cell + procedure :: assignPosition + procedure :: assignDirection + + end type coordList + +contains + +!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! coord Procedures +!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Returns .true. if coordinates are valid + !! + !! Args: + !! None + !! + !! Result: + !! True if coord is valid. See type doc-comment for definition of valid. + !! + elemental function isValid_coord(self) result(correct) + class(coord), intent(in) :: self + logical(defBool) :: correct + + ! Direction vector is normalised within floating point tolerance + correct = abs(norm2(self % dir) - ONE) < FP_REL_TOL + + correct = correct .and. self % uniIdx > 0 + correct = correct .and. self % localID > 0 + correct = correct .and. self % uniRootId > 0 + + end function isValid_coord + + !! + !! Print to screen contents of the coord + !! + subroutine display_coord(self) + class(coord), intent(in) :: self + + print *, "R: ", self % r + print *, "U: ", self % dir + print *, "UniIdx: ", numToChar(self % uniIDx), " LocalID: ", numToChar(self % localID), & + "UniRootId", numToChar(self % uniRootID) + + end subroutine display_coord + + !! + !! Return to uninitialised state + !! + elemental subroutine kill_coord(self) + class(coord), intent(inout) :: self + + self % r = ZERO + self % dir = ZERO + self % isRotated = .false. + self % rotMat = ZERO + self % uniIdx = 0 + self % uniRootID = 0 + self % localID = 0 + self % cellIdx = 0 + + end subroutine kill_coord + + +!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! coordList Procedures +!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Initialise coordList + !! + !! Change state from UNINITIALISED to ABOVE GEOMETRY + !! + !! Args: + !! r [in] -> Position in level 1 + !! u [in] -> Normalised direction in level 1 (norm2(u)=1.0) + !! + !! NOTE: + !! Does not check if u is normalised! + !! + pure subroutine init(self, r, u) + class(coordList), intent(inout) :: self + real(defReal), dimension(3), intent(in) :: r + real(defReal), dimension(3), intent(in) :: u + + call self % takeAboveGeom() + + self % lvl(1) % r = r + self % lvl(1) % dir = u + self % nesting = 1 + + end subroutine init + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(coordList), intent(inout) :: self + + self % nesting = 0 + self % matIdx = -3 + self % uniqueID = -3 + + ! Kill coordinates + call self % lvl % kill() + + end subroutine kill + + !! + !! Return true if co-ordinates List is placed in geometry + !! + !! Args: + !! None + !! + !! Result: + !! True if co-ordinates are PLACED. + !! + elemental function isPlaced(self) result(isIt) + class(coordList), intent(in) :: self + logical(defBool) :: isIt + + isIt = (self % matIdx > 0) .and. (self % uniqueID > 0) .and. (self % nesting >= 1) + + end function isPlaced + + !! + !! Return true if co-ordinates are above geometry + !! + !! Args: + !! None + !! + !! Result: + !! True if co-ordinates are ABOVE GEOMETRY + !! + elemental function isAbove(self) result(isIt) + class(coordList), intent(in) :: self + logical(defBool) :: isIt + + isIt = (self % matIdx < 0) .and. (self % uniqueID < 0) .and. (self % nesting == 1) + + end function isAbove + + !! + !! Return true if coordinates are uninitialised + !! + !! Args: + !! None + !! + !! Result: + !! True if co-ordinates are UNINITIALISED + !! + elemental function isUninitialised(self) result(isIt) + class(coordList), intent(in) :: self + logical(defBool) :: isIt + + isIt = .not.( self % isPlaced() .or. self % isAbove() ) + + end function isUninitialised + + !! + !! Add another level of co-ordinates + !! + !! Simply increments nesting counter + !! + !! Args: + !! None + !! + pure subroutine addLevel(self) + class(coordList), intent(inout) :: self + + self % nesting = self % nesting + 1 + + end subroutine addLevel + + !! + !! Takes co-ordinates above the geometry + !! + !! State changes to ABOVE GEOMETRY + !! + !! Args: + !! None + !! + !! NOTE: + !! If called on UNINITIALISED may result in unnormalised direction at level 1! + !! + elemental subroutine takeAboveGeom(self) + class(coordList), intent(inout) :: self + + self % nesting = 1 + self % matIdx = -3 + self % uniqueID = -3 + + end subroutine takeAboveGeom + + !! + !! Decrease nestting to level n + !! + !! Args: + !! n [in] -> New nesting level + !! + !! Errors: + !! fatalError if n is -ve or larger then current nesting + !! + subroutine decreaseLevel(self, n) + class(coordList), intent(inout) :: self + integer(shortInt), intent(in) :: n + character(100),parameter :: Here = 'decreaseLevel (coord_class.f90)' + + if (n > self % nesting .or. n < 1) then + call fatalError(Here,'New nesting: '//numToChar(n)//' is invalid. Current nesting: '//& + numToChar(self % nesting)) + end if + + self % nesting = n + + end subroutine decreaseLevel + + !! + !! Move a point ABOVE the geometry + !! + !! Changes state to ABOVE GEOMETRY + !! + !! Args: + !! d [in] -> Distance (+ve or -ve) + !! + !! Errors: + !! If d < 0 then movment is backwards. + !! + elemental subroutine moveGlobal(self, d) + class(coordList), intent(inout) :: self + real(defReal), intent(in) :: d + + call self % takeAboveGeom() + self % lvl(1) % r = self % lvl(1) % r + d * self % lvl(1) % dir + + end subroutine moveGlobal + + !! + !! Move point inside the geometry + !! + !! Moves above and including level n + !! Does not change matIdx nor uniqueID + !! + !! Args: + !! d [in] -> Distance (+ve or -ve) + !! n [in] -> Nesting level + !! + !! Errors: + !! If d < 0.0 movment is backwards + !! + subroutine moveLocal(self, d, n) + class(coordList), intent(inout) :: self + real(defReal), intent(in) :: d + integer(shortInt), intent(in) :: n + integer(shortInt) :: i + + call self % decreaseLevel(n) + do i = 1 , n + self % lvl(i) % r = self % lvl(i) % r + d * self % lvl(i) % dir + end do + + end subroutine moveLocal + + !! + !! Rotate direction of the point + !! + !! Does not change the state of co-ordinates + !! + !! Args: + !! mu [in] -> Cosine of polar deflection angle <-1,1> + !! phi [in] -> Azimuthal deflection angle <0;2*pi> + !! + elemental subroutine rotate(self, mu, phi) + class(coordList), intent(inout) :: self + real(defReal), intent(in) :: mu + real(defReal), intent(in) :: phi + integer(shortInt) :: i + + ! Rotate directions in all nesting levels + self % lvl(1) % dir = rotateVector(self % lvl(1) % dir, mu, phi) + + ! Propagate rotation to lower levels + do i = 2, self % nesting + if (self % lvl(i) % isRotated) then + ! Note that rotation must be performed with the matrix + ! Deflections by mu & phi depend on coordinates + ! Deflection by the same my & phi may be diffrent at diffrent, rotated levels! + self % lvl(i) % dir = matmul(self % lvl(i) % rotMat, self % lvl(i-1) % dir) + + else + self % lvl(i) % dir = self % lvl(i-1) % dir + + end if + end do + + end subroutine rotate + + !! + !! Returns the index of the cell occupied at the lowest level + !! + !! Args: + !! None + !! + !! Result: + !! cellIdx at the lowest ocupied level + !! + elemental function cell(self)result(cellIdx) + class(coordList), intent(in) :: self + integer(shortInt) :: cellIdx + + cellIdx = self % lvl(max(self % nesting, 1)) % cellIdx + + end function cell + + !! + !! Take co-ordinates ABOVE GEOMETRY and assign new position + !! + !! Args: + !! r [in] -> New position at level 1 + !! + pure subroutine assignPosition(self, r) + class(coordList), intent(inout) :: self + real(defReal), dimension(3), intent(in) :: r + + call self % takeAboveGeom() + self % lvl(1) % r = r + + end subroutine assignPosition + + !! + !! Assign new direction + !! + !! Does not change the state of co-ordinates + !! + !! Args: + !! u [in] -> New normalised direction at level 1 + !! + !! NOTE: + !! Does not check if u is normalised! + !! + pure subroutine assignDirection(self, u) + class(coordList), intent(inout) :: self + real(defReal), dimension(3), intent(in) :: u + integer(shortInt) :: i + + ! Assign new direction in global frame + self % lvl(1) % dir = u + + ! Propage the change to lower levels + do i = 2, self % nesting + if(self % lvl(i) % isRotated) then + self % lvl(i) % dir = matmul(self % lvl(i) % rotMat, self % lvl(i-1) % dir) + + else + self % lvl(i) % dir = self % lvl(i-1) % dir + + end if + end do + + end subroutine assignDirection + +end module coord_class diff --git a/NuclearData/emissionENDF/angleLawENDF/tabularAngle_class.f90 b/NuclearData/emissionENDF/angleLawENDF/tabularAngle_class.f90 index b1401303e..fde43798c 100644 --- a/NuclearData/emissionENDF/angleLawENDF/tabularAngle_class.f90 +++ b/NuclearData/emissionENDF/angleLawENDF/tabularAngle_class.f90 @@ -1,212 +1,212 @@ -module tabularAngle_class - - use numPrecision - use genericProcedures, only : binarySearch, searchError, interpolate, fatalError, isSorted - use aceCard_class, only : aceCard - use RNG_class, only : RNG - use angleLawENDF_inter, only : angleLawENDF - - ! Diffrent mu pdfs - use muEndfPdf_inter, only : muEndfPdf - use muEndfPdfSlot_class, only : muEndfPdfSlot - use isotropicMu_class, only : isotropicMu - use equiBin32Mu_class, only : equiBin32Mu - use tabularMu_class, only : tabularMu - - implicit none - private - - interface tabularAngle - module procedure new_tabularAngle - module procedure new_tabularAngle_fromACE - end interface - - !! - !! Contains energy dependant mu data - !! - type,public,extends(angleLawENDF) :: tabularAngle - private - real(defReal),dimension(:),allocatable :: eGrid - type(muEndfPdfSlot),dimension(:),allocatable :: muEndfPdfs - contains - procedure :: init - procedure :: build - procedure :: sample - procedure :: probabilityOf - procedure :: kill - end type tabularAngle - -contains - - !! - !! Initialise from aceCard and MT number - !! - subroutine init(self, ACE, MT) - class(tabularAngle), intent(inout) :: self - class(aceCard), intent(inout) :: ACE - integer(shortInt), intent(in) :: MT - real(defReal), dimension(:), allocatable :: eGrid - integer(shortInt) :: N, i - integer(shortInt),dimension(:),allocatable :: muLoc - type(muEndfPdfSlot),dimension(:), allocatable :: muPdfs - - ! Read initial information - N = ACE % readInt() ! Read size of the energy grid - eGrid = ACE % readRealArray(N) ! Read energy grid - muLoc = ACE % readIntArray(N) ! Read mu pdf locators - - ! Allocate space for angleLawENDFslots - allocate(muPdfs(N)) - - ! Build array of muPdfs - do i=1,size(muLoc) - select case(muLoc(i)) - case(0) ! Isotropic mu pdf - call muPdfs(i) % init(ACE, 'isotropicMu') - - case(1:) ! +ve -> 32 equiprobable bin distribution - call ACE % setToAnglePdf(muLoc(i)) - call muPdfs(i) % init(ACE, 'equiBin32Mu') - - case(:-1) ! -ve -> tabular pdf - call ACE % setToAnglePdf( abs(muLoc(i))) - call muPdfs(i) % init(ACE, 'tabularMu') ! Explicity use CDF in ACE data - - case default ! Clearly this should never happen. But codes surprise you... - call fatalError('new_tabularAngle_fromACE (tabularAngle_class.f90)','Impossible state. WTF?') - - end select - end do - - ! Initialise new tabularAngle - call self % build(eGrid, muPdfs) - - end subroutine init - - !! - !! Given collison energy and random number generator sample mu - !! - function sample(self,E,rand) result (mu) - class(tabularAngle), intent(in) :: self - real(defReal), intent(in) :: E - class(RNG), intent(inout) :: rand - real(defReal) :: mu - integer(shortInt) :: idx - real(defReal) :: r, eps - character(100),parameter :: Here='sample (tabularAngle_class.f90)' - - idx = binarySearch(self % eGrid,E) - call searchError(idx,Here) - - eps = (E - self % eGrid(idx)) / (self % eGrid(idx+1) - self % eGrid(idx)) - r = rand % get() - - if(r < eps) then - mu = self % muEndfPdfs(idx+1) % sample(rand) - else - mu = self % muEndfPdfs(idx) % sample(rand) - - end if - - end function sample - - !! - !! Return probability density of mu at collision energy E - !! - function probabilityOf(self,mu,E) result (prob) - class(tabularAngle), intent(in) :: self - real(defReal), intent(in) :: E, mu - real(defReal) :: prob - integer(shortInt) :: idx - real(defReal) :: prob_1, prob_0, E_1, E_0 - character(100),parameter :: Here='probabilityOf (tabularAngle_class.f90)' - - idx = binarySearch(self % eGrid,E) - call searchError(idx,Here) - - prob_0 = self % muEndfPdfs(idx) % probabilityOf(mu) - prob_1 = self % muEndfPdfs(idx+1) % probabilityOf(mu) - - E_0 = self % eGrid(idx) - E_1 = self % eGrid(idx+1) - - prob = interpolate(E_0, E_1, prob_0, prob_1, E) - - - end function probabilityOf - - !! - !! Initialise from energy grid and array of corresponding mu PDFs at single energy - !! NOTE : Content in muEndfPdfs slots will be deallocated (moved allocation) - !! - subroutine build(self, eGrid, muEndfPdfs) - class(tabularAngle),intent(inout) :: self - real(defReal),dimension(:), intent(in) :: eGrid - type(muEndfPdfSlot),dimension(:), intent(inout) :: muEndfPdfs - integer(shortInt) :: i - character(100),parameter :: Here='init (tabularAngle_class.f90)' - - ! Perform checks - if(size(eGrid) /= size(muEndfPdfs)) call fatalError(Here,'eGrid and muEndfPdfs have diffrent size') - - if(.not.(isSorted(eGrid))) call fatalError(Here,'eGrid is not sorted ascending') - if(any( eGrid < 0.0 )) call fatalError(Here,'eGrid contains -ve values') - - if(allocated(self % eGrid)) deallocate(self % eGrid) - if(allocated(self % muEndfPdfs)) deallocate(self % muEndfPdfs) - - ! Copy energy grid and move allocation of muEndfPdfSlots - self % eGrid = eGrid - - allocate(self % muEndfPdfs(size(eGrid))) - - do i=1,size(muEndfPdfs) - call self % muEndfPdfs(i) % moveAllocFrom( muEndfPdfs(i) ) - - end do - - end subroutine build - - !! - !! Constructor of tabularAngle - !! NOTE : Content in muEndfPdfs slots will be deallocated (moved allocation) - !! - function new_tabularAngle(eGrid,muEndfPdfs) result(new) - real(defReal),dimension(:), intent(in) :: eGrid - type(muEndfPdfSlot),dimension(:), intent(inout) :: muEndfPdfs - type(tabularAngle) :: new - - call new % build(eGrid, muEndfPdfs) - - end function new_tabularAngle - - !! - !! Constructoe of tabularAngle from ACE - !! ACE head should be set to beginning of tabular mu data - !! - function new_tabularAngle_fromACE(ACE) result(new) - class(aceCard), intent(inout) :: ACE - type(tabularAngle) :: new - - ! Initialise new tabularAngle - dummy MT - call new % init(ACE, 1) - - end function new_tabularAngle_fromACE - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(tabularAngle), intent(inout) :: self - - ! Kill angular PDFs - if(allocated(self % muEndfPdfs)) call self % muEndfPdfs % kill() - - ! Deallocate arrays - if(allocated(self % eGrid)) deallocate(self % eGrid) - if(allocated(self % muEndfPdfs)) deallocate(self % muEndfPdfs) - - - end subroutine kill - -end module tabularAngle_class +module tabularAngle_class + + use numPrecision + use genericProcedures, only : binarySearch, searchError, interpolate, fatalError, isSorted + use aceCard_class, only : aceCard + use RNG_class, only : RNG + use angleLawENDF_inter, only : angleLawENDF + + ! Diffrent mu pdfs + use muEndfPdf_inter, only : muEndfPdf + use muEndfPdfSlot_class, only : muEndfPdfSlot + use isotropicMu_class, only : isotropicMu + use equiBin32Mu_class, only : equiBin32Mu + use tabularMu_class, only : tabularMu + + implicit none + private + + interface tabularAngle + module procedure new_tabularAngle + module procedure new_tabularAngle_fromACE + end interface + + !! + !! Contains energy dependant mu data + !! + type,public,extends(angleLawENDF) :: tabularAngle + private + real(defReal),dimension(:),allocatable :: eGrid + type(muEndfPdfSlot),dimension(:),allocatable :: muEndfPdfs + contains + procedure :: init + procedure :: build + procedure :: sample + procedure :: probabilityOf + procedure :: kill + end type tabularAngle + +contains + + !! + !! Initialise from aceCard and MT number + !! + subroutine init(self, ACE, MT) + class(tabularAngle), intent(inout) :: self + class(aceCard), intent(inout) :: ACE + integer(shortInt), intent(in) :: MT + real(defReal), dimension(:), allocatable :: eGrid + integer(shortInt) :: N, i + integer(shortInt),dimension(:),allocatable :: muLoc + type(muEndfPdfSlot),dimension(:), allocatable :: muPdfs + + ! Read initial information + N = ACE % readInt() ! Read size of the energy grid + eGrid = ACE % readRealArray(N) ! Read energy grid + muLoc = ACE % readIntArray(N) ! Read mu pdf locators + + ! Allocate space for angleLawENDFslots + allocate(muPdfs(N)) + + ! Build array of muPdfs + do i=1,size(muLoc) + select case(muLoc(i)) + case(0) ! Isotropic mu pdf + call muPdfs(i) % init(ACE, 'isotropicMu') + + case(1:) ! +ve -> 32 equiprobable bin distribution + call ACE % setToAnglePdf(muLoc(i)) + call muPdfs(i) % init(ACE, 'equiBin32Mu') + + case(:-1) ! -ve -> tabular pdf + call ACE % setToAnglePdf( abs(muLoc(i))) + call muPdfs(i) % init(ACE, 'tabularMu') ! Explicity use CDF in ACE data + + case default ! Clearly this should never happen. But codes surprise you... + call fatalError('new_tabularAngle_fromACE (tabularAngle_class.f90)','Impossible state. WTF?') + + end select + end do + + ! Initialise new tabularAngle + call self % build(eGrid, muPdfs) + + end subroutine init + + !! + !! Given collison energy and random number generator sample mu + !! + function sample(self,E,rand) result (mu) + class(tabularAngle), intent(in) :: self + real(defReal), intent(in) :: E + class(RNG), intent(inout) :: rand + real(defReal) :: mu + integer(shortInt) :: idx + real(defReal) :: r, eps + character(100),parameter :: Here='sample (tabularAngle_class.f90)' + + idx = binarySearch(self % eGrid,E) + call searchError(idx,Here) + + eps = (E - self % eGrid(idx)) / (self % eGrid(idx+1) - self % eGrid(idx)) + r = rand % get() + + if(r < eps) then + mu = self % muEndfPdfs(idx+1) % sample(rand) + else + mu = self % muEndfPdfs(idx) % sample(rand) + + end if + + end function sample + + !! + !! Return probability density of mu at collision energy E + !! + function probabilityOf(self,mu,E) result (prob) + class(tabularAngle), intent(in) :: self + real(defReal), intent(in) :: E, mu + real(defReal) :: prob + integer(shortInt) :: idx + real(defReal) :: prob_1, prob_0, E_1, E_0 + character(100),parameter :: Here='probabilityOf (tabularAngle_class.f90)' + + idx = binarySearch(self % eGrid,E) + call searchError(idx,Here) + + prob_0 = self % muEndfPdfs(idx) % probabilityOf(mu) + prob_1 = self % muEndfPdfs(idx+1) % probabilityOf(mu) + + E_0 = self % eGrid(idx) + E_1 = self % eGrid(idx+1) + + prob = interpolate(E_0, E_1, prob_0, prob_1, E) + + + end function probabilityOf + + !! + !! Initialise from energy grid and array of corresponding mu PDFs at single energy + !! NOTE : Content in muEndfPdfs slots will be deallocated (moved allocation) + !! + subroutine build(self, eGrid, muEndfPdfs) + class(tabularAngle),intent(inout) :: self + real(defReal),dimension(:), intent(in) :: eGrid + type(muEndfPdfSlot),dimension(:), intent(inout) :: muEndfPdfs + integer(shortInt) :: i + character(100),parameter :: Here='init (tabularAngle_class.f90)' + + ! Perform checks + if(size(eGrid) /= size(muEndfPdfs)) call fatalError(Here,'eGrid and muEndfPdfs have diffrent size') + + if(.not.(isSorted(eGrid))) call fatalError(Here,'eGrid is not sorted ascending') + if(any( eGrid < 0.0 )) call fatalError(Here,'eGrid contains -ve values') + + if(allocated(self % eGrid)) deallocate(self % eGrid) + if(allocated(self % muEndfPdfs)) deallocate(self % muEndfPdfs) + + ! Copy energy grid and move allocation of muEndfPdfSlots + self % eGrid = eGrid + + allocate(self % muEndfPdfs(size(eGrid))) + + do i=1,size(muEndfPdfs) + call self % muEndfPdfs(i) % moveAllocFrom( muEndfPdfs(i) ) + + end do + + end subroutine build + + !! + !! Constructor of tabularAngle + !! NOTE : Content in muEndfPdfs slots will be deallocated (moved allocation) + !! + function new_tabularAngle(eGrid,muEndfPdfs) result(new) + real(defReal),dimension(:), intent(in) :: eGrid + type(muEndfPdfSlot),dimension(:), intent(inout) :: muEndfPdfs + type(tabularAngle) :: new + + call new % build(eGrid, muEndfPdfs) + + end function new_tabularAngle + + !! + !! Constructoe of tabularAngle from ACE + !! ACE head should be set to beginning of tabular mu data + !! + function new_tabularAngle_fromACE(ACE) result(new) + class(aceCard), intent(inout) :: ACE + type(tabularAngle) :: new + + ! Initialise new tabularAngle - dummy MT + call new % init(ACE, 1) + + end function new_tabularAngle_fromACE + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(tabularAngle), intent(inout) :: self + + ! Kill angular PDFs + if(allocated(self % muEndfPdfs)) call self % muEndfPdfs % kill() + + ! Deallocate arrays + if(allocated(self % eGrid)) deallocate(self % eGrid) + if(allocated(self % muEndfPdfs)) deallocate(self % muEndfPdfs) + + + end subroutine kill + +end module tabularAngle_class diff --git a/NuclearData/emissionENDF/correlatedLawENDF/correlatedLawENDF_inter.f90 b/NuclearData/emissionENDF/correlatedLawENDF/correlatedLawENDF_inter.f90 index 9376da99a..da6b2c083 100644 --- a/NuclearData/emissionENDF/correlatedLawENDF/correlatedLawENDF_inter.f90 +++ b/NuclearData/emissionENDF/correlatedLawENDF/correlatedLawENDF_inter.f90 @@ -1,84 +1,84 @@ -module correlatedLawENDF_inter - - use numPrecision - use RNG_class, only : RNG - - implicit none - private - - !! - !! Abstract interface for objects containing correleated mu energy data - !! - !! Interface: - !! sample -> Sample outgoing energy & angle - !! probabilityOf -> Return propability density at outgoing the energy & angle - !! kill -> Return to uninitialised state - !! - type, public,abstract :: correlatedLawENDF - private - contains - procedure(sample),deferred :: sample - procedure(probabilityOf),deferred :: probabilityOf - procedure(kill),deferred :: kill - end type correlatedLawENDF - - abstract interface - - !! - !! Samples mu and E_out givent incident energy E_in and random nummber generator - !! - !! Args: - !! mu [out] -> Cosing of polar deflection angle in <-1;1> - !! E_out [out] -> Outgoing energy [MeV] - !! E_in [in] -> Incident energy [Mev] - !! rand [inout] -> Random number generator - !! - !! Error: - !! fatalError if sampling fails for any reason - !! - subroutine sample(self, mu, E_out, E_in, rand) - import :: correlatedLawENDF, & - defReal, & - RNG - class(correlatedLawENDF), intent(in) :: self - real(defReal), intent(out) :: mu - real(defReal), intent(out) :: E_out - real(defReal), intent(in) :: E_in - class(RNG), intent(inout) :: rand - end subroutine - - !! - !! Returns probability that neutron was emitted at mu & E_out given incident energy E_in - !! - !! Args: - !! mu [in] -> Cosing of polar deflection angle in <-1;1> - !! E_out [in] -> Outgoing energy [MeV] - !! E_in [in] -> Incident energy [Mev] - !! - !! Result: - !! Probability density for outgoing mu & E_out from incident particle at E_in - !! - !! Errors: - !! Returns 0.0 if outgoing values are out of range. - !! - function probabilityOf(self, mu, E_out, E_in) result(prob) - import :: correlatedLawENDF, & - defReal - class(correlatedLawENDF), intent(in) :: self - real(defReal), intent(in) :: mu - real(defReal), intent(in) :: E_out - real(defReal), intent(in) :: E_in - real(defReal) :: prob - end function probabilityOf - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - import :: correlatedLawENDF - class(correlatedLawENDF), intent(inout) :: self - end subroutine kill - - end interface - -end module correlatedLawENDF_inter +module correlatedLawENDF_inter + + use numPrecision + use RNG_class, only : RNG + + implicit none + private + + !! + !! Abstract interface for objects containing correleated mu energy data + !! + !! Interface: + !! sample -> Sample outgoing energy & angle + !! probabilityOf -> Return propability density at outgoing the energy & angle + !! kill -> Return to uninitialised state + !! + type, public,abstract :: correlatedLawENDF + private + contains + procedure(sample),deferred :: sample + procedure(probabilityOf),deferred :: probabilityOf + procedure(kill),deferred :: kill + end type correlatedLawENDF + + abstract interface + + !! + !! Samples mu and E_out givent incident energy E_in and random nummber generator + !! + !! Args: + !! mu [out] -> Cosing of polar deflection angle in <-1;1> + !! E_out [out] -> Outgoing energy [MeV] + !! E_in [in] -> Incident energy [Mev] + !! rand [inout] -> Random number generator + !! + !! Error: + !! fatalError if sampling fails for any reason + !! + subroutine sample(self, mu, E_out, E_in, rand) + import :: correlatedLawENDF, & + defReal, & + RNG + class(correlatedLawENDF), intent(in) :: self + real(defReal), intent(out) :: mu + real(defReal), intent(out) :: E_out + real(defReal), intent(in) :: E_in + class(RNG), intent(inout) :: rand + end subroutine + + !! + !! Returns probability that neutron was emitted at mu & E_out given incident energy E_in + !! + !! Args: + !! mu [in] -> Cosing of polar deflection angle in <-1;1> + !! E_out [in] -> Outgoing energy [MeV] + !! E_in [in] -> Incident energy [Mev] + !! + !! Result: + !! Probability density for outgoing mu & E_out from incident particle at E_in + !! + !! Errors: + !! Returns 0.0 if outgoing values are out of range. + !! + function probabilityOf(self, mu, E_out, E_in) result(prob) + import :: correlatedLawENDF, & + defReal + class(correlatedLawENDF), intent(in) :: self + real(defReal), intent(in) :: mu + real(defReal), intent(in) :: E_out + real(defReal), intent(in) :: E_in + real(defReal) :: prob + end function probabilityOf + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + import :: correlatedLawENDF + class(correlatedLawENDF), intent(inout) :: self + end subroutine kill + + end interface + +end module correlatedLawENDF_inter diff --git a/NuclearData/emissionENDF/energyLawENDF/energyLawENDF_inter.f90 b/NuclearData/emissionENDF/energyLawENDF/energyLawENDF_inter.f90 index c0569fc38..fd416d8dd 100644 --- a/NuclearData/emissionENDF/energyLawENDF/energyLawENDF_inter.f90 +++ b/NuclearData/emissionENDF/energyLawENDF/energyLawENDF_inter.f90 @@ -1,78 +1,78 @@ -module energyLawEndf_inter - - use numPrecision - use RNG_class, only : RNG - - implicit none - private - - !! - !! Abstract interface for diffrent energy distributions - !! - !! Interface: - !! sample -> Sample outgoing energy - !! probabilityOf -> Return propability density at outgoing the energy & angle - !! kill -> Return to uninitialised state - !! - type,abstract, public :: energyLawENDF - private - contains - procedure(sample),deferred :: sample - procedure(probabilityOf),deferred :: probabilityOf - procedure(kill),deferred :: kill - end type energyLawENDF - - - abstract interface - - !! - !! Sample outgoing energy given random number generator and incedent energy - !! - !! Args: - !! E_in [in] -> incident energy [MeV] - !! rand [inout] -> random number generator - !! - !! Returns: - !! Outgoing energy [MeV] - !! - !! Errors: - !! Gives fatalError if sampling fails to sample energy Law - !! - function sample(self,E_in,rand) result (E_out) - import :: energyLawEndf,& - defReal, & - RNG - class(energyLawEndf), intent(in) :: self - real(defReal), intent(in) :: E_in - class(RNG), intent(inout) :: rand - real(defReal) :: E_out - end function - - !! - !! Give probability of outgoing energy given incedent energy - !! - !! Args: - !! E_out [in] -> outgoing energy energy [MeV] - !! E_in [in] -> incident energy [MeV] - !! - !! Returns: - !! Probability of transition in [0,1] - !! - function probabilityOf(self,E_out,E_in) result (prob) - import :: energyLawEndf,& - defReal - class(energyLawEndf), intent(in) :: self - real(defReal), intent(in) :: E_out,E_in - real(defReal) :: prob - end function - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - import :: energyLawEndf - class(energyLawEndf), intent(inout) :: self - end subroutine kill - - end interface -end module energyLawEndf_inter +module energyLawEndf_inter + + use numPrecision + use RNG_class, only : RNG + + implicit none + private + + !! + !! Abstract interface for diffrent energy distributions + !! + !! Interface: + !! sample -> Sample outgoing energy + !! probabilityOf -> Return propability density at outgoing the energy & angle + !! kill -> Return to uninitialised state + !! + type,abstract, public :: energyLawENDF + private + contains + procedure(sample),deferred :: sample + procedure(probabilityOf),deferred :: probabilityOf + procedure(kill),deferred :: kill + end type energyLawENDF + + + abstract interface + + !! + !! Sample outgoing energy given random number generator and incedent energy + !! + !! Args: + !! E_in [in] -> incident energy [MeV] + !! rand [inout] -> random number generator + !! + !! Returns: + !! Outgoing energy [MeV] + !! + !! Errors: + !! Gives fatalError if sampling fails to sample energy Law + !! + function sample(self,E_in,rand) result (E_out) + import :: energyLawEndf,& + defReal, & + RNG + class(energyLawEndf), intent(in) :: self + real(defReal), intent(in) :: E_in + class(RNG), intent(inout) :: rand + real(defReal) :: E_out + end function + + !! + !! Give probability of outgoing energy given incedent energy + !! + !! Args: + !! E_out [in] -> outgoing energy energy [MeV] + !! E_in [in] -> incident energy [MeV] + !! + !! Returns: + !! Probability of transition in [0,1] + !! + function probabilityOf(self,E_out,E_in) result (prob) + import :: energyLawEndf,& + defReal + class(energyLawEndf), intent(in) :: self + real(defReal), intent(in) :: E_out,E_in + real(defReal) :: prob + end function + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + import :: energyLawEndf + class(energyLawEndf), intent(inout) :: self + end subroutine kill + + end interface +end module energyLawEndf_inter diff --git a/NuclearData/emissionENDF/releaseLawENDF/constantRelease_class.f90 b/NuclearData/emissionENDF/releaseLawENDF/constantRelease_class.f90 index eb6a60054..fe02ffac7 100644 --- a/NuclearData/emissionENDF/releaseLawENDF/constantRelease_class.f90 +++ b/NuclearData/emissionENDF/releaseLawENDF/constantRelease_class.f90 @@ -1,75 +1,75 @@ -module constantRelease_class - - use numPrecision - use genericProcedures, only : fatalError - use releaseLawENDF_inter, only : releaseLawENDF - - implicit none - private - - interface constantRelease - module procedure new_constantRelease - end interface - - !! - !! Constant release of neutrons independent of incedent energy - !! - type, public, extends(releaseLawENDF) :: constantRelease - private - real(defReal) :: secondaryRelease = ONE - contains - procedure :: init - procedure :: releaseAt - procedure :: kill - end type constantRelease - -contains - - !! - !! Initialise - !! - subroutine init(self,release) - class(constantRelease), intent(inout) :: self - real(defReal), intent(in) :: release - character(100),parameter :: Here='init (constantRelease_class.f90)' - - if( release < 0) call fatalError(Here,'-ve value of release provided!') - self % secondaryRelease = release - - end subroutine init - - !! - !! Release at energy E_in - !! - function releaseAt(self,E_in) result(release) - class(constantRelease), intent(in) :: self - real(defReal), intent(in) :: E_in - real(defReal) :: release - - release = self % secondaryRelease - - end function releaseAt - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(constantRelease), intent(inout) :: self - - self % secondaryRelease = ONE - - end subroutine kill - - !! - !! Constructor - !! - function new_constantRelease(release) result(new) - real(defReal), intent(in) :: release - type(constantRelease) :: new - - call new % init(release) - - end function new_constantRelease - - -end module constantRelease_class +module constantRelease_class + + use numPrecision + use genericProcedures, only : fatalError + use releaseLawENDF_inter, only : releaseLawENDF + + implicit none + private + + interface constantRelease + module procedure new_constantRelease + end interface + + !! + !! Constant release of neutrons independent of incedent energy + !! + type, public, extends(releaseLawENDF) :: constantRelease + private + real(defReal) :: secondaryRelease = ONE + contains + procedure :: init + procedure :: releaseAt + procedure :: kill + end type constantRelease + +contains + + !! + !! Initialise + !! + subroutine init(self,release) + class(constantRelease), intent(inout) :: self + real(defReal), intent(in) :: release + character(100),parameter :: Here='init (constantRelease_class.f90)' + + if( release < 0) call fatalError(Here,'-ve value of release provided!') + self % secondaryRelease = release + + end subroutine init + + !! + !! Release at energy E_in + !! + function releaseAt(self,E_in) result(release) + class(constantRelease), intent(in) :: self + real(defReal), intent(in) :: E_in + real(defReal) :: release + + release = self % secondaryRelease + + end function releaseAt + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(constantRelease), intent(inout) :: self + + self % secondaryRelease = ONE + + end subroutine kill + + !! + !! Constructor + !! + function new_constantRelease(release) result(new) + real(defReal), intent(in) :: release + type(constantRelease) :: new + + call new % init(release) + + end function new_constantRelease + + +end module constantRelease_class diff --git a/NuclearData/emissionENDF/releaseLawENDF/polynomialRelease_class.f90 b/NuclearData/emissionENDF/releaseLawENDF/polynomialRelease_class.f90 index c803061e0..5b009c5a8 100644 --- a/NuclearData/emissionENDF/releaseLawENDF/polynomialRelease_class.f90 +++ b/NuclearData/emissionENDF/releaseLawENDF/polynomialRelease_class.f90 @@ -1,103 +1,103 @@ -module polynomialrelease_class - - use numPrecision - use aceCard_class, only : aceCard - use releaseLawENDF_inter, only : releaseLawENDF - - implicit none - private - - interface polynomialRelease - module procedure new_polynomialRelease - module procedure new_polynomialRelease_fromACE - end interface - - !! - !! Polynomial representation of Nu data - !! a_0 + a_1 * x + a_2 * x**2 + ... etc. - !! - type, public,extends(releaseLawENDF) :: polynomialRelease - private - real(defReal),dimension(:),allocatable :: coeffs !! Polynomial coefficients [a_0,a_1,...] - contains - procedure :: init - procedure :: releaseAt - procedure :: kill - end type polynomialRelease - -contains - - !! - !! Initialise - !! - subroutine init(self,coeffs) - class(polynomialRelease), intent(inout) :: self - real(defReal),dimension(:),intent(in) :: coeffs - - if (allocated(self % coeffs)) deallocate(self % coeffs) - - self % coeffs = coeffs ! implicit allocation - end subroutine - - !! - !! Calculate release at energy E_in - !! - pure function releaseAt(self,E_in) result(release) - class(polynomialRelease), intent(in) :: self - real(defReal), intent(in) :: E_in - real(defReal) :: release - integer(shortInt) :: i - - ! Horner Method Evaluation of a Polynomial - release = 0.0 - do i=size(self % coeffs),1,-1 - release = release * E_in + self % coeffs(i) - end do - - end function releaseAt - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(polynomialRelease), intent(inout) :: self - - if(allocated(self % coeffs)) deallocate(self % coeffs) - - end subroutine kill - - !! - !! Constructor - !! - function new_polynomialRelease(coeffs) result(new) - real(defReal),dimension(:),intent(in) :: coeffs - type(polynomialRelease) :: new - - call new % init(coeffs) - - end function new_polynomialRelease - - !! - !! Constructor from ACE - !! Head of aceCard needs to be set to the beginning of the data (KNU+1 in Table F-5 of MCNP Manual) - !! NOTE : Defining another init for ACE would help to avoid unnecesary reallocation of memory - !! - function new_polynomialRelease_fromACE(ACE) result(new) - type(aceCard), intent(inout) :: ACE - type(polynomialRelease) :: new - real(defReal),dimension(:),allocatable :: coeffs - integer(shortInt) :: N - - ! Read number of coefficients - N = ACE % readInt() - - ! Read coefficients - coeffs = ACE % readRealArray(N) - - ! Initialise - call new % init(coeffs) - - end function new_polynomialRelease_fromACE - - -end module polynomialRelease_class +module polynomialrelease_class + + use numPrecision + use aceCard_class, only : aceCard + use releaseLawENDF_inter, only : releaseLawENDF + + implicit none + private + + interface polynomialRelease + module procedure new_polynomialRelease + module procedure new_polynomialRelease_fromACE + end interface + + !! + !! Polynomial representation of Nu data + !! a_0 + a_1 * x + a_2 * x**2 + ... etc. + !! + type, public,extends(releaseLawENDF) :: polynomialRelease + private + real(defReal),dimension(:),allocatable :: coeffs !! Polynomial coefficients [a_0,a_1,...] + contains + procedure :: init + procedure :: releaseAt + procedure :: kill + end type polynomialRelease + +contains + + !! + !! Initialise + !! + subroutine init(self,coeffs) + class(polynomialRelease), intent(inout) :: self + real(defReal),dimension(:),intent(in) :: coeffs + + if (allocated(self % coeffs)) deallocate(self % coeffs) + + self % coeffs = coeffs ! implicit allocation + end subroutine + + !! + !! Calculate release at energy E_in + !! + pure function releaseAt(self,E_in) result(release) + class(polynomialRelease), intent(in) :: self + real(defReal), intent(in) :: E_in + real(defReal) :: release + integer(shortInt) :: i + + ! Horner Method Evaluation of a Polynomial + release = 0.0 + do i=size(self % coeffs),1,-1 + release = release * E_in + self % coeffs(i) + end do + + end function releaseAt + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(polynomialRelease), intent(inout) :: self + + if(allocated(self % coeffs)) deallocate(self % coeffs) + + end subroutine kill + + !! + !! Constructor + !! + function new_polynomialRelease(coeffs) result(new) + real(defReal),dimension(:),intent(in) :: coeffs + type(polynomialRelease) :: new + + call new % init(coeffs) + + end function new_polynomialRelease + + !! + !! Constructor from ACE + !! Head of aceCard needs to be set to the beginning of the data (KNU+1 in Table F-5 of MCNP Manual) + !! NOTE : Defining another init for ACE would help to avoid unnecesary reallocation of memory + !! + function new_polynomialRelease_fromACE(ACE) result(new) + type(aceCard), intent(inout) :: ACE + type(polynomialRelease) :: new + real(defReal),dimension(:),allocatable :: coeffs + integer(shortInt) :: N + + ! Read number of coefficients + N = ACE % readInt() + + ! Read coefficients + coeffs = ACE % readRealArray(N) + + ! Initialise + call new % init(coeffs) + + end function new_polynomialRelease_fromACE + + +end module polynomialRelease_class diff --git a/NuclearData/emissionENDF/releaseLawENDF/releaseLawENDF_inter.f90 b/NuclearData/emissionENDF/releaseLawENDF/releaseLawENDF_inter.f90 index 419bff7c9..452b7db6c 100644 --- a/NuclearData/emissionENDF/releaseLawENDF/releaseLawENDF_inter.f90 +++ b/NuclearData/emissionENDF/releaseLawENDF/releaseLawENDF_inter.f90 @@ -1,41 +1,41 @@ -module releaseLawENDF_inter - - use numPrecision - - implicit none - private - !! - !! Abstract interface class for all polymorfic classes to contain various ENDF laws for secondary - !! neutron emissions - !! - type,abstract, public :: releaseLawENDF - private - contains - procedure(releaseAt),deferred :: releaseAt - procedure(kill),deferred :: kill - end type releaseLawENDF - - abstract interface - - !! - !! Obtain average neutron emission for incedent energy E_in - !! - function releaseAt(self,E_in) result(release) - import :: defReal,& - releaseLawENDF - class(releaseLawENDF), intent(in) :: self - real(defReal), intent(in) :: E_in - real(defReal) :: release - end function releaseAt - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - import :: releaseLawENDF - class(releaseLawENDF), intent(inout) :: self - end subroutine kill - - end interface - -end module releaseLawENDF_inter +module releaseLawENDF_inter + + use numPrecision + + implicit none + private + !! + !! Abstract interface class for all polymorfic classes to contain various ENDF laws for secondary + !! neutron emissions + !! + type,abstract, public :: releaseLawENDF + private + contains + procedure(releaseAt),deferred :: releaseAt + procedure(kill),deferred :: kill + end type releaseLawENDF + + abstract interface + + !! + !! Obtain average neutron emission for incedent energy E_in + !! + function releaseAt(self,E_in) result(release) + import :: defReal,& + releaseLawENDF + class(releaseLawENDF), intent(in) :: self + real(defReal), intent(in) :: E_in + real(defReal) :: release + end function releaseAt + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + import :: releaseLawENDF + class(releaseLawENDF), intent(inout) :: self + end subroutine kill + + end interface + +end module releaseLawENDF_inter diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index 9c133c1ee..b3d6f9eec 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -1,84 +1,84 @@ -module universalVariables - - use numPrecision - - implicit none - - ! *** DON't CHANGE THIS. HARDCODED IS FINE - ! CHANGE THIS: NUMBER MUST BE CALCULATED DURING INITIAL GEOMETRY PROCESSING - ! Problematic for separating modules! - integer(shortInt), parameter, public :: HARDCODED_MAX_NEST = 8 - integer(shortInt), parameter, public :: MAX_OUTGOING_PARTICLES = 5 - - ! CHANGE THIS: NUMBER WILL DEPEND ON SYSTEM ARCHITECTURE - ! WILL AFFECT PARALLEL SCALING - integer(shortInt), parameter, public :: array_pad = 64 - - ! Display information - integer(shortInt), parameter, public :: MAX_COL = 70 ! Maximum number of columns in console display - - ! Define variables which are important for tracking neutrons in the geometry - real(defReal), parameter, public :: INFINITY = 2.0_defReal**63, & - surface_tol = 1.0e-12_defReal, & ! Tol. on closeness to surface - SURF_TOL = 1.0E-12_defReal, & - INF = 2.0_defReal**63, & - NUDGE = 1.0e-8_defReal ! Distance to poke neutrons across boundaries for surface tracking - - ! Flags for different possible events in movement in geometry - integer(shortINt), parameter, public :: COLL_EV = 1, & - BOUNDARY_EV = 2, & - CROSS_EV = 3, & - LOST_EV = 4 - - ! Create definitions for readability when dealing with positions relative to surfaces - logical(defBool), parameter, public :: behind = .FALSE., & - infront = .TRUE., & - outside = .FALSE., & - inside = .TRUE. - - ! Special material Indexes - ! NOTE: All material indices MUST BE NON-NEGATIVE! - integer(shortInt), parameter :: OUTSIDE_MAT = 0 ,& - VOID_MAT = huge(OUTSIDE_MAT), & - UNDEF_MAT = VOID_MAT - 1 - - - ! Define integers for each fill type that a cell may have - integer(shortInt), parameter :: OUTSIDE_FILL = 0, & - materialFill = 1, & - universeFill = 2, & - latticeFill = 3 - - ! Define integers for boundary condition types - integer(shortInt), parameter :: VACUUM_BC = 0, & - REFLECTIVE_BC = 1, & - PERIODIC_BC = 2 - - ! Integer indexes of cardinal directions - integer(shortInt), parameter :: X_AXIS = 1 ,& - Y_AXIS = 2 ,& - Z_AXIS = 3 - - ! Particle Type Enumeration - integer(shortInt), parameter :: P_NEUTRON_CE = 1, & - P_NEUTRON_MG = 2 - - ! Search error codes - integer(shortInt), parameter :: valueOutsideArray = -1,& - tooManyIter = -2,& - targetNotFound = -3, & - NOT_FOUND = -3 - - ! Physical constants - real(defReal), parameter :: neutronMass = 939.5654133_defReal, & ! Neutron mass in MeV/c^2 - lightSpeed = 2.99792458e10_defReal, & ! Light speed in cm/s - energyPerFission = 200.0_defReal ! MeV - - ! Unit conversion - real(defReal), parameter :: joulesPerMeV = 1.60218e-13 ! Convert MeV to J - - ! Global name variables used to define specific geometry or field types - character(nameLen), parameter :: nameUFS = 'uniFissSites' - character(nameLen), parameter :: nameWW = 'WeightWindows' - -end module universalVariables +module universalVariables + + use numPrecision + + implicit none + + ! *** DON't CHANGE THIS. HARDCODED IS FINE + ! CHANGE THIS: NUMBER MUST BE CALCULATED DURING INITIAL GEOMETRY PROCESSING + ! Problematic for separating modules! + integer(shortInt), parameter, public :: HARDCODED_MAX_NEST = 8 + integer(shortInt), parameter, public :: MAX_OUTGOING_PARTICLES = 5 + + ! CHANGE THIS: NUMBER WILL DEPEND ON SYSTEM ARCHITECTURE + ! WILL AFFECT PARALLEL SCALING + integer(shortInt), parameter, public :: array_pad = 64 + + ! Display information + integer(shortInt), parameter, public :: MAX_COL = 70 ! Maximum number of columns in console display + + ! Define variables which are important for tracking neutrons in the geometry + real(defReal), parameter, public :: INFINITY = 2.0_defReal**63, & + surface_tol = 1.0e-12_defReal, & ! Tol. on closeness to surface + SURF_TOL = 1.0E-12_defReal, & + INF = 2.0_defReal**63, & + NUDGE = 1.0e-8_defReal ! Distance to poke neutrons across boundaries for surface tracking + + ! Flags for different possible events in movement in geometry + integer(shortINt), parameter, public :: COLL_EV = 1, & + BOUNDARY_EV = 2, & + CROSS_EV = 3, & + LOST_EV = 4 + + ! Create definitions for readability when dealing with positions relative to surfaces + logical(defBool), parameter, public :: behind = .FALSE., & + infront = .TRUE., & + outside = .FALSE., & + inside = .TRUE. + + ! Special material Indexes + ! NOTE: All material indices MUST BE NON-NEGATIVE! + integer(shortInt), parameter :: OUTSIDE_MAT = 0 ,& + VOID_MAT = huge(OUTSIDE_MAT), & + UNDEF_MAT = VOID_MAT - 1 + + + ! Define integers for each fill type that a cell may have + integer(shortInt), parameter :: OUTSIDE_FILL = 0, & + materialFill = 1, & + universeFill = 2, & + latticeFill = 3 + + ! Define integers for boundary condition types + integer(shortInt), parameter :: VACUUM_BC = 0, & + REFLECTIVE_BC = 1, & + PERIODIC_BC = 2 + + ! Integer indexes of cardinal directions + integer(shortInt), parameter :: X_AXIS = 1 ,& + Y_AXIS = 2 ,& + Z_AXIS = 3 + + ! Particle Type Enumeration + integer(shortInt), parameter :: P_NEUTRON_CE = 1, & + P_NEUTRON_MG = 2 + + ! Search error codes + integer(shortInt), parameter :: valueOutsideArray = -1,& + tooManyIter = -2,& + targetNotFound = -3, & + NOT_FOUND = -3 + + ! Physical constants + real(defReal), parameter :: neutronMass = 939.5654133_defReal, & ! Neutron mass in MeV/c^2 + lightSpeed = 2.99792458e10_defReal, & ! Light speed in cm/s + energyPerFission = 200.0_defReal ! MeV + + ! Unit conversion + real(defReal), parameter :: joulesPerMeV = 1.60218e-13 ! Convert MeV to J + + ! Global name variables used to define specific geometry or field types + character(nameLen), parameter :: nameUFS = 'uniFissSites' + character(nameLen), parameter :: nameWW = 'WeightWindows' + +end module universalVariables diff --git a/Tallies/TallyClerks/trackClerk_class.f90 b/Tallies/TallyClerks/trackClerk_class.f90 index acd4c8303..30ce3e5af 100644 --- a/Tallies/TallyClerks/trackClerk_class.f90 +++ b/Tallies/TallyClerks/trackClerk_class.f90 @@ -1,292 +1,292 @@ -module trackClerk_class - - use numPrecision - use tallyCodes - use genericProcedures, only : fatalError - use dictionary_class, only : dictionary - use particle_class, only : particle, particleState - use outputFile_class, only : outputFile - use scoreMemory_class, only : scoreMemory - use tallyClerk_inter, only : tallyClerk, kill_super => kill - - ! Nuclear Data interface - use nuclearDatabase_inter, only : nuclearDatabase - - ! Tally Filters - use tallyFilter_inter, only : tallyFilter - use tallyFilterFactory_func, only : new_tallyFilter - - ! Tally Maps - use tallyMap_inter, only : tallyMap - use tallyMapFactory_func, only : new_tallyMap - - ! Tally Responses - use tallyResponseSlot_class, only : tallyResponseSlot - - implicit none - private - - !! - !! Track length estimator of reaction rates - !! Calculates flux weighted integrals from paticles travelled paths - !! - !! Private Members: - !! filter -> Space to store tally Filter - !! map -> Space to store tally Map - !! response -> Array of responses - !! width -> Number of responses (# of result bins for each map position) - !! - !! NOTE that maps and filters refer to the pre-transition particle state! This - !! would lead to wrong results in case of spatial grids (e.g. a Cartesian x-y grid) - !! - !! Interface - !! tallyClerk Interface - !! - !! SAMPLE DICTIOANRY INPUT: - !! - !! myTrackClerk { - !! type trackClerk; - !! # filter { } # - !! # map { } # - !! response (resName1 #resName2 ... #) - !! resName1 { } - !! #resNamew { run-time procedures - procedure :: reportPath - - ! Output procedures - procedure :: display - procedure :: print - - end type trackClerk - -contains - - !! - !! Initialise clerk from dictionary and name - !! - !! See tallyClerk_inter for details - !! - subroutine init(self, dict, name) - class(trackClerk), intent(inout) :: self - class(dictionary), intent(in) :: dict - character(nameLen), intent(in) :: name - character(nameLen),dimension(:),allocatable :: responseNames - integer(shortInt) :: i - - ! Assign name - call self % setName(name) - - ! Load filetr - if( dict % isPresent('filter')) then - call new_tallyFilter(self % filter, dict % getDictPtr('filter')) - end if - - ! Load map - if( dict % isPresent('map')) then - call new_tallyMap(self % map, dict % getDictPtr('map')) - end if - - ! Get names of response dictionaries - call dict % get(responseNames,'response') - - ! Load responses - allocate(self % response(size(responseNames))) - do i=1, size(responseNames) - call self % response(i) % init(dict % getDictPtr( responseNames(i) )) - end do - - ! Set width - self % width = size(responseNames) - - end subroutine init - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(trackClerk), intent(inout) :: self - - ! Superclass - call kill_super(self) - - ! Kill and deallocate filter - if(allocated(self % filter)) then - deallocate(self % filter) - end if - - ! Kill and deallocate map - if(allocated(self % map)) then - call self % map % kill() - deallocate(self % map) - end if - - ! Kill and deallocate responses - if(allocated(self % response)) then - deallocate(self % response) - end if - - self % width = 0 - - end subroutine kill - - !! - !! Returns array of codes that represent diffrent reports - !! - !! See tallyClerk_inter for details - !! - function validReports(self) result(validCodes) - class(trackClerk),intent(in) :: self - integer(shortInt),dimension(:),allocatable :: validCodes - - validCodes = [path_CODE] - - end function validReports - - !! - !! Return memory size of the clerk - !! - !! See tallyClerk_inter for details - !! - elemental function getSize(self) result(S) - class(trackClerk), intent(in) :: self - integer(shortInt) :: S - - S = size(self % response) - if(allocated(self % map)) S = S * self % map % bins(0) - - end function getSize - - !! - !! Process incoming track length report - !! - !! See tallyClerk_inter for details - !! - subroutine reportPath(self, p, L, xsData,mem) - class(trackClerk), intent(inout) :: self - class(particle), intent(in) :: p - real(defReal), intent(in) :: L - class(nuclearDatabase), intent(inout) :: xsData - type(scoreMemory), intent(inout) :: mem - type(particleState) :: state - type(particle) :: pTmp - integer(shortInt) :: binIdx, i - integer(longInt) :: adrr - real(defReal) :: scoreVal, flx - character(100), parameter :: Here =' reportPath (trackClerk_class.f90)' - - ! Get pre-transition particle state - state = p % prePath - - ! Check if within filter - if(allocated( self % filter)) then - if(self % filter % isFail(state)) return - end if - - ! Find bin index - if(allocated(self % map)) then - binIdx = self % map % map(state) - else - binIdx = 1 - end if - - ! Return if invalid bin index - if (binIdx == 0) return - - ! Calculate bin address - adrr = self % getMemAddress() + self % width * (binIdx -1) - 1 - - ! tranfer information about Prestate material to a temporary particle - pTmp = p - pTmp % coords % matIdx = state % matIdx - - ! Calculate flux sample L = path travelled - flx = L - - ! Append all bins - do i=1,self % width - scoreVal = self % response(i) % get(pTmp, xsData) * p % w * flx - call mem % score(scoreVal, adrr + i) - end do - - end subroutine reportPath - - !! - !! Display convergance progress on the console - !! - !! See tallyClerk_inter for details - !! - subroutine display(self, mem) - class(trackClerk), intent(in) :: self - type(scoreMemory), intent(in) :: mem - - print *, 'trackClerk does not support display yet' - - end subroutine display - - !! - !! Write contents of the clerk to output file - !! - !! See tallyClerk_inter for details - !! - subroutine print(self, outFile, mem) - class(trackClerk), intent(in) :: self - class(outputFile), intent(inout) :: outFile - type(scoreMemory), intent(in) :: mem - real(defReal) :: val, std - integer(shortInt) :: i - integer(shortInt),dimension(:),allocatable :: resArrayShape - character(nameLen) :: name - - ! Begin block - call outFile % startBlock(self % getName()) - - ! If track clerk has map print map information - if( allocated(self % map)) then - call self % map % print(outFile) - end if - - ! Write results. - ! Get shape of result array - if(allocated(self % map)) then - resArrayShape = [size(self % response), self % map % binArrayShape()] - else - resArrayShape = [size(self % response)] - end if - - ! Start array - name ='Res' - call outFile % startArray(name, resArrayShape) - - ! Print results to the file - do i=1,product(resArrayShape) - call mem % getResult(val, std, self % getMemAddress() - 1 + i) - call outFile % addResult(val,std) - - end do - - call outFile % endArray() - call outFile % endBlock() - - end subroutine print - -end module trackClerk_class +module trackClerk_class + + use numPrecision + use tallyCodes + use genericProcedures, only : fatalError + use dictionary_class, only : dictionary + use particle_class, only : particle, particleState + use outputFile_class, only : outputFile + use scoreMemory_class, only : scoreMemory + use tallyClerk_inter, only : tallyClerk, kill_super => kill + + ! Nuclear Data interface + use nuclearDatabase_inter, only : nuclearDatabase + + ! Tally Filters + use tallyFilter_inter, only : tallyFilter + use tallyFilterFactory_func, only : new_tallyFilter + + ! Tally Maps + use tallyMap_inter, only : tallyMap + use tallyMapFactory_func, only : new_tallyMap + + ! Tally Responses + use tallyResponseSlot_class, only : tallyResponseSlot + + implicit none + private + + !! + !! Track length estimator of reaction rates + !! Calculates flux weighted integrals from paticles travelled paths + !! + !! Private Members: + !! filter -> Space to store tally Filter + !! map -> Space to store tally Map + !! response -> Array of responses + !! width -> Number of responses (# of result bins for each map position) + !! + !! NOTE that maps and filters refer to the pre-transition particle state! This + !! would lead to wrong results in case of spatial grids (e.g. a Cartesian x-y grid) + !! + !! Interface + !! tallyClerk Interface + !! + !! SAMPLE DICTIOANRY INPUT: + !! + !! myTrackClerk { + !! type trackClerk; + !! # filter { } # + !! # map { } # + !! response (resName1 #resName2 ... #) + !! resName1 { } + !! #resNamew { run-time procedures + procedure :: reportPath + + ! Output procedures + procedure :: display + procedure :: print + + end type trackClerk + +contains + + !! + !! Initialise clerk from dictionary and name + !! + !! See tallyClerk_inter for details + !! + subroutine init(self, dict, name) + class(trackClerk), intent(inout) :: self + class(dictionary), intent(in) :: dict + character(nameLen), intent(in) :: name + character(nameLen),dimension(:),allocatable :: responseNames + integer(shortInt) :: i + + ! Assign name + call self % setName(name) + + ! Load filetr + if( dict % isPresent('filter')) then + call new_tallyFilter(self % filter, dict % getDictPtr('filter')) + end if + + ! Load map + if( dict % isPresent('map')) then + call new_tallyMap(self % map, dict % getDictPtr('map')) + end if + + ! Get names of response dictionaries + call dict % get(responseNames,'response') + + ! Load responses + allocate(self % response(size(responseNames))) + do i=1, size(responseNames) + call self % response(i) % init(dict % getDictPtr( responseNames(i) )) + end do + + ! Set width + self % width = size(responseNames) + + end subroutine init + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(trackClerk), intent(inout) :: self + + ! Superclass + call kill_super(self) + + ! Kill and deallocate filter + if(allocated(self % filter)) then + deallocate(self % filter) + end if + + ! Kill and deallocate map + if(allocated(self % map)) then + call self % map % kill() + deallocate(self % map) + end if + + ! Kill and deallocate responses + if(allocated(self % response)) then + deallocate(self % response) + end if + + self % width = 0 + + end subroutine kill + + !! + !! Returns array of codes that represent diffrent reports + !! + !! See tallyClerk_inter for details + !! + function validReports(self) result(validCodes) + class(trackClerk),intent(in) :: self + integer(shortInt),dimension(:),allocatable :: validCodes + + validCodes = [path_CODE] + + end function validReports + + !! + !! Return memory size of the clerk + !! + !! See tallyClerk_inter for details + !! + elemental function getSize(self) result(S) + class(trackClerk), intent(in) :: self + integer(shortInt) :: S + + S = size(self % response) + if(allocated(self % map)) S = S * self % map % bins(0) + + end function getSize + + !! + !! Process incoming track length report + !! + !! See tallyClerk_inter for details + !! + subroutine reportPath(self, p, L, xsData,mem) + class(trackClerk), intent(inout) :: self + class(particle), intent(in) :: p + real(defReal), intent(in) :: L + class(nuclearDatabase), intent(inout) :: xsData + type(scoreMemory), intent(inout) :: mem + type(particleState) :: state + type(particle) :: pTmp + integer(shortInt) :: binIdx, i + integer(longInt) :: adrr + real(defReal) :: scoreVal, flx + character(100), parameter :: Here =' reportPath (trackClerk_class.f90)' + + ! Get pre-transition particle state + state = p % prePath + + ! Check if within filter + if(allocated( self % filter)) then + if(self % filter % isFail(state)) return + end if + + ! Find bin index + if(allocated(self % map)) then + binIdx = self % map % map(state) + else + binIdx = 1 + end if + + ! Return if invalid bin index + if (binIdx == 0) return + + ! Calculate bin address + adrr = self % getMemAddress() + self % width * (binIdx -1) - 1 + + ! tranfer information about Prestate material to a temporary particle + pTmp = p + pTmp % coords % matIdx = state % matIdx + + ! Calculate flux sample L = path travelled + flx = L + + ! Append all bins + do i=1,self % width + scoreVal = self % response(i) % get(pTmp, xsData) * p % w * flx + call mem % score(scoreVal, adrr + i) + end do + + end subroutine reportPath + + !! + !! Display convergance progress on the console + !! + !! See tallyClerk_inter for details + !! + subroutine display(self, mem) + class(trackClerk), intent(in) :: self + type(scoreMemory), intent(in) :: mem + + print *, 'trackClerk does not support display yet' + + end subroutine display + + !! + !! Write contents of the clerk to output file + !! + !! See tallyClerk_inter for details + !! + subroutine print(self, outFile, mem) + class(trackClerk), intent(in) :: self + class(outputFile), intent(inout) :: outFile + type(scoreMemory), intent(in) :: mem + real(defReal) :: val, std + integer(shortInt) :: i + integer(shortInt),dimension(:),allocatable :: resArrayShape + character(nameLen) :: name + + ! Begin block + call outFile % startBlock(self % getName()) + + ! If track clerk has map print map information + if( allocated(self % map)) then + call self % map % print(outFile) + end if + + ! Write results. + ! Get shape of result array + if(allocated(self % map)) then + resArrayShape = [size(self % response), self % map % binArrayShape()] + else + resArrayShape = [size(self % response)] + end if + + ! Start array + name ='Res' + call outFile % startArray(name, resArrayShape) + + ! Print results to the file + do i=1,product(resArrayShape) + call mem % getResult(val, std, self % getMemAddress() - 1 + i) + call outFile % addResult(val,std) + + end do + + call outFile % endArray() + call outFile % endBlock() + + end subroutine print + +end module trackClerk_class diff --git a/Tallies/TallyMaps/Tests/weightMap_test.f90 b/Tallies/TallyMaps/Tests/weightMap_test.f90 index 40073757a..f018077b4 100644 --- a/Tallies/TallyMaps/Tests/weightMap_test.f90 +++ b/Tallies/TallyMaps/Tests/weightMap_test.f90 @@ -1,202 +1,202 @@ -module weightMap_test - use numPrecision - use pFUnit_mod - use particle_class, only : particleState - use dictionary_class, only : dictionary - use outputFile_class, only : outputFile - - use weightMap_class, only : weightMap - - implicit none - - -@testCase - type, extends(TestCase) :: test_weightMap - private - type(weightMap) :: map_lin - type(weightMap) :: map_log - type(weightMap) :: map_unstruct - contains - procedure :: setUp - procedure :: tearDown - end type test_weightMap - - real(defReal),dimension(*), parameter :: UNSTRUCT_GRID = [ 0.00000000001_defReal, & - 0.00000003_defReal, 0.000000058_defReal, 0.00000014_defReal, 0.00000028_defReal, & - 0.00000035_defReal, 0.000000625_defReal, 0.000000972_defReal, 0.00000102_defReal,& - 0.000001097_defReal, 0.00000115_defReal, 0.000001855_defReal, 0.000004_defReal,& - 0.000009877_defReal, 0.000015968_defReal, 0.000148728_defReal, 0.00553_defReal,& - 0.009118_defReal, 0.111_defReal, 0.5_defReal, 0.821_defReal, 1.353_defReal, & - 2.231_defReal, 3.679_defReal, 6.0655_defReal, 10.0_defReal] - - - -contains - - !! - !! Sets up test_weightMap object we can use in a number of tests - !! - subroutine setUp(this) - class(test_weightMap), intent(inout) :: this - type(dictionary) :: tempDict - - ! Build map lin - call tempDict % init(4) - call tempDict % store('grid','lin') - call tempDict % store('min', 0.01_defReal) - call tempDict % store('max', 10.0_defReal) - call tempDict % store('N', 20) - - call this % map_lin % init(tempDict) - call tempDict % kill() - - ! Build map log - call tempDict % init(4) - call tempDict % store('grid','log') - call tempDict % store('min', 1.0E-7_defReal) - call tempDict % store('max', 10.0_defReal) - call tempDict % store('N', 20) - - call this % map_log % init(tempDict) - call tempDict % kill() - - ! Build map log - call tempDict % init(2) - call tempDict % store('grid','unstruct') - call tempDict % store('bins', UNSTRUCT_GRID) - - call this % map_unstruct % init(tempDict) - call tempDict % kill() - - - end subroutine setUp - - !! - !! Kills test_weightMap object we can use in a number of tests - !! - subroutine tearDown(this) - class(test_weightMap), intent(inout) :: this - - call this % map_lin % kill() - call this % map_log % kill() - call this % map_unstruct % kill() - - end subroutine tearDown - -!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> -!! PROPER TESTS BEGIN HERE -!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> - - !! - !! Test Linear grid - !! -@Test - subroutine testLinearGrid(this) - class(test_weightMap), intent(inout) :: this - real(defReal),dimension(6),parameter :: wgt = [7.5774_defReal, 9.3652_defReal, 3.9223_defReal, & - 6.5548_defReal, 1.7119_defReal, 20.0_defReal] - integer(shortInt),dimension(6),parameter :: RES_IDX = [16, 19, 8, 14, 4, 0] - integer(shortInt),dimension(6) :: idx - type(particleState),dimension(6) :: states - - states % wgt = wgt - idx = this % map_lin % map(states) - @assertEqual(RES_IDX, idx) - - end subroutine testLinearGrid - - !! - !! Test Log grid - !! -@Test - subroutine testLogGrid(this) - class(test_weightMap), intent(inout) :: this - real(defReal),dimension(6),parameter :: wgt = [0.0445008907555061_defReal, & - 1.79747463687278e-07_defReal, & - 1.64204055725811e-05_defReal, & - 2.34083673923110e-07_defReal, & - 5.98486350302033e-07_defReal, & - 20.00000000000000000_defReal] - integer(shortInt),dimension(6),parameter :: RES_IDX = [15, 1, 6, 1, 2, 0] - integer(shortInt),dimension(6) :: idx - type(particleState),dimension(6) :: states - - states % wgt = wgt - idx = this % map_log % map(states) - @assertEqual(RES_IDX, idx) - - end subroutine testLogGrid - - !! - !! Test Unstruct grid - !! -@Test - subroutine testUnstructGrid(this) - class(test_weightMap), intent(inout) :: this - real(defReal),dimension(6),parameter :: wgt = [0.0761191517392624_defReal, & - 0.00217742635754091_defReal, & - 6.38548311340975e-08_defReal, & - 2.52734532533842_defReal, & - 2.59031729968032e-11_defReal, & - 20.00000000000000000_defReal] - integer(shortInt),dimension(6),parameter :: RES_IDX = [18, 16, 3, 23, 1, 0] - integer(shortInt),dimension(6) :: idx - type(particleState),dimension(6) :: states - - states % wgt = wgt - idx = this % map_unstruct % map(states) - @assertEqual(RES_IDX, idx) - - end subroutine testUnstructGrid - - !! - !! Test bin number retrival - !! -@Test - subroutine testBinNumber(this) - class(test_weightMap), intent(inout) :: this - - ! Linear weightMap - @assertEqual(20, this % map_lin % bins(1),'1st Dimension') - @assertEqual(20, this % map_lin % bins(0),'All bins') - @assertEqual(0, this % map_lin % bins(-3),'Invalid Dimension') - - ! Log weightMap - @assertEqual(20, this % map_log % bins(1),'1st Dimension') - @assertEqual(20, this % map_log % bins(0),'All bins') - @assertEqual(0, this % map_log % bins(-3),'Invalid Dimension') - - ! Unstructured weightMap - @assertEqual(25, this % map_unstruct % bins(1),'1st Dimension') - @assertEqual(25, this % map_unstruct % bins(0),'All bins') - @assertEqual(0, this % map_unstruct % bins(-3),'Invalid Dimension') - - end subroutine testBinNumber - - !! - !! Test correctness of print subroutine - !! Does not checks that values are correct, but that calls sequance is without errors - !! -@Test - subroutine testPrint(this) - class(test_weightMap), intent(inout) :: this - type(outputFile) :: out - - call out % init('dummyPrinter', fatalErrors = .false.) - - call this % map_lin % print(out) - @assertTrue(out % isValid(),'Linear map case') - call out % reset() - - call this % map_log % print(out) - @assertTrue(out % isValid(),'Logarithmic map case') - call out % reset() - - call this % map_unstruct % print(out) - @assertTrue(out % isValid(),'Unstructured map case') - call out % reset() - - end subroutine testPrint - - -end module weightMap_test +module weightMap_test + use numPrecision + use pFUnit_mod + use particle_class, only : particleState + use dictionary_class, only : dictionary + use outputFile_class, only : outputFile + + use weightMap_class, only : weightMap + + implicit none + + +@testCase + type, extends(TestCase) :: test_weightMap + private + type(weightMap) :: map_lin + type(weightMap) :: map_log + type(weightMap) :: map_unstruct + contains + procedure :: setUp + procedure :: tearDown + end type test_weightMap + + real(defReal),dimension(*), parameter :: UNSTRUCT_GRID = [ 0.00000000001_defReal, & + 0.00000003_defReal, 0.000000058_defReal, 0.00000014_defReal, 0.00000028_defReal, & + 0.00000035_defReal, 0.000000625_defReal, 0.000000972_defReal, 0.00000102_defReal,& + 0.000001097_defReal, 0.00000115_defReal, 0.000001855_defReal, 0.000004_defReal,& + 0.000009877_defReal, 0.000015968_defReal, 0.000148728_defReal, 0.00553_defReal,& + 0.009118_defReal, 0.111_defReal, 0.5_defReal, 0.821_defReal, 1.353_defReal, & + 2.231_defReal, 3.679_defReal, 6.0655_defReal, 10.0_defReal] + + + +contains + + !! + !! Sets up test_weightMap object we can use in a number of tests + !! + subroutine setUp(this) + class(test_weightMap), intent(inout) :: this + type(dictionary) :: tempDict + + ! Build map lin + call tempDict % init(4) + call tempDict % store('grid','lin') + call tempDict % store('min', 0.01_defReal) + call tempDict % store('max', 10.0_defReal) + call tempDict % store('N', 20) + + call this % map_lin % init(tempDict) + call tempDict % kill() + + ! Build map log + call tempDict % init(4) + call tempDict % store('grid','log') + call tempDict % store('min', 1.0E-7_defReal) + call tempDict % store('max', 10.0_defReal) + call tempDict % store('N', 20) + + call this % map_log % init(tempDict) + call tempDict % kill() + + ! Build map log + call tempDict % init(2) + call tempDict % store('grid','unstruct') + call tempDict % store('bins', UNSTRUCT_GRID) + + call this % map_unstruct % init(tempDict) + call tempDict % kill() + + + end subroutine setUp + + !! + !! Kills test_weightMap object we can use in a number of tests + !! + subroutine tearDown(this) + class(test_weightMap), intent(inout) :: this + + call this % map_lin % kill() + call this % map_log % kill() + call this % map_unstruct % kill() + + end subroutine tearDown + +!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! PROPER TESTS BEGIN HERE +!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Test Linear grid + !! +@Test + subroutine testLinearGrid(this) + class(test_weightMap), intent(inout) :: this + real(defReal),dimension(6),parameter :: wgt = [7.5774_defReal, 9.3652_defReal, 3.9223_defReal, & + 6.5548_defReal, 1.7119_defReal, 20.0_defReal] + integer(shortInt),dimension(6),parameter :: RES_IDX = [16, 19, 8, 14, 4, 0] + integer(shortInt),dimension(6) :: idx + type(particleState),dimension(6) :: states + + states % wgt = wgt + idx = this % map_lin % map(states) + @assertEqual(RES_IDX, idx) + + end subroutine testLinearGrid + + !! + !! Test Log grid + !! +@Test + subroutine testLogGrid(this) + class(test_weightMap), intent(inout) :: this + real(defReal),dimension(6),parameter :: wgt = [0.0445008907555061_defReal, & + 1.79747463687278e-07_defReal, & + 1.64204055725811e-05_defReal, & + 2.34083673923110e-07_defReal, & + 5.98486350302033e-07_defReal, & + 20.00000000000000000_defReal] + integer(shortInt),dimension(6),parameter :: RES_IDX = [15, 1, 6, 1, 2, 0] + integer(shortInt),dimension(6) :: idx + type(particleState),dimension(6) :: states + + states % wgt = wgt + idx = this % map_log % map(states) + @assertEqual(RES_IDX, idx) + + end subroutine testLogGrid + + !! + !! Test Unstruct grid + !! +@Test + subroutine testUnstructGrid(this) + class(test_weightMap), intent(inout) :: this + real(defReal),dimension(6),parameter :: wgt = [0.0761191517392624_defReal, & + 0.00217742635754091_defReal, & + 6.38548311340975e-08_defReal, & + 2.52734532533842_defReal, & + 2.59031729968032e-11_defReal, & + 20.00000000000000000_defReal] + integer(shortInt),dimension(6),parameter :: RES_IDX = [18, 16, 3, 23, 1, 0] + integer(shortInt),dimension(6) :: idx + type(particleState),dimension(6) :: states + + states % wgt = wgt + idx = this % map_unstruct % map(states) + @assertEqual(RES_IDX, idx) + + end subroutine testUnstructGrid + + !! + !! Test bin number retrival + !! +@Test + subroutine testBinNumber(this) + class(test_weightMap), intent(inout) :: this + + ! Linear weightMap + @assertEqual(20, this % map_lin % bins(1),'1st Dimension') + @assertEqual(20, this % map_lin % bins(0),'All bins') + @assertEqual(0, this % map_lin % bins(-3),'Invalid Dimension') + + ! Log weightMap + @assertEqual(20, this % map_log % bins(1),'1st Dimension') + @assertEqual(20, this % map_log % bins(0),'All bins') + @assertEqual(0, this % map_log % bins(-3),'Invalid Dimension') + + ! Unstructured weightMap + @assertEqual(25, this % map_unstruct % bins(1),'1st Dimension') + @assertEqual(25, this % map_unstruct % bins(0),'All bins') + @assertEqual(0, this % map_unstruct % bins(-3),'Invalid Dimension') + + end subroutine testBinNumber + + !! + !! Test correctness of print subroutine + !! Does not checks that values are correct, but that calls sequance is without errors + !! +@Test + subroutine testPrint(this) + class(test_weightMap), intent(inout) :: this + type(outputFile) :: out + + call out % init('dummyPrinter', fatalErrors = .false.) + + call this % map_lin % print(out) + @assertTrue(out % isValid(),'Linear map case') + call out % reset() + + call this % map_log % print(out) + @assertTrue(out % isValid(),'Logarithmic map case') + call out % reset() + + call this % map_unstruct % print(out) + @assertTrue(out % isValid(),'Unstructured map case') + call out % reset() + + end subroutine testPrint + + +end module weightMap_test diff --git a/Tallies/TallyMaps/weightMap_class.f90 b/Tallies/TallyMaps/weightMap_class.f90 index 19d663c44..89730ac5f 100644 --- a/Tallies/TallyMaps/weightMap_class.f90 +++ b/Tallies/TallyMaps/weightMap_class.f90 @@ -1,282 +1,282 @@ -module weightMap_class - - use numPrecision - use universalVariables - use genericProcedures, only : fatalError - use dictionary_class, only : dictionary - use grid_class, only : grid - use particle_class, only : particleState - use outputFile_class, only : outputFile - use tallyMap1D_inter, only : tallyMap1D, kill_super => kill - - implicit none - private - - !! - !! Constructor - !! - interface weightMap - module procedure weightMap_fromDict - end interface - - !! - !! Map that divides weight into number of discrete bins - !! Returns index 0 for elements outside division - !! - !! Private Members: - !! binBounds -> grid with bin boundaries - !! N -> Integer number of bins in the map - !! - !! Interface: - !! tallyMap interface - !! build -> build instance of spaceMap without dictionary - !! - !! NOTE: Behaviour of points exactly at the boundary between two bins is undefined. - !! They can be in either of two bins. - !! - !! Sample Dictionary Input: - !! structMap { - !! type weightMap; - !! grid lin; - !! min 0.0; - !! max 2.0; - !! N 20; - !! } - !! - !! unstructMap { - !! type weightMap; - !! grid ustruct; - !! bins (0.0 0.2 0.5 0.8 1.0); - !! } - !! - type, public,extends(tallyMap1D) :: weightMap - private - type(grid) :: binBounds - integer(shortInt) :: N = 0 - - contains - ! Superclass interface implementaction - procedure :: init - procedure :: bins - procedure :: map - procedure :: getAxisName - procedure :: print - procedure :: kill - - ! Class specific procedures - generic :: build => build_fromGrid, build_structured - procedure,private :: build_fromGrid - procedure,private :: build_structured - end type weightMap - -contains - - !! - !! Build from explicit grid of bin boundaries - !! - !! Args: - !! grid [in] -> Array of sorted ascending defReal values - !! - !! Errors: - !! None from here. Grid type is responsible for checking input consistency - !! - subroutine build_fromGrid(self, grid) - class(weightMap), intent(inout) :: self - real(defReal), dimension(:), intent(in) :: grid - - self % N = size(grid)-1 - call self % binBounds % init(grid) - - end subroutine build_fromGrid - - !! - !! Build from min and max value, number of bins and direction - !! - !! Args: - !! mini [in] -> minumum value on the grid - !! maxi [in] -> maximum value on the grid - !! N [in] -> Number of bins in the grid - !! type [in] -> nameLen type of interpolation 'lin' or 'log' - !! - !! Errors: - !! None from here. Grid type is responsible for checking input consistency - !! - subroutine build_structured(self, mini, maxi, N, type) - class(weightMap), intent(inout) :: self - real(defReal), intent(in) :: mini - real(defReal), intent(in) :: maxi - integer(shortInt),intent(in) :: N - character(nameLen), intent(in) :: type - - self % N = N - call self % binBounds % init(mini, maxi, N, type) - - end subroutine build_structured - - !! - !! Initialise from dictionary - !! - !! See tallyMap for specification - !! - subroutine init(self, dict) - class(weightMap), intent(inout) :: self - class(dictionary), intent(in) :: dict - character(nameLen) :: str, type - real(defReal) :: mini, maxi - real(defReal),dimension(:),allocatable :: bins - integer(shortInt) :: N - character(100), parameter :: Here = 'init (weightMap_class.f90)' - - if(.not.dict % isPresent('grid')) call fatalError(Here,"Keyword 'grid' must be present") - - ! Read grid definition keyword - call dict % get(str,'grid') - - ! Choose approperiate definition - select case(str) - case('lin') - ! Read settings - call dict % get(mini,'min') - call dict % get(maxi,'max') - call dict % get(N,'N') - type = 'lin' - - ! Initialise - call self % build(mini, maxi, N, type) - - case('log') - ! Read settings - call dict % get(mini,'min') - call dict % get(maxi,'max') - call dict % get(N,'N') - type = 'log' - - ! Initialise - call self % build(mini, maxi, N, type) - - case('unstruct') - ! Read settings - call dict % get(bins,'bins') - - ! Initialise - call self % build(bins) - - case default - call fatalError(Here,"'grid' keyword must be: lin, log or usntruct") - - end select - - end subroutine init - - !! - !! Return total number of bins in this division along dimension D - !! For D=0 return all bins - !! - !! See tallyMap for specification - !! - elemental function bins(self, D) result(N) - class(weightMap), intent(in) :: self - integer(shortInt), intent(in) :: D - integer(shortInt) :: N - - if (D == 1 .or. D == 0) then - N = self % N - else - N = 0 - end if - - end function bins - - !! - !! Map particle to a single bin. - !! - !! See tallyMap for specification - !! - elemental function map(self,state) result(idx) - class(weightMap), intent(in) :: self - class(particleState), intent(in) :: state - integer(shortInt) :: idx - - ! Find position on the grid - idx = self % binBounds % search(state % wgt) - if (idx == valueOutsideArray) idx = 0 - - end function map - - !! - !! Return string that describes variable used to divide event space - !! - !! See tallyMap for specification - !! - function getAxisName(self) result(name) - class(weightMap), intent(in) :: self - character(nameLen) :: name - - name = 'Weight' - - end function getAxisName - - !! - !! Add information about division axis to the output file - !! - !! See tallyMap for specification - !! - subroutine print(self,out) - class(weightMap), intent(in) :: self - class(outputFile), intent(inout) :: out - character(nameLen) :: name - integer(shortInt) :: i - - ! Name the array - name = trim(self % getAxisName()) //'Bounds' - - call out % startArray(name,[self % N,2]) - do i=1,self % N - ! Print lower bin boundary - call out % addValue(self % binBounds % bin(i)) - end do - - do i=1,self % N - ! Print upper bin boundar - call out % addValue(self % binBounds % bin(i+1)) - end do - - call out % endArray() - - end subroutine print - - !! - !! Return instance of weightMap from dictionary - !! - !! Args: - !! dict[in] -> input dictionary for the map - !! - !! Result: - !! Initialised weightMap instance - !! - !! Errors: - !! See init procedure. - !! - function weightMap_fromDict(dict) result(new) - class(dictionary), intent(in) :: dict - type(weightMap) :: new - - call new % init(dict) - - end function weightMap_fromDict - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(weightMap), intent(inout) :: self - - call kill_super(self) - - ! Kill local - call self % binBounds % kill() - self % N = 0 - - end subroutine kill - -end module weightMap_class +module weightMap_class + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError + use dictionary_class, only : dictionary + use grid_class, only : grid + use particle_class, only : particleState + use outputFile_class, only : outputFile + use tallyMap1D_inter, only : tallyMap1D, kill_super => kill + + implicit none + private + + !! + !! Constructor + !! + interface weightMap + module procedure weightMap_fromDict + end interface + + !! + !! Map that divides weight into number of discrete bins + !! Returns index 0 for elements outside division + !! + !! Private Members: + !! binBounds -> grid with bin boundaries + !! N -> Integer number of bins in the map + !! + !! Interface: + !! tallyMap interface + !! build -> build instance of spaceMap without dictionary + !! + !! NOTE: Behaviour of points exactly at the boundary between two bins is undefined. + !! They can be in either of two bins. + !! + !! Sample Dictionary Input: + !! structMap { + !! type weightMap; + !! grid lin; + !! min 0.0; + !! max 2.0; + !! N 20; + !! } + !! + !! unstructMap { + !! type weightMap; + !! grid ustruct; + !! bins (0.0 0.2 0.5 0.8 1.0); + !! } + !! + type, public,extends(tallyMap1D) :: weightMap + private + type(grid) :: binBounds + integer(shortInt) :: N = 0 + + contains + ! Superclass interface implementaction + procedure :: init + procedure :: bins + procedure :: map + procedure :: getAxisName + procedure :: print + procedure :: kill + + ! Class specific procedures + generic :: build => build_fromGrid, build_structured + procedure,private :: build_fromGrid + procedure,private :: build_structured + end type weightMap + +contains + + !! + !! Build from explicit grid of bin boundaries + !! + !! Args: + !! grid [in] -> Array of sorted ascending defReal values + !! + !! Errors: + !! None from here. Grid type is responsible for checking input consistency + !! + subroutine build_fromGrid(self, grid) + class(weightMap), intent(inout) :: self + real(defReal), dimension(:), intent(in) :: grid + + self % N = size(grid)-1 + call self % binBounds % init(grid) + + end subroutine build_fromGrid + + !! + !! Build from min and max value, number of bins and direction + !! + !! Args: + !! mini [in] -> minumum value on the grid + !! maxi [in] -> maximum value on the grid + !! N [in] -> Number of bins in the grid + !! type [in] -> nameLen type of interpolation 'lin' or 'log' + !! + !! Errors: + !! None from here. Grid type is responsible for checking input consistency + !! + subroutine build_structured(self, mini, maxi, N, type) + class(weightMap), intent(inout) :: self + real(defReal), intent(in) :: mini + real(defReal), intent(in) :: maxi + integer(shortInt),intent(in) :: N + character(nameLen), intent(in) :: type + + self % N = N + call self % binBounds % init(mini, maxi, N, type) + + end subroutine build_structured + + !! + !! Initialise from dictionary + !! + !! See tallyMap for specification + !! + subroutine init(self, dict) + class(weightMap), intent(inout) :: self + class(dictionary), intent(in) :: dict + character(nameLen) :: str, type + real(defReal) :: mini, maxi + real(defReal),dimension(:),allocatable :: bins + integer(shortInt) :: N + character(100), parameter :: Here = 'init (weightMap_class.f90)' + + if(.not.dict % isPresent('grid')) call fatalError(Here,"Keyword 'grid' must be present") + + ! Read grid definition keyword + call dict % get(str,'grid') + + ! Choose approperiate definition + select case(str) + case('lin') + ! Read settings + call dict % get(mini,'min') + call dict % get(maxi,'max') + call dict % get(N,'N') + type = 'lin' + + ! Initialise + call self % build(mini, maxi, N, type) + + case('log') + ! Read settings + call dict % get(mini,'min') + call dict % get(maxi,'max') + call dict % get(N,'N') + type = 'log' + + ! Initialise + call self % build(mini, maxi, N, type) + + case('unstruct') + ! Read settings + call dict % get(bins,'bins') + + ! Initialise + call self % build(bins) + + case default + call fatalError(Here,"'grid' keyword must be: lin, log or usntruct") + + end select + + end subroutine init + + !! + !! Return total number of bins in this division along dimension D + !! For D=0 return all bins + !! + !! See tallyMap for specification + !! + elemental function bins(self, D) result(N) + class(weightMap), intent(in) :: self + integer(shortInt), intent(in) :: D + integer(shortInt) :: N + + if (D == 1 .or. D == 0) then + N = self % N + else + N = 0 + end if + + end function bins + + !! + !! Map particle to a single bin. + !! + !! See tallyMap for specification + !! + elemental function map(self,state) result(idx) + class(weightMap), intent(in) :: self + class(particleState), intent(in) :: state + integer(shortInt) :: idx + + ! Find position on the grid + idx = self % binBounds % search(state % wgt) + if (idx == valueOutsideArray) idx = 0 + + end function map + + !! + !! Return string that describes variable used to divide event space + !! + !! See tallyMap for specification + !! + function getAxisName(self) result(name) + class(weightMap), intent(in) :: self + character(nameLen) :: name + + name = 'Weight' + + end function getAxisName + + !! + !! Add information about division axis to the output file + !! + !! See tallyMap for specification + !! + subroutine print(self,out) + class(weightMap), intent(in) :: self + class(outputFile), intent(inout) :: out + character(nameLen) :: name + integer(shortInt) :: i + + ! Name the array + name = trim(self % getAxisName()) //'Bounds' + + call out % startArray(name,[self % N,2]) + do i=1,self % N + ! Print lower bin boundary + call out % addValue(self % binBounds % bin(i)) + end do + + do i=1,self % N + ! Print upper bin boundar + call out % addValue(self % binBounds % bin(i+1)) + end do + + call out % endArray() + + end subroutine print + + !! + !! Return instance of weightMap from dictionary + !! + !! Args: + !! dict[in] -> input dictionary for the map + !! + !! Result: + !! Initialised weightMap instance + !! + !! Errors: + !! See init procedure. + !! + function weightMap_fromDict(dict) result(new) + class(dictionary), intent(in) :: dict + type(weightMap) :: new + + call new % init(dict) + + end function weightMap_fromDict + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(weightMap), intent(inout) :: self + + call kill_super(self) + + ! Kill local + call self % binBounds % kill() + self % N = 0 + + end subroutine kill + +end module weightMap_class diff --git a/Tallies/TallyResponses/Tests/weightResponse_test.f90 b/Tallies/TallyResponses/Tests/weightResponse_test.f90 index 2d9a4d53f..5360cb860 100644 --- a/Tallies/TallyResponses/Tests/weightResponse_test.f90 +++ b/Tallies/TallyResponses/Tests/weightResponse_test.f90 @@ -1,83 +1,83 @@ -module weightResponse_test - - use numPrecision - use endfConstants - use weightResponse_class, only : weightResponse - use particle_class, only : particle, P_NEUTRON - use dictionary_class, only : dictionary - use testNeutronDatabase_class, only : testNeutronDatabase - use pFUnit_mod - - implicit none - -@testCase - type, extends(TestCase) :: test_weightResponse - private - type(weightResponse) :: response_weight_m0 - type(weightResponse) :: response_weight_m2 - type(testNeutronDatabase) :: xsData - contains - procedure :: setUp - procedure :: tearDown - end type test_weightResponse - - -contains - - !! - !! Sets up test_macroResponse object we can use in a number of tests - !! - subroutine setUp(this) - class(test_weightResponse), intent(inout) :: this - type(dictionary) :: tempDict - - ! Cross-sections: Total - call this % xsData % build(4.0_defReal) - - ! Set up weight response - call tempDict % init(1) - call tempDict % store('moment', 0) - call this % response_weight_m0 % init(tempDict) - call tempDict % kill() - - call tempDict % init(1) - call tempDict % store('moment', 2) - call this % response_weight_m2 % init(tempDict) - call tempDict % kill() - - end subroutine setUp - - !! - !! Kills test_weightResponse object we can use in a number of tests - !! - subroutine tearDown(this) - class(test_weightResponse), intent(inout) :: this - - ! Kill and deallocate testTransportNuclearData - call this % xsData % kill() - - end subroutine tearDown - -!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> -!! PROPER TESTS BEGIN HERE -!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> - - !! - !! Test correct behaviour of the filter - !! -@Test - subroutine testGettingResponse(this) - class(test_weightResponse), intent(inout) :: this - type(particle) :: p - real(defReal), parameter :: TOL = 1.0E-9 - - p % type = P_NEUTRON - p % w = 2.0_defReal - - ! Test response values - @assertEqual(2.0_defReal, this % response_weight_m0 % get(p, this % xsData), TOL) - @assertEqual(8.0_defReal, this % response_weight_m2 % get(p, this % xsData), TOL) - - end subroutine testGettingResponse - -end module weightResponse_test +module weightResponse_test + + use numPrecision + use endfConstants + use weightResponse_class, only : weightResponse + use particle_class, only : particle, P_NEUTRON + use dictionary_class, only : dictionary + use testNeutronDatabase_class, only : testNeutronDatabase + use pFUnit_mod + + implicit none + +@testCase + type, extends(TestCase) :: test_weightResponse + private + type(weightResponse) :: response_weight_m0 + type(weightResponse) :: response_weight_m2 + type(testNeutronDatabase) :: xsData + contains + procedure :: setUp + procedure :: tearDown + end type test_weightResponse + + +contains + + !! + !! Sets up test_macroResponse object we can use in a number of tests + !! + subroutine setUp(this) + class(test_weightResponse), intent(inout) :: this + type(dictionary) :: tempDict + + ! Cross-sections: Total + call this % xsData % build(4.0_defReal) + + ! Set up weight response + call tempDict % init(1) + call tempDict % store('moment', 0) + call this % response_weight_m0 % init(tempDict) + call tempDict % kill() + + call tempDict % init(1) + call tempDict % store('moment', 2) + call this % response_weight_m2 % init(tempDict) + call tempDict % kill() + + end subroutine setUp + + !! + !! Kills test_weightResponse object we can use in a number of tests + !! + subroutine tearDown(this) + class(test_weightResponse), intent(inout) :: this + + ! Kill and deallocate testTransportNuclearData + call this % xsData % kill() + + end subroutine tearDown + +!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! PROPER TESTS BEGIN HERE +!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Test correct behaviour of the filter + !! +@Test + subroutine testGettingResponse(this) + class(test_weightResponse), intent(inout) :: this + type(particle) :: p + real(defReal), parameter :: TOL = 1.0E-9 + + p % type = P_NEUTRON + p % w = 2.0_defReal + + ! Test response values + @assertEqual(2.0_defReal, this % response_weight_m0 % get(p, this % xsData), TOL) + @assertEqual(8.0_defReal, this % response_weight_m2 % get(p, this % xsData), TOL) + + end subroutine testGettingResponse + +end module weightResponse_test diff --git a/Tallies/TallyResponses/weightResponse_class.f90 b/Tallies/TallyResponses/weightResponse_class.f90 index e007e20dd..ac637bf80 100644 --- a/Tallies/TallyResponses/weightResponse_class.f90 +++ b/Tallies/TallyResponses/weightResponse_class.f90 @@ -1,104 +1,104 @@ -module weightResponse_class - - use numPrecision - use endfConstants - use genericProcedures, only : fatalError, numToChar - use dictionary_class, only : dictionary - use particle_class, only : particle, P_NEUTRON - use tallyResponse_inter, only : tallyResponse - - ! Nuclear Data interfaces - use nuclearDatabase_inter, only : nuclearDatabase - use neutronMaterial_inter, only : neutronMaterial, neutronMaterial_CptrCast - - implicit none - private - - - !! - !! tallyResponse for scoring particle weights - !! Currently supports neutrons only - !! - !! Interface: - !! tallyResponse interface - !! - !! Sample dictionary input - !! name { - !! type weightResponse; moment 1; - !! } - !! - type, public,extends(tallyResponse) :: weightResponse - private - integer(shortInt) :: moment - contains - ! Superclass Procedures - procedure :: init - procedure :: get - procedure :: kill - - end type weightResponse - -contains - - !! - !! Initialise Response from dictionary - !! - !! See tallyResponse_inter for details - !! - subroutine init(self, dict) - class(weightResponse), intent(inout) :: self - class(dictionary), intent(in) :: dict - character(100), parameter :: Here ='init (weightResponse_class.f90)' - - ! Get response moment to be calculated - call dict % getOrDefault(self % moment, 'moment', 1) - - if (self % moment < 0) call fatalError(Here, 'Moment must be bigger or equal zero.') - - end subroutine init - - !! - !! Return response value - !! - !! See tallyResponse_inter for details - !! - !! Errors: - !! Return ZERO if particle is not a Neutron - !! - function get(self, p, xsData) result(val) - class(weightResponse), intent(in) :: self - class(particle), intent(in) :: p - class(nuclearDatabase), intent(inout) :: xsData - real(defReal) :: val - class(neutronMaterial), pointer :: mat - - val = ZERO - - ! Return 0.0 if particle is not neutron - if(p % type /= P_NEUTRON) return - - ! Get pointer to active material data - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) - - ! Return if material is not a neutronMaterial - if(.not.associated(mat)) return - - if (self % moment == 0) then - val = xsData % getTotalMatXS(p, p % matIdx()) / (p % w) - else - val = xsData % getTotalMatXS(p, p % matIdx()) * ((p % w) ** (self % moment - 1)) - end if - - end function get - - !! - !! Return to uninitialised State - !! - elemental subroutine kill(self) - class(weightResponse), intent(inout) :: self - - ! Do nothing for nothing can be done - - end subroutine kill - -end module weightResponse_class +module weightResponse_class + + use numPrecision + use endfConstants + use genericProcedures, only : fatalError, numToChar + use dictionary_class, only : dictionary + use particle_class, only : particle, P_NEUTRON + use tallyResponse_inter, only : tallyResponse + + ! Nuclear Data interfaces + use nuclearDatabase_inter, only : nuclearDatabase + use neutronMaterial_inter, only : neutronMaterial, neutronMaterial_CptrCast + + implicit none + private + + + !! + !! tallyResponse for scoring particle weights + !! Currently supports neutrons only + !! + !! Interface: + !! tallyResponse interface + !! + !! Sample dictionary input + !! name { + !! type weightResponse; moment 1; + !! } + !! + type, public,extends(tallyResponse) :: weightResponse + private + integer(shortInt) :: moment + contains + ! Superclass Procedures + procedure :: init + procedure :: get + procedure :: kill + + end type weightResponse + +contains + + !! + !! Initialise Response from dictionary + !! + !! See tallyResponse_inter for details + !! + subroutine init(self, dict) + class(weightResponse), intent(inout) :: self + class(dictionary), intent(in) :: dict + character(100), parameter :: Here ='init (weightResponse_class.f90)' + + ! Get response moment to be calculated + call dict % getOrDefault(self % moment, 'moment', 1) + + if (self % moment < 0) call fatalError(Here, 'Moment must be bigger or equal zero.') + + end subroutine init + + !! + !! Return response value + !! + !! See tallyResponse_inter for details + !! + !! Errors: + !! Return ZERO if particle is not a Neutron + !! + function get(self, p, xsData) result(val) + class(weightResponse), intent(in) :: self + class(particle), intent(in) :: p + class(nuclearDatabase), intent(inout) :: xsData + real(defReal) :: val + class(neutronMaterial), pointer :: mat + + val = ZERO + + ! Return 0.0 if particle is not neutron + if(p % type /= P_NEUTRON) return + + ! Get pointer to active material data + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) + + ! Return if material is not a neutronMaterial + if(.not.associated(mat)) return + + if (self % moment == 0) then + val = xsData % getTotalMatXS(p, p % matIdx()) / (p % w) + else + val = xsData % getTotalMatXS(p, p % matIdx()) * ((p % w) ** (self % moment - 1)) + end if + + end function get + + !! + !! Return to uninitialised State + !! + elemental subroutine kill(self) + class(weightResponse), intent(inout) :: self + + ! Do nothing for nothing can be done + + end subroutine kill + +end module weightResponse_class diff --git a/Tallies/Tests/scoreMemory_test.f90 b/Tallies/Tests/scoreMemory_test.f90 index 58da5f18b..b3bbeec27 100644 --- a/Tallies/Tests/scoreMemory_test.f90 +++ b/Tallies/Tests/scoreMemory_test.f90 @@ -1,300 +1,300 @@ -module scoreMemory_test - use numPrecision - use genericProcedures, only : numToChar - use scoreMemory_class, only : scoreMemory - use pFUnit_mod - - implicit none - -@testParameter(constructor = new_testNumber) - type, extends(AbstractTestParameter) :: testNumber - integer(shortInt) :: i - contains - procedure :: toString - end type testNumber - -@testCase(constructor=newTest) - type, extends(ParameterizedTestCase) :: test_scoreMemory - private - integer(longInt) :: Ncycles - integer(shortInt) :: batchSize - real(defReal),dimension(:), allocatable :: scores - integer(shortInt), dimension(:),allocatable :: scoresInt - - end type test_scoreMemory - - -contains - - !! - !! Build new test parameter form integer - !! - function new_testNumber(i) result (tstNum) - integer(shortInt) :: i - type(testNumber) :: tstNum - - tstNum % i = i - - end function new_testNumber - - !! - !! Write test parameter to string - !! - function toString(this) result(string) - class(testNumber), intent(in) :: this - character(:), allocatable :: string - character(nameLen) :: str - - write (str,*) this % i - string = str - - end function toString - - !! - !! Construct test case - !! - !! - !! - function newTest(testParam) result(tst) - type(testNumber), intent(in) :: testParam - type(test_scoreMemory) :: tst - real(defReal),dimension(200) :: random - integer(shortInt) :: seed, i - integer(shortInt),parameter :: A = 2469 ! Multiplier of LC PRNG - integer(shortInt),parameter :: M = 65521 ! Modulus of PRNG - - ! Load batchSize - tst % batchSize = testParam % i - tst % Ncycles = 10 * tst % batchSize - - ! Generate a vector of 20 pseudo-random numbers in <0;1> - ! Generator is not sophisticated but robust - seed = 9294 - do i=1,200 - seed = mod(A * seed , M) - random(i) = seed / real(M,defReal) - end do - - ! Generate some scores and calculate their sum and sum of squares - tst % scores = TWO + sin(PI * random - PI/2) - tst % scoresInt = int(random * 100, shortInt) - - end function newTest - -!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> -!! PROPER TESTS BEGIN HERE -!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> - - !! - !! Test acoring for a case with batchSize == 1 - !! Look at the end of the file to find MATLAB SCRIPT used to generate reference values - !! -@Test(cases=[1]) - subroutine testScoring(this) - class(test_scoreMemory), intent(inout) :: this - type(scoreMemory) :: mem - integer(shortInt) :: i, j - real(defReal) :: res1, res2, STD - real(defReal), parameter :: TOL = 1.0E-9 - - ! Initialise score memory - call mem % init(7_longInt, 1, batchSize = this % batchSize) - - ! Test getting batchSize - @assertEqual(this % batchSize, mem % getBatchSize(),'Test getBatchSize() :') - - ! Score in - do i=1,10 - ! Score - do j=20*(i-1)+1,20 * i - call mem % score(this % scores(j), 1_longInt) - call mem % score(this % scoresInt(j), 2_longInt) - call mem % score(int(this % scoresInt(j),longInt),3_longInt) - call mem % accumulate(this % scores(j), 4_longInt) - call mem % accumulate(this % scoresInt(j), 5_longInt) - call mem % accumulate(int(this % scoresInt(j),longInt),6_longInt) - - end do - ! Close a single bin with diffrent normalisation - call mem % closeBin(1.2_defReal, 3_longInt) - - ! Close Cycle - call mem % closeCycle(0.7_defReal) - - end do - - ! Get results from bin 1 - call mem % getResult(res1, 1_longInt) - call mem % getResult(res2, STD, 1_longInt) - - @assertEqual(26.401471259728442_defReal, res1, TOL) - @assertEqual(26.401471259728442_defReal, res2, TOL) - @assertEqual(0.645969443981583_defReal, STD, TOL) - - ! Get results from bin 2 - call mem % getResult(res1, 2_longInt) - call mem % getResult(res2, STD, 2_longInt) - - @assertEqual(623.0_defReal, res1, TOL) - @assertEqual(623.0_defReal, res2, TOL) - @assertEqual(27.982494527829360_defReal, STD, TOL) - - ! Get results from bin 3 - call mem % getResult(res1, 3_longInt) - call mem % getResult(res2, STD, 3_longInt) - - @assertEqual(1068.0_defReal, res1, TOL) - @assertEqual(1068.0_defReal, res2, TOL) - @assertEqual(47.969990619136050_defReal, STD, TOL) - - ! Get results from bin 4 - call mem % getResult(res1, 4_longInt, 200) - call mem % getResult(res2, STD, 4_longInt, 200) - - @assertEqual(1.885819375694888_defReal, res1, TOL) - @assertEqual(1.885819375694888_defReal, res2, TOL) - @assertEqual(0.049102082638055_defReal, STD, TOL) - - ! Get results from bin 5 - call mem % getResult(res1, 5_longInt, 200) - call mem % getResult(res2, STD, 5_longInt, 200) - - @assertEqual(44.500000000000000_defReal, res1, TOL) - @assertEqual(44.500000000000000_defReal, res2, TOL) - @assertEqual(2.015580019267494_defReal, STD, TOL) - - ! Get results from bin 6 - call mem % getResult(res1, 6_longInt, 200) - call mem % getResult(res2, STD, 6_longInt, 200) - - @assertEqual(44.500000000000000_defReal, res1, TOL) - @assertEqual(44.500000000000000_defReal, res2, TOL) - @assertEqual(2.015580019267494_defReal, STD, TOL) - - ! Get results from an empty bin 7 - call mem % getResult(res1, 7_longInt) - call mem % getResult(res2, STD, 7_longInt) - - @assertEqual(ZERO, res1, TOL) - @assertEqual(ZERO, res2, TOL) - @assertEqual(ZERO, STD, TOL) - - ! Get results from invalid bins - call mem % getResult(res1, -7_longInt) - call mem % getResult(res2, STD, -7_longInt) - - @assertEqual(ZERO, res1, TOL) - @assertEqual(ZERO, res2, TOL) - @assertEqual(ZERO, STD, TOL) - - call mem % getResult(res1, 8_longInt) - call mem % getResult(res2, STD, 8_longInt) - - @assertEqual(ZERO, res1, TOL) - @assertEqual(ZERO, res2, TOL) - @assertEqual(ZERO, STD, TOL) - - ! Free memor y - call mem % kill() - - end subroutine testScoring - - !! - !! Test lastCycle - !! Ignors test parametrisation - !! -@Test(cases=[1]) - subroutine testLastCycle(this) - class(test_scoreMemory), intent(inout) :: this - type(scoreMemory) :: mem - integer(shortInt) :: i - - call mem % init(1_longInt, 1, batchSize = 8) - - ! Test getting batchSize - @assertEqual(8, mem % getBatchSize(),'Test getBatchSize() :') - - do i=1,16 - if(i == 8 .or. i == 16) then - @assertTrue( mem % lastCycle(), 'In cycle num: '//numToChar(i)) - else - @assertFalse( mem % lastCycle(), 'In cycle num: '//numToChar(i)) - end if - call mem % closeCycle(ONE) - end do - - call mem % kill() - - end subroutine testLastCycle - - !! - !! Test get score - !! Ignore test parametrisation - !! -@Test(cases=[1]) - subroutine testGetScore(this) - class(test_scoreMemory), intent(inout) :: this - type(scoreMemory) :: mem - real(defReal),parameter :: TOL = 1.0E-9 - - call mem % init(1_longInt, 1) - - call mem % score(ONE,1_longInt) - call mem % score(ONE,1_longInt) - call mem % score(ONE,1_longInt) - - @assertEqual(3*ONE, mem % getScore(1_longInt), TOL, 'Test getScore, valid bin:') - @assertEqual(ZERO, mem % getScore(0_longInt), TOL, 'Test getScore, not +ve bin:') - @assertEqual(ZERO, mem % getScore(2_longInt), TOL, 'Test getScore, too large bin:') - - end subroutine testGetScore - - !! - !! Test killing uninitialised scoreMemory - !! -@Test(cases=[1]) - subroutine testKillUnalloc(this) - class(test_scoreMemory), intent(inout) :: this - type(scoreMemory) :: mem - - call mem % kill() - - end subroutine testKillUnalloc - -end module scoreMemory_test -!! MATLAB SCRIPT USED TO GENERATE REFERENCE VALUES -!clear -!rand = zeros(20,1); -!seed = 9294; -! -!%LCG Params -!A = 2469; -!M = 65521; -! -!for i=1:1:200 -! seed = mod(A * seed, M); -! rand(i) = seed/M; -!end -! -!% Calculate scores vector -!scores = 2.0 + sin(pi() .* rand - pi()/2); -!scoresInt = floor(100.*rand); -! -!% Accumulate results -!resAcc = mean(scores) -!stdAcc = sqrt(var(scores)./200) -! -!resAccInt = mean(scoresInt) -!stdAccInt = sqrt(var(scoresInt)./200) -! -!% Reshape scores -!scores = reshape(scores,[20,10]); -!scores = sum(scores,1)* 0.7; -!res = mean(scores) -!std = sqrt(var(scores)./10) -! -!% Reshape scores -!scoresInt = reshape(scoresInt,[20,10]); -!scoresInt = sum(scoresInt,1)* 0.7; -!resInt = mean(scoresInt) -!stdInt = sqrt(var(scoresInt)./10) +module scoreMemory_test + use numPrecision + use genericProcedures, only : numToChar + use scoreMemory_class, only : scoreMemory + use pFUnit_mod + + implicit none + +@testParameter(constructor = new_testNumber) + type, extends(AbstractTestParameter) :: testNumber + integer(shortInt) :: i + contains + procedure :: toString + end type testNumber + +@testCase(constructor=newTest) + type, extends(ParameterizedTestCase) :: test_scoreMemory + private + integer(longInt) :: Ncycles + integer(shortInt) :: batchSize + real(defReal),dimension(:), allocatable :: scores + integer(shortInt), dimension(:),allocatable :: scoresInt + + end type test_scoreMemory + + +contains + + !! + !! Build new test parameter form integer + !! + function new_testNumber(i) result (tstNum) + integer(shortInt) :: i + type(testNumber) :: tstNum + + tstNum % i = i + + end function new_testNumber + + !! + !! Write test parameter to string + !! + function toString(this) result(string) + class(testNumber), intent(in) :: this + character(:), allocatable :: string + character(nameLen) :: str + + write (str,*) this % i + string = str + + end function toString + + !! + !! Construct test case + !! + !! + !! + function newTest(testParam) result(tst) + type(testNumber), intent(in) :: testParam + type(test_scoreMemory) :: tst + real(defReal),dimension(200) :: random + integer(shortInt) :: seed, i + integer(shortInt),parameter :: A = 2469 ! Multiplier of LC PRNG + integer(shortInt),parameter :: M = 65521 ! Modulus of PRNG + + ! Load batchSize + tst % batchSize = testParam % i + tst % Ncycles = 10 * tst % batchSize + + ! Generate a vector of 20 pseudo-random numbers in <0;1> + ! Generator is not sophisticated but robust + seed = 9294 + do i=1,200 + seed = mod(A * seed , M) + random(i) = seed / real(M,defReal) + end do + + ! Generate some scores and calculate their sum and sum of squares + tst % scores = TWO + sin(PI * random - PI/2) + tst % scoresInt = int(random * 100, shortInt) + + end function newTest + +!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! PROPER TESTS BEGIN HERE +!!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Test acoring for a case with batchSize == 1 + !! Look at the end of the file to find MATLAB SCRIPT used to generate reference values + !! +@Test(cases=[1]) + subroutine testScoring(this) + class(test_scoreMemory), intent(inout) :: this + type(scoreMemory) :: mem + integer(shortInt) :: i, j + real(defReal) :: res1, res2, STD + real(defReal), parameter :: TOL = 1.0E-9 + + ! Initialise score memory + call mem % init(7_longInt, 1, batchSize = this % batchSize) + + ! Test getting batchSize + @assertEqual(this % batchSize, mem % getBatchSize(),'Test getBatchSize() :') + + ! Score in + do i=1,10 + ! Score + do j=20*(i-1)+1,20 * i + call mem % score(this % scores(j), 1_longInt) + call mem % score(this % scoresInt(j), 2_longInt) + call mem % score(int(this % scoresInt(j),longInt),3_longInt) + call mem % accumulate(this % scores(j), 4_longInt) + call mem % accumulate(this % scoresInt(j), 5_longInt) + call mem % accumulate(int(this % scoresInt(j),longInt),6_longInt) + + end do + ! Close a single bin with diffrent normalisation + call mem % closeBin(1.2_defReal, 3_longInt) + + ! Close Cycle + call mem % closeCycle(0.7_defReal) + + end do + + ! Get results from bin 1 + call mem % getResult(res1, 1_longInt) + call mem % getResult(res2, STD, 1_longInt) + + @assertEqual(26.401471259728442_defReal, res1, TOL) + @assertEqual(26.401471259728442_defReal, res2, TOL) + @assertEqual(0.645969443981583_defReal, STD, TOL) + + ! Get results from bin 2 + call mem % getResult(res1, 2_longInt) + call mem % getResult(res2, STD, 2_longInt) + + @assertEqual(623.0_defReal, res1, TOL) + @assertEqual(623.0_defReal, res2, TOL) + @assertEqual(27.982494527829360_defReal, STD, TOL) + + ! Get results from bin 3 + call mem % getResult(res1, 3_longInt) + call mem % getResult(res2, STD, 3_longInt) + + @assertEqual(1068.0_defReal, res1, TOL) + @assertEqual(1068.0_defReal, res2, TOL) + @assertEqual(47.969990619136050_defReal, STD, TOL) + + ! Get results from bin 4 + call mem % getResult(res1, 4_longInt, 200) + call mem % getResult(res2, STD, 4_longInt, 200) + + @assertEqual(1.885819375694888_defReal, res1, TOL) + @assertEqual(1.885819375694888_defReal, res2, TOL) + @assertEqual(0.049102082638055_defReal, STD, TOL) + + ! Get results from bin 5 + call mem % getResult(res1, 5_longInt, 200) + call mem % getResult(res2, STD, 5_longInt, 200) + + @assertEqual(44.500000000000000_defReal, res1, TOL) + @assertEqual(44.500000000000000_defReal, res2, TOL) + @assertEqual(2.015580019267494_defReal, STD, TOL) + + ! Get results from bin 6 + call mem % getResult(res1, 6_longInt, 200) + call mem % getResult(res2, STD, 6_longInt, 200) + + @assertEqual(44.500000000000000_defReal, res1, TOL) + @assertEqual(44.500000000000000_defReal, res2, TOL) + @assertEqual(2.015580019267494_defReal, STD, TOL) + + ! Get results from an empty bin 7 + call mem % getResult(res1, 7_longInt) + call mem % getResult(res2, STD, 7_longInt) + + @assertEqual(ZERO, res1, TOL) + @assertEqual(ZERO, res2, TOL) + @assertEqual(ZERO, STD, TOL) + + ! Get results from invalid bins + call mem % getResult(res1, -7_longInt) + call mem % getResult(res2, STD, -7_longInt) + + @assertEqual(ZERO, res1, TOL) + @assertEqual(ZERO, res2, TOL) + @assertEqual(ZERO, STD, TOL) + + call mem % getResult(res1, 8_longInt) + call mem % getResult(res2, STD, 8_longInt) + + @assertEqual(ZERO, res1, TOL) + @assertEqual(ZERO, res2, TOL) + @assertEqual(ZERO, STD, TOL) + + ! Free memor y + call mem % kill() + + end subroutine testScoring + + !! + !! Test lastCycle + !! Ignors test parametrisation + !! +@Test(cases=[1]) + subroutine testLastCycle(this) + class(test_scoreMemory), intent(inout) :: this + type(scoreMemory) :: mem + integer(shortInt) :: i + + call mem % init(1_longInt, 1, batchSize = 8) + + ! Test getting batchSize + @assertEqual(8, mem % getBatchSize(),'Test getBatchSize() :') + + do i=1,16 + if(i == 8 .or. i == 16) then + @assertTrue( mem % lastCycle(), 'In cycle num: '//numToChar(i)) + else + @assertFalse( mem % lastCycle(), 'In cycle num: '//numToChar(i)) + end if + call mem % closeCycle(ONE) + end do + + call mem % kill() + + end subroutine testLastCycle + + !! + !! Test get score + !! Ignore test parametrisation + !! +@Test(cases=[1]) + subroutine testGetScore(this) + class(test_scoreMemory), intent(inout) :: this + type(scoreMemory) :: mem + real(defReal),parameter :: TOL = 1.0E-9 + + call mem % init(1_longInt, 1) + + call mem % score(ONE,1_longInt) + call mem % score(ONE,1_longInt) + call mem % score(ONE,1_longInt) + + @assertEqual(3*ONE, mem % getScore(1_longInt), TOL, 'Test getScore, valid bin:') + @assertEqual(ZERO, mem % getScore(0_longInt), TOL, 'Test getScore, not +ve bin:') + @assertEqual(ZERO, mem % getScore(2_longInt), TOL, 'Test getScore, too large bin:') + + end subroutine testGetScore + + !! + !! Test killing uninitialised scoreMemory + !! +@Test(cases=[1]) + subroutine testKillUnalloc(this) + class(test_scoreMemory), intent(inout) :: this + type(scoreMemory) :: mem + + call mem % kill() + + end subroutine testKillUnalloc + +end module scoreMemory_test +!! MATLAB SCRIPT USED TO GENERATE REFERENCE VALUES +!clear +!rand = zeros(20,1); +!seed = 9294; +! +!%LCG Params +!A = 2469; +!M = 65521; +! +!for i=1:1:200 +! seed = mod(A * seed, M); +! rand(i) = seed/M; +!end +! +!% Calculate scores vector +!scores = 2.0 + sin(pi() .* rand - pi()/2); +!scoresInt = floor(100.*rand); +! +!% Accumulate results +!resAcc = mean(scores) +!stdAcc = sqrt(var(scores)./200) +! +!resAccInt = mean(scoresInt) +!stdAccInt = sqrt(var(scoresInt)./200) +! +!% Reshape scores +!scores = reshape(scores,[20,10]); +!scores = sum(scores,1)* 0.7; +!res = mean(scores) +!std = sqrt(var(scores)./10) +! +!% Reshape scores +!scoresInt = reshape(scoresInt,[20,10]); +!scoresInt = sum(scoresInt,1)* 0.7; +!resInt = mean(scoresInt) +!stdInt = sqrt(var(scoresInt)./10) diff --git a/Tallies/scoreMemory_class.f90 b/Tallies/scoreMemory_class.f90 index 6b8d15a54..feb195f75 100644 --- a/Tallies/scoreMemory_class.f90 +++ b/Tallies/scoreMemory_class.f90 @@ -1,449 +1,449 @@ -module scoreMemory_class - - use numPrecision - use universalVariables, only : array_pad - use genericProcedures, only : fatalError, numToChar - use openmp_func, only : ompGetMaxThreads, ompGetThreadNum - - implicit none - private - - !! Parameters for indexes of per cycle SCORE, Cumulative Sum and Cumulative Sum of squares - integer(shortInt), parameter :: CSUM = 1, & - CSUM2 = 2 - - !! Size of the 2nd Dimension of bins - integer(shortInt), parameter :: DIM2 = 2 - - - !! - !! scoreMemory is a class that stores space for scores from tallies. - !! It is separate from tallyClerks and individual responses to allow: - !! -> Easy writing and (later) reading from file for archivisation of results - !! -> Easy possibility of extention to tally higher moments of result - !! -> Possibility of extension to tally covariance of selected tally bins - !! -> Easy copying and recombination of results for OpenMP shared memory parallelism - !! -> Easy, output format-independent way to perform regression tests - !! -> Easy handling of different batch sizes - !! - !! For every bin index there are two positions: CSUM, CSUM2. All are initialised to 0. - !! For scoring, an array is created with dimension (Nbins,nThreads) to mitigate false sharing. - !! On accumulation, this array adds to the normal bin array. - !! - !! Interface: - !! init(N,idBS): Initialise with integer size N and integer id. Optional integer Batch Size. - !! - !! kill(): Elemental. Return to uninitialised state. - !! - !! score(score,idx): Score in the bin under idx. FatalError if idx is outside bounds. Score - !! is defReal, shortInt or longInt - !! - !! accumulate(score,idx): Accumulate result in cumulative sums in bin under idx. FatalError - !! if idx is outside bounds. Score is defReal, shortInt or longInt. - !! - !! getResult(mean, STD, idx, samples): Retrieve mean value and standard deviation of the - !! estimate under idx. Use optional samples to specify number of estimates used to - !! evaluate mean and STD from default, which is number of batches in score memory. - !! STD is optional. - !! - !! getScore(idx): Return current value of score from bin under idx. FatalError if idx is - !! outside bounds. - !! - !! closeBin(normFactor,idx): Multiplies score under bin by normFactor and accumulates it in - !! cumulative sums. Then sets the bin to zero. - !! - !! closeCycle(normFactor): Multiplies all scores by normFactor and accumulates them in - !! cumulative sums. Sets all scors to zero. - !! - !! lastCycle(): Return true if the next call to closeCycle will close a batch. - !! - !! getBatchSize(): Returns number of cycles that constitute a single batch. - !! - !! Example use case: - !! - !! do batches=1,20 - !! do hist=1,10 - !! call scoreMem % score(hist,1) ! Score hist (1,10) in bin 1 - !! call scoreMem % accumulate(hist,2) ! Accumulate hist in CSUMs of bin 2 - !! end do - !! call scoreMem % closeCycle(ONE) ! Close batch without normalisation (factor = ONE) - !! end do - !! - !! call scoreMem % getResult(mean,STD,1) ! Get result from bin 1 with STD - !! call scoreMem % getResult(mean,2,200) ! Get mean from bin 2 assuming 200 samples - !! - !! NOTE: Following indexing is used in bins class member - !! bins(binIndex,binType) binType is CSUM/CSUM2 - !! NOTE2: If batch size is not a denominator of cycles scored results accumulated - !! in extra cycles are discarded in current implementation - !! - type, public :: scoreMemory - !private - real(defReal),dimension(:,:),allocatable :: bins !! Space for storing cumul data (2nd dim size is always 2!) - real(defReal),dimension(:,:),allocatable :: parallelBins !! Space for scoring for different threads - integer(longInt) :: N = 0 !! Size of memory (number of bins) - integer(shortInt) :: nThreads = 0 !! Number of threads used for parallelBins - integer(shortInt) :: id !! Id of the tally - integer(shortInt) :: batchN = 0 !! Number of Batches - integer(shortInt) :: cycles = 0 !! Cycles counter - integer(shortInt) :: batchSize = 1 !! Batch interval size (in cycles) - contains - ! Interface procedures - procedure :: init - procedure :: kill - generic :: score => score_defReal, score_shortInt, score_longInt - generic :: accumulate => accumulate_defReal, accumulate_shortInt, accumulate_longInt - generic :: getResult => getResult_withSTD, getResult_withoutSTD - procedure :: getScore - procedure :: closeCycle - procedure :: closeBin - procedure :: lastCycle - procedure :: getBatchSize - - ! Private procedures - procedure, private :: score_defReal - procedure, private :: score_shortInt - procedure, private :: score_longInt - procedure, private :: accumulate_defReal - procedure, private :: accumulate_shortInt - procedure, private :: accumulate_longInt - procedure, private :: getResult_withSTD - procedure, private :: getResult_withoutSTD - - end type scoreMemory - -contains - - !! - !! Allocate space for the bins given number of bins N - !! Optionaly change batchSize from 1 to any +ve number - !! - subroutine init(self, N, id, batchSize ) - class(scoreMemory),intent(inout) :: self - integer(longInt),intent(in) :: N - integer(shortInt),intent(in) :: id - integer(shortInt),optional,intent(in) :: batchSize - character(100), parameter :: Here= 'init (scoreMemory_class.f90)' - - ! Allocate space and zero all bins - allocate( self % bins(N, DIM2)) - self % bins = ZERO - - self % nThreads = ompGetMaxThreads() - - ! Note the array padding to avoid false sharing - allocate( self % parallelBins(N + array_pad, self % nThreads)) - self % parallelBins = ZERO - - ! Save size of memory - self % N = N - - ! Assign memory id - self % id = id - - ! Set batchN, cycles and batchSize to default values - self % batchN = 0 - self % cycles = 0 - self % batchSize = 1 - - if(present(batchSize)) then - if(batchSize > 0) then - self % batchSize = batchSize - else - call fatalError(Here,'Batch Size of: '// numToChar(batchSize) //' is invalid') - end if - end if - - end subroutine init - - !! - !! Deallocate memory and return to uninitialised state - !! - subroutine kill(self) - class(scoreMemory), intent(inout) :: self - - if(allocated(self % bins)) deallocate(self % bins) - if(allocated(self % parallelBins)) deallocate(self % parallelBins) - self % N = 0 - self % nThreads = 0 - self % batchN = 0 - - end subroutine kill - - !! - !! Score a result on a given single bin under idx - !! - subroutine score_defReal(self, score, idx) - class(scoreMemory), intent(inout) :: self - real(defReal), intent(in) :: score - integer(longInt), intent(in) :: idx - integer(shortInt) :: thread_idx - character(100),parameter :: Here = 'score_defReal (scoreMemory_class.f90)' - - ! Verify bounds for the index - if( idx < 0_longInt .or. idx > self % N) then - call fatalError(Here,'Index '//numToChar(idx)//' is outside bounds of & - & memory with size '//numToChar(self % N)) - end if - - ! Add the score - thread_idx = ompGetThreadNum() + 1 - self % parallelBins(idx, thread_idx) = & - self % parallelBins(idx, thread_idx) + score - - end subroutine score_defReal - - !! - !! Score a result with shortInt on a given bin under idx - !! - subroutine score_shortInt(self, score, idx) - class(scoreMemory), intent(inout) :: self - integer(shortInt), intent(in) :: score - integer(longInt), intent(in) :: idx - - call self % score_defReal(real(score, defReal), idx) - - end subroutine score_shortInt - - !! - !! Score a result with longInt on a given bin under idx - !! - subroutine score_longInt(self, score, idx) - class(scoreMemory), intent(inout) :: self - integer(longInt), intent(in) :: score - integer(longInt), intent(in) :: idx - - call self % score_defReal(real(score, defReal), idx) - - end subroutine score_longInt - - !! - !! Increment the result directly on cumulative sums - !! - subroutine accumulate_defReal(self, score, idx) - class(scoreMemory), intent(inout) :: self - real(defReal), intent(in) :: score - integer(longInt), intent(in) :: idx - character(100),parameter :: Here = 'accumulate_defReal (scoreMemory_class.f90)' - - ! Verify bounds for the index - if( idx < 0_longInt .or. idx > self % N) then - call fatalError(Here,'Index '//numToChar(idx)//' is outside bounds of & - & memory with size '//numToChar(self % N)) - end if - - ! Add the score - self % bins(idx, CSUM) = self % bins(idx, CSUM) + score - self % bins(idx, CSUM2) = self % bins(idx, CSUM2) + score * score - - end subroutine accumulate_defReal - - !! - !! Increment the result directly on cumulative sums with shortInt score - !! - subroutine accumulate_shortInt(self, score, idx) - class(scoreMemory), intent(inout) :: self - integer(shortInt), intent(in) :: score - integer(longInt), intent(in) :: idx - - call self % accumulate_defReal(real(score, defReal), idx) - - end subroutine accumulate_shortInt - - !! - !! Increment the result directly on cumulative sums with longInt score - !! - subroutine accumulate_longInt(self, score, idx) - class(scoreMemory), intent(inout) :: self - integer(longInt), intent(in) :: score - integer(longInt), intent(in) :: idx - - call self % accumulate_defReal(real(score, defReal), idx) - - end subroutine accumulate_longInt - - !! - !! Close Cycle - !! Increments cycle counter and detects end-of-batch - !! When batch finishes it normalises all scores by the factor and moves them to CSUMs - !! - subroutine closeCycle(self, normFactor) - class(scoreMemory), intent(inout) :: self - real(defReal),intent(in) :: normFactor - integer(longInt) :: i - real(defReal), save :: res - !$omp threadprivate(res) - - ! Increment Cycle Counter - self % cycles = self % cycles + 1 - - if(mod(self % cycles, self % batchSize) == 0) then ! Close Batch - - !$omp parallel do - do i = 1, self % N - - ! Normalise scores - self % parallelBins(i,:) = self % parallelBins(i,:) * normFactor - res = sum(self % parallelBins(i,:)) - - ! Zero all score bins - self % parallelBins(i,:) = ZERO - - ! Increment cumulative sums - self % bins(i,CSUM) = self % bins(i,CSUM) + res - self % bins(i,CSUM2) = self % bins(i,CSUM2) + res * res - - end do - !$omp end parallel do - - ! Increment batch counter - self % batchN = self % batchN + 1 - - end if - - end subroutine closeCycle - - !! - !! Close Cycle - !! Multiplies score in bin under idx by normFactor, accumulates it and sets it to zero - !! - subroutine closeBin(self, normFactor, idx) - class(scoreMemory), intent(inout) :: self - real(defReal),intent(in) :: normFactor - integer(longInt), intent(in) :: idx - real(defReal) :: res - character(100),parameter :: Here = 'closeBin (scoreMemory_class.f90)' - - ! Verify bounds for the index - if( idx < 0_longInt .or. idx > self % N) then - call fatalError(Here,'Index '//numToChar(idx)//' is outside bounds of & - & memory with size '//numToChar(self % N)) - end if - - ! Normalise score - self % parallelBins(idx, :) = self % parallelBins(idx, :) * normFactor - - ! Increment cumulative sum - res = sum(self % parallelBins(idx,:)) - self % bins(idx,CSUM) = self % bins(idx,CSUM) + res - self % bins(idx,CSUM2) = self % bins(idx,CSUM2) + res * res - - ! Zero the score - self % parallelBins(idx,:) = ZERO - - end subroutine closeBin - - - !! - !! Return true if next closeCycle will close a batch - !! - function lastCycle(self) result(isIt) - class(scoreMemory), intent(in) :: self - logical(defBool) :: isIt - - isIt = mod(self % cycles + 1, self % batchSize) == 0 - - end function lastCycle - - !! - !! Return batchSize - !! - pure function getBatchSize(self) result(S) - class(scoreMemory), intent(in) :: self - integer(shortInt) :: S - - S = self % batchSize - - end function getBatchSize - - !! - !! Load mean result and Standard deviation into provided arguments - !! Load from bin indicated by idx - !! Returns 0 if index is invalid - !! - elemental subroutine getResult_withSTD(self, mean, STD, idx, samples) - class(scoreMemory), intent(in) :: self - real(defReal), intent(out) :: mean - real(defReal),intent(out) :: STD - integer(longInt), intent(in) :: idx - integer(shortInt), intent(in),optional :: samples - integer(shortInt) :: N - real(defReal) :: inv_N, inv_Nm1 - - !! Verify index. Return 0 if not present - if( idx < 0_longInt .or. idx > self % N) then - mean = ZERO - STD = ZERO - return - end if - - ! Check if # of samples is provided - if( present(samples)) then - N = samples - else - N = self % batchN - end if - - ! Calculate mean - mean = self % bins(idx, CSUM) / N - - ! Calculate STD - inv_N = ONE / N - if( N /= 1) then - inv_Nm1 = ONE / (N - 1) - else - inv_Nm1 = ONE - end if - STD = self % bins(idx, CSUM2) *inv_N * inv_Nm1 - mean * mean * inv_Nm1 - STD = sqrt(STD) - - end subroutine getResult_withSTD - - !! - !! Load mean result provided argument - !! Load from bin indicated by idx - !! Returns 0 if index is invalid - !! - elemental subroutine getResult_withoutSTD(self, mean, idx, samples) - class(scoreMemory), intent(in) :: self - real(defReal), intent(out) :: mean - integer(longInt), intent(in) :: idx - integer(shortInt), intent(in),optional :: samples - integer(shortInt) :: N - - !! Verify index. Return 0 if not present - if( idx < 0_longInt .or. idx > self % N) then - mean = ZERO - return - end if - - ! Check if # of samples is provided - if( present(samples)) then - N = samples - else - N = self % batchN - end if - - ! Calculate mean - mean = self % bins(idx, CSUM) / N - - end subroutine getResult_withoutSTD - - !! - !! Obtain value of a score in a bin - !! Return ZERO for invalid bin address (idx) - !! - elemental function getScore(self, idx) result (score) - class(scoreMemory), intent(in) :: self - integer(longInt), intent(in) :: idx - real(defReal) :: score - - if(idx <= 0_longInt .or. idx > self % N) then - score = ZERO - else - score = sum(self % parallelBins(idx, :)) - end if - - end function getScore - -end module scoreMemory_class +module scoreMemory_class + + use numPrecision + use universalVariables, only : array_pad + use genericProcedures, only : fatalError, numToChar + use openmp_func, only : ompGetMaxThreads, ompGetThreadNum + + implicit none + private + + !! Parameters for indexes of per cycle SCORE, Cumulative Sum and Cumulative Sum of squares + integer(shortInt), parameter :: CSUM = 1, & + CSUM2 = 2 + + !! Size of the 2nd Dimension of bins + integer(shortInt), parameter :: DIM2 = 2 + + + !! + !! scoreMemory is a class that stores space for scores from tallies. + !! It is separate from tallyClerks and individual responses to allow: + !! -> Easy writing and (later) reading from file for archivisation of results + !! -> Easy possibility of extention to tally higher moments of result + !! -> Possibility of extension to tally covariance of selected tally bins + !! -> Easy copying and recombination of results for OpenMP shared memory parallelism + !! -> Easy, output format-independent way to perform regression tests + !! -> Easy handling of different batch sizes + !! + !! For every bin index there are two positions: CSUM, CSUM2. All are initialised to 0. + !! For scoring, an array is created with dimension (Nbins,nThreads) to mitigate false sharing. + !! On accumulation, this array adds to the normal bin array. + !! + !! Interface: + !! init(N,idBS): Initialise with integer size N and integer id. Optional integer Batch Size. + !! + !! kill(): Elemental. Return to uninitialised state. + !! + !! score(score,idx): Score in the bin under idx. FatalError if idx is outside bounds. Score + !! is defReal, shortInt or longInt + !! + !! accumulate(score,idx): Accumulate result in cumulative sums in bin under idx. FatalError + !! if idx is outside bounds. Score is defReal, shortInt or longInt. + !! + !! getResult(mean, STD, idx, samples): Retrieve mean value and standard deviation of the + !! estimate under idx. Use optional samples to specify number of estimates used to + !! evaluate mean and STD from default, which is number of batches in score memory. + !! STD is optional. + !! + !! getScore(idx): Return current value of score from bin under idx. FatalError if idx is + !! outside bounds. + !! + !! closeBin(normFactor,idx): Multiplies score under bin by normFactor and accumulates it in + !! cumulative sums. Then sets the bin to zero. + !! + !! closeCycle(normFactor): Multiplies all scores by normFactor and accumulates them in + !! cumulative sums. Sets all scors to zero. + !! + !! lastCycle(): Return true if the next call to closeCycle will close a batch. + !! + !! getBatchSize(): Returns number of cycles that constitute a single batch. + !! + !! Example use case: + !! + !! do batches=1,20 + !! do hist=1,10 + !! call scoreMem % score(hist,1) ! Score hist (1,10) in bin 1 + !! call scoreMem % accumulate(hist,2) ! Accumulate hist in CSUMs of bin 2 + !! end do + !! call scoreMem % closeCycle(ONE) ! Close batch without normalisation (factor = ONE) + !! end do + !! + !! call scoreMem % getResult(mean,STD,1) ! Get result from bin 1 with STD + !! call scoreMem % getResult(mean,2,200) ! Get mean from bin 2 assuming 200 samples + !! + !! NOTE: Following indexing is used in bins class member + !! bins(binIndex,binType) binType is CSUM/CSUM2 + !! NOTE2: If batch size is not a denominator of cycles scored results accumulated + !! in extra cycles are discarded in current implementation + !! + type, public :: scoreMemory + !private + real(defReal),dimension(:,:),allocatable :: bins !! Space for storing cumul data (2nd dim size is always 2!) + real(defReal),dimension(:,:),allocatable :: parallelBins !! Space for scoring for different threads + integer(longInt) :: N = 0 !! Size of memory (number of bins) + integer(shortInt) :: nThreads = 0 !! Number of threads used for parallelBins + integer(shortInt) :: id !! Id of the tally + integer(shortInt) :: batchN = 0 !! Number of Batches + integer(shortInt) :: cycles = 0 !! Cycles counter + integer(shortInt) :: batchSize = 1 !! Batch interval size (in cycles) + contains + ! Interface procedures + procedure :: init + procedure :: kill + generic :: score => score_defReal, score_shortInt, score_longInt + generic :: accumulate => accumulate_defReal, accumulate_shortInt, accumulate_longInt + generic :: getResult => getResult_withSTD, getResult_withoutSTD + procedure :: getScore + procedure :: closeCycle + procedure :: closeBin + procedure :: lastCycle + procedure :: getBatchSize + + ! Private procedures + procedure, private :: score_defReal + procedure, private :: score_shortInt + procedure, private :: score_longInt + procedure, private :: accumulate_defReal + procedure, private :: accumulate_shortInt + procedure, private :: accumulate_longInt + procedure, private :: getResult_withSTD + procedure, private :: getResult_withoutSTD + + end type scoreMemory + +contains + + !! + !! Allocate space for the bins given number of bins N + !! Optionaly change batchSize from 1 to any +ve number + !! + subroutine init(self, N, id, batchSize ) + class(scoreMemory),intent(inout) :: self + integer(longInt),intent(in) :: N + integer(shortInt),intent(in) :: id + integer(shortInt),optional,intent(in) :: batchSize + character(100), parameter :: Here= 'init (scoreMemory_class.f90)' + + ! Allocate space and zero all bins + allocate( self % bins(N, DIM2)) + self % bins = ZERO + + self % nThreads = ompGetMaxThreads() + + ! Note the array padding to avoid false sharing + allocate( self % parallelBins(N + array_pad, self % nThreads)) + self % parallelBins = ZERO + + ! Save size of memory + self % N = N + + ! Assign memory id + self % id = id + + ! Set batchN, cycles and batchSize to default values + self % batchN = 0 + self % cycles = 0 + self % batchSize = 1 + + if(present(batchSize)) then + if(batchSize > 0) then + self % batchSize = batchSize + else + call fatalError(Here,'Batch Size of: '// numToChar(batchSize) //' is invalid') + end if + end if + + end subroutine init + + !! + !! Deallocate memory and return to uninitialised state + !! + subroutine kill(self) + class(scoreMemory), intent(inout) :: self + + if(allocated(self % bins)) deallocate(self % bins) + if(allocated(self % parallelBins)) deallocate(self % parallelBins) + self % N = 0 + self % nThreads = 0 + self % batchN = 0 + + end subroutine kill + + !! + !! Score a result on a given single bin under idx + !! + subroutine score_defReal(self, score, idx) + class(scoreMemory), intent(inout) :: self + real(defReal), intent(in) :: score + integer(longInt), intent(in) :: idx + integer(shortInt) :: thread_idx + character(100),parameter :: Here = 'score_defReal (scoreMemory_class.f90)' + + ! Verify bounds for the index + if( idx < 0_longInt .or. idx > self % N) then + call fatalError(Here,'Index '//numToChar(idx)//' is outside bounds of & + & memory with size '//numToChar(self % N)) + end if + + ! Add the score + thread_idx = ompGetThreadNum() + 1 + self % parallelBins(idx, thread_idx) = & + self % parallelBins(idx, thread_idx) + score + + end subroutine score_defReal + + !! + !! Score a result with shortInt on a given bin under idx + !! + subroutine score_shortInt(self, score, idx) + class(scoreMemory), intent(inout) :: self + integer(shortInt), intent(in) :: score + integer(longInt), intent(in) :: idx + + call self % score_defReal(real(score, defReal), idx) + + end subroutine score_shortInt + + !! + !! Score a result with longInt on a given bin under idx + !! + subroutine score_longInt(self, score, idx) + class(scoreMemory), intent(inout) :: self + integer(longInt), intent(in) :: score + integer(longInt), intent(in) :: idx + + call self % score_defReal(real(score, defReal), idx) + + end subroutine score_longInt + + !! + !! Increment the result directly on cumulative sums + !! + subroutine accumulate_defReal(self, score, idx) + class(scoreMemory), intent(inout) :: self + real(defReal), intent(in) :: score + integer(longInt), intent(in) :: idx + character(100),parameter :: Here = 'accumulate_defReal (scoreMemory_class.f90)' + + ! Verify bounds for the index + if( idx < 0_longInt .or. idx > self % N) then + call fatalError(Here,'Index '//numToChar(idx)//' is outside bounds of & + & memory with size '//numToChar(self % N)) + end if + + ! Add the score + self % bins(idx, CSUM) = self % bins(idx, CSUM) + score + self % bins(idx, CSUM2) = self % bins(idx, CSUM2) + score * score + + end subroutine accumulate_defReal + + !! + !! Increment the result directly on cumulative sums with shortInt score + !! + subroutine accumulate_shortInt(self, score, idx) + class(scoreMemory), intent(inout) :: self + integer(shortInt), intent(in) :: score + integer(longInt), intent(in) :: idx + + call self % accumulate_defReal(real(score, defReal), idx) + + end subroutine accumulate_shortInt + + !! + !! Increment the result directly on cumulative sums with longInt score + !! + subroutine accumulate_longInt(self, score, idx) + class(scoreMemory), intent(inout) :: self + integer(longInt), intent(in) :: score + integer(longInt), intent(in) :: idx + + call self % accumulate_defReal(real(score, defReal), idx) + + end subroutine accumulate_longInt + + !! + !! Close Cycle + !! Increments cycle counter and detects end-of-batch + !! When batch finishes it normalises all scores by the factor and moves them to CSUMs + !! + subroutine closeCycle(self, normFactor) + class(scoreMemory), intent(inout) :: self + real(defReal),intent(in) :: normFactor + integer(longInt) :: i + real(defReal), save :: res + !$omp threadprivate(res) + + ! Increment Cycle Counter + self % cycles = self % cycles + 1 + + if(mod(self % cycles, self % batchSize) == 0) then ! Close Batch + + !$omp parallel do + do i = 1, self % N + + ! Normalise scores + self % parallelBins(i,:) = self % parallelBins(i,:) * normFactor + res = sum(self % parallelBins(i,:)) + + ! Zero all score bins + self % parallelBins(i,:) = ZERO + + ! Increment cumulative sums + self % bins(i,CSUM) = self % bins(i,CSUM) + res + self % bins(i,CSUM2) = self % bins(i,CSUM2) + res * res + + end do + !$omp end parallel do + + ! Increment batch counter + self % batchN = self % batchN + 1 + + end if + + end subroutine closeCycle + + !! + !! Close Cycle + !! Multiplies score in bin under idx by normFactor, accumulates it and sets it to zero + !! + subroutine closeBin(self, normFactor, idx) + class(scoreMemory), intent(inout) :: self + real(defReal),intent(in) :: normFactor + integer(longInt), intent(in) :: idx + real(defReal) :: res + character(100),parameter :: Here = 'closeBin (scoreMemory_class.f90)' + + ! Verify bounds for the index + if( idx < 0_longInt .or. idx > self % N) then + call fatalError(Here,'Index '//numToChar(idx)//' is outside bounds of & + & memory with size '//numToChar(self % N)) + end if + + ! Normalise score + self % parallelBins(idx, :) = self % parallelBins(idx, :) * normFactor + + ! Increment cumulative sum + res = sum(self % parallelBins(idx,:)) + self % bins(idx,CSUM) = self % bins(idx,CSUM) + res + self % bins(idx,CSUM2) = self % bins(idx,CSUM2) + res * res + + ! Zero the score + self % parallelBins(idx,:) = ZERO + + end subroutine closeBin + + + !! + !! Return true if next closeCycle will close a batch + !! + function lastCycle(self) result(isIt) + class(scoreMemory), intent(in) :: self + logical(defBool) :: isIt + + isIt = mod(self % cycles + 1, self % batchSize) == 0 + + end function lastCycle + + !! + !! Return batchSize + !! + pure function getBatchSize(self) result(S) + class(scoreMemory), intent(in) :: self + integer(shortInt) :: S + + S = self % batchSize + + end function getBatchSize + + !! + !! Load mean result and Standard deviation into provided arguments + !! Load from bin indicated by idx + !! Returns 0 if index is invalid + !! + elemental subroutine getResult_withSTD(self, mean, STD, idx, samples) + class(scoreMemory), intent(in) :: self + real(defReal), intent(out) :: mean + real(defReal),intent(out) :: STD + integer(longInt), intent(in) :: idx + integer(shortInt), intent(in),optional :: samples + integer(shortInt) :: N + real(defReal) :: inv_N, inv_Nm1 + + !! Verify index. Return 0 if not present + if( idx < 0_longInt .or. idx > self % N) then + mean = ZERO + STD = ZERO + return + end if + + ! Check if # of samples is provided + if( present(samples)) then + N = samples + else + N = self % batchN + end if + + ! Calculate mean + mean = self % bins(idx, CSUM) / N + + ! Calculate STD + inv_N = ONE / N + if( N /= 1) then + inv_Nm1 = ONE / (N - 1) + else + inv_Nm1 = ONE + end if + STD = self % bins(idx, CSUM2) *inv_N * inv_Nm1 - mean * mean * inv_Nm1 + STD = sqrt(STD) + + end subroutine getResult_withSTD + + !! + !! Load mean result provided argument + !! Load from bin indicated by idx + !! Returns 0 if index is invalid + !! + elemental subroutine getResult_withoutSTD(self, mean, idx, samples) + class(scoreMemory), intent(in) :: self + real(defReal), intent(out) :: mean + integer(longInt), intent(in) :: idx + integer(shortInt), intent(in),optional :: samples + integer(shortInt) :: N + + !! Verify index. Return 0 if not present + if( idx < 0_longInt .or. idx > self % N) then + mean = ZERO + return + end if + + ! Check if # of samples is provided + if( present(samples)) then + N = samples + else + N = self % batchN + end if + + ! Calculate mean + mean = self % bins(idx, CSUM) / N + + end subroutine getResult_withoutSTD + + !! + !! Obtain value of a score in a bin + !! Return ZERO for invalid bin address (idx) + !! + elemental function getScore(self, idx) result (score) + class(scoreMemory), intent(in) :: self + integer(longInt), intent(in) :: idx + real(defReal) :: score + + if(idx <= 0_longInt .or. idx > self % N) then + score = ZERO + else + score = sum(self % parallelBins(idx, :)) + end if + + end function getScore + +end module scoreMemory_class diff --git a/TransportOperator/transportOperatorDT_class.f90 b/TransportOperator/transportOperatorDT_class.f90 index 0e1064f1a..dab5ea602 100644 --- a/TransportOperator/transportOperatorDT_class.f90 +++ b/TransportOperator/transportOperatorDT_class.f90 @@ -1,92 +1,92 @@ -!! -!! Transport operator for delta tracking -!! -module transportOperatorDT_class - use numPrecision - use universalVariables - - use genericProcedures, only : fatalError, numToChar - use particle_class, only : particle - use particleDungeon_class, only : particleDungeon - use dictionary_class, only : dictionary - use rng_class, only : rng - - ! Superclass - use transportOperator_inter, only : transportOperator - - ! Geometry interfaces - use geometry_inter, only : geometry - - ! Tally interface - use tallyCodes - use tallyAdmin_class, only : tallyAdmin - - ! Nuclear data interfaces - use nuclearDatabase_inter, only : nuclearDatabase - - implicit none - private - - !! - !! Transport operator that moves a particle with delta tracking - !! - type, public, extends(transportOperator) :: transportOperatorDT - contains - procedure :: transit => deltaTracking - end type transportOperatorDT - -contains - - subroutine deltaTracking(self, p, tally, thisCycle, nextCycle) - class(transportOperatorDT), intent(inout) :: self - class(particle), intent(inout) :: p - type(tallyAdmin), intent(inout) :: tally - class(particleDungeon), intent(inout) :: thisCycle - class(particleDungeon), intent(inout) :: nextCycle - real(defReal) :: majorant_inv, sigmaT, distance - character(100), parameter :: Here = 'deltaTracking (transportOIperatorDT_class.f90)' - - ! Get majornat XS inverse: 1/Sigma_majorant - majorant_inv = ONE / self % xsData % getMajorantXS(p) - - DTLoop:do - distance = -log( p% pRNG % get() ) * majorant_inv - - ! Move partice in the geometry - call self % geom % teleport(p % coords, distance) - - ! If particle has leaked exit - if (p % matIdx() == OUTSIDE_FILL) then - p % fate = LEAK_FATE - p % isDead = .true. - return - end if - - ! Check for void - if( p % matIdx() == VOID_MAT) cycle DTLoop - - ! Give error if the particle somehow ended in an undefined material - if (p % matIdx() == UNDEF_MAT) then - print *, p % rGlobal() - call fatalError(Here, "Particle is in undefined material") - end if - - ! Obtain the local cross-section - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - - ! Protect Against Sillines - !if( sigmaT*majorant_inv < ZERO .or. ONE < sigmaT*majorant_inv) then - ! call fatalError(Here, "TotalXS/MajorantXS is silly: "//numToChar(sigmaT*majorant_inv)) - !end if - - ! Roll RNG to determine if the collision is real or virtual - ! Exit the loop if the collision is real - if (p % pRNG % get() < sigmaT*majorant_inv) exit DTLoop - - end do DTLoop - - call tally % reportTrans(p) - end subroutine deltaTracking - - -end module transportOperatorDT_class +!! +!! Transport operator for delta tracking +!! +module transportOperatorDT_class + use numPrecision + use universalVariables + + use genericProcedures, only : fatalError, numToChar + use particle_class, only : particle + use particleDungeon_class, only : particleDungeon + use dictionary_class, only : dictionary + use rng_class, only : rng + + ! Superclass + use transportOperator_inter, only : transportOperator + + ! Geometry interfaces + use geometry_inter, only : geometry + + ! Tally interface + use tallyCodes + use tallyAdmin_class, only : tallyAdmin + + ! Nuclear data interfaces + use nuclearDatabase_inter, only : nuclearDatabase + + implicit none + private + + !! + !! Transport operator that moves a particle with delta tracking + !! + type, public, extends(transportOperator) :: transportOperatorDT + contains + procedure :: transit => deltaTracking + end type transportOperatorDT + +contains + + subroutine deltaTracking(self, p, tally, thisCycle, nextCycle) + class(transportOperatorDT), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + class(particleDungeon), intent(inout) :: thisCycle + class(particleDungeon), intent(inout) :: nextCycle + real(defReal) :: majorant_inv, sigmaT, distance + character(100), parameter :: Here = 'deltaTracking (transportOIperatorDT_class.f90)' + + ! Get majornat XS inverse: 1/Sigma_majorant + majorant_inv = ONE / self % xsData % getMajorantXS(p) + + DTLoop:do + distance = -log( p% pRNG % get() ) * majorant_inv + + ! Move partice in the geometry + call self % geom % teleport(p % coords, distance) + + ! If particle has leaked exit + if (p % matIdx() == OUTSIDE_FILL) then + p % fate = LEAK_FATE + p % isDead = .true. + return + end if + + ! Check for void + if( p % matIdx() == VOID_MAT) cycle DTLoop + + ! Give error if the particle somehow ended in an undefined material + if (p % matIdx() == UNDEF_MAT) then + print *, p % rGlobal() + call fatalError(Here, "Particle is in undefined material") + end if + + ! Obtain the local cross-section + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + + ! Protect Against Sillines + !if( sigmaT*majorant_inv < ZERO .or. ONE < sigmaT*majorant_inv) then + ! call fatalError(Here, "TotalXS/MajorantXS is silly: "//numToChar(sigmaT*majorant_inv)) + !end if + + ! Roll RNG to determine if the collision is real or virtual + ! Exit the loop if the collision is real + if (p % pRNG % get() < sigmaT*majorant_inv) exit DTLoop + + end do DTLoop + + call tally % reportTrans(p) + end subroutine deltaTracking + + +end module transportOperatorDT_class diff --git a/TransportOperator/transportOperatorOLD_class.f90 b/TransportOperator/transportOperatorOLD_class.f90 index a4baef4a1..e7cdfe151 100644 --- a/TransportOperator/transportOperatorOLD_class.f90 +++ b/TransportOperator/transportOperatorOLD_class.f90 @@ -1,430 +1,430 @@ -! -! Transport operator - determines how a neutron moves from point r' to r -! given initial energy and direction -! -! - -module transportOperator_class - use numPrecision - use genericProcedures - use universalVariables - - use coord_class - use particle_class - use surface_class - use geometry_class - use cell_class - use universe_class - use rng_class - use lattice_class - - !use Nuclear_Data_MG_class !Re-instate later!!! - !use Nuclear_Data_CE_class - use geometry_class - - implicit none - private - - - type, public :: transportOperator - private - class(rng), pointer :: random => null() ! RNG - should this be associated to particle? - !class(Nuclear_data_MG), pointer :: MGData => null() ! multi-group data - !class(Nuclear_data_CE), pointer :: CEData => null() ! continuous energy data - class(geometry), pointer :: geom => null() ! references the geometry for cell searching - logical :: isDT = .true. ! perform delta tracking? - contains - procedure :: initMG - procedure :: performTransport - procedure :: getSigmaT - procedure :: getMajorant - procedure :: deltaTracking - procedure :: surfaceTracking - procedure :: applyBCsDT - procedure :: applyBCsST - procedure :: walk - end type transportOperator - -contains - - !! - !! Initialise for multi-group data - !! - subroutine initMG(self, random, geom) !return nuclearData at some point! - class(transportOperator), intent(inout) :: self - !class(Nuclear_data_MG), target :: nuclearData - class(rng), target :: random - class(geometry), target :: geom - - self%random => random - !self%MGData => nuclearData - self%geom => geom - - end subroutine initMG - - !! - !! Find the total cross-section from the nuclear data provided, continuous or multi-group - !! - function getSigmaT(self,p)result(sigmaT) - class(transportOperator), intent(in) :: self - class(particle), intent(in) :: p - real(defReal) :: sigmaT - - if (p % isMG) then - !sigmaT = self % MGData % giveTotalXS(p) - sigmaT = 0.6 - return - else - !sigmaT = self % CEData % giveTotalXS(p) - sigmaT = 0.6 - return - end if - - end function getSigmaT - - !! - !! Find the majorant cross-section from the nuclear data provided, continuous or multi-group - !! - function getMajorant(self,p)result(majorant) - class(transportOperator), intent(in) :: self - class(particle), intent(in) :: p - real(defReal) :: majorant - - if (p % isMG) then - !majorant = self % MGData % giveMajorantXS(p) - majorant = 0.8 - return - else - !majorant = self % CEData % giveMajorantXS(p) - majorant = 0.8 - return - end if - - end function getMajorant - - !! - !! Transport particle from r' to r given current direction and energy - !! - subroutine performTransport(self,p) - class(transportOperator), intent(in) :: self - class(particle), intent(inout) :: p - - if (self % isDT) then - call self % deltaTracking(p) - else - call self % surfaceTracking(p) - end if - - end subroutine performTransport - - !! - !! Performs delta tracking - !! - subroutine deltaTracking(self,p) - class(transportOperator), intent(in) :: self - class(particle), intent(inout) :: p - real(defReal) :: majorant, sigmaT, distance - type(cell_ptr) :: currentCell - - majorant = self % getMajorant(p) - DTLoop:do - distance = -log(self%random%get())/majorant - - ! Move particle to new location in the global co-ordinate systems - call p % moveGlobal(distance) - - ! Find the new cell which the particle occupies - currentCell = self % geom % whichCell(p%coords) - - ! If the particle is outside the geometry, apply boundary conditions - if (.not. currentCell % insideGeom()) then - call self % applyBCsDT(p, currentCell) - ! End the transport step if the particle is killed - if (p % isDead) then - exit DTLoop - end if - end if - - ! Obtain the local cross-section - sigmaT = self % getSigmaT(p) - - ! Roll RNG to determine if the collision is real or virtual - ! Exit the loop if the collision is real - if (self%random%get() < sigmaT/majorant) then - exit DTLoop - end if - end do DTLoop - - call currentCell % kill() - - end subroutine deltaTracking - - !! - !! Apply boundary conditions when using delta tracking - !! - subroutine applyBCsDT(self, p, currentCell) - class(transportOperator), intent(in) :: self - class(particle), intent(inout) :: p - class(cell_ptr), intent(inout) :: currentCell - type(surface_ptr) :: currentSurface - - ! Iterate until particle is either inside the geometry or dead - do while (.NOT. currentCell % insideGeom()) - ! Identify which surface the particle crossed at the highest geometry level - currentSurface = currentCell % whichSurface(p%rGlobal(), -p%dirGlobal()) - - ! Check the boundary conditions on the surface - ! If vacuum, kill the particle - if (currentSurface % isVacuum()) then - p % isDead = .TRUE. - - ! If reflective or periodic, must ensure that the surface is a plane! - else if (currentSurface % isReflective()) then - - ! Return particle to global coordinates and apply the reflective transform - call p % resetNesting() - call currentSurface % reflectiveTransform(p%coords%lvl(1)%r, p%coords%lvl(1)%dir) - - ! Identify which cell the particle now occupies - currentCell = self % geom % whichCell(p%coords) - - else if (currentSurface % isPeriodic()) then - - ! Return particle to gloabl coordinates and apply the periodic translation associated with the surface - call p % teleport(p % rGlobal() + currentSurface % periodicTranslation()) - - ! Identify which cell the particle now occupies - currentCell = self % geom % whichCell(p%coords) - - else - call fatalError('applyBCsDT','Could not identify correct boundary conditions') - end if - - end do - - ! The particle should no longer be sat on a surface - call currentSurface % kill() - - end subroutine applyBCsDT - - - !! - !! Performs surface tracking - !! - subroutine surfaceTracking(self,p) - class(transportOperator), intent(in) :: self - class(particle), intent(inout) :: p - real(defReal) :: sigmaT, distance, boundaryDistance, & - testDistance, latDistance, lDist - integer(shortInt) :: i, n, nMin, latIdx, iLat - type(cell_ptr) :: c, currentCell - type(lattice_ptr) :: lat - logical(defBool) :: moveUp - - STLoop: do - ! Obtain the local cross-section - sigmaT = self % getSigmaT(p) - - ! Calculate boundary distance: descend the different co-ordinate levels starting from the highest - ! Ensures bounds of parent cells are not exceeded - n = p % nesting() - nMin = 1 - boundaryDistance = INFINITY - latDistance = INFINITY - do i = 1,n - c = self % geom % cells(p % getCellIdx(i)) - testDistance = c % getDistance(p%rLocal(i), p%dirLocal(i)) - - ! Check if the particle is in a lattice cell - latIdx = p % getLatIdx(i) - if (latIdx > 0) then - lat = self % geom % lattices(latIdx) - lDist = lat % getDistance(p%rLocal(i), p%dirLocal(i)) - if (latDistance >= lDist) then - latDistance = lDist - iLat = i - 1 - end if - end if - - if (boundaryDistance > testDistance) then - boundaryDistance = testDistance - nMin = i - ! Must move up a level if crossing a lattice boundary - if (boundaryDistance > latDistance) then - nMin = iLat - boundaryDistance = latDistance - end if - end if - end do - call c % kill() - call lat % kill() - n = nMin - - ! Sample particle flight distance - distance = -log(self%random%get())/sigmaT - - ! The particle escapes the cell and moves to the next - !if (abs(boundaryDistance - distance)/boundaryDistance >= surface_tol) then - if (boundaryDistance <= distance) then - - ! Move particle to the surface with a small nudge to move across the boundary - call p % moveLocal(boundaryDistance + NUDGE, n) - - ! Find the new base cell which the particle occupies - currentCell = self % geom % whichCell(p%coords, n) - - ! If the particle is outside the geometry, apply boundary conditions - do while (.not. currentCell % insideGeom()) - call self % applyBCsST(p, currentCell) - ! End transport if the particle is killed - if (p % isDead) then - exit STLoop - end if - end do - - ! Continue performing surface tracking - cycle - - else - ! Move particle to new location - call p % moveLocal(distance, n) - exit STLoop - end if - end do STLoop - - call currentCell % kill() - - end subroutine surfaceTracking - - !! - !! Apply boundary conditions when using surface tracking - !! This routine may need checking for cases in which the boundary - !! is crossed repeatedly - !! - subroutine applyBCsST(self, p, currentCell) - class(transportOperator), intent(in) :: self - class(particle), intent(inout) :: p - class(cell_ptr), intent(inout) :: currentCell - type(surface_ptr) :: currentSurface - - ! Return to global coordinates - this may be a superfluous call!! - call p % resetNesting() - - ! Identify which surface the particle crossed at the highest geometry level - currentSurface = currentCell % whichSurface(p%rGlobal(), -p%dirGlobal()) - - ! Check the boundary conditions on the surface - ! If vacuum, kill the particle - if (currentSurface % isVacuum()) then - p % isDead = .TRUE. - call currentSurface % kill() - - ! If reflective or periodic, must ensure that the surface is a plane! - else if (currentSurface % isReflective()) then - - ! Move particle back to surface which it crossed at the highest geometry level - p%coords%lvl(1)%r = p%rGlobal() - NUDGE * p%dirGlobal() - - ! Reflect the particle's direction of travel at the highest geometry level - call currentSurface % reflect(p%coords%lvl(1)%r, p%coords%lvl(1)%dir) - - ! Nudge the particle to avoid problems at corners - call p % moveGlobal(NUDGE) - - ! Identify which cell the particle now occupies - currentCell = self % geom % whichCell(p%coords) - - ! The particle should no longer be sat on a surface - call currentSurface % kill() - - else if (currentSurface % isPeriodic()) then - - ! Apply the periodic translation associated with the surface - call p % teleport(p%rGlobal() + currentSurface % periodicTranslation() & - + NUDGE * p%dirGlobal()) - - ! Identify which cell the particle now occupies - currentCell = self % geom % whichCell(p%coords) - - ! The particle should no longer be sat on a surface - call currentSurface % kill() - - else - call fatalError('applyBCsST','Could not identify correct boundary conditions') - end if - - end subroutine applyBCsST - - !! - !! Walks the particle for a number of steps or until the particle is killed - !! Does this by surface tracking without accounting for material properties - !! - subroutine walk(self,p,steps) - class(transportOperator), intent(in) :: self - class(particle), intent(inout) :: p - integer(shortInt), intent(in) :: steps - real(defReal) :: boundaryDistance, testDistance, latDistance, lDist - integer(shortInt) :: i, n, nMin, step, latIdx, iLat - type(cell_ptr) :: c, currentCell - type(lattice_ptr) :: lat - - STLoop: do step =1,steps - - ! Calculate boundary distance: descend the different co-ordinate levels starting from the highest - ! Ensures bounds of parent cells are not exceeded - n = p % nesting() - nMin = 1 - boundaryDistance = INFINITY - latDistance = INFINITY - do i = 1,n - c = self % geom % cells(p % getCellIdx(i)) - testDistance = c % getDistance(p%rLocal(i), p%dirLocal(i)) - - ! Check if the particle is in a lattice cell - latIdx = p % getLatIdx(i) - if (latIdx > 0) then - lat = self % geom % lattices(latIdx) - lDist = lat % getDistance(p%rLocal(i), p%dirLocal(i)) - if (latDistance >= lDist) then - latDistance = lDist - iLat = i - 1 - end if - end if - - if (abs(boundaryDistance - testDistance)/boundaryDistance >= surface_tol) then - boundaryDistance = testDistance - nMin = i - ! Must move up a level if crossing a lattice boundary - if (boundaryDistance >= latDistance) then - nMin = iLat - boundaryDistance = latDistance - end if - end if - end do - call c % kill() - call lat % kill() - n = nMin - - ! Move particle to the surface with a small nudge to move across the boundary - call p % moveLocal(boundaryDistance + NUDGE, n) - - ! Find the new base cell which the particle occupies - currentCell = self % geom % whichCell(p%coords, n) - - ! If the particle is outside the geometry, apply boundary conditions - do while (.not. currentCell % insideGeom()) - call self % applyBCsST(p, currentCell) - ! End transport if the particle is killed - if (p % isDead) then - print *,'DEAD' - exit STLoop - end if - end do - - end do STLoop - - call currentCell % kill() - - end subroutine walk - -end module transportOperator_class +! +! Transport operator - determines how a neutron moves from point r' to r +! given initial energy and direction +! +! + +module transportOperator_class + use numPrecision + use genericProcedures + use universalVariables + + use coord_class + use particle_class + use surface_class + use geometry_class + use cell_class + use universe_class + use rng_class + use lattice_class + + !use Nuclear_Data_MG_class !Re-instate later!!! + !use Nuclear_Data_CE_class + use geometry_class + + implicit none + private + + + type, public :: transportOperator + private + class(rng), pointer :: random => null() ! RNG - should this be associated to particle? + !class(Nuclear_data_MG), pointer :: MGData => null() ! multi-group data + !class(Nuclear_data_CE), pointer :: CEData => null() ! continuous energy data + class(geometry), pointer :: geom => null() ! references the geometry for cell searching + logical :: isDT = .true. ! perform delta tracking? + contains + procedure :: initMG + procedure :: performTransport + procedure :: getSigmaT + procedure :: getMajorant + procedure :: deltaTracking + procedure :: surfaceTracking + procedure :: applyBCsDT + procedure :: applyBCsST + procedure :: walk + end type transportOperator + +contains + + !! + !! Initialise for multi-group data + !! + subroutine initMG(self, random, geom) !return nuclearData at some point! + class(transportOperator), intent(inout) :: self + !class(Nuclear_data_MG), target :: nuclearData + class(rng), target :: random + class(geometry), target :: geom + + self%random => random + !self%MGData => nuclearData + self%geom => geom + + end subroutine initMG + + !! + !! Find the total cross-section from the nuclear data provided, continuous or multi-group + !! + function getSigmaT(self,p)result(sigmaT) + class(transportOperator), intent(in) :: self + class(particle), intent(in) :: p + real(defReal) :: sigmaT + + if (p % isMG) then + !sigmaT = self % MGData % giveTotalXS(p) + sigmaT = 0.6 + return + else + !sigmaT = self % CEData % giveTotalXS(p) + sigmaT = 0.6 + return + end if + + end function getSigmaT + + !! + !! Find the majorant cross-section from the nuclear data provided, continuous or multi-group + !! + function getMajorant(self,p)result(majorant) + class(transportOperator), intent(in) :: self + class(particle), intent(in) :: p + real(defReal) :: majorant + + if (p % isMG) then + !majorant = self % MGData % giveMajorantXS(p) + majorant = 0.8 + return + else + !majorant = self % CEData % giveMajorantXS(p) + majorant = 0.8 + return + end if + + end function getMajorant + + !! + !! Transport particle from r' to r given current direction and energy + !! + subroutine performTransport(self,p) + class(transportOperator), intent(in) :: self + class(particle), intent(inout) :: p + + if (self % isDT) then + call self % deltaTracking(p) + else + call self % surfaceTracking(p) + end if + + end subroutine performTransport + + !! + !! Performs delta tracking + !! + subroutine deltaTracking(self,p) + class(transportOperator), intent(in) :: self + class(particle), intent(inout) :: p + real(defReal) :: majorant, sigmaT, distance + type(cell_ptr) :: currentCell + + majorant = self % getMajorant(p) + DTLoop:do + distance = -log(self%random%get())/majorant + + ! Move particle to new location in the global co-ordinate systems + call p % moveGlobal(distance) + + ! Find the new cell which the particle occupies + currentCell = self % geom % whichCell(p%coords) + + ! If the particle is outside the geometry, apply boundary conditions + if (.not. currentCell % insideGeom()) then + call self % applyBCsDT(p, currentCell) + ! End the transport step if the particle is killed + if (p % isDead) then + exit DTLoop + end if + end if + + ! Obtain the local cross-section + sigmaT = self % getSigmaT(p) + + ! Roll RNG to determine if the collision is real or virtual + ! Exit the loop if the collision is real + if (self%random%get() < sigmaT/majorant) then + exit DTLoop + end if + end do DTLoop + + call currentCell % kill() + + end subroutine deltaTracking + + !! + !! Apply boundary conditions when using delta tracking + !! + subroutine applyBCsDT(self, p, currentCell) + class(transportOperator), intent(in) :: self + class(particle), intent(inout) :: p + class(cell_ptr), intent(inout) :: currentCell + type(surface_ptr) :: currentSurface + + ! Iterate until particle is either inside the geometry or dead + do while (.NOT. currentCell % insideGeom()) + ! Identify which surface the particle crossed at the highest geometry level + currentSurface = currentCell % whichSurface(p%rGlobal(), -p%dirGlobal()) + + ! Check the boundary conditions on the surface + ! If vacuum, kill the particle + if (currentSurface % isVacuum()) then + p % isDead = .TRUE. + + ! If reflective or periodic, must ensure that the surface is a plane! + else if (currentSurface % isReflective()) then + + ! Return particle to global coordinates and apply the reflective transform + call p % resetNesting() + call currentSurface % reflectiveTransform(p%coords%lvl(1)%r, p%coords%lvl(1)%dir) + + ! Identify which cell the particle now occupies + currentCell = self % geom % whichCell(p%coords) + + else if (currentSurface % isPeriodic()) then + + ! Return particle to gloabl coordinates and apply the periodic translation associated with the surface + call p % teleport(p % rGlobal() + currentSurface % periodicTranslation()) + + ! Identify which cell the particle now occupies + currentCell = self % geom % whichCell(p%coords) + + else + call fatalError('applyBCsDT','Could not identify correct boundary conditions') + end if + + end do + + ! The particle should no longer be sat on a surface + call currentSurface % kill() + + end subroutine applyBCsDT + + + !! + !! Performs surface tracking + !! + subroutine surfaceTracking(self,p) + class(transportOperator), intent(in) :: self + class(particle), intent(inout) :: p + real(defReal) :: sigmaT, distance, boundaryDistance, & + testDistance, latDistance, lDist + integer(shortInt) :: i, n, nMin, latIdx, iLat + type(cell_ptr) :: c, currentCell + type(lattice_ptr) :: lat + logical(defBool) :: moveUp + + STLoop: do + ! Obtain the local cross-section + sigmaT = self % getSigmaT(p) + + ! Calculate boundary distance: descend the different co-ordinate levels starting from the highest + ! Ensures bounds of parent cells are not exceeded + n = p % nesting() + nMin = 1 + boundaryDistance = INFINITY + latDistance = INFINITY + do i = 1,n + c = self % geom % cells(p % getCellIdx(i)) + testDistance = c % getDistance(p%rLocal(i), p%dirLocal(i)) + + ! Check if the particle is in a lattice cell + latIdx = p % getLatIdx(i) + if (latIdx > 0) then + lat = self % geom % lattices(latIdx) + lDist = lat % getDistance(p%rLocal(i), p%dirLocal(i)) + if (latDistance >= lDist) then + latDistance = lDist + iLat = i - 1 + end if + end if + + if (boundaryDistance > testDistance) then + boundaryDistance = testDistance + nMin = i + ! Must move up a level if crossing a lattice boundary + if (boundaryDistance > latDistance) then + nMin = iLat + boundaryDistance = latDistance + end if + end if + end do + call c % kill() + call lat % kill() + n = nMin + + ! Sample particle flight distance + distance = -log(self%random%get())/sigmaT + + ! The particle escapes the cell and moves to the next + !if (abs(boundaryDistance - distance)/boundaryDistance >= surface_tol) then + if (boundaryDistance <= distance) then + + ! Move particle to the surface with a small nudge to move across the boundary + call p % moveLocal(boundaryDistance + NUDGE, n) + + ! Find the new base cell which the particle occupies + currentCell = self % geom % whichCell(p%coords, n) + + ! If the particle is outside the geometry, apply boundary conditions + do while (.not. currentCell % insideGeom()) + call self % applyBCsST(p, currentCell) + ! End transport if the particle is killed + if (p % isDead) then + exit STLoop + end if + end do + + ! Continue performing surface tracking + cycle + + else + ! Move particle to new location + call p % moveLocal(distance, n) + exit STLoop + end if + end do STLoop + + call currentCell % kill() + + end subroutine surfaceTracking + + !! + !! Apply boundary conditions when using surface tracking + !! This routine may need checking for cases in which the boundary + !! is crossed repeatedly + !! + subroutine applyBCsST(self, p, currentCell) + class(transportOperator), intent(in) :: self + class(particle), intent(inout) :: p + class(cell_ptr), intent(inout) :: currentCell + type(surface_ptr) :: currentSurface + + ! Return to global coordinates - this may be a superfluous call!! + call p % resetNesting() + + ! Identify which surface the particle crossed at the highest geometry level + currentSurface = currentCell % whichSurface(p%rGlobal(), -p%dirGlobal()) + + ! Check the boundary conditions on the surface + ! If vacuum, kill the particle + if (currentSurface % isVacuum()) then + p % isDead = .TRUE. + call currentSurface % kill() + + ! If reflective or periodic, must ensure that the surface is a plane! + else if (currentSurface % isReflective()) then + + ! Move particle back to surface which it crossed at the highest geometry level + p%coords%lvl(1)%r = p%rGlobal() - NUDGE * p%dirGlobal() + + ! Reflect the particle's direction of travel at the highest geometry level + call currentSurface % reflect(p%coords%lvl(1)%r, p%coords%lvl(1)%dir) + + ! Nudge the particle to avoid problems at corners + call p % moveGlobal(NUDGE) + + ! Identify which cell the particle now occupies + currentCell = self % geom % whichCell(p%coords) + + ! The particle should no longer be sat on a surface + call currentSurface % kill() + + else if (currentSurface % isPeriodic()) then + + ! Apply the periodic translation associated with the surface + call p % teleport(p%rGlobal() + currentSurface % periodicTranslation() & + + NUDGE * p%dirGlobal()) + + ! Identify which cell the particle now occupies + currentCell = self % geom % whichCell(p%coords) + + ! The particle should no longer be sat on a surface + call currentSurface % kill() + + else + call fatalError('applyBCsST','Could not identify correct boundary conditions') + end if + + end subroutine applyBCsST + + !! + !! Walks the particle for a number of steps or until the particle is killed + !! Does this by surface tracking without accounting for material properties + !! + subroutine walk(self,p,steps) + class(transportOperator), intent(in) :: self + class(particle), intent(inout) :: p + integer(shortInt), intent(in) :: steps + real(defReal) :: boundaryDistance, testDistance, latDistance, lDist + integer(shortInt) :: i, n, nMin, step, latIdx, iLat + type(cell_ptr) :: c, currentCell + type(lattice_ptr) :: lat + + STLoop: do step =1,steps + + ! Calculate boundary distance: descend the different co-ordinate levels starting from the highest + ! Ensures bounds of parent cells are not exceeded + n = p % nesting() + nMin = 1 + boundaryDistance = INFINITY + latDistance = INFINITY + do i = 1,n + c = self % geom % cells(p % getCellIdx(i)) + testDistance = c % getDistance(p%rLocal(i), p%dirLocal(i)) + + ! Check if the particle is in a lattice cell + latIdx = p % getLatIdx(i) + if (latIdx > 0) then + lat = self % geom % lattices(latIdx) + lDist = lat % getDistance(p%rLocal(i), p%dirLocal(i)) + if (latDistance >= lDist) then + latDistance = lDist + iLat = i - 1 + end if + end if + + if (abs(boundaryDistance - testDistance)/boundaryDistance >= surface_tol) then + boundaryDistance = testDistance + nMin = i + ! Must move up a level if crossing a lattice boundary + if (boundaryDistance >= latDistance) then + nMin = iLat + boundaryDistance = latDistance + end if + end if + end do + call c % kill() + call lat % kill() + n = nMin + + ! Move particle to the surface with a small nudge to move across the boundary + call p % moveLocal(boundaryDistance + NUDGE, n) + + ! Find the new base cell which the particle occupies + currentCell = self % geom % whichCell(p%coords, n) + + ! If the particle is outside the geometry, apply boundary conditions + do while (.not. currentCell % insideGeom()) + call self % applyBCsST(p, currentCell) + ! End transport if the particle is killed + if (p % isDead) then + print *,'DEAD' + exit STLoop + end if + end do + + end do STLoop + + call currentCell % kill() + + end subroutine walk + +end module transportOperator_class diff --git a/TransportOperator/transportOperatorST_class.f90 b/TransportOperator/transportOperatorST_class.f90 index 03ebfb660..0eda486e5 100644 --- a/TransportOperator/transportOperatorST_class.f90 +++ b/TransportOperator/transportOperatorST_class.f90 @@ -1,121 +1,121 @@ -!! -!! Transport operator for delta tracking -!! -module transportOperatorST_class - use numPrecision - use universalVariables - - use genericProcedures, only : fatalError - use particle_class, only : particle - use particleDungeon_class, only : particleDungeon - use dictionary_class, only : dictionary - use RNG_class, only : RNG - - ! Superclass - use transportOperator_inter, only : transportOperator, init_super => init - - ! Geometry interfaces - use geometry_inter, only : geometry, distCache - - ! Tally interface - use tallyCodes - use tallyAdmin_class, only : tallyAdmin - - ! Nuclear data interfaces - use nuclearDatabase_inter, only : nuclearDatabase - - implicit none - private - - !! - !! Transport operator that moves a particle with delta tracking - !! - !! Sample Input Dictionary: - !! trans { type transportOperatorST; cache 0;} - !! - type, public, extends(transportOperator) :: transportOperatorST - logical(defBool) :: cache = .true. - contains - procedure :: transit => surfaceTracking - procedure :: init - end type transportOperatorST - -contains - - !! - !! Performs surface tracking - !! - subroutine surfaceTracking(self, p, tally, thisCycle, nextCycle) - class(transportOperatorST), intent(inout) :: self - class(particle), intent(inout) :: p - type(tallyAdmin), intent(inout) :: tally - class(particleDungeon),intent(inout) :: thisCycle - class(particleDungeon),intent(inout) :: nextCycle - integer(shortInt) :: event - real(defReal) :: sigmaT, dist - type(distCache) :: cache - character(100), parameter :: Here = 'surfaceTracking (transportOperatorST_class.f90)' - - STLoop: do - - ! Obtain the local cross-section - if( p % matIdx() == VOID_MAT) then - dist = INFINITY - - else - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - dist = -log( p % pRNG % get()) / sigmaT - end if - - ! Save state before movement - call p % savePrePath() - - ! Move to the next stop. - if (self % cache) then - call self % geom % move_withCache(p % coords, dist, event, cache) - - else - call self % geom % move(p % coords, dist, event) - - end if - - ! Send tally report for a path moved - call tally % reportPath(p, dist) - - ! Kill particle if it has leaked - if( p % matIdx() == OUTSIDE_FILL) then - p % isDead = .true. - p % fate = LEAK_FATE - end if - - ! Give error if the particle somehow ended in an undefined material - if (p % matIdx() == UNDEF_MAT) then - print *, p % rGlobal() - call fatalError(Here, "Particle is in undefined material") - end if - - ! Return if particle stoped at collision (not cell boundary) - if( event == COLL_EV .or. p % isDead) exit STLoop - - end do STLoop - - call tally % reportTrans(p) - - end subroutine surfaceTracking - - !! - !! Initialise surface operator from a dictionary - !! - !! See transportOperator_inter for details - !! - subroutine init(self, dict) - class(transportOperatorST), intent(inout) :: self - class(dictionary), intent(in) :: dict - - if (dict % isPresent('cache')) then - call dict % get(self % cache, 'cache') - end if - - end subroutine init - -end module transportOperatorST_class +!! +!! Transport operator for delta tracking +!! +module transportOperatorST_class + use numPrecision + use universalVariables + + use genericProcedures, only : fatalError + use particle_class, only : particle + use particleDungeon_class, only : particleDungeon + use dictionary_class, only : dictionary + use RNG_class, only : RNG + + ! Superclass + use transportOperator_inter, only : transportOperator, init_super => init + + ! Geometry interfaces + use geometry_inter, only : geometry, distCache + + ! Tally interface + use tallyCodes + use tallyAdmin_class, only : tallyAdmin + + ! Nuclear data interfaces + use nuclearDatabase_inter, only : nuclearDatabase + + implicit none + private + + !! + !! Transport operator that moves a particle with delta tracking + !! + !! Sample Input Dictionary: + !! trans { type transportOperatorST; cache 0;} + !! + type, public, extends(transportOperator) :: transportOperatorST + logical(defBool) :: cache = .true. + contains + procedure :: transit => surfaceTracking + procedure :: init + end type transportOperatorST + +contains + + !! + !! Performs surface tracking + !! + subroutine surfaceTracking(self, p, tally, thisCycle, nextCycle) + class(transportOperatorST), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + class(particleDungeon),intent(inout) :: thisCycle + class(particleDungeon),intent(inout) :: nextCycle + integer(shortInt) :: event + real(defReal) :: sigmaT, dist + type(distCache) :: cache + character(100), parameter :: Here = 'surfaceTracking (transportOperatorST_class.f90)' + + STLoop: do + + ! Obtain the local cross-section + if( p % matIdx() == VOID_MAT) then + dist = INFINITY + + else + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + dist = -log( p % pRNG % get()) / sigmaT + end if + + ! Save state before movement + call p % savePrePath() + + ! Move to the next stop. + if (self % cache) then + call self % geom % move_withCache(p % coords, dist, event, cache) + + else + call self % geom % move(p % coords, dist, event) + + end if + + ! Send tally report for a path moved + call tally % reportPath(p, dist) + + ! Kill particle if it has leaked + if( p % matIdx() == OUTSIDE_FILL) then + p % isDead = .true. + p % fate = LEAK_FATE + end if + + ! Give error if the particle somehow ended in an undefined material + if (p % matIdx() == UNDEF_MAT) then + print *, p % rGlobal() + call fatalError(Here, "Particle is in undefined material") + end if + + ! Return if particle stoped at collision (not cell boundary) + if( event == COLL_EV .or. p % isDead) exit STLoop + + end do STLoop + + call tally % reportTrans(p) + + end subroutine surfaceTracking + + !! + !! Initialise surface operator from a dictionary + !! + !! See transportOperator_inter for details + !! + subroutine init(self, dict) + class(transportOperatorST), intent(inout) :: self + class(dictionary), intent(in) :: dict + + if (dict % isPresent('cache')) then + call dict % get(self % cache, 'cache') + end if + + end subroutine init + +end module transportOperatorST_class diff --git a/TransportOperator/transportOperator_inter.f90 b/TransportOperator/transportOperator_inter.f90 index 8d0e30e68..240f155f9 100644 --- a/TransportOperator/transportOperator_inter.f90 +++ b/TransportOperator/transportOperator_inter.f90 @@ -1,143 +1,143 @@ -module transportOperator_inter - - use numPrecision - use universalVariables - use genericProcedures, only : fatalError - - use particle_class, only : particle - use particleDungeon_class, only : particleDungeon - use dictionary_class, only : dictionary - - ! Geometry interfaces - use geometryReg_mod, only : gr_geomPtr => geomPtr - use geometry_inter, only : geometry - - ! Tally interface - use tallyAdmin_class, only : tallyAdmin - - ! Nuclear data interfaces - use nuclearDataReg_mod, only : ndReg_get => get - use nuclearDatabase_inter, only : nuclearDatabase - - - - implicit none - private - - - !! - !! This is an abstract interface for all types of transport processing - !! -> This interface only deals with scalar processing of particle transport - !! -> Assumes that particle moves without any external forces (assumes that particle - !! moves along straight lines between colisions) - !! - !! Public interface: - !! transport(p, tally, thisCycle, nextCycle) -> given particle, tally and particle dungeons - !! for particles in this and next cycle performs movement of a particle in the geometry. - !! Sends transistion report to the tally. Sends history report as well if particle dies. - !! init(dict, geom) -> initialises transport operator from a dictionary and pointer to a - !! geometry - !! - !! Customisable procedures or transport actions - !! transit(p, tally, thisCycle, nextCycle) -> implements movement from collision to collision - !! - type, abstract, public :: transportOperator - !! Nuclear Data block pointer -> public so it can be used by subclasses (protected member) - class(nuclearDatabase), pointer :: xsData => null() - - !! Geometry pointer -> public so it can be used by subclasses (protected member) - class(geometry), pointer :: geom => null() - - contains - ! Public interface - procedure, non_overridable :: transport - - ! Extentable initialisation and deconstruction procedure - procedure :: init - procedure :: kill - - ! Customisable deferred procedures - procedure(transit), deferred :: transit - - end type transportOperator - - ! Extandable procedures - public :: init - public :: kill - - - abstract interface - !! - !! Move particle from collision to collision - !! Kill particle if needed - !! - subroutine transit(self, p, tally, thisCycle, nextCycle) - import :: transportOperator, & - particle, & - tallyAdmin, & - particleDungeon - class(transportOperator), intent(inout) :: self - class(particle), intent(inout) :: p - type(tallyAdmin), intent(inout) :: tally - class(particleDungeon), intent(inout) :: thisCycle - class(particleDungeon), intent(inout) :: nextCycle - end subroutine transit - end interface - -contains - - !! - !! Master non-overridable subroutine to perform transport - !! Performs everything common to all types of transport - !! - subroutine transport(self, p, tally, thisCycle, nextCycle) - class(transportOperator), intent(inout) :: self - class(particle), intent(inout) :: p - type(tallyAdmin), intent(inout) :: tally - class(particleDungeon), intent(inout) :: thisCycle - class(particleDungeon), intent(inout) :: nextCycle - character(100),parameter :: Here ='transport (transportOperator_inter.f90)' - - ! Get nuclear data pointer form the particle - self % xsData => ndReg_get(p % getType()) - - ! Save geometry pointer - self % geom => gr_geomPtr(p % geomIdx) - - ! Save pre-transition state - call p % savePreTransition() - - ! Perform transit - call self % transit(p, tally, thisCycle, nextCycle) - - ! Send history reports if particle died - if( p % isDead) then - call tally % reportHist(p) - end if - - end subroutine transport - - !! - !! Initialise transport operator from dictionary and geometry - !! - subroutine init(self, dict) - class(transportOperator), intent(inout) :: self - class(dictionary), intent(in) :: dict - - ! Do nothing - - end subroutine init - - !! - !! Free memory. Return to uninitialised state - !! - elemental subroutine kill(self) - class(transportOperator), intent(inout) :: self - - self % geom => null() - self % xsData => null() - - end subroutine kill - - -end module transportOperator_inter +module transportOperator_inter + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError + + use particle_class, only : particle + use particleDungeon_class, only : particleDungeon + use dictionary_class, only : dictionary + + ! Geometry interfaces + use geometryReg_mod, only : gr_geomPtr => geomPtr + use geometry_inter, only : geometry + + ! Tally interface + use tallyAdmin_class, only : tallyAdmin + + ! Nuclear data interfaces + use nuclearDataReg_mod, only : ndReg_get => get + use nuclearDatabase_inter, only : nuclearDatabase + + + + implicit none + private + + + !! + !! This is an abstract interface for all types of transport processing + !! -> This interface only deals with scalar processing of particle transport + !! -> Assumes that particle moves without any external forces (assumes that particle + !! moves along straight lines between colisions) + !! + !! Public interface: + !! transport(p, tally, thisCycle, nextCycle) -> given particle, tally and particle dungeons + !! for particles in this and next cycle performs movement of a particle in the geometry. + !! Sends transistion report to the tally. Sends history report as well if particle dies. + !! init(dict, geom) -> initialises transport operator from a dictionary and pointer to a + !! geometry + !! + !! Customisable procedures or transport actions + !! transit(p, tally, thisCycle, nextCycle) -> implements movement from collision to collision + !! + type, abstract, public :: transportOperator + !! Nuclear Data block pointer -> public so it can be used by subclasses (protected member) + class(nuclearDatabase), pointer :: xsData => null() + + !! Geometry pointer -> public so it can be used by subclasses (protected member) + class(geometry), pointer :: geom => null() + + contains + ! Public interface + procedure, non_overridable :: transport + + ! Extentable initialisation and deconstruction procedure + procedure :: init + procedure :: kill + + ! Customisable deferred procedures + procedure(transit), deferred :: transit + + end type transportOperator + + ! Extandable procedures + public :: init + public :: kill + + + abstract interface + !! + !! Move particle from collision to collision + !! Kill particle if needed + !! + subroutine transit(self, p, tally, thisCycle, nextCycle) + import :: transportOperator, & + particle, & + tallyAdmin, & + particleDungeon + class(transportOperator), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + class(particleDungeon), intent(inout) :: thisCycle + class(particleDungeon), intent(inout) :: nextCycle + end subroutine transit + end interface + +contains + + !! + !! Master non-overridable subroutine to perform transport + !! Performs everything common to all types of transport + !! + subroutine transport(self, p, tally, thisCycle, nextCycle) + class(transportOperator), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + class(particleDungeon), intent(inout) :: thisCycle + class(particleDungeon), intent(inout) :: nextCycle + character(100),parameter :: Here ='transport (transportOperator_inter.f90)' + + ! Get nuclear data pointer form the particle + self % xsData => ndReg_get(p % getType()) + + ! Save geometry pointer + self % geom => gr_geomPtr(p % geomIdx) + + ! Save pre-transition state + call p % savePreTransition() + + ! Perform transit + call self % transit(p, tally, thisCycle, nextCycle) + + ! Send history reports if particle died + if( p % isDead) then + call tally % reportHist(p) + end if + + end subroutine transport + + !! + !! Initialise transport operator from dictionary and geometry + !! + subroutine init(self, dict) + class(transportOperator), intent(inout) :: self + class(dictionary), intent(in) :: dict + + ! Do nothing + + end subroutine init + + !! + !! Free memory. Return to uninitialised state + !! + elemental subroutine kill(self) + class(transportOperator), intent(inout) :: self + + self % geom => null() + self % xsData => null() + + end subroutine kill + + +end module transportOperator_inter diff --git a/Visualisation/visualiser_class.f90 b/Visualisation/visualiser_class.f90 index 9641f7758..00065b352 100644 --- a/Visualisation/visualiser_class.f90 +++ b/Visualisation/visualiser_class.f90 @@ -1,394 +1,394 @@ -module visualiser_class - - use numPrecision - use universalVariables - use genericProcedures, only : fatalError, numToChar - use hashFunctions_func, only : knuthHash - use imgBmp_func, only : imgBmp_toFile - use commandLineUI, only : getInputFile - use dictionary_class, only : dictionary - use geometry_inter, only : geometry - use outputVTK_class - - implicit none - private - - !! - !! Object responsible for controlling visualisation - !! - !! Object that creates images relating to SCONE geometries - !! Should be extensible for adding different visualisation methods - !! Recieves and generates data for visualisation - !! Requires a dictionary input which specifies the procedures to call - !! Presently supports: VTK voxel mesh creation - !! - !! Private members: - !! name -> name to be used for generating output files (corresponding to input) - !! geom -> pointer to geometry - !! vizDict -> dictionary containing visualisations to be generated - !! - !! Interface: - !! init -> initialises visualiser - !! makeViz -> constructs requested visualisations - !! kill -> cleans up visualiser - !! - !! Sample dictionary input: - !! viz{ - !! vizDict1{ } - !! #vizDict2{ }# - !! } - !! - !! NOTE: For details regarding contents of the vizDict dictionaries see the documentation - !! of 'makeVTK' and 'makeBmpImg' functions - !! - type, public :: visualiser - character(nameLen), private :: name - class(geometry), pointer, private :: geom => null() - type(dictionary), private :: vizDict - contains - procedure :: init - procedure :: makeViz - procedure :: kill - procedure, private :: makeVTK - procedure, private :: makeBmpImg - end type - -contains - - !! - !! Initialises visualiser - !! - !! Provides visualiser with filename for output, - !! geometry information, and the dictionary decribing - !! what is to be plotted - !! - !! Args: - !! geom [inout] -> pointer to the geometry - !! vizDict[in] -> dictionary containing what is to be visualised - !! - !! Result: - !! Initialised visualiser - !! - subroutine init(self, geom, vizDict) - class(visualiser), intent(inout) :: self - class(geometry), pointer, intent(inout) :: geom - class(dictionary), intent(in) :: vizDict - character(:), allocatable :: string - - ! Obtain file name - call getInputFile(string) - self % name = string - - ! Point to geometry - self % geom => geom - - ! Store visualisation dictionary - self % vizDict = vizDict - - end subroutine init - - !! - !! Generate all visualisations specified by vizDict - !! - !! Proceed through all dictionaries contained within vizDict - !! and perform all corresponding visualisations - !! - !! Result: - !! Visualisation outputs corresponding to dictionary contents - !! - !! Errors: - !! Returns an error if an unrecognised visualisation is requested - !! - subroutine makeViz(self) - class(visualiser), intent(inout) :: self - class(dictionary), pointer :: tempDict - character(nameLen),dimension(:), allocatable :: keysArr - integer(shortInt) :: i - character(nameLen) :: type - character(nameLen) :: here ='makeViz (visualiser_class.f90)' - - ! Loop through each sub-dictionary and generate visualisation - ! (if the visualisation method is available) - call self % vizDict % keys(keysArr,'dict') - - do i=1,size(keysArr) - tempDict => self % vizDict % getDictPtr(keysArr(i)) - call tempDict % get(type,'type') - select case(type) - case('vtk') - call self % makeVTK(tempDict) - - case('bmp') - call self % makeBmpImg(tempDict) - - case default - call fatalError(here, 'Unrecognised visualisation - presently only accept vtk') - - end select - - end do - - end subroutine makeViz - - !! - !! Generate a VTK output - !! - !! Creates the VTK file corresponding to the contents of dict - !! - !! Args: - !! dict [in] -> dictionary containing description of VTK file to be made - !! - !! Sample input dictionary: - !! VTK { - !! type vtk; - !! corner (-1.0 -1.0 -1.0); // lower corner of the plot volume - !! width (2.0 2.0 2.0); // width in each direction - !! vox (300 300 300); // Resolution in each direction - !! #what uniqueId;# // Plot target. 'material' or 'uniqueId'. Default: 'material' - !! } - !! - !! TODO: VTK output is placed in a input filename appended by '.vtk' extension. - !! This prevents multiple VTK visualistions (due to overriding). Might also become - !! weird for input files with extension e.g. 'input.dat'. - !! DEMAND USER TO GIVE OUTPUT NAME - !! - subroutine makeVTK(self, dict) - class(visualiser), intent(inout) :: self - class(dictionary), intent(in) :: dict - type(outputVTK) :: vtk - integer(shortInt), dimension(:,:,:), allocatable:: voxelMat - real(defReal), dimension(:), allocatable :: corner ! corner of the mesh - real(defReal), dimension(:), allocatable :: center ! center of the mesh - real(defReal), dimension(:), allocatable :: width ! corner of the mesh - integer(shortInt), dimension(:), allocatable :: nVox ! number of mesh voxels - character(nameLen) :: what - character(nameLen) :: here ='makeVTK (visualiser_class.f90)' - - call vtk % init(dict) - - ! Identify whether plotting 'material' or 'cellID' - call dict % getOrDefault(what, 'what', 'material') - - ! Obtain geometry data - call dict % get(corner, 'corner') - call dict % get(width, 'width') - center = corner + width/TWO - call dict % get(nVox, 'vox') - - if (size(corner) /= 3) then - call fatalError(here,'Voxel plot requires corner to have 3 values') - endif - if (size(width) /= 3) then - call fatalError(here,'Voxel plot requires width to have 3 values') - endif - if (size(nVox) /= 3) then - call fatalError(here,'Voxel plot requires vox to have 3 values') - endif - allocate(voxelMat(nVox(1), nVox(2), nVox(3))) - - ! Have geometry obtain data - call self % geom % voxelPlot(voxelMat, center, what, width) - - ! In principle, can add multiple data sets to VTK - not done here yet - ! VTK data set will use 'what' variable as a name - call vtk % addData(voxelMat, what) - call vtk % output(self % name) - call vtk % kill() - - end subroutine makeVTK - - !! - !! Generate a BMP slice image of the geometry - !! - !! Args: - !! dict [in] -> Dictionary with settings - !! - !! Sample dictionary input: - !! bmp_img { - !! type bmp; - !! #what uniqueID;# // Target of the plot. 'uniqueId' or 'material'. Default: 'material' - !! output img; // Name of output file without extension - !! centre (0.0 0.0 0.0); // Coordinates of the centre of the plot - !! axis x; // Must be 'x', 'y' or 'z' - !! res (300 300); // Resolution of the image - !! #width (1.0 2.0);# // Width of the plot from the centre - !! } - !! - !! NOTE: If 'width' is not given, the plot will extend to the bounds of the geometry. - !! This may result in the provided centre beeing moved to the center of the geoemtry in the - !! plot plane. However, the position on the plot axis will be unchanged. - !! - subroutine makeBmpImg(self, dict) - class(visualiser), intent(inout) :: self - class(dictionary), intent(in) :: dict - real(defReal), dimension(3) :: centre - real(defReal), dimension(2) :: width - character(1) :: dir - character(nameLen) :: tempChar - logical(defBool) :: useWidth - character(nameLen) :: what, outputFile - real(defReal), dimension(:), allocatable :: temp - integer(shortInt), dimension(:), allocatable :: tempInt - integer(shortInt), dimension(:,:), allocatable :: img - character(100), parameter :: Here = 'makeBmpImg (visualiser_class.f90)' - - ! Get plot parameters - - ! Identify whether plotting 'material' or 'cellID' - call dict % getOrDefault(what, 'what', 'material') - - ! Get name of the output file - call dict % get(outputFile, 'output') - outputFile = trim(outputFile) // '.bmp' - - ! Central point - call dict % get(temp, 'centre') - - if (size(temp) /= 3) then - call fatalError(Here, "'center' must have size 3. Has: "//numToChar(size(temp))) - end if - - centre = temp - - ! Axis - call dict % get(tempChar, 'axis') - - if (len_trim(tempChar) /= 1) then - call fatalError(Here, "'axis' must be x,y or z. Not: "//tempChar) - end if - - dir = tempChar(1:1) - - ! Resolution - call dict % get(tempInt, 'res') - - if (size(tempInt) /= 2) then - call fatalError(Here, "'res' must have size 2. Has: "//numToChar(size(tempInt))) - else if (any(tempInt <= 0)) then - call fatalError(Here, "Resolution must be +ve. There is 0 or -ve entry!") - end if - - allocate(img(tempInt(1), tempInt(2))) - - ! Optional width - useWidth = dict % isPresent('width') - if (useWidth) then - call dict % get(temp, 'width') - - ! Check for errors - if (size(temp) /= 2) then - call fatalError(Here, "'width' must have size 2. Has: "//numToChar((size(temp)))) - else if (any(temp <= ZERO)) then - call fatalError(Here, "'width' must be +ve. It isn't.") - end if - - width = temp - - end if - - ! Get plot - if (useWidth) then - call self % geom % slicePlot(img, centre, dir, what, width) - else - call self % geom % slicePlot(img, centre, dir, what) - end if - - ! Translate to an image - select case (what) - case ('material') - img = materialColor(img) - - case ('uniqueID') - img = uniqueIDColor(img) - - case default - call fatalError(Here, "Invalid request for plot target. Must be 'material' or 'uniqueID'& - & is: "//what) - end select - - ! Print image - call imgBmp_toFile(img, outputFile) - - end subroutine makeBmpImg - - !! - !! Terminates visualiser - !! - !! Cleans up remnants of visualiser once it is no longer needed - !! - !! Result: - !! An empty visualiser object - !! - subroutine kill(self) - class(visualiser), intent(inout) :: self - - self % name ='' - self % geom => null() - call self % vizDict % kill() - - end subroutine kill - - - !! - !! Convert matIdx to a 24bit color - !! - !! Special materials are associeted with special colors: - !! OUTSIDE_MAT -> white (#ffffff) - !! VOID_MAT -> black (#000000) - !! UNDEF_MAT -> green (#00ff00) - !! - !! Args: - !! matIdx [in] -> Value of the material index - !! - !! Result: - !! A 24-bit color specifing the material - !! - elemental function materialColor(matIdx) result(color) - integer(shortInt), intent(in) :: matIdx - integer(shortInt) :: color - integer(shortInt), parameter :: COL_OUTSIDE = int(z'ffffff', shortInt) - integer(shortInt), parameter :: COL_VOID = int(z'000000', shortInt) - integer(shortInt), parameter :: COL_UNDEF = int(z'00ff00', shortInt) - - select case (matIdx) - case (OUTSIDE_MAT) - color = COL_OUTSIDE - - case (VOID_MAT) - color = COL_VOID - - case (UNDEF_MAT) - color = COL_UNDEF - - case default - color = knuthHash(matIdx, 24) - - end select - - end function materialColor - - !! - !! Convert uniqueID to 24bit color - !! - !! An elemental wrapper over Knuth Hash - !! - !! We use a hash function to scatter colors accross all available. - !! Knuth multiplicative hash is very good at scattering integer - !! sequences e.g. {1, 2, 3...}. Thus, it is ideal for a colormap. - !! - !! Args: - !! uniqueID [in] -> Value of the uniqueID - !! - !! Result: - !! A 24-bit color specifing the uniqueID - !! - elemental function uniqueIDColor(uniqueID) result(color) - integer(shortInt), intent(in) :: uniqueID - integer(shortInt) :: color - - color = knuthHash(uniqueID, 24) - - end function uniqueIDColor - - -end module visualiser_class +module visualiser_class + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError, numToChar + use hashFunctions_func, only : knuthHash + use imgBmp_func, only : imgBmp_toFile + use commandLineUI, only : getInputFile + use dictionary_class, only : dictionary + use geometry_inter, only : geometry + use outputVTK_class + + implicit none + private + + !! + !! Object responsible for controlling visualisation + !! + !! Object that creates images relating to SCONE geometries + !! Should be extensible for adding different visualisation methods + !! Recieves and generates data for visualisation + !! Requires a dictionary input which specifies the procedures to call + !! Presently supports: VTK voxel mesh creation + !! + !! Private members: + !! name -> name to be used for generating output files (corresponding to input) + !! geom -> pointer to geometry + !! vizDict -> dictionary containing visualisations to be generated + !! + !! Interface: + !! init -> initialises visualiser + !! makeViz -> constructs requested visualisations + !! kill -> cleans up visualiser + !! + !! Sample dictionary input: + !! viz{ + !! vizDict1{ } + !! #vizDict2{ }# + !! } + !! + !! NOTE: For details regarding contents of the vizDict dictionaries see the documentation + !! of 'makeVTK' and 'makeBmpImg' functions + !! + type, public :: visualiser + character(nameLen), private :: name + class(geometry), pointer, private :: geom => null() + type(dictionary), private :: vizDict + contains + procedure :: init + procedure :: makeViz + procedure :: kill + procedure, private :: makeVTK + procedure, private :: makeBmpImg + end type + +contains + + !! + !! Initialises visualiser + !! + !! Provides visualiser with filename for output, + !! geometry information, and the dictionary decribing + !! what is to be plotted + !! + !! Args: + !! geom [inout] -> pointer to the geometry + !! vizDict[in] -> dictionary containing what is to be visualised + !! + !! Result: + !! Initialised visualiser + !! + subroutine init(self, geom, vizDict) + class(visualiser), intent(inout) :: self + class(geometry), pointer, intent(inout) :: geom + class(dictionary), intent(in) :: vizDict + character(:), allocatable :: string + + ! Obtain file name + call getInputFile(string) + self % name = string + + ! Point to geometry + self % geom => geom + + ! Store visualisation dictionary + self % vizDict = vizDict + + end subroutine init + + !! + !! Generate all visualisations specified by vizDict + !! + !! Proceed through all dictionaries contained within vizDict + !! and perform all corresponding visualisations + !! + !! Result: + !! Visualisation outputs corresponding to dictionary contents + !! + !! Errors: + !! Returns an error if an unrecognised visualisation is requested + !! + subroutine makeViz(self) + class(visualiser), intent(inout) :: self + class(dictionary), pointer :: tempDict + character(nameLen),dimension(:), allocatable :: keysArr + integer(shortInt) :: i + character(nameLen) :: type + character(nameLen) :: here ='makeViz (visualiser_class.f90)' + + ! Loop through each sub-dictionary and generate visualisation + ! (if the visualisation method is available) + call self % vizDict % keys(keysArr,'dict') + + do i=1,size(keysArr) + tempDict => self % vizDict % getDictPtr(keysArr(i)) + call tempDict % get(type,'type') + select case(type) + case('vtk') + call self % makeVTK(tempDict) + + case('bmp') + call self % makeBmpImg(tempDict) + + case default + call fatalError(here, 'Unrecognised visualisation - presently only accept vtk') + + end select + + end do + + end subroutine makeViz + + !! + !! Generate a VTK output + !! + !! Creates the VTK file corresponding to the contents of dict + !! + !! Args: + !! dict [in] -> dictionary containing description of VTK file to be made + !! + !! Sample input dictionary: + !! VTK { + !! type vtk; + !! corner (-1.0 -1.0 -1.0); // lower corner of the plot volume + !! width (2.0 2.0 2.0); // width in each direction + !! vox (300 300 300); // Resolution in each direction + !! #what uniqueId;# // Plot target. 'material' or 'uniqueId'. Default: 'material' + !! } + !! + !! TODO: VTK output is placed in a input filename appended by '.vtk' extension. + !! This prevents multiple VTK visualistions (due to overriding). Might also become + !! weird for input files with extension e.g. 'input.dat'. + !! DEMAND USER TO GIVE OUTPUT NAME + !! + subroutine makeVTK(self, dict) + class(visualiser), intent(inout) :: self + class(dictionary), intent(in) :: dict + type(outputVTK) :: vtk + integer(shortInt), dimension(:,:,:), allocatable:: voxelMat + real(defReal), dimension(:), allocatable :: corner ! corner of the mesh + real(defReal), dimension(:), allocatable :: center ! center of the mesh + real(defReal), dimension(:), allocatable :: width ! corner of the mesh + integer(shortInt), dimension(:), allocatable :: nVox ! number of mesh voxels + character(nameLen) :: what + character(nameLen) :: here ='makeVTK (visualiser_class.f90)' + + call vtk % init(dict) + + ! Identify whether plotting 'material' or 'cellID' + call dict % getOrDefault(what, 'what', 'material') + + ! Obtain geometry data + call dict % get(corner, 'corner') + call dict % get(width, 'width') + center = corner + width/TWO + call dict % get(nVox, 'vox') + + if (size(corner) /= 3) then + call fatalError(here,'Voxel plot requires corner to have 3 values') + endif + if (size(width) /= 3) then + call fatalError(here,'Voxel plot requires width to have 3 values') + endif + if (size(nVox) /= 3) then + call fatalError(here,'Voxel plot requires vox to have 3 values') + endif + allocate(voxelMat(nVox(1), nVox(2), nVox(3))) + + ! Have geometry obtain data + call self % geom % voxelPlot(voxelMat, center, what, width) + + ! In principle, can add multiple data sets to VTK - not done here yet + ! VTK data set will use 'what' variable as a name + call vtk % addData(voxelMat, what) + call vtk % output(self % name) + call vtk % kill() + + end subroutine makeVTK + + !! + !! Generate a BMP slice image of the geometry + !! + !! Args: + !! dict [in] -> Dictionary with settings + !! + !! Sample dictionary input: + !! bmp_img { + !! type bmp; + !! #what uniqueID;# // Target of the plot. 'uniqueId' or 'material'. Default: 'material' + !! output img; // Name of output file without extension + !! centre (0.0 0.0 0.0); // Coordinates of the centre of the plot + !! axis x; // Must be 'x', 'y' or 'z' + !! res (300 300); // Resolution of the image + !! #width (1.0 2.0);# // Width of the plot from the centre + !! } + !! + !! NOTE: If 'width' is not given, the plot will extend to the bounds of the geometry. + !! This may result in the provided centre beeing moved to the center of the geoemtry in the + !! plot plane. However, the position on the plot axis will be unchanged. + !! + subroutine makeBmpImg(self, dict) + class(visualiser), intent(inout) :: self + class(dictionary), intent(in) :: dict + real(defReal), dimension(3) :: centre + real(defReal), dimension(2) :: width + character(1) :: dir + character(nameLen) :: tempChar + logical(defBool) :: useWidth + character(nameLen) :: what, outputFile + real(defReal), dimension(:), allocatable :: temp + integer(shortInt), dimension(:), allocatable :: tempInt + integer(shortInt), dimension(:,:), allocatable :: img + character(100), parameter :: Here = 'makeBmpImg (visualiser_class.f90)' + + ! Get plot parameters + + ! Identify whether plotting 'material' or 'cellID' + call dict % getOrDefault(what, 'what', 'material') + + ! Get name of the output file + call dict % get(outputFile, 'output') + outputFile = trim(outputFile) // '.bmp' + + ! Central point + call dict % get(temp, 'centre') + + if (size(temp) /= 3) then + call fatalError(Here, "'center' must have size 3. Has: "//numToChar(size(temp))) + end if + + centre = temp + + ! Axis + call dict % get(tempChar, 'axis') + + if (len_trim(tempChar) /= 1) then + call fatalError(Here, "'axis' must be x,y or z. Not: "//tempChar) + end if + + dir = tempChar(1:1) + + ! Resolution + call dict % get(tempInt, 'res') + + if (size(tempInt) /= 2) then + call fatalError(Here, "'res' must have size 2. Has: "//numToChar(size(tempInt))) + else if (any(tempInt <= 0)) then + call fatalError(Here, "Resolution must be +ve. There is 0 or -ve entry!") + end if + + allocate(img(tempInt(1), tempInt(2))) + + ! Optional width + useWidth = dict % isPresent('width') + if (useWidth) then + call dict % get(temp, 'width') + + ! Check for errors + if (size(temp) /= 2) then + call fatalError(Here, "'width' must have size 2. Has: "//numToChar((size(temp)))) + else if (any(temp <= ZERO)) then + call fatalError(Here, "'width' must be +ve. It isn't.") + end if + + width = temp + + end if + + ! Get plot + if (useWidth) then + call self % geom % slicePlot(img, centre, dir, what, width) + else + call self % geom % slicePlot(img, centre, dir, what) + end if + + ! Translate to an image + select case (what) + case ('material') + img = materialColor(img) + + case ('uniqueID') + img = uniqueIDColor(img) + + case default + call fatalError(Here, "Invalid request for plot target. Must be 'material' or 'uniqueID'& + & is: "//what) + end select + + ! Print image + call imgBmp_toFile(img, outputFile) + + end subroutine makeBmpImg + + !! + !! Terminates visualiser + !! + !! Cleans up remnants of visualiser once it is no longer needed + !! + !! Result: + !! An empty visualiser object + !! + subroutine kill(self) + class(visualiser), intent(inout) :: self + + self % name ='' + self % geom => null() + call self % vizDict % kill() + + end subroutine kill + + + !! + !! Convert matIdx to a 24bit color + !! + !! Special materials are associeted with special colors: + !! OUTSIDE_MAT -> white (#ffffff) + !! VOID_MAT -> black (#000000) + !! UNDEF_MAT -> green (#00ff00) + !! + !! Args: + !! matIdx [in] -> Value of the material index + !! + !! Result: + !! A 24-bit color specifing the material + !! + elemental function materialColor(matIdx) result(color) + integer(shortInt), intent(in) :: matIdx + integer(shortInt) :: color + integer(shortInt), parameter :: COL_OUTSIDE = int(z'ffffff', shortInt) + integer(shortInt), parameter :: COL_VOID = int(z'000000', shortInt) + integer(shortInt), parameter :: COL_UNDEF = int(z'00ff00', shortInt) + + select case (matIdx) + case (OUTSIDE_MAT) + color = COL_OUTSIDE + + case (VOID_MAT) + color = COL_VOID + + case (UNDEF_MAT) + color = COL_UNDEF + + case default + color = knuthHash(matIdx, 24) + + end select + + end function materialColor + + !! + !! Convert uniqueID to 24bit color + !! + !! An elemental wrapper over Knuth Hash + !! + !! We use a hash function to scatter colors accross all available. + !! Knuth multiplicative hash is very good at scattering integer + !! sequences e.g. {1, 2, 3...}. Thus, it is ideal for a colormap. + !! + !! Args: + !! uniqueID [in] -> Value of the uniqueID + !! + !! Result: + !! A 24-bit color specifing the uniqueID + !! + elemental function uniqueIDColor(uniqueID) result(color) + integer(shortInt), intent(in) :: uniqueID + integer(shortInt) :: color + + color = knuthHash(uniqueID, 24) + + end function uniqueIDColor + + +end module visualiser_class From 6d20056ab049ec7773539f84ad20675987a70a07 Mon Sep 17 00:00:00 2001 From: Mikolaj-A-Kowalski Date: Fri, 25 Aug 2023 19:00:12 +0200 Subject: [PATCH 2/3] Remove trailing whitespace --- CollisionOperator/CMakeLists.txt | 4 +- .../CollisionProcessors/CMakeLists.txt | 8 +- .../collisionProcessor_inter.f90 | 2 +- CollisionOperator/collisionOperator_class.f90 | 2 +- DataStructures/Tests/dictionary_test.f90 | 2 +- DataStructures/dynArray_class.f90 | 2 +- DataStructures/stack_class.f90 | 2 +- Geometry/Cells/cell_inter.f90 | 2 +- Geometry/Fields/VectorFields/CMakeLists.txt | 2 +- .../QuadSurfaces/quadSurface_inter.f90 | 2 +- .../Surfaces/Tests/truncCylinder_test.f90 | 2 +- .../Universes/Tests/universeShelf_test.f90 | 2 +- Geometry/Universes/latUniverse_class.f90 | 2 +- Geometry/Universes/universeShelf_class.f90 | 2 +- Geometry/coord_class.f90 | 2 +- InputFiles/XS/URRa_2_1_XSS | 26 +- InputFiles/mox_vol | 106 ++-- IntegrationTestFiles/Geometry/test_cyl | 46 +- IntegrationTestFiles/Geometry/test_lat | 48 +- IntegrationTestFiles/mgMat1 | 30 +- IntegrationTestFiles/mgMat2 | 38 +- IntegrationTestFiles/testWW | 12 +- LinearAlgebra/CMakeLists.txt | 8 +- NamedGrids/CMakeLists.txt | 8 +- NamedGrids/Tests/energyGridRegistry_test.f90 | 2 +- NamedGrids/energyGridRegistry_mod.f90 | 2 +- NuclearData/CMakeLists.txt | 2 +- NuclearData/DataDecks/dataDeck_inter.f90 | 2 +- .../endfTable/endfTable_class.f90 | 2 +- .../pdf/kalbachTable_class.f90 | 2 +- .../Reactions/correlatedReactionCE_inter.f90 | 2 +- .../reactionMG/Tests/fissionMG_test.f90 | 2 +- .../Reactions/reactionMG/fissionMG_class.f90 | 2 +- NuclearData/ceNeutronData/CMakeLists.txt | 2 +- .../Tests/aceNeutronNuclide_iTest.f90 | 2 +- .../ceNeutronData/ceNeutronDatabase_inter.f90 | 2 +- NuclearData/emissionENDF/CMakeLists.txt | 10 +- .../emissionENDF/angleLawENDF/CMakeLists.txt | 4 +- .../angleLawENDF/angleLawENDF_inter.f90 | 2 +- .../angleLawENDF/muEndfPdf/CMakeLists.txt | 4 +- .../angleLawENDF/noAngle_class.f90 | 2 +- .../correlatedPdfs/kalbachPdf_class.f90 | 2 +- .../correlatedLawENDF/kalbach87_class.f90 | 2 +- .../emissionENDF/energyLawENDF/CMakeLists.txt | 10 +- .../Tests/multipleEnergyLaws_test.f90 | 2 +- .../energyLawENDF/energyLawENDFslot_class.f90 | 2 +- .../evaporationSpectrum_class.f90 | 2 +- .../energyLawENDF/levelScattering_class.f90 | 2 +- .../energyLawENDF/maxwellSpectrum_class.f90 | 2 +- .../energyLawENDF/testEnergyLaw_class.f90 | 2 +- .../releaseLawENDF/CMakeLists.txt | 4 +- .../releaseLawENDF/constantRelease_class.f90 | 2 +- .../polynomialRelease_class.f90 | 2 +- .../releaseLawENDF/tabularRelease_class.f90 | 2 +- NuclearData/mgNeutronData/CMakeLists.txt | 10 +- .../mgNeutronData/mgNeutronDatabase_inter.f90 | 2 +- NuclearData/nuclideHandle_inter.f90 | 2 +- NuclearData/testNeutronData/CMakeLists.txt | 4 +- NuclearData/xsPackages/CMakeLists.txt | 2 +- ParticleObjects/CMakeLists.txt | 6 +- ParticleObjects/particleDungeon_class.f90 | 20 +- ParticleObjects/particle_class.f90 | 2 +- PhysicsPackages/physicsPackage_inter.f90 | 2 +- RandomNumbers/CMakeLists.txt | 4 +- RandomNumbers/Tests/RNG_test.f90 | 2 +- SharedModules/Tests/charLib_test.f90 | 2 +- SharedModules/Tests/conversions_test.f90 | 2 +- SharedModules/Tests/sort_test.f90 | 2 +- SharedModules/grid_class.f90 | 2 +- SharedModules/legendrePoly_func.f90 | 2 +- SharedModules/numPrecision.f90 | 2 +- SharedModules/universalVariables.f90 | 2 +- Tallies/CMakeLists.txt | 10 +- Tallies/TallyClerks/CMakeLists.txt | 4 +- .../collisionProbabilityClerk_class.f90 | 6 +- Tallies/TallyClerks/mgXsClerk_class.f90 | 2 +- Tallies/TallyClerks/trackClerk_class.f90 | 2 +- Tallies/TallyFilters/CMakeLists.txt | 4 +- Tallies/TallyFilters/energyFilter_class.f90 | 2 +- .../TallyFilters/tallyFilterSlot_class.f90 | 2 +- Tallies/TallyFilters/testFilter_class.f90 | 2 +- Tallies/TallyMaps/Tests/multiMap_test.f90 | 2 +- Tallies/TallyMaps/Tests/spaceMap_test.f90 | 2 +- Tallies/TallyMaps/Tests/weightMap_test.f90 | 2 +- Tallies/TallyMaps/tallyMap1D_inter.f90 | 2 +- Tallies/TallyResponses/CMakeLists.txt | 8 +- Tallies/scoreMemory_class.f90 | 12 +- Tallies/tallyActiveAdmin_class.f90 | 2 +- Tallies/tallyAdminBase_class.f90 | 2 +- Tallies/tallyInactiveAdmin_class.f90 | 2 +- Tallies/tallyTimeAdmin_class.f90 | 2 +- UserInterface/commandLineUI.f90 | 2 +- Visualisation/VTK/CMakeLists.txt | 4 +- Visualisation/VTK/outputVTK_class.f90 | 14 +- cmake/FindPFUNIT.cmake | 99 ++- cmake/add_integration_tests.cmake | 32 +- cmake/add_sources.cmake | 22 +- cmake/add_unit_tests.cmake | 32 +- docs/Unit Testing.rst | 2 +- docs/User Manual.rst | 576 +++++++++--------- scripts/install_cream.sh | 6 +- scripts/test_cream.sh | 8 +- 102 files changed, 689 insertions(+), 690 deletions(-) diff --git a/CollisionOperator/CMakeLists.txt b/CollisionOperator/CMakeLists.txt index ef0b276db..0c33e7338 100644 --- a/CollisionOperator/CMakeLists.txt +++ b/CollisionOperator/CMakeLists.txt @@ -1,5 +1,5 @@ add_subdirectory(CollisionProcessors) -# Add Source Files to the global list -add_sources( ./collisionOperator_class.f90 +# Add Source Files to the global list +add_sources( ./collisionOperator_class.f90 ./scatteringKernels_func.f90) diff --git a/CollisionOperator/CollisionProcessors/CMakeLists.txt b/CollisionOperator/CollisionProcessors/CMakeLists.txt index ee923a0ed..7a169c75d 100644 --- a/CollisionOperator/CollisionProcessors/CMakeLists.txt +++ b/CollisionOperator/CollisionProcessors/CMakeLists.txt @@ -1,6 +1,6 @@ -# Add Source Files to the global list -add_sources( ./collisionProcessor_inter.f90 - ./collisionProcessorFactory_func.f90 +# Add Source Files to the global list +add_sources( ./collisionProcessor_inter.f90 + ./collisionProcessorFactory_func.f90 ./neutronCEstd_class.f90 ./neutronCEimp_class.f90 - ./neutronMGstd_class.f90) + ./neutronMGstd_class.f90) diff --git a/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 b/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 index b19a106b7..6ab8c122d 100644 --- a/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 +++ b/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 @@ -118,7 +118,7 @@ subroutine collide(self, p, tally ,thisCycle, nextCycle) ! Report in-collision & save pre-collison state ! Note: the ordering must not be changed between feeding the particle to the tally - ! and updating the particle's preCollision state, otherwise this may cause certain + ! and updating the particle's preCollision state, otherwise this may cause certain ! tallies (e.g., collisionProbability) to return dubious results call tally % reportInColl(p) call p % savePreCollision() diff --git a/CollisionOperator/collisionOperator_class.f90 b/CollisionOperator/collisionOperator_class.f90 index 07ee57a49..558009875 100644 --- a/CollisionOperator/collisionOperator_class.f90 +++ b/CollisionOperator/collisionOperator_class.f90 @@ -140,5 +140,5 @@ subroutine collide(self, p, tally, thisCycle, nextCycle) call self % physicsTable(idx) % proc % collide(p, tally, thisCycle, nextCycle) end subroutine collide - + end module collisionOperator_class diff --git a/DataStructures/Tests/dictionary_test.f90 b/DataStructures/Tests/dictionary_test.f90 index cb4cf8216..23df964dc 100644 --- a/DataStructures/Tests/dictionary_test.f90 +++ b/DataStructures/Tests/dictionary_test.f90 @@ -14,7 +14,7 @@ module dictionary_test !! Parameters real(defReal),parameter :: realVal = 3.3_defReal - integer(shortInt),parameter :: boolVal = 1 + integer(shortInt),parameter :: boolVal = 1 integer(shortInt), parameter :: intVal = 1_shortInt character(nameLen),parameter :: charNameLen = 'GoFortran_DownWithCpp' character(pathLen), parameter :: charPathLen ='/home/KyloRen/VaderFanFic' diff --git a/DataStructures/dynArray_class.f90 b/DataStructures/dynArray_class.f90 index 09a648cf9..d6c182907 100644 --- a/DataStructures/dynArray_class.f90 +++ b/DataStructures/dynArray_class.f90 @@ -120,7 +120,7 @@ pure function isEmpty_shortInt(self) result(isIt) isIt = self % mySize == 0 .or. .not.allocated(self % array) end function isEmpty_shortInt - + !! !! Return current memory capacity of the dynamicArray !! diff --git a/DataStructures/stack_class.f90 b/DataStructures/stack_class.f90 index 862e41095..d17fc9f2a 100644 --- a/DataStructures/stack_class.f90 +++ b/DataStructures/stack_class.f90 @@ -135,7 +135,7 @@ subroutine clean_shortInt(self) end subroutine clean_shortInt - + !! !! Increases size of the stack !! diff --git a/Geometry/Cells/cell_inter.f90 b/Geometry/Cells/cell_inter.f90 index 7657f44f3..0469fe260 100644 --- a/Geometry/Cells/cell_inter.f90 +++ b/Geometry/Cells/cell_inter.f90 @@ -86,7 +86,7 @@ end function inside !! Args: !! d [out] -> Distance to the boundary !! surfIdx [out] -> Index of a surface that will be crossed. If the surface is not defined on - !! the surface shelf its value should be -ve. If no surface is hit return 0. + !! the surface shelf its value should be -ve. If no surface is hit return 0. !! r [in] -> Position !! u [in] -> ormalised direction (norm2(u) = 1.0) !! diff --git a/Geometry/Fields/VectorFields/CMakeLists.txt b/Geometry/Fields/VectorFields/CMakeLists.txt index 90d74e6c7..02f01cb5f 100644 --- a/Geometry/Fields/VectorFields/CMakeLists.txt +++ b/Geometry/Fields/VectorFields/CMakeLists.txt @@ -6,5 +6,5 @@ add_sources( ./vectorField_inter.f90 add_unit_tests( ./Tests/uniformVectorField_test.f90 ./Tests/uniFissSitesField_test.f90) - + add_integration_tests( ./Tests/weightWindowsField_iTest.f90) diff --git a/Geometry/Surfaces/QuadSurfaces/quadSurface_inter.f90 b/Geometry/Surfaces/QuadSurfaces/quadSurface_inter.f90 index 62f4c47e2..67df49f18 100644 --- a/Geometry/Surfaces/QuadSurfaces/quadSurface_inter.f90 +++ b/Geometry/Surfaces/QuadSurfaces/quadSurface_inter.f90 @@ -4,7 +4,7 @@ module quadSurface_inter implicit none private - + !! !! Abstract interface to group all quadratic surfaces. !! diff --git a/Geometry/Surfaces/Tests/truncCylinder_test.f90 b/Geometry/Surfaces/Tests/truncCylinder_test.f90 index 5cd29a124..9d4c53c65 100644 --- a/Geometry/Surfaces/Tests/truncCylinder_test.f90 +++ b/Geometry/Surfaces/Tests/truncCylinder_test.f90 @@ -245,7 +245,7 @@ subroutine testBC(this) r(pe) = [12.0_defReal, 0.0_defReal, 2.3_defReal] u(pe) = [ONE, ZERO, ZERO] r_ref(pe) = [3.0_defReal, 0.0_defReal, 2.3_defReal] - u_ref = u + u_ref = u call this % surf % transformBC(r, u) @assertEqual(r_ref, r, TOL) @assertEqual(u_ref, u, TOL) diff --git a/Geometry/Universes/Tests/universeShelf_test.f90 b/Geometry/Universes/Tests/universeShelf_test.f90 index f92e00943..2d473bd2d 100644 --- a/Geometry/Universes/Tests/universeShelf_test.f90 +++ b/Geometry/Universes/Tests/universeShelf_test.f90 @@ -105,7 +105,7 @@ subroutine test_get() @assertEqual(10, ptr % id()) @assertEqual(10, unis % getID(idx)) - ! Universe ID 21 -> With the fast access + ! Universe ID 21 -> With the fast access idx = unis % getIdx(21) ptr => unis % getPtr_fast(idx) @assertEqual(21, ptr % id()) diff --git a/Geometry/Universes/latUniverse_class.f90 b/Geometry/Universes/latUniverse_class.f90 index 798ebd9d8..f622498fb 100644 --- a/Geometry/Universes/latUniverse_class.f90 +++ b/Geometry/Universes/latUniverse_class.f90 @@ -308,7 +308,7 @@ subroutine distance(self, d, surfIdx, coords) ! Provide default axis to ensure no out of bounds array access if ! all distances happen to be infinite d = INF - ax = 1 + ax = 1 do i = 1, 3 ! Nominator and denominator will have the same sign (by ealier bounds selection) test_d = (bounds(i) - r_bar(i)) / u(i) diff --git a/Geometry/Universes/universeShelf_class.f90 b/Geometry/Universes/universeShelf_class.f90 index 1a34757c3..27462589f 100644 --- a/Geometry/Universes/universeShelf_class.f90 +++ b/Geometry/Universes/universeShelf_class.f90 @@ -46,7 +46,7 @@ module universeShelf_class !! init -> Initialise and build uniFills !! getPtr -> Get pointer to a universe given by its index !! getPtr_fast -> Get pointer to a universe without bounds checking. Should be used in - !! speed-critical parts. + !! speed-critical parts. !! getIdx -> Get uniIdx of a universe given by uniId !! getId -> Get uniId of a universe given by uniIdx !! getSize -> Return the number of universes (max uniIdx) diff --git a/Geometry/coord_class.f90 b/Geometry/coord_class.f90 index ed699ce67..d7900d9a7 100644 --- a/Geometry/coord_class.f90 +++ b/Geometry/coord_class.f90 @@ -391,7 +391,7 @@ elemental subroutine rotate(self, mu, phi) if (self % lvl(i) % isRotated) then ! Note that rotation must be performed with the matrix ! Deflections by mu & phi depend on coordinates - ! Deflection by the same my & phi may be diffrent at diffrent, rotated levels! + ! Deflection by the same my & phi may be diffrent at diffrent, rotated levels! self % lvl(i) % dir = matmul(self % lvl(i) % rotMat, self % lvl(i-1) % dir) else diff --git a/InputFiles/XS/URRa_2_1_XSS b/InputFiles/XS/URRa_2_1_XSS index 352d7efbc..caec00d5c 100644 --- a/InputFiles/XS/URRa_2_1_XSS +++ b/InputFiles/XS/URRa_2_1_XSS @@ -1,25 +1,25 @@ -// This XSS are for a URR-2-1-IN/SL Benchamrk Problem -// Source: A. Sood, R. A. Forster, and D. K. Parsons, +// This XSS are for a URR-2-1-IN/SL Benchamrk Problem +// Source: A. Sood, R. A. Forster, and D. K. Parsons, // ‘Analytical Benchmark Test Set For Criticality Code Verification’ // -numberOfGroups 2; +numberOfGroups 2; capture (0.0010046 0.025788); fission (0.0010484 0.050632); -nu (2.5 2.5); -chi (1.0 0.0); - -scatteringMultiplicity ( -1.0 1.0 -1.0 1.0 ); +nu (2.5 2.5); +chi (1.0 0.0); -P0 ( - 0.62568 0.029227 +scatteringMultiplicity ( +1.0 1.0 +1.0 1.0 ); + +P0 ( + 0.62568 0.029227 0.0 2.443830 -); +); P1 ( 0.27459 0.0075737 0.0 0.83318 -); \ No newline at end of file +); \ No newline at end of file diff --git a/InputFiles/mox_vol b/InputFiles/mox_vol index 717292f79..685dbe444 100644 --- a/InputFiles/mox_vol +++ b/InputFiles/mox_vol @@ -1,44 +1,44 @@ -type rayVolPhysicsPackage; +type rayVolPhysicsPackage; pop 20000; -cycles 20; -mfp 3.3; -abs_prob 0.01; -robust 0; - -geometry { - type geometryStd; - boundary ( 1 1 2 2 0 0); +cycles 20; +mfp 3.3; +abs_prob 0.01; +robust 0; + +geometry { + type geometryStd; + boundary ( 1 1 2 2 0 0); graph {type shrunk;} - surfaces { - squareBound { id 1; type zSquareCylinder; origin (0.0 0.0 0.0); halfwidth (10.71 10.71 0.0);} + surfaces { + squareBound { id 1; type zSquareCylinder; origin (0.0 0.0 0.0); halfwidth (10.71 10.71 0.0);} } - - cells { + + cells { } - - universes { - root { id 1; type rootUniverse; border 1; fill u<401>; } - - // Pin universes - pin31 { id 31; type pinUniverse; radii (0.4095 0.4180 0.4750 0.4850 0.5400 0.0 ); + + universes { + root { id 1; type rootUniverse; border 1; fill u<401>; } + + // Pin universes + pin31 { id 31; type pinUniverse; radii (0.4095 0.4180 0.4750 0.4850 0.5400 0.0 ); fills (mox43 void clad void alClad water);} - pin41 { id 41; type pinUniverse; radii (0.4095 0.4180 0.4750 0.4850 0.5400 0.0 ); - fills (mox70 void clad void alClad water);} - pin51 { id 51; type pinUniverse; radii (0.4095 0.4180 0.4750 0.4850 0.5400 0.0 ); - fills (mox87 void clad void alClad water);} + pin41 { id 41; type pinUniverse; radii (0.4095 0.4180 0.4750 0.4850 0.5400 0.0 ); + fills (mox70 void clad void alClad water);} + pin51 { id 51; type pinUniverse; radii (0.4095 0.4180 0.4750 0.4850 0.5400 0.0 ); + fills (mox87 void clad void alClad water);} pin21 {id 21; type pinUniverse; radii (0.3400 0.5400 0.0); fills (water clad water);} - // Lattices + // Lattices latMox { - id 401; - type latUniverse; - origin (0.0 0.0 0.0); + id 401; + type latUniverse; + origin (0.0 0.0 0.0); pitch (1.26 1.26 0.0); - shape (17 17 0); - padMat water; - map ( + shape (17 17 0); + padMat water; + map ( 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 31 31 41 41 41 41 21 41 41 21 41 41 21 41 41 41 41 31 @@ -55,44 +55,44 @@ geometry { 31 41 41 21 41 51 51 51 51 51 51 51 41 21 41 41 31 31 41 41 41 41 21 41 41 21 41 41 21 41 41 41 41 31 31 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 31 - 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 ); } + 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 ); } } - + } nuclearData { - handles { - } - materials { + handles { + } + materials { numberOfGroups 69; - - water { + + water { temp 75675; composition { } } - - clad { + + clad { temp 12345; - composition { } + composition { } } alClad { - temp 9876; - composition { } + temp 9876; + composition { } } - - mox43 { - temp 87476; + + mox43 { + temp 87476; composition {} } - mox70 { - temp 6786; + mox70 { + temp 6786; composition {} - } - mox87 { - temp 8765; - composition {} - } - + } + mox87 { + temp 8765; + composition {} + } + } } diff --git a/IntegrationTestFiles/Geometry/test_cyl b/IntegrationTestFiles/Geometry/test_cyl index 40027c53c..6c8c2d164 100644 --- a/IntegrationTestFiles/Geometry/test_cyl +++ b/IntegrationTestFiles/Geometry/test_cyl @@ -1,25 +1,25 @@ // -// Test input file -// Tilted cylinder in a box +// Test input file +// Tilted cylinder in a box // -boundary ( 1 1 2 2 0 0); -graph { type shrunk; } +boundary ( 1 1 2 2 0 0); +graph { type shrunk; } -surfaces { - squareBound { id 1; type box; origin (0.0 0.0 0.0); halfwidth (5.0 5.0 5.0);} +surfaces { + squareBound { id 1; type box; origin (0.0 0.0 0.0); halfwidth (5.0 5.0 5.0);} } - -cells { + +cells { } - -universes { - root { id 1; type rootUniverse; border 1; fill u<10>;} - - // Pin universes + +universes { + root { id 1; type rootUniverse; border 1; fill u<10>;} + + // Pin universes pin31 { id 10; type pinUniverse; origin (1.0 0.0 0.0); rotation (0.0 30.0 0.0); radii (0.900 0.0 ); fills (mox43 water);} - // Include an unused universe + // Include an unused universe pin32 {id 32; type pinUniverse; radii (0.0); fills (water);} @@ -27,22 +27,22 @@ universes { nuclearData { - materials { - - water { + materials { + + water { temp 75675; composition { } } - - mox43 { - temp 87476; + + mox43 { + temp 87476; composition { } } - uox { - temp 6786; + uox { + temp 6786; composition { } - } + } } } diff --git a/IntegrationTestFiles/Geometry/test_lat b/IntegrationTestFiles/Geometry/test_lat index 855db0287..df07f69ff 100644 --- a/IntegrationTestFiles/Geometry/test_lat +++ b/IntegrationTestFiles/Geometry/test_lat @@ -1,23 +1,23 @@ -boundary ( 1 1 2 2 0 0); -graph { type shrunk; } +boundary ( 1 1 2 2 0 0); +graph { type shrunk; } -surfaces { - squareBound { id 1; type zSquareCylinder; origin (0.0 0.0 0.0); halfwidth (1.26 1.26 0.0);} - sqPinBound { id 2; type zSquareCylinder; origin (0.0 0.0 0.0); halfwidth (0.5 0.5 0.0);} +surfaces { + squareBound { id 1; type zSquareCylinder; origin (0.0 0.0 0.0); halfwidth (1.26 1.26 0.0);} + sqPinBound { id 2; type zSquareCylinder; origin (0.0 0.0 0.0); halfwidth (0.5 0.5 0.0);} } - -cells { + +cells { sqPinIn {id 1; type simpleCell; surfaces (-2); filltype mat; material uox; } - sqPinOut {id 2; type simpleCell; surfaces (2); filltype mat; material water;} + sqPinOut {id 2; type simpleCell; surfaces (2); filltype mat; material water;} } - -universes { - root { id 1; type rootUniverse; border 1; fill u<10>;} - - // Pin universes + +universes { + root { id 1; type rootUniverse; border 1; fill u<10>;} + + // Pin universes pin31 { id 31; type pinUniverse; radii (0.5400 0.0 ); fills (mox43 water);} - sqPin { id 32; type cellUniverse; cells (1 2);} + sqPin { id 32; type cellUniverse; cells (1 2);} lat10 {id 10; type latUniverse; shape (2 2 0); pitch (1.26 1.26 0.0); padMat water; map (31 32 32 31);} @@ -25,23 +25,23 @@ universes { nuclearData { - materials { - - water { + materials { + + water { temp 75675; composition { } } - - mox43 { - temp 87476; + + mox43 { + temp 87476; composition { } } - uox { - temp 6786; + uox { + temp 6786; composition { } - } - + } + } } diff --git a/IntegrationTestFiles/mgMat1 b/IntegrationTestFiles/mgMat1 index dc347f059..11023f5fd 100644 --- a/IntegrationTestFiles/mgMat1 +++ b/IntegrationTestFiles/mgMat1 @@ -1,21 +1,21 @@ -numberOfGroups 4; +numberOfGroups 4; -capture (1.0 2.0 3.0 4.0); +capture (1.0 2.0 3.0 4.0); -scatteringMultiplicity ( +scatteringMultiplicity ( 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 - 1.0 1.0 1.0 1.0); - -P0 ( - 0.5 0.3 0.2 0.1 - 0.0 1.0 0.3 0.1 - 0.0 0.0 2.0 1.0 + 1.0 1.0 1.0 1.0); + +P0 ( + 0.5 0.3 0.2 0.1 + 0.0 1.0 0.3 0.1 + 0.0 0.0 2.0 1.0 0.0 0.0 0.1 3.0 ); - -P1 ( - -0.1 0.0 0.0 0.0 - 0.0 -0.2 0.0 0.0 - 0.0 0.0 0.0 0.0 - 0.0 0.0 0.0 0.0 ); \ No newline at end of file + +P1 ( + -0.1 0.0 0.0 0.0 + 0.0 -0.2 0.0 0.0 + 0.0 0.0 0.0 0.0 + 0.0 0.0 0.0 0.0 ); diff --git a/IntegrationTestFiles/mgMat2 b/IntegrationTestFiles/mgMat2 index 1d371f40b..afa25e910 100644 --- a/IntegrationTestFiles/mgMat2 +++ b/IntegrationTestFiles/mgMat2 @@ -1,27 +1,27 @@ -numberOfGroups 4; +numberOfGroups 4; -capture (1.0 2.0 3.0 4.0); +capture (1.0 2.0 3.0 4.0); -scatteringMultiplicity ( +scatteringMultiplicity ( 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 - 1.0 1.0 1.0 1.0); - -P0 ( - 0.5 0.3 0.2 0.1 - 0.0 1.0 0.3 0.1 - 0.0 0.0 2.0 1.0 + 1.0 1.0 1.0 1.0); + +P0 ( + 0.5 0.3 0.2 0.1 + 0.0 1.0 0.3 0.1 + 0.0 0.0 2.0 1.0 0.0 0.0 0.1 3.0 ); - -P1 ( - -0.1 0.0 0.0 0.0 - 0.0 -0.2 0.0 0.0 - 0.0 0.0 0.0 0.0 - 0.0 0.0 0.0 0.0 ); - -fission (1.0 0.0 0.0 0.0); -chi (0.8 0.2 0.0 0.0); +P1 ( + -0.1 0.0 0.0 0.0 + 0.0 -0.2 0.0 0.0 + 0.0 0.0 0.0 0.0 + 0.0 0.0 0.0 0.0 ); + +fission (1.0 0.0 0.0 0.0); + +chi (0.8 0.2 0.0 0.0); -nu (2.3 0.0 0.0 0.0); \ No newline at end of file +nu (2.3 0.0 0.0 0.0); diff --git a/IntegrationTestFiles/testWW b/IntegrationTestFiles/testWW index 6e9ae3548..3eee6de50 100644 --- a/IntegrationTestFiles/testWW +++ b/IntegrationTestFiles/testWW @@ -1,8 +1,8 @@ -map {type multiMap; maps (mapx mapy ene); -mapx {type spaceMap; axis x; grid unstruct; bins (0.0 1.0 2.0); } +map {type multiMap; maps (mapx mapy ene); +mapx {type spaceMap; axis x; grid unstruct; bins (0.0 1.0 2.0); } mapy {type spaceMap; axis y; grid unstruct; bins (0.0 5.0 10.0 15.0); } -ene {type energyMap; grid unstruct; bins (1.0E-11 0.625E-06 20.0); } } +ene {type energyMap; grid unstruct; bins (1.0E-11 0.625E-06 20.0); } } -constSurvival 2.0; -wLower (0.5 0.1 0.2 0.1 0.5 0.5 0.25 0.3 0.4 0.1 0.5 0.6); -wUpper (2.0 1.2 1.5 1.1 2.0 4.0 1.25 1.7 1.5 1.1 3.0 5.0); \ No newline at end of file +constSurvival 2.0; +wLower (0.5 0.1 0.2 0.1 0.5 0.5 0.25 0.3 0.4 0.1 0.5 0.6); +wUpper (2.0 1.2 1.5 1.1 2.0 4.0 1.25 1.7 1.5 1.1 3.0 5.0); diff --git a/LinearAlgebra/CMakeLists.txt b/LinearAlgebra/CMakeLists.txt index c730701d7..97231c460 100644 --- a/LinearAlgebra/CMakeLists.txt +++ b/LinearAlgebra/CMakeLists.txt @@ -1,5 +1,5 @@ -# Add source files to global list -add_sources( ./linearAlgebra_func.f90) +# Add source files to global list +add_sources( ./linearAlgebra_func.f90) -# Add tests to global list -add_unit_tests( ./Tests/linearAlgebra_test.f90) \ No newline at end of file +# Add tests to global list +add_unit_tests( ./Tests/linearAlgebra_test.f90) \ No newline at end of file diff --git a/NamedGrids/CMakeLists.txt b/NamedGrids/CMakeLists.txt index 6b9d1fd89..78f4292f5 100644 --- a/NamedGrids/CMakeLists.txt +++ b/NamedGrids/CMakeLists.txt @@ -1,6 +1,6 @@ -# Add Source Files to the global list +# Add Source Files to the global list add_sources (./energyGridRegistry_mod.f90 ./preDefEnergyGrids.f90) - -# Add Tests -add_unit_tests(./Tests/energyGridRegistry_test.f90) \ No newline at end of file + +# Add Tests +add_unit_tests(./Tests/energyGridRegistry_test.f90) \ No newline at end of file diff --git a/NamedGrids/Tests/energyGridRegistry_test.f90 b/NamedGrids/Tests/energyGridRegistry_test.f90 index f1dc0643c..773f0d577 100644 --- a/NamedGrids/Tests/energyGridRegistry_test.f90 +++ b/NamedGrids/Tests/energyGridRegistry_test.f90 @@ -172,5 +172,5 @@ subroutine testGettingUndefinedGrid() end subroutine testGettingUndefinedGrid - + end module energyGridRegistry_test diff --git a/NamedGrids/energyGridRegistry_mod.f90 b/NamedGrids/energyGridRegistry_mod.f90 index ed3b753af..ae7242ade 100644 --- a/NamedGrids/energyGridRegistry_mod.f90 +++ b/NamedGrids/energyGridRegistry_mod.f90 @@ -245,5 +245,5 @@ subroutine new_energyGrid(eGrid, name, dict) end select end subroutine new_energyGrid - + end module energyGridRegistry_mod diff --git a/NuclearData/CMakeLists.txt b/NuclearData/CMakeLists.txt index 47126f0d0..028d6bbcd 100644 --- a/NuclearData/CMakeLists.txt +++ b/NuclearData/CMakeLists.txt @@ -40,4 +40,4 @@ add_integration_tests(./Reactions/Tests/elasticScattering_iTest.f90 ./Reactions/Tests/neutronScattering_iTest.f90 ./Reactions/Tests/fissionCE_iTest.f90 ./Tests/aceLibraryRead_iTest.f90 - ./DataDecks/Tests/aceCard_iTest.f90) + ./DataDecks/Tests/aceCard_iTest.f90) diff --git a/NuclearData/DataDecks/dataDeck_inter.f90 b/NuclearData/DataDecks/dataDeck_inter.f90 index e1b7479e2..8c6b6cd3e 100644 --- a/NuclearData/DataDecks/dataDeck_inter.f90 +++ b/NuclearData/DataDecks/dataDeck_inter.f90 @@ -44,5 +44,5 @@ end function myType contains - + end module dataDeck_inter diff --git a/NuclearData/NuclearDataStructures/endfTable/endfTable_class.f90 b/NuclearData/NuclearDataStructures/endfTable/endfTable_class.f90 index f3d6b4a6e..59dce770e 100644 --- a/NuclearData/NuclearDataStructures/endfTable/endfTable_class.f90 +++ b/NuclearData/NuclearDataStructures/endfTable/endfTable_class.f90 @@ -294,7 +294,7 @@ function integral(self, x) result(y) do while (x(val) <= self % x(i)) y(val) = csum + endf_bin_integral(x0, x1, y0, y1, x(val), flag) val = val + 1 - if (val > size(x)) exit + if (val > size(x)) exit end do end if diff --git a/NuclearData/NuclearDataStructures/pdf/kalbachTable_class.f90 b/NuclearData/NuclearDataStructures/pdf/kalbachTable_class.f90 index 6452d4d98..5d2ebf2d5 100644 --- a/NuclearData/NuclearDataStructures/pdf/kalbachTable_class.f90 +++ b/NuclearData/NuclearDataStructures/pdf/kalbachTable_class.f90 @@ -292,5 +292,5 @@ subroutine initCdf(self,x,pdf,cdf,R,A,flag) end select end subroutine initCDF - + end module kalbachTable_class diff --git a/NuclearData/Reactions/correlatedReactionCE_inter.f90 b/NuclearData/Reactions/correlatedReactionCE_inter.f90 index b36d3b477..4a0ed2b9b 100644 --- a/NuclearData/Reactions/correlatedReactionCE_inter.f90 +++ b/NuclearData/Reactions/correlatedReactionCE_inter.f90 @@ -133,5 +133,5 @@ pure function correlatedReactionCE_CptrCast(source) result(ptr) end select end function correlatedReactionCE_CptrCast - + end module correlatedReactionCE_inter diff --git a/NuclearData/Reactions/reactionMG/Tests/fissionMG_test.f90 b/NuclearData/Reactions/reactionMG/Tests/fissionMG_test.f90 index e47c6f0cb..072dd8922 100644 --- a/NuclearData/Reactions/reactionMG/Tests/fissionMG_test.f90 +++ b/NuclearData/Reactions/reactionMG/Tests/fissionMG_test.f90 @@ -76,5 +76,5 @@ subroutine fissionMG_Build_And_Functionality() call reaction % kill() end subroutine fissionMG_Build_And_Functionality - + end module fissionMG_test diff --git a/NuclearData/Reactions/reactionMG/fissionMG_class.f90 b/NuclearData/Reactions/reactionMG/fissionMG_class.f90 index 99d6a653d..3d51ee384 100644 --- a/NuclearData/Reactions/reactionMG/fissionMG_class.f90 +++ b/NuclearData/Reactions/reactionMG/fissionMG_class.f90 @@ -147,7 +147,7 @@ pure function releaseDelayed(self, G) result(N) N = ZERO end function releaseDelayed - + !! !! Sample the delay rate for the delayed particle !! diff --git a/NuclearData/ceNeutronData/CMakeLists.txt b/NuclearData/ceNeutronData/CMakeLists.txt index c91d91b60..58b43ebf4 100644 --- a/NuclearData/ceNeutronData/CMakeLists.txt +++ b/NuclearData/ceNeutronData/CMakeLists.txt @@ -5,4 +5,4 @@ add_sources(./ceNeutronCache_mod.f90 ./ceNeutronNuclide_inter.f90 ./ceNeutronMaterial_class.f90 ./aceLibrary_mod.f90 - ) \ No newline at end of file + ) \ No newline at end of file diff --git a/NuclearData/ceNeutronData/aceDatabase/Tests/aceNeutronNuclide_iTest.f90 b/NuclearData/ceNeutronData/aceDatabase/Tests/aceNeutronNuclide_iTest.f90 index a7d0d03ca..80fcbb1f0 100644 --- a/NuclearData/ceNeutronData/aceDatabase/Tests/aceNeutronNuclide_iTest.f90 +++ b/NuclearData/ceNeutronData/aceDatabase/Tests/aceNeutronNuclide_iTest.f90 @@ -46,5 +46,5 @@ subroutine testACEnuclideU233() end subroutine testACEnuclideU233 - + end module aceNeutronNuclide_iTest diff --git a/NuclearData/ceNeutronData/ceNeutronDatabase_inter.f90 b/NuclearData/ceNeutronData/ceNeutronDatabase_inter.f90 index 988b35594..9cc45c564 100644 --- a/NuclearData/ceNeutronData/ceNeutronDatabase_inter.f90 +++ b/NuclearData/ceNeutronData/ceNeutronDatabase_inter.f90 @@ -287,5 +287,5 @@ pure function ceNeutronDatabase_CptrCast(source) result(ptr) end function ceNeutronDatabase_CptrCast - + end module ceNeutronDatabase_inter diff --git a/NuclearData/emissionENDF/CMakeLists.txt b/NuclearData/emissionENDF/CMakeLists.txt index a6d8f5041..ad4fb5349 100644 --- a/NuclearData/emissionENDF/CMakeLists.txt +++ b/NuclearData/emissionENDF/CMakeLists.txt @@ -1,8 +1,8 @@ -# Add Nested Directories +# Add Nested Directories add_subdirectory(angleLawENDF) add_subdirectory(energyLawENDF) -add_subdirectory(releaseLawENDF) -add_subdirectory(correlatedLawENDF) +add_subdirectory(releaseLawENDF) +add_subdirectory(correlatedLawENDF) -# Add Source Files to the global list -add_sources( ./emissionENDF_class.f90) +# Add Source Files to the global list +add_sources( ./emissionENDF_class.f90) diff --git a/NuclearData/emissionENDF/angleLawENDF/CMakeLists.txt b/NuclearData/emissionENDF/angleLawENDF/CMakeLists.txt index 5ab360e28..dac6c56be 100644 --- a/NuclearData/emissionENDF/angleLawENDF/CMakeLists.txt +++ b/NuclearData/emissionENDF/angleLawENDF/CMakeLists.txt @@ -1,7 +1,7 @@ add_subdirectory(muEndfPdf) -# Add Source Files to the global list -add_sources ( ./angleLawENDF_inter.f90 +# Add Source Files to the global list +add_sources ( ./angleLawENDF_inter.f90 ./angleLawENDFslot_class.f90 ./angleLawENDFfactory_func.f90 ./tabularAngle_class.f90 diff --git a/NuclearData/emissionENDF/angleLawENDF/angleLawENDF_inter.f90 b/NuclearData/emissionENDF/angleLawENDF/angleLawENDF_inter.f90 index 95de2797c..fac5bf605 100644 --- a/NuclearData/emissionENDF/angleLawENDF/angleLawENDF_inter.f90 +++ b/NuclearData/emissionENDF/angleLawENDF/angleLawENDF_inter.f90 @@ -68,5 +68,5 @@ end subroutine kill end interface - + end module angleLawENDF_inter diff --git a/NuclearData/emissionENDF/angleLawENDF/muEndfPdf/CMakeLists.txt b/NuclearData/emissionENDF/angleLawENDF/muEndfPdf/CMakeLists.txt index 4ed697925..1b9ff713c 100644 --- a/NuclearData/emissionENDF/angleLawENDF/muEndfPdf/CMakeLists.txt +++ b/NuclearData/emissionENDF/angleLawENDF/muEndfPdf/CMakeLists.txt @@ -1,6 +1,6 @@ -# Add Source Files to the global list +# Add Source Files to the global list add_sources ( ./muEndfPdf_inter.f90 - ./muEndfPdfSlot_class.f90 + ./muEndfPdfSlot_class.f90 ./isotropicMu_class.f90 ./equiBin32Mu_class.f90 ./tabularMu_class.f90 ) \ No newline at end of file diff --git a/NuclearData/emissionENDF/angleLawENDF/noAngle_class.f90 b/NuclearData/emissionENDF/angleLawENDF/noAngle_class.f90 index f2a6ba933..c58489e9e 100644 --- a/NuclearData/emissionENDF/angleLawENDF/noAngle_class.f90 +++ b/NuclearData/emissionENDF/angleLawENDF/noAngle_class.f90 @@ -94,5 +94,5 @@ function new_noAngle() result(new) dummy = new % probabilityOf(HALF,ONE) end function new_noAngle - + end module noAngle_class diff --git a/NuclearData/emissionENDF/correlatedLawENDF/correlatedPdfs/kalbachPdf_class.f90 b/NuclearData/emissionENDF/correlatedLawENDF/correlatedPdfs/kalbachPdf_class.f90 index 5089f4a40..08faa9d32 100644 --- a/NuclearData/emissionENDF/correlatedLawENDF/correlatedPdfs/kalbachPdf_class.f90 +++ b/NuclearData/emissionENDF/correlatedLawENDF/correlatedPdfs/kalbachPdf_class.f90 @@ -126,7 +126,7 @@ subroutine init_withPDF(self,E,pdf,R,A,interFlag) ! Perform checks if(any( E < 0.0 ) ) call fatalError(Here,'E contains -ve values') - + ! Initialise table call self % table % init(E,pdf,R,A,interFlag) diff --git a/NuclearData/emissionENDF/correlatedLawENDF/kalbach87_class.f90 b/NuclearData/emissionENDF/correlatedLawENDF/kalbach87_class.f90 index be35367c4..de04d12c0 100644 --- a/NuclearData/emissionENDF/correlatedLawENDF/kalbach87_class.f90 +++ b/NuclearData/emissionENDF/correlatedLawENDF/kalbach87_class.f90 @@ -86,7 +86,7 @@ subroutine sample(self,mu,E_out,E_in,rand) factor = (E_out- E_min_low)/(E_max_low - E_min_low) end if - + ! Interpolate outgoing energy E_out = E_min *(ONE - factor) + factor * E_max diff --git a/NuclearData/emissionENDF/energyLawENDF/CMakeLists.txt b/NuclearData/emissionENDF/energyLawENDF/CMakeLists.txt index 379087cf6..5c6f3b581 100644 --- a/NuclearData/emissionENDF/energyLawENDF/CMakeLists.txt +++ b/NuclearData/emissionENDF/energyLawENDF/CMakeLists.txt @@ -1,5 +1,5 @@ -# Add Source Files to the global list +# Add Source Files to the global list add_sources( ./energyLawENDF_inter.f90 ./energyLawENDFslot_class.f90 ./energyLawENDFfactory_func.f90 @@ -11,7 +11,7 @@ add_sources( ./energyLawENDF_inter.f90 ./evaporationSpectrum_class.f90 ./multipleEnergyLaws_class.f90 ./testEnergyLaw_class.f90) - -# Add Tests to global list -add_unit_tests( ./Tests/multipleEnergyLaws_test.f90) - + +# Add Tests to global list +add_unit_tests( ./Tests/multipleEnergyLaws_test.f90) + diff --git a/NuclearData/emissionENDF/energyLawENDF/Tests/multipleEnergyLaws_test.f90 b/NuclearData/emissionENDF/energyLawENDF/Tests/multipleEnergyLaws_test.f90 index 9bf0b7b6c..9ad7d17d1 100644 --- a/NuclearData/emissionENDF/energyLawENDF/Tests/multipleEnergyLaws_test.f90 +++ b/NuclearData/emissionENDF/energyLawENDF/Tests/multipleEnergyLaws_test.f90 @@ -132,5 +132,5 @@ subroutine testSampling(this) @assertGreaterThan(7.38_defReal, Chi) end subroutine testSampling - + end module multipleEnergyLaws_test diff --git a/NuclearData/emissionENDF/energyLawENDF/energyLawENDFslot_class.f90 b/NuclearData/emissionENDF/energyLawENDF/energyLawENDFslot_class.f90 index 01ea6d82d..f97f10368 100644 --- a/NuclearData/emissionENDF/energyLawENDF/energyLawENDFslot_class.f90 +++ b/NuclearData/emissionENDF/energyLawENDF/energyLawENDFslot_class.f90 @@ -90,5 +90,5 @@ subroutine moveAllocFrom(LHS,RHS) call move_alloc(RHS, LHS % slot) end subroutine moveAllocFrom - + end module energyLawENDFslot_class diff --git a/NuclearData/emissionENDF/energyLawENDF/evaporationSpectrum_class.f90 b/NuclearData/emissionENDF/energyLawENDF/evaporationSpectrum_class.f90 index e0f245a48..e5bd84d84 100644 --- a/NuclearData/emissionENDF/energyLawENDF/evaporationSpectrum_class.f90 +++ b/NuclearData/emissionENDF/energyLawENDF/evaporationSpectrum_class.f90 @@ -229,5 +229,5 @@ function new_evaporationSpectrum_fromACE(ACE) result(new) end function new_evaporationSpectrum_fromACE - + end module evaporationSpectrum_class diff --git a/NuclearData/emissionENDF/energyLawENDF/levelScattering_class.f90 b/NuclearData/emissionENDF/energyLawENDF/levelScattering_class.f90 index 295eca39c..a5bf3a3e2 100644 --- a/NuclearData/emissionENDF/energyLawENDF/levelScattering_class.f90 +++ b/NuclearData/emissionENDF/energyLawENDF/levelScattering_class.f90 @@ -123,7 +123,7 @@ function new_levelScattering(LDAT1,LDAT2) result(new) real(defReal), intent(in) :: LDAT1 real(defReal), intent(in) :: LDAT2 type(levelScattering) :: new - + ! Initialise call new % init(LDAT1, LDAT2) diff --git a/NuclearData/emissionENDF/energyLawENDF/maxwellSpectrum_class.f90 b/NuclearData/emissionENDF/energyLawENDF/maxwellSpectrum_class.f90 index 2cba3afb3..7e17455ce 100644 --- a/NuclearData/emissionENDF/energyLawENDF/maxwellSpectrum_class.f90 +++ b/NuclearData/emissionENDF/energyLawENDF/maxwellSpectrum_class.f90 @@ -155,7 +155,7 @@ function new_maxwellSpectrum(eGrid,T,U) result(new) call new % init(eGrid,T,U) end function new_maxwellSPectrum - + !! !! Constructor !! Multiple interpolation regions & interpolation schemes diff --git a/NuclearData/emissionENDF/energyLawENDF/testEnergyLaw_class.f90 b/NuclearData/emissionENDF/energyLawENDF/testEnergyLaw_class.f90 index f51e5660b..687f7b6ce 100644 --- a/NuclearData/emissionENDF/energyLawENDF/testEnergyLaw_class.f90 +++ b/NuclearData/emissionENDF/energyLawENDF/testEnergyLaw_class.f90 @@ -81,5 +81,5 @@ elemental subroutine kill(self) self % E_out = ZERO end subroutine kill - + end module testEnergyLaw_class diff --git a/NuclearData/emissionENDF/releaseLawENDF/CMakeLists.txt b/NuclearData/emissionENDF/releaseLawENDF/CMakeLists.txt index ee169ae14..42c39beb7 100644 --- a/NuclearData/emissionENDF/releaseLawENDF/CMakeLists.txt +++ b/NuclearData/emissionENDF/releaseLawENDF/CMakeLists.txt @@ -1,8 +1,8 @@ -# Add Source Files to the global list +# Add Source Files to the global list add_sources( ./releaseLawENDF_inter.f90 ./releaseLawENDFslot_class.f90 - ./releaseLawENDFfactory_func.f90 + ./releaseLawENDFfactory_func.f90 ./polynomialRelease_class.f90 ./constantRelease_class.f90 ./tabularRelease_class.f90 ) \ No newline at end of file diff --git a/NuclearData/emissionENDF/releaseLawENDF/constantRelease_class.f90 b/NuclearData/emissionENDF/releaseLawENDF/constantRelease_class.f90 index fe02ffac7..3dd72a427 100644 --- a/NuclearData/emissionENDF/releaseLawENDF/constantRelease_class.f90 +++ b/NuclearData/emissionENDF/releaseLawENDF/constantRelease_class.f90 @@ -71,5 +71,5 @@ function new_constantRelease(release) result(new) end function new_constantRelease - + end module constantRelease_class diff --git a/NuclearData/emissionENDF/releaseLawENDF/polynomialRelease_class.f90 b/NuclearData/emissionENDF/releaseLawENDF/polynomialRelease_class.f90 index 5b009c5a8..3c11aa3fe 100644 --- a/NuclearData/emissionENDF/releaseLawENDF/polynomialRelease_class.f90 +++ b/NuclearData/emissionENDF/releaseLawENDF/polynomialRelease_class.f90 @@ -38,7 +38,7 @@ subroutine init(self,coeffs) self % coeffs = coeffs ! implicit allocation end subroutine - + !! !! Calculate release at energy E_in !! diff --git a/NuclearData/emissionENDF/releaseLawENDF/tabularRelease_class.f90 b/NuclearData/emissionENDF/releaseLawENDF/tabularRelease_class.f90 index 49a95a127..2e2ec007c 100644 --- a/NuclearData/emissionENDF/releaseLawENDF/tabularRelease_class.f90 +++ b/NuclearData/emissionENDF/releaseLawENDF/tabularRelease_class.f90 @@ -122,7 +122,7 @@ function new_tabularRelease_simple(eGrid, releaseValues) result(new) call new % init(eGrid, releaseValues) end function new_tabularRelease_simple - + !! !! Constructor with multiple interpolation regions !! diff --git a/NuclearData/mgNeutronData/CMakeLists.txt b/NuclearData/mgNeutronData/CMakeLists.txt index 04d7a738f..79081c0a3 100644 --- a/NuclearData/mgNeutronData/CMakeLists.txt +++ b/NuclearData/mgNeutronData/CMakeLists.txt @@ -1,8 +1,8 @@ -# Add source files for compilation +# Add source files for compilation add_sources(./mgNeutronMaterial_inter.f90 ./mgNeutronDatabase_inter.f90 ./baseMgNeutron/baseMgNeutronMaterial_class.f90 - ./baseMgNeutron/baseMgNeutronDatabase_class.f90) - -# Add tests -add_integration_tests(./baseMgNeutron/Tests/baseMgNeutronDatabase_iTest.f90) \ No newline at end of file + ./baseMgNeutron/baseMgNeutronDatabase_class.f90) + +# Add tests +add_integration_tests(./baseMgNeutron/Tests/baseMgNeutronDatabase_iTest.f90) \ No newline at end of file diff --git a/NuclearData/mgNeutronData/mgNeutronDatabase_inter.f90 b/NuclearData/mgNeutronData/mgNeutronDatabase_inter.f90 index e2c905cb4..9caca7c1e 100644 --- a/NuclearData/mgNeutronData/mgNeutronDatabase_inter.f90 +++ b/NuclearData/mgNeutronData/mgNeutronDatabase_inter.f90 @@ -20,7 +20,7 @@ module mgNeutronDatabase_inter !! It just provides a common superclass for related classes !! and holds the number of energy groups !! - !! Public members: + !! Public members: !! nG -> number of energy groups !! type, public, abstract, extends(nuclearDatabase) :: mgNeutronDatabase diff --git a/NuclearData/nuclideHandle_inter.f90 b/NuclearData/nuclideHandle_inter.f90 index c1aa55c7d..f61510dcb 100644 --- a/NuclearData/nuclideHandle_inter.f90 +++ b/NuclearData/nuclideHandle_inter.f90 @@ -72,5 +72,5 @@ end subroutine kill end interface - + end module nuclideHandle_inter diff --git a/NuclearData/testNeutronData/CMakeLists.txt b/NuclearData/testNeutronData/CMakeLists.txt index b4b37c522..7173c8b7b 100644 --- a/NuclearData/testNeutronData/CMakeLists.txt +++ b/NuclearData/testNeutronData/CMakeLists.txt @@ -1,3 +1,3 @@ -# Add to Compilation +# Add to Compilation add_sources( ./testNeutronDatabase_class.f90 - ./testNeutronMaterial_class.f90) \ No newline at end of file + ./testNeutronMaterial_class.f90) \ No newline at end of file diff --git a/NuclearData/xsPackages/CMakeLists.txt b/NuclearData/xsPackages/CMakeLists.txt index 0c91759d9..f1846803b 100644 --- a/NuclearData/xsPackages/CMakeLists.txt +++ b/NuclearData/xsPackages/CMakeLists.txt @@ -1 +1 @@ -add_sources(./neutronXsPackages_class.f90) \ No newline at end of file +add_sources(./neutronXsPackages_class.f90) \ No newline at end of file diff --git a/ParticleObjects/CMakeLists.txt b/ParticleObjects/CMakeLists.txt index 0cc2a3427..525d856a6 100644 --- a/ParticleObjects/CMakeLists.txt +++ b/ParticleObjects/CMakeLists.txt @@ -1,8 +1,8 @@ add_subdirectory(Source) -# Add Source Files to the global list +# Add Source Files to the global list add_sources( particle_class.f90 - particleDungeon_class.f90 ) + particleDungeon_class.f90 ) add_unit_tests( ./Tests/particle_test.f90 - ./Tests/particleDungeon_test.f90) + ./Tests/particleDungeon_test.f90) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 7d47337ec..485e9303e 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -27,8 +27,8 @@ module particleDungeon_class !! Dungeon can work like stacks or arrays. Stack-like behaviour is not really thread safe !! so it can be utilised when collecting and processing secondary particles in history !! that should be processed during the course of one cycle. Alternatively, one can use the - !! critical variations of the stack-like procedures. - !! Array-like behaviour allows to easily distribute particles among threads. As long as indices + !! critical variations of the stack-like procedures. + !! Array-like behaviour allows to easily distribute particles among threads. As long as indices !! assigned to different threads do not overlap, reading is thread-safe (I hope-MAK). !! !! @@ -170,18 +170,18 @@ subroutine detainCritical_particle(self,p) ! Increase population and weight self % pop = self % pop + 1 pop = self % pop - + ! Check for population overflow if (pop > size(self % prisoners)) then call fatalError(Here,'Run out of space for particles.& & Max size:'//numToChar(size(self % prisoners)) //& ' Current population: ' // numToChar(self % pop)) end if - + ! Load new particle self % prisoners(pop) = p !$omp end critical (dungeon) - + end subroutine detainCritical_particle !! @@ -224,16 +224,16 @@ subroutine detainCritical_particleState(self,p_state) !$omp critical (dungeon) self % pop = self % pop + 1 pop = self % pop - + ! Check for population overflow if (pop > size(self % prisoners)) then call fatalError(Here,'Run out of space for particles.& & Max size:'//numToChar(size(self % prisoners)) //& ' Current population: ' // numToChar(self % pop)) end if - + ! Load new particle - self % prisoners(pop) = p_state + self % prisoners(pop) = p_state !$omp end critical (dungeon) end subroutine detainCritical_particleState @@ -272,11 +272,11 @@ subroutine releaseCritical(self, p) ! Decrease population pop = self % pop self % pop = self % pop - 1 - + ! Load data into the particle p = self % prisoners(pop) !$omp end critical (dungeon) - + p % isDead = .false. end subroutine releaseCritical diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index a331d2105..d03990301 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -112,7 +112,7 @@ module particle_class ! Particle processing information class(RNG), pointer :: pRNG => null() ! Pointer to RNG associated with the particle real(defReal) :: k_eff ! Value of default keff for implicit source generation - integer(shortInt) :: geomIdx ! Index of the geometry used by the particle + integer(shortInt) :: geomIdx ! Index of the geometry used by the particle ! Archived snapshots of previous states type(particleState) :: preHistory diff --git a/PhysicsPackages/physicsPackage_inter.f90 b/PhysicsPackages/physicsPackage_inter.f90 index 50db9763b..a5e3e1792 100644 --- a/PhysicsPackages/physicsPackage_inter.f90 +++ b/PhysicsPackages/physicsPackage_inter.f90 @@ -48,5 +48,5 @@ end subroutine kill end interface contains - + end module physicsPackage_inter diff --git a/RandomNumbers/CMakeLists.txt b/RandomNumbers/CMakeLists.txt index 219469df6..23eac404e 100644 --- a/RandomNumbers/CMakeLists.txt +++ b/RandomNumbers/CMakeLists.txt @@ -1,4 +1,4 @@ -# Add Source Files to the global list +# Add Source Files to the global list add_sources( RNG_class.f90) -add_unit_tests( ./Tests/RNG_test.f90) \ No newline at end of file +add_unit_tests( ./Tests/RNG_test.f90) \ No newline at end of file diff --git a/RandomNumbers/Tests/RNG_test.f90 b/RandomNumbers/Tests/RNG_test.f90 index 315f40b2a..c37425ce3 100644 --- a/RandomNumbers/Tests/RNG_test.f90 +++ b/RandomNumbers/Tests/RNG_test.f90 @@ -58,7 +58,7 @@ subroutine testSkip() ! Skip 2nd generator forward call rand2 % skip(int(N, longInt)) r2_end = rand2 % get() - + ! Skip 2nd generator backwards. Must be 1 more becouse we drew a RN from generator call rand2 % skip(-int(N + 1, longInt)) r2_start = rand2 % get() diff --git a/SharedModules/Tests/charLib_test.f90 b/SharedModules/Tests/charLib_test.f90 index f4b8e230e..41c7b8f55 100644 --- a/SharedModules/Tests/charLib_test.f90 +++ b/SharedModules/Tests/charLib_test.f90 @@ -57,5 +57,5 @@ subroutine testSplitChar() end subroutine testSplitChar - + end module charLib_test diff --git a/SharedModules/Tests/conversions_test.f90 b/SharedModules/Tests/conversions_test.f90 index 3397e0bac..07b1b8c31 100644 --- a/SharedModules/Tests/conversions_test.f90 +++ b/SharedModules/Tests/conversions_test.f90 @@ -40,5 +40,5 @@ subroutine testCharToInt() end subroutine testCharToInt - + end module conversions_test diff --git a/SharedModules/Tests/sort_test.f90 b/SharedModules/Tests/sort_test.f90 index 0e279578c..e112a8126 100644 --- a/SharedModules/Tests/sort_test.f90 +++ b/SharedModules/Tests/sort_test.f90 @@ -24,7 +24,7 @@ subroutine testSwaping() @assertEqual(4_shortInt, i1) @assertEqual(-7_shortInt, i2) - + ! Swap same integers (If one tries XOR swap this can fail) i1 = 4 i2 = 4 diff --git a/SharedModules/grid_class.f90 b/SharedModules/grid_class.f90 index 360fb6a7a..45f887658 100644 --- a/SharedModules/grid_class.f90 +++ b/SharedModules/grid_class.f90 @@ -132,7 +132,7 @@ elemental function bin(self,idx) class(grid), intent(in) :: self integer(shortInt), intent(in) :: idx real(defReal) :: bin - + if (idx > 0 .and. idx <= size(self % bins)) then bin = self % bins(idx) else diff --git a/SharedModules/legendrePoly_func.f90 b/SharedModules/legendrePoly_func.f90 index ef135401d..232f8cc49 100644 --- a/SharedModules/legendrePoly_func.f90 +++ b/SharedModules/legendrePoly_func.f90 @@ -98,5 +98,5 @@ function sampleLegendre_P1(P1,rand) result(x) end function sampleLegendre_P1 - + end module legendrePoly_func diff --git a/SharedModules/numPrecision.f90 b/SharedModules/numPrecision.f90 index ec7d22a43..8ee8a140a 100644 --- a/SharedModules/numPrecision.f90 +++ b/SharedModules/numPrecision.f90 @@ -27,5 +27,5 @@ module numPrecision contains - + end module numPrecision diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index b3d6f9eec..8ce9626e9 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -79,6 +79,6 @@ module universalVariables ! Global name variables used to define specific geometry or field types character(nameLen), parameter :: nameUFS = 'uniFissSites' - character(nameLen), parameter :: nameWW = 'WeightWindows' + character(nameLen), parameter :: nameWW = 'WeightWindows' end module universalVariables diff --git a/Tallies/CMakeLists.txt b/Tallies/CMakeLists.txt index b82752c49..04d25d793 100644 --- a/Tallies/CMakeLists.txt +++ b/Tallies/CMakeLists.txt @@ -1,14 +1,14 @@ add_subdirectory(TallyClerks) add_subdirectory(TallyFilters) add_subdirectory(TallyMaps) -add_subdirectory(TallyResponses) +add_subdirectory(TallyResponses) -# Add Source Files to the global list +# Add Source Files to the global list add_sources( ./tallyCodes.f90 ./tallyResult_class.f90 ./tallyAdmin_class.f90 ./scoreMemory_class.f90) - + add_unit_tests(./Tests/scoreMemory_test.f90) - - + + diff --git a/Tallies/TallyClerks/CMakeLists.txt b/Tallies/TallyClerks/CMakeLists.txt index 1b0997906..65c25255a 100644 --- a/Tallies/TallyClerks/CMakeLists.txt +++ b/Tallies/TallyClerks/CMakeLists.txt @@ -1,4 +1,4 @@ -# Add Source Files to the global list +# Add Source Files to the global list add_sources(./tallyClerk_inter.f90 ./tallyClerkFactory_func.f90 ./tallyClerkSlot_class.f90 @@ -13,7 +13,7 @@ add_sources(./tallyClerk_inter.f90 ./centreOfMassClerk_class.f90 ./mgXsClerk_class.f90 ) - + add_unit_tests(./Tests/collisionClerk_test.f90 ./Tests/trackClerk_test.f90 ./Tests/keffAnalogClerk_test.f90 diff --git a/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 b/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 index c56ee5daf..d264bba2e 100644 --- a/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 +++ b/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 @@ -45,13 +45,13 @@ module collisionProbabilityClerk_class !! -> CPM is stored in column-major order [prodBin, startBin]. !! -> CPs are only non-zero within an energy group. It may be more efficient to !! define a slightly different CPClerk which has a separate map for energy. - !! With a fine energy and space discretisation, a large sparse matrix will be + !! With a fine energy and space discretisation, a large sparse matrix will be !! produced by the current clerk which could be avoided with a slightly different !! implementation. !! !! Private Members: !! map -> Map to divide phase-space into bins - !! resp -> Response for transfer function + !! resp -> Response for transfer function !! (Not presently used, would be macroTotal by default) !! N -> Number of Bins !! @@ -198,7 +198,7 @@ subroutine reportInColl(self, p, xsData, mem) ! neutrons which collide outside the mapped region of phase space ! These correspond to index = 0 - ! Calculate collision probability + ! Calculate collision probability ! Used the simple estimator - the commented line can allow CP to generalise to ! other responses ! For collision probability, top and bottom will cancel -- for other probabilities, diff --git a/Tallies/TallyClerks/mgXsClerk_class.f90 b/Tallies/TallyClerks/mgXsClerk_class.f90 index 1c8e6c5a8..ee0072e1b 100644 --- a/Tallies/TallyClerks/mgXsClerk_class.f90 +++ b/Tallies/TallyClerks/mgXsClerk_class.f90 @@ -124,7 +124,7 @@ subroutine init(self, dict, name) ! Assign name call self % setName(name) - + ! Load energy map and bin number if (dict % isPresent('energyMap')) then call new_tallyMap(self % energyMap, dict % getDictPtr('energyMap')) diff --git a/Tallies/TallyClerks/trackClerk_class.f90 b/Tallies/TallyClerks/trackClerk_class.f90 index 30ce3e5af..70ff771a0 100644 --- a/Tallies/TallyClerks/trackClerk_class.f90 +++ b/Tallies/TallyClerks/trackClerk_class.f90 @@ -36,7 +36,7 @@ module trackClerk_class !! response -> Array of responses !! width -> Number of responses (# of result bins for each map position) !! - !! NOTE that maps and filters refer to the pre-transition particle state! This + !! NOTE that maps and filters refer to the pre-transition particle state! This !! would lead to wrong results in case of spatial grids (e.g. a Cartesian x-y grid) !! !! Interface diff --git a/Tallies/TallyFilters/CMakeLists.txt b/Tallies/TallyFilters/CMakeLists.txt index b86600c1e..bf26e156c 100644 --- a/Tallies/TallyFilters/CMakeLists.txt +++ b/Tallies/TallyFilters/CMakeLists.txt @@ -1,11 +1,11 @@ -# Add Source Files to the global list +# Add Source Files to the global list add_sources( ./tallyFilter_inter.f90 ./tallyFilterSlot_class.f90 ./tallyFilterFactory_func.f90 ./testFilter_class.f90 ./energyFilter_class.f90 ) - + add_unit_tests(./Tests/energyFilter_test.f90 ./Tests/testFilter_test.f90 ) \ No newline at end of file diff --git a/Tallies/TallyFilters/energyFilter_class.f90 b/Tallies/TallyFilters/energyFilter_class.f90 index 339fc72d2..54b037c19 100644 --- a/Tallies/TallyFilters/energyFilter_class.f90 +++ b/Tallies/TallyFilters/energyFilter_class.f90 @@ -155,7 +155,7 @@ subroutine build_CE(self, Emin, Emax) self % Glow = -huge(self % Glow) end subroutine build_CE - + !! !! Build energyFilter for MG particles only from components !! diff --git a/Tallies/TallyFilters/tallyFilterSlot_class.f90 b/Tallies/TallyFilters/tallyFilterSlot_class.f90 index 36fecaa31..7b751c974 100644 --- a/Tallies/TallyFilters/tallyFilterSlot_class.f90 +++ b/Tallies/TallyFilters/tallyFilterSlot_class.f90 @@ -78,5 +78,5 @@ subroutine kill(self) end subroutine kill - + end module tallyFilterSlot_class diff --git a/Tallies/TallyFilters/testFilter_class.f90 b/Tallies/TallyFilters/testFilter_class.f90 index 663aba71c..7b57ea507 100644 --- a/Tallies/TallyFilters/testFilter_class.f90 +++ b/Tallies/TallyFilters/testFilter_class.f90 @@ -52,5 +52,5 @@ elemental function isPass(self,state) result(passed) passed = (self % minIdx <= state % matIdx) .and. (state % matIdx <= self % maxIdx) end function isPass - + end module testFilter_class diff --git a/Tallies/TallyMaps/Tests/multiMap_test.f90 b/Tallies/TallyMaps/Tests/multiMap_test.f90 index faee29754..a7a77f597 100644 --- a/Tallies/TallyMaps/Tests/multiMap_test.f90 +++ b/Tallies/TallyMaps/Tests/multiMap_test.f90 @@ -122,7 +122,7 @@ subroutine testPrint(this) call this % map % print(out) @assertTrue(out % isValid(),'Incorrect printing sequence: ') - call out % reset() + call out % reset() end subroutine testPrint diff --git a/Tallies/TallyMaps/Tests/spaceMap_test.f90 b/Tallies/TallyMaps/Tests/spaceMap_test.f90 index 569040ba2..15922bde3 100644 --- a/Tallies/TallyMaps/Tests/spaceMap_test.f90 +++ b/Tallies/TallyMaps/Tests/spaceMap_test.f90 @@ -185,7 +185,7 @@ subroutine testPrint(this) call this % map_unstruct % print(out) @assertTrue(out % isValid(),'For map with unstructured grid: ') - call out % reset() + call out % reset() end subroutine testPrint diff --git a/Tallies/TallyMaps/Tests/weightMap_test.f90 b/Tallies/TallyMaps/Tests/weightMap_test.f90 index f018077b4..e2c434ea9 100644 --- a/Tallies/TallyMaps/Tests/weightMap_test.f90 +++ b/Tallies/TallyMaps/Tests/weightMap_test.f90 @@ -194,7 +194,7 @@ subroutine testPrint(this) call this % map_unstruct % print(out) @assertTrue(out % isValid(),'Unstructured map case') - call out % reset() + call out % reset() end subroutine testPrint diff --git a/Tallies/TallyMaps/tallyMap1D_inter.f90 b/Tallies/TallyMaps/tallyMap1D_inter.f90 index 804cdd14c..c8fffd8fc 100644 --- a/Tallies/TallyMaps/tallyMap1D_inter.f90 +++ b/Tallies/TallyMaps/tallyMap1D_inter.f90 @@ -39,7 +39,7 @@ elemental function dimensions(self) result(D) D = 1 end function dimensions - + !! !! Return to uninitialised state !! diff --git a/Tallies/TallyResponses/CMakeLists.txt b/Tallies/TallyResponses/CMakeLists.txt index 67985b802..872f53da7 100644 --- a/Tallies/TallyResponses/CMakeLists.txt +++ b/Tallies/TallyResponses/CMakeLists.txt @@ -1,6 +1,6 @@ -# Add Source Files to the global list +# Add Source Files to the global list add_sources(./tallyResponse_inter.f90 - ./tallyResponseFactory_func.f90 + ./tallyResponseFactory_func.f90 ./tallyResponseSlot_class.f90 ./fluxResponse_class.f90 ./macroResponse_class.f90 @@ -9,9 +9,9 @@ add_sources(./tallyResponse_inter.f90 ./testResponse_class.f90 ) - + add_unit_tests(./Tests/fluxResponse_test.f90 - ./Tests/testResponse_test.f90 + ./Tests/testResponse_test.f90 ./Tests/macroResponse_test.f90 ./Tests/microResponse_test.f90 ./Tests/weightResponse_test.f90 diff --git a/Tallies/scoreMemory_class.f90 b/Tallies/scoreMemory_class.f90 index feb195f75..16d73d255 100644 --- a/Tallies/scoreMemory_class.f90 +++ b/Tallies/scoreMemory_class.f90 @@ -176,7 +176,7 @@ end subroutine kill subroutine score_defReal(self, score, idx) class(scoreMemory), intent(inout) :: self real(defReal), intent(in) :: score - integer(longInt), intent(in) :: idx + integer(longInt), intent(in) :: idx integer(shortInt) :: thread_idx character(100),parameter :: Here = 'score_defReal (scoreMemory_class.f90)' @@ -278,18 +278,18 @@ subroutine closeCycle(self, normFactor) self % cycles = self % cycles + 1 if(mod(self % cycles, self % batchSize) == 0) then ! Close Batch - + !$omp parallel do do i = 1, self % N - + ! Normalise scores self % parallelBins(i,:) = self % parallelBins(i,:) * normFactor res = sum(self % parallelBins(i,:)) - + ! Zero all score bins self % parallelBins(i,:) = ZERO - - ! Increment cumulative sums + + ! Increment cumulative sums self % bins(i,CSUM) = self % bins(i,CSUM) + res self % bins(i,CSUM2) = self % bins(i,CSUM2) + res * res diff --git a/Tallies/tallyActiveAdmin_class.f90 b/Tallies/tallyActiveAdmin_class.f90 index dd7f01d76..19366a5b6 100644 --- a/Tallies/tallyActiveAdmin_class.f90 +++ b/Tallies/tallyActiveAdmin_class.f90 @@ -228,5 +228,5 @@ function isConverged(self) result(isIt) end if end function isConverged - + end module tallyActiveAdmin_class diff --git a/Tallies/tallyAdminBase_class.f90 b/Tallies/tallyAdminBase_class.f90 index 6643e2d4d..7a8f70472 100644 --- a/Tallies/tallyAdminBase_class.f90 +++ b/Tallies/tallyAdminBase_class.f90 @@ -89,7 +89,7 @@ module tallyAdminBase_class public :: init public :: print public :: kill - + contains !! !! Process incoming collision report diff --git a/Tallies/tallyInactiveAdmin_class.f90 b/Tallies/tallyInactiveAdmin_class.f90 index 1f7e4507a..3d3f5f92a 100644 --- a/Tallies/tallyInactiveAdmin_class.f90 +++ b/Tallies/tallyInactiveAdmin_class.f90 @@ -128,5 +128,5 @@ subroutine display(self) call display_super(self) end subroutine display - + end module tallyInactiveAdmin_class diff --git a/Tallies/tallyTimeAdmin_class.f90 b/Tallies/tallyTimeAdmin_class.f90 index 25163d72f..5e0074c71 100644 --- a/Tallies/tallyTimeAdmin_class.f90 +++ b/Tallies/tallyTimeAdmin_class.f90 @@ -215,5 +215,5 @@ function isConverged(self) result(isIt) end if end function isConverged - + end module tallyTimeAdmin_class diff --git a/UserInterface/commandLineUI.f90 b/UserInterface/commandLineUI.f90 index 9b6c7786d..bd34ee552 100644 --- a/UserInterface/commandLineUI.f90 +++ b/UserInterface/commandLineUI.f90 @@ -482,7 +482,7 @@ subroutine init_optionDescriptor(self,keyword,Narg,argTypes,help) case default call parseError("Unrecognised argument type: "//trim(argTypes(i))//" Must be & - & 'int', 'real' or 'char' ") + & 'int', 'real' or 'char' ") end select end do diff --git a/Visualisation/VTK/CMakeLists.txt b/Visualisation/VTK/CMakeLists.txt index 5975e9d0f..bee40744b 100644 --- a/Visualisation/VTK/CMakeLists.txt +++ b/Visualisation/VTK/CMakeLists.txt @@ -1,2 +1,2 @@ -# Add Source Files to the global list -add_sources( outputVTK_class.f90) +# Add Source Files to the global list +add_sources( outputVTK_class.f90) diff --git a/Visualisation/VTK/outputVTK_class.f90 b/Visualisation/VTK/outputVTK_class.f90 index b1a7e0dcc..a7c691bfe 100644 --- a/Visualisation/VTK/outputVTK_class.f90 +++ b/Visualisation/VTK/outputVTK_class.f90 @@ -46,14 +46,14 @@ module outputVTK_class !! } !! type, public :: outputVTK - logical(defBool), private :: legacy = .TRUE. - integer(shortInt), dimension(2), private :: version = [3,0] - real(defReal), dimension(3), private :: corner - real(defReal), dimension(3), private :: width - integer(shortInt), dimension(3), private :: nVox - integer(shortInt), private :: nCells + logical(defBool), private :: legacy = .TRUE. + integer(shortInt), dimension(2), private :: version = [3,0] + real(defReal), dimension(3), private :: corner + real(defReal), dimension(3), private :: width + integer(shortInt), dimension(3), private :: nVox + integer(shortInt), private :: nCells integer(shortInt), private :: nOutput - real(defReal), dimension(:,:,:,:), allocatable, private :: values + real(defReal), dimension(:,:,:,:), allocatable, private :: values character(nameLen), dimension(:), allocatable, private :: dataName logical(defBool), dimension(:), allocatable, private :: dataReal contains diff --git a/cmake/FindPFUNIT.cmake b/cmake/FindPFUNIT.cmake index 6079da5d8..0b49bc379 100644 --- a/cmake/FindPFUNIT.cmake +++ b/cmake/FindPFUNIT.cmake @@ -1,99 +1,98 @@ -# TODO: Sort out the licence +# TODO: Sort out the licence #[=======================================================================[.rst: Find pFUnit -=========== +=========== -Find the pFUnit Fortran Unit Test Framework +Find the pFUnit Fortran Unit Test Framework -General guide to writing Find Modules in CMake is available here: +General guide to writing Find Modules in CMake is available here: https://cmake.org/cmake/help/git-master/manual/cmake-developer.7.html#modules -Expects to find environmental variable PFUNIT_INSTALL that points to the installation -directory of pFUnit. +Expects to find environmental variable PFUNIT_INSTALL that points to the installation +directory of pFUnit. -Result Variables +Result Variables ^^^^^^^^^^^^^^^^ Sets some of the usual findModule variables: - -``PFUNIT_FOUND`` + +``PFUNIT_FOUND`` True if PFUNIT was found. -``PFUNIT_LIBRARIES`` +``PFUNIT_LIBRARIES`` Library to link against ``PFUNIT_INCLUDE_DIR`` - Directory with driver.F90 file + Directory with driver.F90 file Sets some pFUnit Specific variables as well: ``PFUNIT_MOD`` Location of the module directory of pFUnit ``PFUNIT_PREPROC`` - Location of pFUnit Python Preprocessor + Location of pFUnit Python Preprocessor #]=======================================================================] -# TODO: understand what these lines actually do -unset(PFUNIT_LIBRARY CACHE) +# TODO: understand what these lines actually do +unset(PFUNIT_LIBRARY CACHE) unset(PFUNIT_INCLUDE_DIR CACHE) -unset(PFUNIT_MODULES CACHE) -unset(PFUNIT_PREPROC CACHE) +unset(PFUNIT_MODULES CACHE) +unset(PFUNIT_PREPROC CACHE) -# Find path to the pFUnit test driver programme +# Find path to the pFUnit test driver programme find_path(PFUNIT_INCLUDE_DIR - NAMES driver.F90 + NAMES driver.F90 PATHS ENV PFUNIT_INCLUDE_DIR ENV PFUNIT_INSTALL ENV INCLUDE - PATH_SUFFIXES include) - -# Find path to the pFUnit library -find_library(PFUNIT_LIBRARY - NAMES libpfunit.a libpfunit pfunit.a pfunit + PATH_SUFFIXES include) + +# Find path to the pFUnit library +find_library(PFUNIT_LIBRARY + NAMES libpfunit.a libpfunit pfunit.a pfunit PATHS ENV PFUNIT_LIBRARY - ENV PFUNIT_INSTALL - PATH_SUFFIXES lib ) - -# Find path to the pFUnit module directory -find_path(PFUNIT_MODULES + ENV PFUNIT_INSTALL + PATH_SUFFIXES lib ) + +# Find path to the pFUnit module directory +find_path(PFUNIT_MODULES NAMES pfunit_mod pfunit_mod.mod PATHS ENV PFUNIT_MODULES - ENV PFUNIT_INSTALL - PATH_SUFFIXES mod) - + ENV PFUNIT_INSTALL + PATH_SUFFIXES mod) + # Find path to the pFnit Python preprocessor script -find_path(PFUNIT_PREPROC - NAMES pFUnitParser.py - PATHS ENV PATH - ENV PFUNIT_INSTALL - PATH_SUFFIXES bin) - -# Support the REQUIRED and QUIET arguments and set PFUNIT_FOUND to True if found -set(failMSG "pFUnit unit test framework was not found. Set PFUNIT_INSTALL environmental \ +find_path(PFUNIT_PREPROC + NAMES pFUnitParser.py + PATHS ENV PATH + ENV PFUNIT_INSTALL + PATH_SUFFIXES bin) + +# Support the REQUIRED and QUIET arguments and set PFUNIT_FOUND to True if found +set(failMSG "pFUnit unit test framework was not found. Set PFUNIT_INSTALL environmental \ variable to the root of the pFUnit installation directory. If pFUnit is not installed on your \ system, in README you will find instruction on how to obtain it and compile it") include (FindPackageHandleStandardArgs) -find_package_handle_standard_args(PFUNIT ${failMSG} PFUNIT_LIBRARY - PFUNIT_INCLUDE_DIR - PFUNIT_MODULES +find_package_handle_standard_args(PFUNIT ${failMSG} PFUNIT_LIBRARY + PFUNIT_INCLUDE_DIR + PFUNIT_MODULES PFUNIT_PREPROC) -# Handle success and find failure -if(PFUNIT_FOUND) - set(PFUNIT_LIBRARIES ${PFUNIT_LIBRARY}) +# Handle success and find failure +if(PFUNIT_FOUND) + set(PFUNIT_LIBRARIES ${PFUNIT_LIBRARY}) set(PFUNIT_INCLUDE_DIRS ${PFUNIT_INCLUDE_DIR}) set(PFUNIT_MOD ${PFUNIT_MODULES}) - + else() - message(FATAL_ERROR "pFUnit unit test framework was not found. Set PFUNIT_INSTALL environmental + message(FATAL_ERROR "pFUnit unit test framework was not found. Set PFUNIT_INSTALL environmental variable to the root of the pFUnit installation directory. If pFUnit is not installed on your \ system in README you will find instruction on how to obtain it and compile it" ) endif() mark_as_advanced(PFUNIT_LIBRARY PFUNIT_INCLUDE_DIR PFUNIT_MODULES) - - - \ No newline at end of file + + diff --git a/cmake/add_integration_tests.cmake b/cmake/add_integration_tests.cmake index f99326723..f6425f363 100644 --- a/cmake/add_integration_tests.cmake +++ b/cmake/add_integration_tests.cmake @@ -1,20 +1,20 @@ -# Accumulate source files in a global property INTEGRATION_TEST_LIST -# Store source files with their absolute files +# Accumulate source files in a global property INTEGRATION_TEST_LIST +# Store source files with their absolute files # -# At the end INTEGRATION_TEST_LIST can be converted to a variable and used to -# compile large number of files spread across multiple folders with a single command +# At the end INTEGRATION_TEST_LIST can be converted to a variable and used to +# compile large number of files spread across multiple folders with a single command # -function(add_integration_tests) - # Check if the property is already defined - # If it isn't define it +function(add_integration_tests) + # Check if the property is already defined + # If it isn't define it get_property(is_defined GLOBAL PROPERTY INTEGRATION_TEST_LIST DEFINED) if(NOT is_defined) define_property(GLOBAL PROPERTY INTEGRATION_TEST_LIST - BRIEF_DOCS "List of all integration test files" - FULL_DOCS "List of all pFUnit integration test suite files for preprocessing & compilation") + BRIEF_DOCS "List of all integration test files" + FULL_DOCS "List of all pFUnit integration test suite files for preprocessing & compilation") endif() - - # Take files listed in argument list and make their paths absolute + + # Take files listed in argument list and make their paths absolute set(TESTS) foreach(t IN LISTS ARGN) if(NOT IS_ABSOLUTE "${t}") @@ -22,8 +22,8 @@ function(add_integration_tests) endif() list(APPEND TESTS "${t}") endforeach() - - # Append files in argument list to global property - set_property(GLOBAL APPEND PROPERTY INTEGRATION_TESTS_LIST "${TESTS}") - -endfunction(add_integration_tests) \ No newline at end of file + + # Append files in argument list to global property + set_property(GLOBAL APPEND PROPERTY INTEGRATION_TESTS_LIST "${TESTS}") + +endfunction(add_integration_tests) \ No newline at end of file diff --git a/cmake/add_sources.cmake b/cmake/add_sources.cmake index 0bee67e8f..2197c7911 100644 --- a/cmake/add_sources.cmake +++ b/cmake/add_sources.cmake @@ -1,20 +1,20 @@ -# Accumulate source files in a global property SRCS_LIST -# Store source files with their absolute files +# Accumulate source files in a global property SRCS_LIST +# Store source files with their absolute files # -# Add the end SCRS_LIST can be converted to a variable and used to -# compile large number of files spread across multiple folders with a single command +# Add the end SCRS_LIST can be converted to a variable and used to +# compile large number of files spread across multiple folders with a single command # function(add_sources) - # Check if the property is already defined - # If it isn't define it + # Check if the property is already defined + # If it isn't define it get_property(is_defined GLOBAL PROPERTY SRCS_LIST DEFINED) if(NOT is_defined) define_property(GLOBAL PROPERTY SRCS_LIST BRIEF_DOCS "List of source files" FULL_DOCS "List of source files to be compiled in one library") endif() - - # Take files listed in argument list and make their paths absolute + + # Take files listed in argument list and make their paths absolute set(SRCS) foreach(s IN LISTS ARGN) if(NOT IS_ABSOLUTE "${s}") @@ -22,7 +22,7 @@ function(add_sources) endif() list(APPEND SRCS "${s}") endforeach() - - # Append files in argument list to global property - set_property(GLOBAL APPEND PROPERTY SRCS_LIST "${SRCS}") + + # Append files in argument list to global property + set_property(GLOBAL APPEND PROPERTY SRCS_LIST "${SRCS}") endfunction(add_sources) \ No newline at end of file diff --git a/cmake/add_unit_tests.cmake b/cmake/add_unit_tests.cmake index 124ef4040..5159a1fe7 100644 --- a/cmake/add_unit_tests.cmake +++ b/cmake/add_unit_tests.cmake @@ -1,20 +1,20 @@ -# Accumulate source files in a global property UNIT_TEST_LIST -# Store source files with their absolute files +# Accumulate source files in a global property UNIT_TEST_LIST +# Store source files with their absolute files # -# At the end UNIT_TEST_LIST can be converted to a variable and used to -# compile large number of files spread across multiple folders with a single command +# At the end UNIT_TEST_LIST can be converted to a variable and used to +# compile large number of files spread across multiple folders with a single command # -function(add_unit_tests) - # Check if the property is already defined - # If it isn't define it +function(add_unit_tests) + # Check if the property is already defined + # If it isn't define it get_property(is_defined GLOBAL PROPERTY UNIT_TEST_LIST DEFINED) if(NOT is_defined) define_property(GLOBAL PROPERTY UNIT_TEST_LIST - BRIEF_DOCS "List of all test files" - FULL_DOCS "List of all pFUnit test suite files for preprocessing & compilation") + BRIEF_DOCS "List of all test files" + FULL_DOCS "List of all pFUnit test suite files for preprocessing & compilation") endif() - - # Take files listed in argument list and make their paths absolute + + # Take files listed in argument list and make their paths absolute set(TESTS) foreach(t IN LISTS ARGN) if(NOT IS_ABSOLUTE "${t}") @@ -22,8 +22,8 @@ function(add_unit_tests) endif() list(APPEND TESTS "${t}") endforeach() - - # Append files in argument list to global property - set_property(GLOBAL APPEND PROPERTY UNIT_TESTS_LIST "${TESTS}") - -endfunction(add_unit_tests) \ No newline at end of file + + # Append files in argument list to global property + set_property(GLOBAL APPEND PROPERTY UNIT_TESTS_LIST "${TESTS}") + +endfunction(add_unit_tests) \ No newline at end of file diff --git a/docs/Unit Testing.rst b/docs/Unit Testing.rst index 96f2d035a..4063d1cd7 100644 --- a/docs/Unit Testing.rst +++ b/docs/Unit Testing.rst @@ -5,4 +5,4 @@ Unit Testing pFUnit ------ -Information on using pFUnit to create tests will appear here +Information on using pFUnit to create tests will appear here diff --git a/docs/User Manual.rst b/docs/User Manual.rst index 96008fbbe..285ce9110 100644 --- a/docs/User Manual.rst +++ b/docs/User Manual.rst @@ -22,14 +22,14 @@ eigenPhysicsPackage, used for criticality (or eigenvalue) calculations * active: number of active cycles * inactive: number of inactive cycles * dataType: determines type of nuclear data used; can be ``ce`` or ``mg`` -* XSdata: keyword to the name of the nuclearDataHandle used -* seed (*optional*): initial seed for the pseudo random number generator +* XSdata: keyword to the name of the nuclearDataHandle used +* seed (*optional*): initial seed for the pseudo random number generator * outputFile (*optional*, default = 'output'): name of the output file -* outputFormat (*optional*, default = ``asciiMATLAB``): type of output file. - Choices are ``asciiMATLAB`` and ``asciiJSON`` - +* outputFormat (*optional*, default = ``asciiMATLAB``): type of output file. + Choices are ``asciiMATLAB`` and ``asciiJSON`` + Example: :: - + type eigenPhysicsPackage; pop 100000; active 100; @@ -39,20 +39,20 @@ Example: :: seed -244654; outputFile PWR_1; outputFormat asciiJSON; - + transportOperator { } collisionOperator { } inactiveTally { } activeTally { } geometry { } nuclearData { } - + *Optional entries* :: uniformFissionSites { } varianceReduction { } source { } - + .. note:: Although a ``source`` definition is not required, it can be included to replace the default uniform fission source guess used in the first cycle @@ -65,12 +65,12 @@ fixedSourcePhysicsPackage, used for fixed source calculations * pop: number of particles used per batch * cycles: number of batches * dataType: determines type of nuclear data used. Can be ``ce`` or ``mg`` -* XSdata: keyword to the name of the nuclearDataHandle used -* seed (*optional*): initial seed for the pseudo random number generator +* XSdata: keyword to the name of the nuclearDataHandle used +* seed (*optional*): initial seed for the pseudo random number generator * outputFile (*optional*, default = 'output'): name of the output file -* outputFormat (*optional*, default = ``asciiMATLAB``): type of output file. - Choices are ``asciiMATLAB`` and ``asciiJSON`` - +* outputFormat (*optional*, default = ``asciiMATLAB``): type of output file. + Choices are ``asciiMATLAB`` and ``asciiJSON`` + Example: :: type fixedSourcePhysicsPackage; @@ -80,7 +80,7 @@ Example: :: XSdata ceData; seed 2829741; outputFile shield_type11; - + transportOperator { } collisionOperator { } tally { } @@ -101,15 +101,15 @@ rayVolPhysicsPackage, used to perform ray-tracing based volume calculation * cycles: number of cycles * mfp: mean length of ray segments * abs_prob: ray absorption probability after each segment -* robust: 1 for true; 0 for false; enable robust mode: in this case at each collision, - each particle verifies that the material it currently thinks it is in and the one - obtained by *placing* a particle in the geometry with the same spatial position and +* robust: 1 for true; 0 for false; enable robust mode: in this case at each collision, + each particle verifies that the material it currently thinks it is in and the one + obtained by *placing* a particle in the geometry with the same spatial position and direction are in agreement * cache: 1 for true; 0 for false; enable distance caching -* seed (*optional*): initial seed for the pseudo random number generator - +* seed (*optional*): initial seed for the pseudo random number generator + Example: :: - + type rayVolPhysicsPackage; pop 1000000; cycles 100; @@ -117,61 +117,61 @@ Example: :: abs_prob 0.1; robust 1; cache 1; - + geometry { } nuclearData { } vizPhysicsPackage ################# -vizPhysicsPackage, used for visualising geometry +vizPhysicsPackage, used for visualising geometry Example: :: - + type vizPhysicsPackage; geometry { } viz { } - + Source ------ - -For the moment, the only possible external **source** type in SCONE in a point source. + +For the moment, the only possible external **source** type in SCONE in a point source. The properties of a point source are: * r: (x y z) vector with the origin position. [cm] -* particle: ``neutron`` or ``photon``, according to the type of particles emitted by the +* particle: ``neutron`` or ``photon``, according to the type of particles emitted by the source * E or G: emission energy - E: energy of the particles emitted, for continuous energy calculations. [MeV] - G: energy group of the particles emitted, for multi-group calculations - -* dir (*optional*, default = isotropic): (u v w) vector with the direction of the source + +* dir (*optional*, default = isotropic): (u v w) vector with the direction of the source particles Hence, an input would look like: :: source { type pointSource; r (0.0 1.0 5.2); particle neutron; E 14.1; dir (0.0 1.0 0.0); } - + Transport Operator ------------------ The **transport operator** takes care of moving the particles from one collision location to another. In the input file, one must include: :: - + transportOperator { type ; *keywords* } - -The possible types are: + +The possible types are: * transportOperatorST, performs surface tracking (ST) or ray tracing * transportOperatorDT, performs Woodcock delta tracking (DT) * transportOperatorHT, performs a hybrid between ST and DT - - cutoff (*optional*, default = 0.9): cutoff between ST and DT. If, at the particle - energy, the ratio between the local material cross section and the majorant cross + - cutoff (*optional*, default = 0.9): cutoff between ST and DT. If, at the particle + energy, the ratio between the local material cross section and the majorant cross section is larger than the cutoff, DT is used; otherwise ST is used. - + Example: :: transportOperator { type transportOperatorHT; cutoff 0.85; } @@ -179,8 +179,8 @@ Example: :: Collision Operator ------------------ -The **collision operator** process all collision types. It samples the colliding nuclide -and the reaction, and calculates all relevant by-products. In the input file, one must +The **collision operator** process all collision types. It samples the colliding nuclide +and the reaction, and calculates all relevant by-products. In the input file, one must include: :: collisionOperator { neutronCE { type ; *keywords* } } @@ -189,8 +189,8 @@ if continuos energy nuclear data are used, or :: collisionOperator { neutronMG { type ; } } -if multi-group nuclear data are used. In a hybrid simulation, both ``neutronCE`` and -``neutronMG`` can be included. +if multi-group nuclear data are used. In a hybrid simulation, both ``neutronCE`` and +``neutronMG`` can be included. The possible types to be used with **continuous energy** data are: @@ -201,15 +201,15 @@ neutronCEstd, to perform analog collision processing * minEnergy (*optional*, default = 1.0e-11): minimum energy cut-off. [MeV] * maxEnergy (*optional*, default = 20.0): maximum energy cut-off. [MeV] -* energyThreshold (*optional*, default = 400): energy threshold for explicit treatment - of target nuclide movement. Target movement is sampled if neutron energy E < kT ∗ +* energyThreshold (*optional*, default = 400): energy threshold for explicit treatment + of target nuclide movement. Target movement is sampled if neutron energy E < kT ∗ energyThreshold where kT is target material temperature in [MeV]. [-] -* massThreshold (*optional*, default = 1): mass threshold for explicit treatment of - target nuclide movement. Target movement is sampled if target mass A < massThreshold. [Mn] - +* massThreshold (*optional*, default = 1): mass threshold for explicit treatment of + target nuclide movement. Target movement is sampled if target mass A < massThreshold. [Mn] + Example: :: - - collisionOperator { neutronCE { type neutronCEstd; minEnergy 1.0e-12; maxEnergy 30.0; + + collisionOperator { neutronCE { type neutronCEstd; minEnergy 1.0e-12; maxEnergy 30.0; energyThreshold 200; massThreshold 2; } } neutronCEimp @@ -219,37 +219,37 @@ neutronCEimp, to perform implicit collision processing * minEnergy (*optional*, default = 1.0e-11): minimum energy cut-off. [MeV] * maxEnergy (*optional*, default = 20.0): maximum energy cut-off. [MeV] -* energyThreshold (*optional*, default = 400): energy threshold for explicit treatment - of target nuclide movement. Target movement is sampled if neutron energy E < kT ∗ +* energyThreshold (*optional*, default = 400): energy threshold for explicit treatment + of target nuclide movement. Target movement is sampled if neutron energy E < kT ∗ energyThreshold where kT is target material temperature in [MeV]. [-] -* massThreshold (*optional*, default = 1): mass threshold for explicit treatment - of target nuclide movement. Target movement is sampled if target mass A < - massThreshold. [Mn] -* splitting (*optional*, default = 0): 1 for true; 0 for false; enables splitting +* massThreshold (*optional*, default = 1): mass threshold for explicit treatment + of target nuclide movement. Target movement is sampled if target mass A < + massThreshold. [Mn] +* splitting (*optional*, default = 0): 1 for true; 0 for false; enables splitting for particles above a certain weight -* roulette (*optional*, default = 0): 1 for true; 0 for false; enables rouletting +* roulette (*optional*, default = 0): 1 for true; 0 for false; enables rouletting of particles below a certain weight * minWgt (*optional*, default = 0.25): minimum particle weight for rouletting * maxWgt (*optional*, default = 1.25): maximum particle weight for splitting * avgWgt (*optional*, default = 0.5): weight of a particle on surviving rouletting * impAbs (*optional*, default = 0): 1 for true; 0 for false; enables implicit capture -* impGen (*optional*, default = 1): 1 for true; 0 for false; enables implicit fission +* impGen (*optional*, default = 1): 1 for true; 0 for false; enables implicit fission sites generation -* weightWindows (*optional*, default = 0): 1 for true; 0 for false; enables the use of - weight windows -* UFS (*optional*, default = 0): 1 for true; 0 for false; enables the use of uniform - fission sites - +* weightWindows (*optional*, default = 0): 1 for true; 0 for false; enables the use of + weight windows +* UFS (*optional*, default = 0): 1 for true; 0 for false; enables the use of uniform + fission sites + Example: :: - - collisionOperator { neutronCE { type neutronCEimp; minEnergy 1.0e-12; maxEnergy 30.0; + + collisionOperator { neutronCE { type neutronCEimp; minEnergy 1.0e-12; maxEnergy 30.0; impAbs 1; roulette 1; splitting 1; impGen 1; maxWgt 2.0; minWgt 0.1; UFS 1; } } - + The possible types to be used with **multi-group** data are: neutronMGstd ############ - + neutronMGstd, to perform analog collision processing Example: :: @@ -259,7 +259,7 @@ Example: :: Weight Windows -------------- -Weight windows can be used if, inside the collision operator ``CEneutronimp``, the +Weight windows can be used if, inside the collision operator ``CEneutronimp``, the keyword ``weightWindows`` is set to 1. Then, in the input file, one needs to add: :: varianceReduction { type weightWindowsField; file ; } @@ -276,49 +276,49 @@ The file that contains **weight windows** has to include: Example: :: - map { type multiMap; maps (mapx mapy); - mapx { type spaceMap; axis x; grid unstruct; bins (0.0 1.0 2.0); } - mapy { type spaceMap; axis y; grid unstruct; bins (0.0 5.0 10.0 15.0); } } - constSurvival 2.0; - wLower (0.5 0.1 0.2 0.1 0.5 0.5); - wUpper (2.0 1.2 1.5 1.1 2.0 4.0); - + map { type multiMap; maps (mapx mapy); + mapx { type spaceMap; axis x; grid unstruct; bins (0.0 1.0 2.0); } + mapy { type spaceMap; axis y; grid unstruct; bins (0.0 5.0 10.0 15.0); } } + constSurvival 2.0; + wLower (0.5 0.1 0.2 0.1 0.5 0.5); + wUpper (2.0 1.2 1.5 1.1 2.0 4.0); + Uniform Fission Sites --------------------- -Weight windows can be used if, inside the collision operator ``CEneutronimp``, the +Weight windows can be used if, inside the collision operator ``CEneutronimp``, the keyword ``UFS`` is set to 1. Then, in the input file, one needs to add: :: uniformFissionSites { type uniFissSitesField; map { } *keywords* } - -In the input above, ``map`` is the geometrical map used for UFS. The map has to contain + +In the input above, ``map`` is the geometrical map used for UFS. The map has to contain fissile material for the method to make sense. Other keywords are: -* uniformVolMap (*optional*, default = 1): 1 for true; 0 for false; flag that states +* uniformVolMap (*optional*, default = 1): 1 for true; 0 for false; flag that states whether the bins of the map contain equal volumes of fissile material or not * popVolumes (*optional*, default = 1.0e7): if ``uniformVolMap`` is false, a Monte Carlo calculation is run to estimate the fissile material volumes in each map bin. This entry - correspond to the number of points sampled in the geometry for the volume calculation. + correspond to the number of points sampled in the geometry for the volume calculation. Note that this volume calculation is done only once during initialisation Example: :: - uniformFissionSites { type uniFissSitesField; uniformVolMap 0; popVolumes 1.0e8; - map { } + uniformFissionSites { type uniFissSitesField; uniformVolMap 0; popVolumes 1.0e8; + map { } } Geometry -------- -A detailed description about the geometry modelling adopted in SCONE can be found at +A detailed description about the geometry modelling adopted in SCONE can be found at :ref:`Geometry `. In an input file, one has to include: :: - geometry { type ; boundary (a b c d e f); graph { type ; } + geometry { type ; boundary (a b c d e f); graph { type ; } surfaces { } cells { } - universes { } + universes { } } - + At the moment, the only **geometry** type available is ``geometryStd``. As for the boundary six integers have to be inputted. These correspond to the boundary conditions at boundaries (-x +x -y +y -z +z). The possibilities are: @@ -327,11 +327,11 @@ six integers have to be inputted. These correspond to the boundary conditions at * reflective: input 1 * periodic: input 2 -.. note:: +.. note:: Strictly speaking it is up to a particular boundary surface to interpret how the values in the boundary condition sequence are interpreted. For all cube-like surfaces the rule above holds, but for more exotic boundaries (e.g., hexagons) it is worth double checking - the documentation comment of the particular surface in the source code. + the documentation comment of the particular surface in the source code. .. note:: Curved surfaces only allow for vacuum boundaries. @@ -343,10 +343,10 @@ The **graph** definition allows two options: Hence, an example of a geometry input could look like: :: - geometry { type geometryStd; boundary (1 1 1 1 0 0); graph { type shrunk; } + geometry { type geometryStd; boundary (1 1 1 1 0 0); graph { type shrunk; } surfaces { } cells { } - universes { } + universes { } } For more details about the graph-like structure of the nested geometry see the relevant @@ -357,18 +357,18 @@ Surfaces To define one or multiple **surfaces**, the necessary entries are: :: - surfaces { - { id ; type ; *keywords* } - { id ; type ; *keywords* } + surfaces { + { id ; type ; *keywords* } + { id ; type ; *keywords* } ... - { id ; type ; *keywords* } + { id ; type ; *keywords* } } Here, the ``name`` can be anything at the discretion of the user, as long as it doesn't contain spaces. The ``idNumber`` can be any integer; attention must be paid that all -``idNumbers`` are unique. +``idNumbers`` are unique. -Several ``surfaceTypes`` are possible: +Several ``surfaceTypes`` are possible: * box: axis aligned box @@ -390,7 +390,7 @@ input type has to be ``xSquareCylinder``, ``ySquareCylinder`` or ``zSquareCylind Example: :: surf2 { id 25; type ySquareCylinder; origin (3.0 0.0 9.0); halfwidth (4.4 0.0 0.1); } - + * truncCylinder: finite length cylinder aligned with x, y or z axis. The input type has to be ``xTruncCylinder``, ``yTruncCylinder`` or ``zTruncCylinder`` @@ -402,7 +402,7 @@ Example: :: surf3 { id 3; type zTruncCylinder; origin (3.0 2.1 5.0); halfwidth 20.0; radius 1.6; } - + * aPlane: plane with normal along x, y or z. The input type has to be ``xPlane``, ``yPlane`` or ``zPlane`` @@ -412,7 +412,7 @@ Example: :: Example: :: surf4 { id 8; type xPlane; x0 4.0; } - + * plane: generic plane (F(r) = c1 * x + c2 * y + c3 * z - c4) - coeffs: (c1 c2 c3 c4) vector with coefficients @@ -420,8 +420,8 @@ Example: :: Example: :: surf5 { id 55; type plane; coeffs (8.6 3.0 66.0 1.5); } - -* cylinder: infinitely long cylinder aligned with x, y or z axis. The input type + +* cylinder: infinitely long cylinder aligned with x, y or z axis. The input type has to be ``xCylinder``, ``yCylinder`` or ``zCylinder`` - origin: (x y z) vector with the origin position; the entry corresponding to @@ -431,7 +431,7 @@ Example: :: Example: :: billy { id 92; type xCylinder; origin (0.0 0.0 9.0); radius 4.8; } - + * sphere - origin: (x y z) vector with the origin position. [cm] @@ -446,24 +446,24 @@ Cells Similarly to the surfaces, the **cells** in the geometry can be defined as: :: - cells { - { id ; type ; surfaces (); filltype ; *keywords* } - { id ; type ; surfaces (); filltype ; *keywords* } + cells { + { id ; type ; surfaces (); filltype ; *keywords* } + { id ; type ; surfaces (); filltype ; *keywords* } ... - { id ; type ; surfaces (); filltype ; *keywords* } + { id ; type ; surfaces (); filltype ; *keywords* } } - -At the moment, in SCONE, the only ``cellType`` available is ``simpleCell``. + +At the moment, in SCONE, the only ``cellType`` available is ``simpleCell``. In the surface definition, one should include the indexes of the corresponding surfaces with no sign to indicate a positive half-space, or minus sign to indicate -a negative half-space. The space in between cells corresponds to an intersection. +a negative half-space. The space in between cells corresponds to an intersection. The possible ``fillTypes`` are: * mat: if the cells is filled with a homogeneous material - - - material: takes as an input the material name - + + - material: takes as an input the material name + Example: :: cell1 { id 1; type simpleCell; surfaces (1 -6 90); filltype mat; material fuel; } @@ -471,7 +471,7 @@ Example: :: * uni: if the cell is filled with a universe - universe: takes as an input the universe ``id`` - + Example: :: cellX { id 5; type simpleCell; surfaces (2 -3); filltype uni; universe 6; } @@ -481,50 +481,50 @@ Example: :: Example: :: cellixx { id 55; type simpleCell; surfaces (-10); filltype outside; } - + Universes ######### - + Similarly to the surfaces and cells, the **universes** in the geometry can be defined as: :: - universes { - { id ; type ; *keywords* } - { id ; type ; *keywords* } + universes { + { id ; type ; *keywords* } + { id ; type ; *keywords* } ... - { id ; type ; *keywords* } + { id ; type ; *keywords* } } - + Several ``universeTypes`` are possible: -* cellUniverse, composed of the union of different cells. Note that overlaps are +* cellUniverse, composed of the union of different cells. Note that overlaps are forbidden, but there is no check to find overlaps - cells: array containing the ``cellIds`` as used in the cell definition - - origin (*optional*, default = (0.0 0.0 0.0)): (x y z) array with the origin + - origin (*optional*, default = (0.0 0.0 0.0)): (x y z) array with the origin of the universe. [cm] - - rotation (*optional*, default = (0.0 0.0 0.0)): (x y z) array with the + - rotation (*optional*, default = (0.0 0.0 0.0)): (x y z) array with the rotation angles in degrees applied to the universe. [°] -.. note:: +.. note:: When creating a ``cellUniverse`` a user needs to take care to avoid leaving - any 'unspecified' regions (sets in space which do not belong to any cell). - If these are reachable by a particle (e.g., are not covered by any higher - level universe) they will cause a calculation to crash. - + any 'unspecified' regions (sets in space which do not belong to any cell). + If these are reachable by a particle (e.g., are not covered by any higher + level universe) they will cause a calculation to crash. + Example: :: uni3 { id 3; type cellUniverse; cells (1 2 55); origin (1.0 0.0 0.0); rotation (0.0 90.0 180.0); } * pinUniverse, composed of infinite co-centred cylinders - - radii: array containing the radii of the co-centred cylinders. There - must be an entry equal to 0.0, which corresponds to the outermost + - radii: array containing the radii of the co-centred cylinders. There + must be an entry equal to 0.0, which corresponds to the outermost layer, which is infinite. [cm] - fills: array containing the names or ids of what is inside each cylindrical shell. The order of the fills must correspond to the order of the corresponding radii. An entry can be a material name, the keyword ``void``, or a ``u``, where ``id`` is the id of a defined universe - - origin (*optional*, default = (0.0 0.0 0.0)): (x y z) array with the + - origin (*optional*, default = (0.0 0.0 0.0)): (x y z) array with the origin of the universe. [cm] - rotation (*optional*, default = (0.0 0.0 0.0)): (x y z) array with the rotation angles in degrees applied to the universe. [°] @@ -535,11 +535,11 @@ Example: :: * latUniverse, cartesian lattice of constant pitch - - shape: (x y z) array of integers, stating the numbers of x, y and z + - shape: (x y z) array of integers, stating the numbers of x, y and z elements of the lattice. For a 2D lattice, one of the entries has to be 0 - pitch: (x y z) array with the x, y and z lattice pitches. In a 2D lattice, the value entered in the third dimension is not used. [cm] - - padmat: material name or universe index (u) that fills the possible + - padmat: material name or universe index (u) that fills the possible extra space between the lattice and its bounding surface. Also the keyword ``void`` is allowed - map: map that includes the universe ids of the elements of the lattice. @@ -557,7 +557,7 @@ Example: :: 7 8 9 // x: 1-3, y: 2, z: 1 10 11 12 ) } // x: 1-3, y: 1, z: 1 -.. note:: +.. note:: The order of the elements in the lattice is different from other MC codes, e.g., Serpent. The lattice is written in the style *WYSIWYG*: What You See Is What You Get. @@ -567,7 +567,7 @@ Example: :: - fill: inside filling, as a material name or a universe (u) Example: :: - + root { id 1000; type rootUniverse; border 10; fill u<1>; } Visualiser @@ -579,7 +579,7 @@ To **plot** a geometry, the keyword ``viz`` must be present in the input file: : { type ; *keywords* } { type ; *keywords* } } - + The possible types of files that the geometry is plotted in are: vtk @@ -588,7 +588,7 @@ vtk * corner: (x y z) array with the corner of the geometry [cm] * width: (x y z) array with the width of the mesh in each direction [cm] * vox: (x y z) array with the number of voxels requested in each direction -* what (*optional*, default = material): defines what is highlighted in the +* what (*optional*, default = material): defines what is highlighted in the plot; options are ``material`` and ``cellID`` Example: :: @@ -600,26 +600,26 @@ bmp * centre: (x y z) array with the coordinates of the center of the plot [cm] * axis: ``x``, ``y`` or ``z``, it's the axis normal to the 2D plot -* width (*optional*, default = whole geometry): (y z), (x z) or (x y) array +* width (*optional*, default = whole geometry): (y z), (x z) or (x y) array with the width of the geometry plotted in each direction [cm] * res: (y z), (x z) or (x y) array with the resolution of the mesh in each direction * output: name of the output file, with extension ``.bmp`` -* what (*optional*, default = material): defines what is highlighted in the +* what (*optional*, default = material): defines what is highlighted in the plot; options are ``material`` and ``cellID`` Example: :: plotBMP { type bmp; axis z; width (50 10); res (1000 200); output geomZ; what material; } - -.. note:: - SCONE can be run to visualise geometry without actually doing transport, by - including ``--plot`` when running the application. In this case the visualiser + +.. note:: + SCONE can be run to visualise geometry without actually doing transport, by + including ``--plot`` when running the application. In this case the visualiser has to be included in the file. Nuclear Data ------------ -SCONE can be used with both continuous energy data and multi-group data. The type +SCONE can be used with both continuous energy data and multi-group data. The type of data used must be specified in the ``physicsPackage`` options, as well as in the ``collisionOperator`` options. As for **nuclear data**, the input files has to look like: :: @@ -627,7 +627,7 @@ of data used must be specified in the ``physicsPackage`` options, as well as in handles { } materials { } } - + The **handles** definition is structured as the following: :: handles { @@ -636,63 +636,63 @@ The **handles** definition is structured as the following: :: } The name of a handle has to be the same as defined in a ``physicsPackage`` under the -keyword ``XSdata``. +keyword ``XSdata``. -Otherwise, the possible **nuclear database** types allowed are: +Otherwise, the possible **nuclear database** types allowed are: aceNeutronDatabase ################## -aceNeutronDatabase, used for continuous energy data. In this case, the data is read -from ACE files. +aceNeutronDatabase, used for continuous energy data. In this case, the data is read +from ACE files. -* aceLibrary: includes the path to the *.aceXS* file, which includes the paths to +* aceLibrary: includes the path to the *.aceXS* file, which includes the paths to the ACE files * ures (*optional*, default = 0): 1 for true; 0 for false; activates the unresolved resonance probability tables treatment - + Example: :: ceData { type aceNuclearDatabase; aceLibrary ./myFolder/ACElib/JEF311.aceXS; ures 1; } - + baseMgNeutronDatabase ##################### -baseMgNeutronDatabase, used for multi-group data. In this case, the data is read -from files provided by the user. +baseMgNeutronDatabase, used for multi-group data. In this case, the data is read +from files provided by the user. * PN: includes a flag for anisotropy treatment. Could be ``P0`` or ``P1`` - + Example: :: mgData { type baseMgNeutronDatabase; PN P1; } - + The *materials* definition is structured as: :: materials { - { temp ; - composition { } + { temp ; + composition { } *keywords* } - { temp ; - composition { } + { temp ; + composition { } *keywords* } } - + In this case, ``materialName`` can be any name chosen by the user; ``temp`` is the -material temperature in [K]. +material temperature in [K]. -The ``composition`` dictionary must always be included, but it can be empty in -multi-group simulations. In continuous energy simulations, it should include a +The ``composition`` dictionary must always be included, but it can be empty in +multi-group simulations. In continuous energy simulations, it should include a list of the ZAIDs of all the nuclides that compose that material, and the respective atomic densities in [atoms/cm/barn]. The ZAIDs are normally in the form ``ZZAAA.TT``, or ``ZAAA.TT`` for nuclides with Z<10. The code ``TT`` indicates the temperature used -in the nuclear data evaluation, and the options are 03, 06, 09, 12 and 15, +in the nuclear data evaluation, and the options are 03, 06, 09, 12 and 15, corresponding to temperatures of 300K, 600K, 900K, 1200K and 1500K. Other options are: * moder: dictionary that includes information on thermal scattering data. It has to - include a list of ZAIDs for which S(a,b) has to be used, and the name of the file + include a list of ZAIDs for which S(a,b) has to be used, and the name of the file that contains the data. The file has to be included in the list of files in the *.aceXS* input file. Note that this input is ignored if the nuclide or nuclides listed are not included in the material. Only needed for continuous energy simulations. @@ -703,16 +703,16 @@ Other options are: Example 1: :: materials { - fuel { temp 273; - composition { - 92238.03 0.021; + fuel { temp 273; + composition { + 92238.03 0.021; 92235.03 0.004; - 8016.03 0.018535464; } + 8016.03 0.018535464; } } - water { temp 273; - composition { + water { temp 273; + composition { 1001.03 0.0222222; - 8016.03 0.00535; } + 8016.03 0.00535; } moder { 1001.03 h-h2o.42; } } } @@ -720,8 +720,8 @@ Example 1: :: Example 2: :: materials { - fuel { temp 573; - composition { } + fuel { temp 573; + composition { } xsFile ./xss/fuel.txt } } @@ -729,62 +729,62 @@ Example 2: :: Multi-group cross sections -------------------------- -In the case of a multi-group calculation, **multi-group cross sections** must be -provided by the user. These are in separate files compared to the input file. The +In the case of a multi-group calculation, **multi-group cross sections** must be +provided by the user. These are in separate files compared to the input file. The structure of such cross section files is the following: they must include * numberOfGroups: number of energy groups used (=N) * capture: vector of size N with the material-wise macroscopic capture cross section. - The order of the elements corresponds to groups from fast (group 1) to thermal + The order of the elements corresponds to groups from fast (group 1) to thermal (group N) * fission (*optional*): vector of size N with the material-wise macroscopic fission cross section. The order of the elements corresponds to groups from fast (group 1) to thermal (group N). Must be included only if the materials is fissile -* nu (*optional*): vector of size N with the material-wise macroscopic neutron - production nu-bar. The order of the elements corresponds to groups from +* nu (*optional*): vector of size N with the material-wise macroscopic neutron + production nu-bar. The order of the elements corresponds to groups from fast (group 1) to thermal (group N). Must be included only if the materials is fissile * chi (*optional*): vector of size N with the material-wise fission spectrum. The order - of the elements corresponds to groups from fast (group 1) to thermal (group N). + of the elements corresponds to groups from fast (group 1) to thermal (group N). Must be included only if the materials is fissile -* P0: P0 scattering matrix, of size NxN. In the case of a 3x3 matrix, the elements are +* P0: P0 scattering matrix, of size NxN. In the case of a 3x3 matrix, the elements are ordered as: :: 1 -> 1 1 -> 2 1 -> 3 2 -> 1 2 -> 2 2 -> 3 3 -> 1 3 -> 2 3 -> 3 -* scatteringMultiplicity: P0 scattering multiplicity matrix, of size NxN. Contains +* scatteringMultiplicity: P0 scattering multiplicity matrix, of size NxN. Contains multiplicative elements that will be multiplied to the P0 matrix elements for scattering production cross section, hence all elements must be >= 1.0 -* P1 (*optional*): necessary only if ``P1`` is defined in the ``baseMgNeutronDatabase`` +* P1 (*optional*): necessary only if ``P1`` is defined in the ``baseMgNeutronDatabase`` entry ``PN``. It contains the P1 scattering matrix, of size NxN An example file is: :: - numberOfGroups 2; + numberOfGroups 2; capture (0.0010046 0.025788); fission (0.0010484 0.050632); - nu (2.5 2.5); - chi (1.0 0.0); - scatteringMultiplicity ( - 1.0 1.0 - 1.0 1.0 ); - P0 ( - 0.62568 0.029227 + nu (2.5 2.5); + chi (1.0 0.0); + scatteringMultiplicity ( + 1.0 1.0 + 1.0 1.0 ); + P0 ( + 0.62568 0.029227 0.0 2.443830 - ); + ); P1 ( 0.27459 0.0075737 0.0 0.83318 - ); + ); Tallies ------- -As mentioned previously, one might have to include the keywords ``inactiveTally`` and -``activeTally`` in the input file (in the case of ``eigenPhysicsPackage``), or just -``tally`` (in the case of ``fixedSourcePhysicsPackage``). Either way, the **tally** +As mentioned previously, one might have to include the keywords ``inactiveTally`` and +``activeTally`` in the input file (in the case of ``eigenPhysicsPackage``), or just +``tally`` (in the case of ``fixedSourcePhysicsPackage``). Either way, the **tally** definition is the same for all cases: :: tally { @@ -794,9 +794,9 @@ definition is the same for all cases: :: ... { type ; } } - -In this case, ``resName`` can be any name chosen by the user, and it is what will be -reported in the output file. + +In this case, ``resName`` can be any name chosen by the user, and it is what will be +reported in the output file. Tally Clerks ############ @@ -807,30 +807,30 @@ The **tally clerks** determine which kind of estimator will be used. The options - response: defines which response function has to be used for this tally. Note that more than one response can be defined per each tally - - map (*optional*): contains a dictionary with the ``tallyMap`` definition, + - map (*optional*): contains a dictionary with the ``tallyMap`` definition, that defines the domains of integration of each tally - - filter (*optional*): can filter out particles with certain properties, + - filter (*optional*): can filter out particles with certain properties, preventing them from scoring results * trackClerk - - response: defines which response function has to be used for this tally. + - response: defines which response function has to be used for this tally. Note that more than one response can be defined per each tally - - map (*optional*): contains a dictionary with the ``tallyMap`` definition, + - map (*optional*): contains a dictionary with the ``tallyMap`` definition, that defines the domains of integration of each tally - - filter (*optional*): can filter out particles with certain properties, + - filter (*optional*): can filter out particles with certain properties, preventing them from scoring results - + Example: :: tally { - collision_estimator { type collisionClerk; response (); { type ; *keywords* } - map { } + collision_estimator { type collisionClerk; response (); { type ; *keywords* } + map { } filter { } } - track_estimator { type trackClerk; response ( ); - { type ; *keywords* } - { type ; *keywords* } + track_estimator { type trackClerk; response ( ); + { type ; *keywords* } + { type ; *keywords* } } } @@ -856,7 +856,7 @@ Example: :: * collisionProbabilityClerk, tallies a collision probability matrix - - map: contains a dictionary with the ``tallyMap`` definition, that defines + - map: contains a dictionary with the ``tallyMap`` definition, that defines the bins of the matrix Example: :: @@ -866,41 +866,41 @@ Example: :: } * dancoffBellClerk, calculates a single-term rational approximation for a lattice - + - fuelMat: list of fuel material names - modMat: list of moderator material names - Elow (*optional*, default = 0.0): bottom energy boundary; [MeV] - Etop (*optional*, default = 20.0): top energy boundary; [MeV] - + Example: :: tally { dancoff_bell_factors { type dancoffBellClerk; fuelMat (fuel1 fuel2 fuel_Gd); modMat (water); Elow 0.06; Etop 10.0; } } -* mgXsClerk, calculates multi-group cross sections via a collision estimator +* mgXsClerk, calculates multi-group cross sections via a collision estimator of reaction rates and analog tallies of fission spectrum and scattering events ingoing and outgoing energies and multiplicity - - energyMap (*optional*, default = 1 group): definition of the energy group + - energyMap (*optional*, default = 1 group): definition of the energy group structure to be used - spaceMap (*optional*, default = whole geometry): definition of a spatial tally map - PN (*optional*, default = 0): 1 for true; 0 for false; flag that indicates - whether to calculate scattering matrices only up to P1 (``PN 0``) or P7 (``PN 1``) - + whether to calculate scattering matrices only up to P1 (``PN 0``) or P7 (``PN 1``) + Example: :: tally { MGxss { type mgXsClerk; - energyMap { } - spaceMap { } + energyMap { } + spaceMap { } PN 1; } } * shannonEntropyClerk, implicit Shannon entropy estimator - - - map: contains a dictionary with the ``tallyMap`` definition, that defines + + - map: contains a dictionary with the ``tallyMap`` definition, that defines the (spatial) discretisation used to score the entropy - cycles: number of cycles to tally the entropy for @@ -908,7 +908,7 @@ Example: :: tally { shannon_entropy { type shannonEntropyClerk; - map { } + map { } cycles 200; } } @@ -926,7 +926,7 @@ Example: :: Tally Responses ############### -Certain tally clerks, like the ``collisionClerk`` and ``trackClerk``, require +Certain tally clerks, like the ``collisionClerk`` and ``trackClerk``, require a **response function**. The different types of responses could be: * fluxResponse: used to calculate the flux, i.e., the response function is 1.0 @@ -939,31 +939,31 @@ Example: :: * macroResponse: used to score macroscopic reaction rates - - MT: MT number of the desired reaction. The options are: -1 total, -2 capture, + - MT: MT number of the desired reaction. The options are: -1 total, -2 capture, -6 fission, -7 nu*fission, -21 absorption Example: :: tally { - collision_estimator { type collisionClerk; response (total fission); - total { type macroResponse; MT -1; } + collision_estimator { type collisionClerk; response (total fission); + total { type macroResponse; MT -1; } fission { type macroResponse; MT -6; } } } - + * microResponse: used to score microscopic reaction rates - - MT: MT number of the desired reaction. The options are: 1 total, 2 elastic + - MT: MT number of the desired reaction. The options are: 1 total, 2 elastic scattering, 18 fission, 27 absorption, 102 capture - - material: material name where to score the reaction. The material must be + - material: material name where to score the reaction. The material must be defined to include only one nuclide; its density could be anything, it doesn't affect the result Example: :: tally { - collision_estimator { type collisionClerk; response (elScatter capture); - elScatter { type microResponse; MT 2; material water; } - capture { type microResponse; MT 102; material fuel; } + collision_estimator { type collisionClerk; response (elScatter capture); + elScatter { type microResponse; MT 2; material water; } + capture { type microResponse; MT 102; material fuel; } } } @@ -974,62 +974,62 @@ Example: :: Example: :: tally { - collision_estimator { type collisionClerk; response (weight0 weight1 weight2); - weight0 { type weightResponse; moment 0; } - weight1 { type weightResponse; moment 1; } - weight2 { type weightResponse; moment 2; } + collision_estimator { type collisionClerk; response (weight0 weight1 weight2); + weight0 { type weightResponse; moment 0; } + weight1 { type weightResponse; moment 1; } + weight2 { type weightResponse; moment 2; } } } -.. note:: - To calculate the average weight, one should divide weight moment 1 (weight1) - by weight moment 0 (weight0). To calculate the variance of the weights, the - tally results have to be post-processed as: var = weight2/weight0 - (weight1/weight0)^2 +.. note:: + To calculate the average weight, one should divide weight moment 1 (weight1) + by weight moment 0 (weight0). To calculate the variance of the weights, the + tally results have to be post-processed as: var = weight2/weight0 - (weight1/weight0)^2 Tally Maps ########## -The different types of **tally maps** are: +The different types of **tally maps** are: * cellMap (1D map), cell-wise map - cells: list of ids of the cells to be used an map bins - undefBin (*optional*, default = false): 'yes','y','true','TRUE','T' for true; - 'no', 'n', 'false', 'FALSE', 'F' for false; flag that indicates whether all + 'no', 'n', 'false', 'FALSE', 'F' for false; flag that indicates whether all the cells not listed in ``cells`` should constitute a map bin or not - + Example: :: map { type cellMap; cells (1 5 3 2 4 100); undefBin T; } - + * energyMap (1D map), defines an energy group structure - grid: ``log`` for logarithmically spaced bins or ``lin`` for linearly spaced bins - + + min: bottom energy [MeV] + max: top energy [MeV] + N: number of bins - + - grid: ``unstruct`` for unstructured grids, to be manually defined - + + bins: array with the explicit definition of the energy bin boundaries to be used - + - grid: ``predef`` - - + name: name of the predefined group structure. Options are: ``wims69``, + + + name: name of the predefined group structure. Options are: ``wims69``, ``wims172``, ``casmo40``, ``casmo23``, ``casmo12``, ``casmo7``, ``vitaminj`` Examples: :: map1 { type energyMap; grid log; min 1.0e-11; max 20.0; N 300; } map2 { type energyMap; grid lin; min 1.0; max 20.0; N 100; } - map3 { type energyMap; bins (1.0E-9 1.0E-8 0.6E-6 0.3 20.0); } - map4 { type energyMap; name casmo12; } + map3 { type energyMap; bins (1.0E-9 1.0E-8 0.6E-6 0.3 20.0); } + map4 { type energyMap; name casmo12; } -* homogMatMap (1D map), divides based on the material a particle is in with the +* homogMatMap (1D map), divides based on the material a particle is in with the possibility of grouping some materials together - - bins: list of names of the material bins, that can contain one or more + - bins: list of names of the material bins, that can contain one or more materials; this is followed by all the bin names as key, and the material names included in the bin as an entry - undefBin (*optional*, default = false): 'yes','y','true','TRUE','T' for true; @@ -1042,16 +1042,16 @@ Example: :: bin1 (mat1 mat2 mat3); bin2 (fuel1 fuel3 uo2); bin3 (water); - undefBin T; + undefBin T; } * materialMap (1D map), material-wise map - - materials: list of material names to be used as map bins + - materials: list of material names to be used as map bins - undefBin (*optional*, default = false): 'yes','y','true','TRUE','T' for true; - 'no', 'n', 'false', 'FALSE', 'F' for false; flag that indicates whether all + 'no', 'n', 'false', 'FALSE', 'F' for false; flag that indicates whether all the materials not included should constitute a map bin or not - + Example: :: map { type materialMap; materials (fuel water cladding reflector fuelGd); undefBin T; } @@ -1060,10 +1060,10 @@ Example: :: - maps: list of the names of the maps that will compose the ``multiMap``. This is followed by dictionaries that define the requested maps - + Example: :: - map { type multiMap; maps (map1 map2 map10); + map { type multiMap; maps (map1 map2 map10); map1 { <1D map definition> } map2 { <1D map definition> } map10 { <1D map definition> } @@ -1074,13 +1074,13 @@ Example: :: - axis: ``x``, ``y`` or ``z`` - grid: ``lin`` for linearly spaced bins - + + min: bottom coordinate [cm] + max: top coordinate [cm] + N: number of bins - grid: ``unstruct`` for unstructured grids, to be manually defined - + + bins: array with the explicit definition of the bin boundaries to be used Examples: :: @@ -1090,18 +1090,18 @@ Examples: :: * sphericalMap, geometric spherical map - - origin (*optional*, default = (0.0 0.0 .0.)): (x y z) vector with the origin + - origin (*optional*, default = (0.0 0.0 .0.)): (x y z) vector with the origin of the spherical map - - grid: ``lin`` for linearly spaced bins or ``equivolume`` for spherical shells - + - grid: ``lin`` for linearly spaced bins or ``equivolume`` for spherical shells + + Rmin (*optional*, default = 0.0): minimum radius [cm] + Rmax: maximum radius [cm] + N: number of radial bins - grid: ``unstruct`` for unstructured grids, to be manually defined - - + bins: array with the explicit definition of the spherical bin boundaries + + + bins: array with the explicit definition of the spherical bin boundaries to be used Examples: :: @@ -1114,27 +1114,27 @@ Examples: :: one could add axial and azimuthal discretisation - orientation (*optional*, default = ``z``): ``x``, ``y`` or ``z``, axial direction - - origin (*optional*, default = (0.0 0.0)): (y z), (x z) or (x y) vector with + - origin (*optional*, default = (0.0 0.0)): (y z), (x z) or (x y) vector with the origin of the cylindrical map - - rGrid: ``lin`` for linearly spaced bins or ``equivolume`` for cylindrical shells - + - rGrid: ``lin`` for linearly spaced bins or ``equivolume`` for cylindrical shells + + Rmin (*optional*, default = 0.0): minimum radius [cm] + Rmax: maximum radius [cm] + rN: number of radial bins - rGrid: ``unstruct`` for unstructured grids, to be manually defined - - + bins: array with the explicit definition of the cylindrical radial bin + + + bins: array with the explicit definition of the cylindrical radial bin boundaries to be used - + - axGrid (*optional*, default = 1 bin): ``lin`` for linearly spaced axial bins + axMin: minimum axial coordinate [cm] + axMax: maximum axial coordinate [cm] + axN: number of axial bins - - - azimuthalN (*optional*, default = 1 bin): number of angular azimuthal bins - + + - azimuthalN (*optional*, default = 1 bin): number of angular azimuthal bins + Example: :: map1 { type cylindricalMap; orientation y; origin (7.0 0.0); rGrid lin; Rmax 5.0; rN 10; } @@ -1143,36 +1143,36 @@ Example: :: * weightMap (1D map), divides weight into number of discrete bins - grid: ``log`` for logarithmically spaced bins or ``lin`` for linearly spaced bins - + + min: bottom weight + max: top weight + N: number of bins - grid: ``unstruct`` for unstructured grids, to be manually defined - + + bins: array with the explicit definition of the weight bin boundaries to be used Examples: :: map1 { type weightMap; grid log; min 1.0e-3; max 100.0; N 100; } map2 { type weightMap; grid lin; min 0.1; max 2.0; N 20; } - map3 { type weightMap; bins (0.0 0.2 0.4 0.6 0.8 1.0 2.0 5.0 10.0); } - + map3 { type weightMap; bins (0.0 0.2 0.4 0.6 0.8 1.0 2.0 5.0 10.0); } + Tally Filters ############# - -Another option that can be included in the tallies is **tally filters**. These -allow to filter out certain types of particles when scoring results. For now, + +Another option that can be included in the tallies is **tally filters**. These +allow to filter out certain types of particles when scoring results. For now, the only type of filter existing is: * energyFilter, to stop particles within a certain energy range from contributing to a certain tally - + - Emin (for continuous energy particles): minimum energy [MeV] - Emax (for continuous energy particles): maximum energy [MeV] - Gtop (for multi-group particles): top energy group - Glow (for multi-group particles): bottom energy group - + Example: :: CEfilter { type energyFilter; Emin 10.0; Emax 20.0; } @@ -1184,19 +1184,19 @@ Other options Other keywords, such as for results **normalisation**, that could be included are: * norm: its entry is the name of the tally, ``resName``, to be used as a normalisation - criterion. If the tally has multiple bins, (e.g. has a map), the bin with index 1 + criterion. If the tally has multiple bins, (e.g. has a map), the bin with index 1 will be used for normalisation * normVal: value to normalise the tally ``resName`` to * display: its entry is the name of the tally, ``resName``, which will be displayed - each cycle. Only the tally clerks ``keffAnalogClerk`` and ``keffImplicitClerk`` + each cycle. Only the tally clerks ``keffAnalogClerk`` and ``keffImplicitClerk`` support display at the moment * batchSize (*optional*, default = 1): the number of cycles that constitute a single - batch for the purpose of statistical estimation. For example, a value of 5 means + batch for the purpose of statistical estimation. For example, a value of 5 means that a single estimate is obtained from a score accumulated over 5 cycles Example: :: - tally { + tally { display (k-eff); norm fissRate; normVal 100.0; diff --git a/scripts/install_cream.sh b/scripts/install_cream.sh index 9a6c7f191..9b7d8732d 100755 --- a/scripts/install_cream.sh +++ b/scripts/install_cream.sh @@ -7,10 +7,10 @@ set -ex # Change folder to cream -cd ./cream +cd ./cream -# Install Cream +# Install Cream pip install -e .[test] -# Return to root directory +# Return to root directory cd ./.. \ No newline at end of file diff --git a/scripts/test_cream.sh b/scripts/test_cream.sh index 726ca059a..639973613 100755 --- a/scripts/test_cream.sh +++ b/scripts/test_cream.sh @@ -7,10 +7,10 @@ set -ex # Change folder to cream tests -cd ./cream/test +cd ./cream/test -# Execute Tests -pytest +# Execute Tests +pytest -# Return to root directory +# Return to root directory cd ./../.. \ No newline at end of file From 665c48546662277f1c7e04f17b1ee9ce6f9bd514 Mon Sep 17 00:00:00 2001 From: Mikolaj-A-Kowalski Date: Fri, 25 Aug 2023 19:16:28 +0200 Subject: [PATCH 3/3] Add missing newlines at end of file --- .readthedocs.yaml | 2 +- InputFiles/XS/URRa_2_1_XSS | 2 +- LinearAlgebra/CMakeLists.txt | 2 +- NamedGrids/CMakeLists.txt | 2 +- NuclearData/NuclearDataStructures/CMakeLists.txt | 2 +- NuclearData/ceNeutronData/CMakeLists.txt | 2 +- NuclearData/emissionENDF/angleLawENDF/muEndfPdf/CMakeLists.txt | 2 +- NuclearData/emissionENDF/releaseLawENDF/CMakeLists.txt | 2 +- NuclearData/mgNeutronData/CMakeLists.txt | 2 +- NuclearData/testNeutronData/CMakeLists.txt | 2 +- NuclearData/xsPackages/CMakeLists.txt | 2 +- RandomNumbers/CMakeLists.txt | 2 +- Tallies/TallyFilters/CMakeLists.txt | 2 +- Tallies/TallyResponses/CMakeLists.txt | 2 +- cmake/add_integration_tests.cmake | 2 +- cmake/add_sources.cmake | 2 +- cmake/add_unit_tests.cmake | 2 +- docs/Makefile | 2 +- docs/requirements-rtd.txt | 2 +- scripts/install_cream.sh | 2 +- scripts/test_cream.sh | 2 +- 21 files changed, 21 insertions(+), 21 deletions(-) diff --git a/.readthedocs.yaml b/.readthedocs.yaml index 73999c162..530f9b1ba 100644 --- a/.readthedocs.yaml +++ b/.readthedocs.yaml @@ -7,4 +7,4 @@ sphinx: python: version: 3.7 install: - - requirements: docs/requirements-rtd.txt \ No newline at end of file + - requirements: docs/requirements-rtd.txt diff --git a/InputFiles/XS/URRa_2_1_XSS b/InputFiles/XS/URRa_2_1_XSS index caec00d5c..90aa1cf8c 100644 --- a/InputFiles/XS/URRa_2_1_XSS +++ b/InputFiles/XS/URRa_2_1_XSS @@ -22,4 +22,4 @@ P0 ( P1 ( 0.27459 0.0075737 0.0 0.83318 -); \ No newline at end of file +); diff --git a/LinearAlgebra/CMakeLists.txt b/LinearAlgebra/CMakeLists.txt index 97231c460..f848898c6 100644 --- a/LinearAlgebra/CMakeLists.txt +++ b/LinearAlgebra/CMakeLists.txt @@ -2,4 +2,4 @@ add_sources( ./linearAlgebra_func.f90) # Add tests to global list -add_unit_tests( ./Tests/linearAlgebra_test.f90) \ No newline at end of file +add_unit_tests( ./Tests/linearAlgebra_test.f90) diff --git a/NamedGrids/CMakeLists.txt b/NamedGrids/CMakeLists.txt index 78f4292f5..8f21d71f3 100644 --- a/NamedGrids/CMakeLists.txt +++ b/NamedGrids/CMakeLists.txt @@ -3,4 +3,4 @@ add_sources (./energyGridRegistry_mod.f90 ./preDefEnergyGrids.f90) # Add Tests -add_unit_tests(./Tests/energyGridRegistry_test.f90) \ No newline at end of file +add_unit_tests(./Tests/energyGridRegistry_test.f90) diff --git a/NuclearData/NuclearDataStructures/CMakeLists.txt b/NuclearData/NuclearDataStructures/CMakeLists.txt index d14a57dc7..f82ec241a 100644 --- a/NuclearData/NuclearDataStructures/CMakeLists.txt +++ b/NuclearData/NuclearDataStructures/CMakeLists.txt @@ -4,4 +4,4 @@ add_sources ( ./endfTable/endfTable_class.f90 ./pdf/kalbachTable_class.f90) add_unit_tests(./Tests/tabularPdf_test.f90 - ./Tests/endfTable_test.f90) \ No newline at end of file + ./Tests/endfTable_test.f90) diff --git a/NuclearData/ceNeutronData/CMakeLists.txt b/NuclearData/ceNeutronData/CMakeLists.txt index 58b43ebf4..50128fbcd 100644 --- a/NuclearData/ceNeutronData/CMakeLists.txt +++ b/NuclearData/ceNeutronData/CMakeLists.txt @@ -5,4 +5,4 @@ add_sources(./ceNeutronCache_mod.f90 ./ceNeutronNuclide_inter.f90 ./ceNeutronMaterial_class.f90 ./aceLibrary_mod.f90 - ) \ No newline at end of file + ) diff --git a/NuclearData/emissionENDF/angleLawENDF/muEndfPdf/CMakeLists.txt b/NuclearData/emissionENDF/angleLawENDF/muEndfPdf/CMakeLists.txt index 1b9ff713c..591e9c12b 100644 --- a/NuclearData/emissionENDF/angleLawENDF/muEndfPdf/CMakeLists.txt +++ b/NuclearData/emissionENDF/angleLawENDF/muEndfPdf/CMakeLists.txt @@ -3,4 +3,4 @@ add_sources ( ./muEndfPdf_inter.f90 ./muEndfPdfSlot_class.f90 ./isotropicMu_class.f90 ./equiBin32Mu_class.f90 - ./tabularMu_class.f90 ) \ No newline at end of file + ./tabularMu_class.f90 ) diff --git a/NuclearData/emissionENDF/releaseLawENDF/CMakeLists.txt b/NuclearData/emissionENDF/releaseLawENDF/CMakeLists.txt index 42c39beb7..cdca46e7a 100644 --- a/NuclearData/emissionENDF/releaseLawENDF/CMakeLists.txt +++ b/NuclearData/emissionENDF/releaseLawENDF/CMakeLists.txt @@ -5,4 +5,4 @@ add_sources( ./releaseLawENDF_inter.f90 ./releaseLawENDFfactory_func.f90 ./polynomialRelease_class.f90 ./constantRelease_class.f90 - ./tabularRelease_class.f90 ) \ No newline at end of file + ./tabularRelease_class.f90 ) diff --git a/NuclearData/mgNeutronData/CMakeLists.txt b/NuclearData/mgNeutronData/CMakeLists.txt index 79081c0a3..e843413c6 100644 --- a/NuclearData/mgNeutronData/CMakeLists.txt +++ b/NuclearData/mgNeutronData/CMakeLists.txt @@ -5,4 +5,4 @@ add_sources(./mgNeutronMaterial_inter.f90 ./baseMgNeutron/baseMgNeutronDatabase_class.f90) # Add tests -add_integration_tests(./baseMgNeutron/Tests/baseMgNeutronDatabase_iTest.f90) \ No newline at end of file +add_integration_tests(./baseMgNeutron/Tests/baseMgNeutronDatabase_iTest.f90) diff --git a/NuclearData/testNeutronData/CMakeLists.txt b/NuclearData/testNeutronData/CMakeLists.txt index 7173c8b7b..d6a1b5e76 100644 --- a/NuclearData/testNeutronData/CMakeLists.txt +++ b/NuclearData/testNeutronData/CMakeLists.txt @@ -1,3 +1,3 @@ # Add to Compilation add_sources( ./testNeutronDatabase_class.f90 - ./testNeutronMaterial_class.f90) \ No newline at end of file + ./testNeutronMaterial_class.f90) diff --git a/NuclearData/xsPackages/CMakeLists.txt b/NuclearData/xsPackages/CMakeLists.txt index f1846803b..648f31d77 100644 --- a/NuclearData/xsPackages/CMakeLists.txt +++ b/NuclearData/xsPackages/CMakeLists.txt @@ -1 +1 @@ -add_sources(./neutronXsPackages_class.f90) \ No newline at end of file +add_sources(./neutronXsPackages_class.f90) diff --git a/RandomNumbers/CMakeLists.txt b/RandomNumbers/CMakeLists.txt index 23eac404e..740fb2ea7 100644 --- a/RandomNumbers/CMakeLists.txt +++ b/RandomNumbers/CMakeLists.txt @@ -1,4 +1,4 @@ # Add Source Files to the global list add_sources( RNG_class.f90) -add_unit_tests( ./Tests/RNG_test.f90) \ No newline at end of file +add_unit_tests( ./Tests/RNG_test.f90) diff --git a/Tallies/TallyFilters/CMakeLists.txt b/Tallies/TallyFilters/CMakeLists.txt index bf26e156c..59b824f30 100644 --- a/Tallies/TallyFilters/CMakeLists.txt +++ b/Tallies/TallyFilters/CMakeLists.txt @@ -8,4 +8,4 @@ add_sources( ./tallyFilter_inter.f90 add_unit_tests(./Tests/energyFilter_test.f90 ./Tests/testFilter_test.f90 - ) \ No newline at end of file + ) diff --git a/Tallies/TallyResponses/CMakeLists.txt b/Tallies/TallyResponses/CMakeLists.txt index 872f53da7..0deb6a41c 100644 --- a/Tallies/TallyResponses/CMakeLists.txt +++ b/Tallies/TallyResponses/CMakeLists.txt @@ -15,4 +15,4 @@ add_unit_tests(./Tests/fluxResponse_test.f90 ./Tests/macroResponse_test.f90 ./Tests/microResponse_test.f90 ./Tests/weightResponse_test.f90 - ) \ No newline at end of file + ) diff --git a/cmake/add_integration_tests.cmake b/cmake/add_integration_tests.cmake index f6425f363..8573eb98c 100644 --- a/cmake/add_integration_tests.cmake +++ b/cmake/add_integration_tests.cmake @@ -26,4 +26,4 @@ function(add_integration_tests) # Append files in argument list to global property set_property(GLOBAL APPEND PROPERTY INTEGRATION_TESTS_LIST "${TESTS}") -endfunction(add_integration_tests) \ No newline at end of file +endfunction(add_integration_tests) diff --git a/cmake/add_sources.cmake b/cmake/add_sources.cmake index 2197c7911..8ce9861fe 100644 --- a/cmake/add_sources.cmake +++ b/cmake/add_sources.cmake @@ -25,4 +25,4 @@ function(add_sources) # Append files in argument list to global property set_property(GLOBAL APPEND PROPERTY SRCS_LIST "${SRCS}") -endfunction(add_sources) \ No newline at end of file +endfunction(add_sources) diff --git a/cmake/add_unit_tests.cmake b/cmake/add_unit_tests.cmake index 5159a1fe7..83a119316 100644 --- a/cmake/add_unit_tests.cmake +++ b/cmake/add_unit_tests.cmake @@ -26,4 +26,4 @@ function(add_unit_tests) # Append files in argument list to global property set_property(GLOBAL APPEND PROPERTY UNIT_TESTS_LIST "${TESTS}") -endfunction(add_unit_tests) \ No newline at end of file +endfunction(add_unit_tests) diff --git a/docs/Makefile b/docs/Makefile index 298ea9e21..51285967a 100644 --- a/docs/Makefile +++ b/docs/Makefile @@ -16,4 +16,4 @@ help: # Catch-all target: route all unknown targets to Sphinx using the new # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). %: Makefile - @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) \ No newline at end of file + @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) diff --git a/docs/requirements-rtd.txt b/docs/requirements-rtd.txt index 8286f44d4..45fc587a4 100644 --- a/docs/requirements-rtd.txt +++ b/docs/requirements-rtd.txt @@ -1 +1 @@ -sphinxcontrib-katex \ No newline at end of file +sphinxcontrib-katex diff --git a/scripts/install_cream.sh b/scripts/install_cream.sh index 9b7d8732d..7b66ec857 100755 --- a/scripts/install_cream.sh +++ b/scripts/install_cream.sh @@ -13,4 +13,4 @@ cd ./cream pip install -e .[test] # Return to root directory -cd ./.. \ No newline at end of file +cd ./.. diff --git a/scripts/test_cream.sh b/scripts/test_cream.sh index 639973613..adaedf3e6 100755 --- a/scripts/test_cream.sh +++ b/scripts/test_cream.sh @@ -13,4 +13,4 @@ cd ./cream/test pytest # Return to root directory -cd ./../.. \ No newline at end of file +cd ./../..