From b7b9bdf15c737e697535a5504bdb941ee297b7bb Mon Sep 17 00:00:00 2001 From: NRavoisin96 Date: Mon, 7 Oct 2024 15:42:41 +0100 Subject: [PATCH 01/10] Compilation error fix gfortran >= 13.2 --- NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 b/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 index 4b8aa0cfa..888898857 100644 --- a/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 +++ b/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 @@ -111,11 +111,16 @@ subroutine getMacroXSs_byP(self, xss, p) class(mgNeutronMaterial), intent(in) :: self type(neutronMacroXSs), intent(out) :: xss class(particle), intent(in) :: p + integer(shortInt) :: matIdx character(100), parameter :: Here = 'getMacroXSs_byP (mgNeutronMateerial_inter.f90)' if (.not. p % isMG) call fatalError(Here, 'CE particle was given to MG data') - associate (matCache => cache_materialCache(p % matIdx())) + !! + !! Here it is necessary to store p % matIdx() in a dedicated variable to avoid compilation errors with gfortran >= 13.2 + !! + matIdx = p % matIdx() + associate (matCache => cache_materialCache(matIdx)) if (matCache % G_tail /= p % G) then ! Get cross sections From 6c76efafe71d39b87e8531dd644679a1bcd067c8 Mon Sep 17 00:00:00 2001 From: Nathan Date: Wed, 23 Oct 2024 13:12:30 +0100 Subject: [PATCH 02/10] macOS support, floating points comparison initial revision --- .../collisionProcessor_inter.f90 | 2 +- .../neutronCEimp_class.f90 | 2 +- .../neutronCEstd_class.f90 | 2 +- .../neutronMGimp_class.f90 | 2 +- .../neutronMGstd_class.f90 | 2 +- .../Surfaces/QuadSurfaces/aPlane_class.f90 | 12 ++- Geometry/Surfaces/QuadSurfaces/cone_class.f90 | 15 +-- .../Surfaces/QuadSurfaces/cylinder_class.f90 | 4 +- .../Surfaces/QuadSurfaces/plane_class.f90 | 22 +++-- .../Surfaces/QuadSurfaces/sphere_class.f90 | 8 +- Geometry/Surfaces/box_class.f90 | 13 +-- Geometry/Surfaces/squareCylinder_class.f90 | 13 +-- Geometry/Surfaces/truncCylinder_class.f90 | 17 ++-- .../mgNeutronData/mgNeutronMaterial_inter.f90 | 2 +- ParticleObjects/Tests/particle_test.f90 | 4 +- ParticleObjects/particle_class.f90 | 44 ++++----- SharedModules/genericProcedures.f90 | 97 ++++++++++++++++--- Tallies/TallyClerks/collisionClerk_class.f90 | 4 +- .../collisionProbabilityClerk_class.f90 | 2 +- .../TallyClerks/dancoffBellClerk_class.f90 | 2 +- .../TallyClerks/keffImplicitClerk_class.f90 | 8 +- Tallies/TallyClerks/mgXsClerk_class.f90 | 8 +- Tallies/TallyClerks/simpleFMClerk_class.f90 | 8 +- .../TallyMaps/Maps1D/directionMap_class.f90 | 2 +- Tallies/TallyMaps/Maps1D/radialMap_class.f90 | 2 +- Tallies/TallyMaps/cylindricalMap_class.f90 | 2 +- .../TallyResponses/macroResponse_class.f90 | 4 +- .../TallyResponses/microResponse_class.f90 | 2 +- .../TallyResponses/weightResponse_class.f90 | 6 +- .../transportOperatorDT_class.f90 | 10 +- .../transportOperatorHT_class.f90 | 22 ++--- .../transportOperatorST_class.f90 | 8 +- 32 files changed, 216 insertions(+), 135 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 b/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 index f14c3da75..f917fba04 100644 --- a/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 +++ b/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 @@ -119,7 +119,7 @@ subroutine collide(self, p, tally, thisCycle, nextCycle) character(100),parameter :: Here = 'collide (collisionProcessor.f90)' ! Load material index into data package - collDat % matIdx = p % matIdx() + collDat % matIdx = p % getMatIdx() ! Choose collision nuclide and general type (Scatter, Capture or Fission) call self % sampleCollision(p, tally, collDat, thisCycle, nextCycle) diff --git a/CollisionOperator/CollisionProcessors/neutronCEimp_class.f90 b/CollisionOperator/CollisionProcessors/neutronCEimp_class.f90 index ea42f32ad..5cb346f01 100644 --- a/CollisionOperator/CollisionProcessors/neutronCEimp_class.f90 +++ b/CollisionOperator/CollisionProcessors/neutronCEimp_class.f90 @@ -243,7 +243,7 @@ subroutine sampleCollision(self, p, tally, collDat, thisCycle, nextCycle) if(.not.associated(self % xsData)) call fatalError(Here, 'There is no active Neutron CE data!') ! Verify and load material pointer - self % mat => ceNeutronMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) + self % mat => ceNeutronMaterial_CptrCast( self % xsData % getMaterial( p % getMatIdx())) if(.not.associated(self % mat)) call fatalError(Here, 'Material is not ceNeutronMaterial') ! Select collision nuclide diff --git a/CollisionOperator/CollisionProcessors/neutronCEstd_class.f90 b/CollisionOperator/CollisionProcessors/neutronCEstd_class.f90 index dba85ee80..86012f367 100644 --- a/CollisionOperator/CollisionProcessors/neutronCEstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/neutronCEstd_class.f90 @@ -163,7 +163,7 @@ subroutine sampleCollision(self, p, tally, collDat, thisCycle, nextCycle) if (.not.associated(self % xsData)) call fatalError(Here, 'There is no active Neutron CE data!') ! Verify and load material pointer - self % mat => ceNeutronMaterial_CptrCast(self % xsData % getMaterial(p % matIdx())) + self % mat => ceNeutronMaterial_CptrCast(self % xsData % getMaterial(p % getMatIdx())) if (.not.associated(self % mat)) call fatalError(Here, 'Material is not ceNeutronMaterial') ! Select collision nuclide diff --git a/CollisionOperator/CollisionProcessors/neutronMGimp_class.f90 b/CollisionOperator/CollisionProcessors/neutronMGimp_class.f90 index bc2155c22..768b7fd7a 100644 --- a/CollisionOperator/CollisionProcessors/neutronMGimp_class.f90 +++ b/CollisionOperator/CollisionProcessors/neutronMGimp_class.f90 @@ -136,7 +136,7 @@ subroutine sampleCollision(self, p, tally, collDat, thisCycle, nextCycle) if(.not.associated(self % xsData)) call fatalError(Here, "Failed to get active database for MG Neutron") ! Get and verify material pointer - self % mat => mgNeutronMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) + self % mat => mgNeutronMaterial_CptrCast( self % xsData % getMaterial( p % getMatIdx())) if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG Neutron Material") ! Select Main reaction channel diff --git a/CollisionOperator/CollisionProcessors/neutronMGstd_class.f90 b/CollisionOperator/CollisionProcessors/neutronMGstd_class.f90 index b816c6fe6..5909649da 100644 --- a/CollisionOperator/CollisionProcessors/neutronMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/neutronMGstd_class.f90 @@ -103,7 +103,7 @@ subroutine sampleCollision(self, p, tally, collDat, thisCycle, nextCycle) if(.not.associated(self % xsData)) call fatalError(Here, "Failed to get active database for MG Neutron") ! Get and verify material pointer - self % mat => mgNeutronMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) + self % mat => mgNeutronMaterial_CptrCast( self % xsData % getMaterial( p % getMatIdx())) if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG Neutron Material") ! Select Main reaction channel diff --git a/Geometry/Surfaces/QuadSurfaces/aPlane_class.f90 b/Geometry/Surfaces/QuadSurfaces/aPlane_class.f90 index 4ee31b0b3..3a7443bf9 100644 --- a/Geometry/Surfaces/QuadSurfaces/aPlane_class.f90 +++ b/Geometry/Surfaces/QuadSurfaces/aPlane_class.f90 @@ -2,7 +2,7 @@ module aPlane_class use numPrecision use universalVariables, only : X_AXIS, Y_AXIS, Z_AXIS, INF - use genericProcedures, only : fatalError + use genericProcedures, only : fatalError, isEqual use dictionary_class, only : dictionary use quadSurface_inter, only : quadSurface use surface_inter, only : kill_super => kill @@ -196,14 +196,16 @@ pure function going(self, r, u) result(halfspace) real(defReal) :: ua ua = u(self % axis) - halfspace = ua > ZERO - ! Special case of parallel direction - ! Partilce stays in its current halfspace - if (ua == ZERO) then + ! Special case of parallel direction. Particle stays in its current halfspace. + if (isEqual(ua, ZERO)) then halfspace = (r(self % axis) - self % a0) >= ZERO + return + end if + halfspace = ua > ZERO + end function going !! diff --git a/Geometry/Surfaces/QuadSurfaces/cone_class.f90 b/Geometry/Surfaces/QuadSurfaces/cone_class.f90 index b179b89d5..bef9d5178 100644 --- a/Geometry/Surfaces/QuadSurfaces/cone_class.f90 +++ b/Geometry/Surfaces/QuadSurfaces/cone_class.f90 @@ -2,7 +2,7 @@ module cone_class use numPrecision use universalVariables, only : SURF_TOL, INF, X_AXIS, Y_AXIS, Z_AXIS - use genericProcedures, only : fatalError, numToChar, dotProduct + use genericProcedures, only : fatalError, numToChar, isEqual use dictionary_class, only : dictionary use quadSurface_inter, only : quadSurface use surface_inter, only : kill_super => kill @@ -418,15 +418,16 @@ pure function going(self, r, u) result(halfspace) norm = norm/norm2(norm) proj = dot_product(norm,u) - ! Determine halfspace - halfspace = proj > ZERO - - ! Parallel direction - ! Need to use position to determine halfspace - if (proj == ZERO) then + ! Parallel direction. Need to use position to determine halfspace. + if (isEqual(proj, ZERO)) then halfspace = self % evaluate(r) >= ZERO + return + end if + ! Determine halfspace + halfspace = proj > ZERO + end function going !! diff --git a/Geometry/Surfaces/QuadSurfaces/cylinder_class.f90 b/Geometry/Surfaces/QuadSurfaces/cylinder_class.f90 index ed5017c5d..5a32d3683 100644 --- a/Geometry/Surfaces/QuadSurfaces/cylinder_class.f90 +++ b/Geometry/Surfaces/QuadSurfaces/cylinder_class.f90 @@ -2,7 +2,7 @@ module cylinder_class use numPrecision use universalVariables, only : SURF_TOL, INF, X_AXIS, Y_AXIS, Z_AXIS - use genericProcedures, only : fatalError, numToChar, dotProduct + use genericProcedures, only : fatalError, numToChar, isEqual use dictionary_class, only : dictionary use quadSurface_inter, only : quadSurface use surface_inter, only : kill_super => kill @@ -242,7 +242,7 @@ pure function distance(self, r, u) result(d) delta = k*k - a*c ! Technically delta/4 ! Calculate the distance - if (delta < ZERO .or. a == ZERO) then ! No intersection + if (delta < ZERO .or. isEqual(a, ZERO)) then ! No intersection d = INF else if (abs(c) < self % surfTol()) then ! Point at a surface diff --git a/Geometry/Surfaces/QuadSurfaces/plane_class.f90 b/Geometry/Surfaces/QuadSurfaces/plane_class.f90 index dfb913868..1890ac995 100644 --- a/Geometry/Surfaces/QuadSurfaces/plane_class.f90 +++ b/Geometry/Surfaces/QuadSurfaces/plane_class.f90 @@ -2,7 +2,7 @@ module plane_class use numPrecision use universalVariables, only : X_AXIS, Y_AXIS, Z_AXIS, INF - use genericProcedures, only : fatalError, dotProduct, numToChar + use genericProcedures, only : fatalError, numToChar, isEqual use dictionary_class, only : dictionary use quadSurface_inter, only : quadSurface use surface_inter, only : kill_super => kill @@ -128,7 +128,7 @@ pure function evaluate(self, r) result(c) real(defReal), dimension(3), intent(in) :: r real(defReal) :: c - c = dotProduct(r, self % norm) - self % offset + c = dot_product(r, self % norm) - self % offset end function evaluate @@ -151,10 +151,10 @@ pure function distance(self, r, u) result(d) real(defReal) :: d real(defReal) :: k, c - k = dotProduct(u, self % norm) + k = dot_product(u, self % norm) c = self % evaluate(r) - if ( k == ZERO .or. abs(c) < self % surfTol()) then ! Parallel or at the surface + if (isEqual(k, ZERO) .or. abs(c) < self % surfTol()) then ! Parallel or at the surface d = INF else @@ -180,15 +180,17 @@ pure function going(self, r, u) result(halfspace) logical(defBool) :: halfspace real(defReal) :: proj - proj = dotProduct(u, self % norm) - halfspace = proj > ZERO - - ! Special case of parallel direction - ! Partilce stays in its current halfspace - if (proj == ZERO) then + proj = dot_product(u, self % norm) + + ! Special case of parallel direction. Particle stays in its current halfspace + if (isEqual(proj, ZERO)) then halfspace = self % evaluate(r) >= ZERO + return + end if + halfspace = proj > ZERO + end function going !! diff --git a/Geometry/Surfaces/QuadSurfaces/sphere_class.f90 b/Geometry/Surfaces/QuadSurfaces/sphere_class.f90 index 853b6113b..f1b5400ce 100644 --- a/Geometry/Surfaces/QuadSurfaces/sphere_class.f90 +++ b/Geometry/Surfaces/QuadSurfaces/sphere_class.f90 @@ -2,7 +2,7 @@ module sphere_class use numPrecision use universalVariables, only : INF, SURF_TOL - use genericProcedures, only : fatalError, dotProduct, numToChar + use genericProcedures, only : fatalError, numToChar use dictionary_class, only : dictionary use surface_inter, only : kill_super => kill use quadSurface_inter, only : quadSurface @@ -135,7 +135,7 @@ pure function evaluate(self, r) result(c) diff = r - self % origin - c = dotProduct(diff, diff) - self % r_sq + c = dot_product(diff, diff) - self % r_sq end function evaluate @@ -158,7 +158,7 @@ pure function distance(self, r, u) result(d) ! Calculate quadratic components c = self % evaluate(r) - k = dotProduct(r - self % origin, u) + k = dot_product(r - self % origin, u) delta = k*k - c ! Technically delta/4 ! Calculate the distance @@ -193,7 +193,7 @@ pure function going(self, r, u) result(halfspace) real(defReal), dimension(3), intent(in) :: u logical(defBool) :: halfspace - halfspace = dotProduct(r - self % origin, u) >= ZERO + halfspace = dot_product(r - self % origin, u) >= ZERO end function going diff --git a/Geometry/Surfaces/box_class.f90 b/Geometry/Surfaces/box_class.f90 index 221903c9b..a35a7c54b 100644 --- a/Geometry/Surfaces/box_class.f90 +++ b/Geometry/Surfaces/box_class.f90 @@ -2,7 +2,7 @@ module box_class use numPrecision use universalVariables - use genericProcedures, only : fatalError, numToChar, swap + use genericProcedures, only : fatalError, numToChar, swap, isEqual use dictionary_class, only : dictionary use surface_inter, only : surface, kill_super => kill @@ -264,14 +264,15 @@ pure function going(self, r, u) result(halfspace) ! Projection of direction on the normal proj = u(maxCom) * sign(ONE, rl(maxCom)) - halfspace = proj > ZERO - - ! Parallel direction - ! Need to use position to determine halfspace - if (proj == ZERO) then + ! Parallel direction. Need to use position to determine halfspace. + if (isEqual(proj, ZERO)) then halfspace = self % evaluate(r) >= ZERO + return + end if + halfspace = proj > ZERO + end function going !! diff --git a/Geometry/Surfaces/squareCylinder_class.f90 b/Geometry/Surfaces/squareCylinder_class.f90 index 5e41d95ec..ff3897c93 100644 --- a/Geometry/Surfaces/squareCylinder_class.f90 +++ b/Geometry/Surfaces/squareCylinder_class.f90 @@ -2,7 +2,7 @@ module squareCylinder_class use numPrecision use universalVariables - use genericProcedures, only : fatalError, numToChar, swap + use genericProcedures, only : fatalError, numToChar, swap, isEqual use dictionary_class, only : dictionary use surface_inter, only : surface, kill_super => kill @@ -313,13 +313,14 @@ pure function going(self, r, u) result(halfspace) ! Projection of direction on the normal proj = ul(maxCom) * sign(ONE, rl(maxCom)) - halfspace = proj > ZERO - - ! Parallel direction - ! Need to use position to determine halfspace - if (proj == ZERO) then + ! Parallel direction. Need to use position to determine halfspace + if (isEqual(proj, ZERO)) then halfspace = self % evaluate(r) >= ZERO + return + end if + + halfspace = proj > ZERO end function going diff --git a/Geometry/Surfaces/truncCylinder_class.f90 b/Geometry/Surfaces/truncCylinder_class.f90 index c45a56f08..9d59ae4a4 100644 --- a/Geometry/Surfaces/truncCylinder_class.f90 +++ b/Geometry/Surfaces/truncCylinder_class.f90 @@ -2,7 +2,7 @@ module truncCylinder_class use numPrecision use universalVariables - use genericProcedures, only : fatalError, numToChar, swap + use genericProcedures, only : fatalError, numToChar, swap, isEqual use dictionary_class, only : dictionary use surface_inter, only : surface, kill_super => kill @@ -227,7 +227,7 @@ pure function distance(self, r, u) result(d) delta = k*k - a*c1 ! Technically delta/4 ! Find closes & furthest distance - if (delta <= ZERO .or. a == ZERO) then ! No intersection + if (delta <= ZERO .or. isEqual(a, ZERO)) then ! No intersection far = INF near = sign(INF, c1) ! If ray is parallel inside the cylinder it must be fully contained @@ -328,15 +328,16 @@ pure function going(self, r, u) result(halfspace) end if - ! Determine next halfspace - halfspace = proj > ZERO - - ! Parallel direction - ! Need to use position to determine halfspace - if (proj == ZERO) then + ! Parallel direction. Need to use position to determine halfspace. + if (isEqual(proj, ZERO)) then halfspace = c >= ZERO + return + end if + ! Determine next halfspace + halfspace = proj > ZERO + end function going !! diff --git a/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 b/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 index 888898857..f1a0e32af 100644 --- a/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 +++ b/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 @@ -119,7 +119,7 @@ subroutine getMacroXSs_byP(self, xss, p) !! !! Here it is necessary to store p % matIdx() in a dedicated variable to avoid compilation errors with gfortran >= 13.2 !! - matIdx = p % matIdx() + matIdx = p % getMatIdx() associate (matCache => cache_materialCache(matIdx)) if (matCache % G_tail /= p % G) then diff --git a/ParticleObjects/Tests/particle_test.f90 b/ParticleObjects/Tests/particle_test.f90 index 0913229bc..3760b5a73 100644 --- a/ParticleObjects/Tests/particle_test.f90 +++ b/ParticleObjects/Tests/particle_test.f90 @@ -223,7 +223,7 @@ subroutine testMiscAccess(this) @assertEqual(3, this % p_CE % nesting(), 'Nesting Level') ! Level 3 - matIdx = this % p_CE % matIdx() + matIdx = this % p_CE % getMatIdx() cellIdx = this % p_CE % getCellIdx() uniIdx = this % p_CE % getUniIdx() @@ -262,7 +262,7 @@ subroutine testSetMatIdx(this) call this % p_CE % setMatIdx(3) - @assertEqual(3, this % p_CE % matIdx()) + @assertEqual(3, this % p_CE % getMatIdx()) end subroutine testSetMatIdx diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index f5b21c484..7e34c9938 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -132,7 +132,7 @@ module particle_class procedure :: nesting procedure :: getCellIdx procedure :: getUniIdx - procedure :: matIdx + procedure :: getMatIdx procedure, non_overridable :: getType ! Enquiry about physical state @@ -394,13 +394,13 @@ end function getUniIdx !! !! Return current material index !! - pure function matIdx(self) result(Idx) + pure function getMatIdx(self) result(matIdx) class(particle), intent(in) :: self - integer(shortInt) :: idx + integer(shortInt) :: matIdx - idx = self % coords % matIdx + matIdx = self % coords % matIdx - end function matIdx + end function getMatIdx !! !! Return one of the particle Tpes defined in universal variables @@ -667,28 +667,28 @@ end subroutine particleState_fromParticle !! Define equal operation on phase coordinates !! Phase coords are equal if all their components are the same !! - function equal_particleState(LHS,RHS) result(isEqual) + function equal_particleState(LHS,RHS) result(equal) class(particleState), intent(in) :: LHS class(particleState), intent(in) :: RHS - logical(defBool) :: isEqual - - isEqual = .true. - isEqual = isEqual .and. LHS % wgt == RHS % wgt - isEqual = isEqual .and. all(LHS % r == RHS % r) - isEqual = isEqual .and. all(LHS % dir == RHS % dir) - isEqual = isEqual .and. LHS % time == RHS % time - isEqual = isEqual .and. LHS % isMG .eqv. RHS % isMG - isEqual = isEqual .and. LHS % type == RHS % type - isEqual = isEqual .and. LHS % matIdx == RHS % matIdx - isEqual = isEqual .and. LHS % cellIdx == RHS % cellIdx - isEqual = isEqual .and. LHS % uniqueID == RHS % uniqueID - isEqual = isEqual .and. LHS % collisionN == RHS % collisionN - isEqual = isEqual .and. LHS % broodID == RHS % broodID + logical(defBool) :: equal + + equal = .true. + equal = equal .and. LHS % wgt == RHS % wgt + equal = equal .and. all(LHS % r == RHS % r) + equal = equal .and. all(LHS % dir == RHS % dir) + equal = equal .and. LHS % time == RHS % time + equal = equal .and. LHS % isMG .eqv. RHS % isMG + equal = equal .and. LHS % type == RHS % type + equal = equal .and. LHS % matIdx == RHS % matIdx + equal = equal .and. LHS % cellIdx == RHS % cellIdx + equal = equal .and. LHS % uniqueID == RHS % uniqueID + equal = equal .and. LHS % collisionN == RHS % collisionN + equal = equal .and. LHS % broodID == RHS % broodID if( LHS % isMG ) then - isEqual = isEqual .and. LHS % G == RHS % G + equal = equal .and. LHS % G == RHS % G else - isEqual = isEqual .and. LHS % E == RHS % E + equal = equal .and. LHS % E == RHS % E end if end function equal_particleState diff --git a/SharedModules/genericProcedures.f90 b/SharedModules/genericProcedures.f90 index 04646b2d2..c9d9b6564 100644 --- a/SharedModules/genericProcedures.f90 +++ b/SharedModules/genericProcedures.f90 @@ -91,8 +91,12 @@ module genericProcedures module procedure concatenateArrays_Real end interface - contains + interface isEqual + module procedure isEqual_defReal + module procedure isEqual_defRealArray + end interface +contains !! !! Binary search for the largest smaller-or-equal element in the array @@ -594,6 +598,86 @@ function concatenateArrays_Real(array1,array2) result(out) end function concatenateArrays_Real + !! + !! Returns .true. if two floating point numbers are equal. + !! + !! Due to floating point artihmetic and rounding-off errors being slightly different + !! across different architectures (eg, Intel vs ARM), it is necessary to use some small + !! tolerances to assert equality between two floating point numbers. These tolerances + !! are specified in numPrecision.f90. + !! + elemental function isEqual_defReal(a, b) result(equal) + real(defReal), intent(in) :: a, b + logical(defBool) :: equal + real(defReal) :: absDiff + + ! Initialise equal = .true. and check for perfect (to the bit) equality, since we can + ! return early in this case. + equal = .true. + if (a == b) return + + ! Compute the absolute value of the difference between the two floating point numbers. + ! Note that if a and b are both very large and of opposite signs this can cause overflow. + absDiff = abs(a - b) + + ! Check if absDiff is less than some absolute very small tolerance first and return if yes. + if (absDiff < floatTol) return + + ! Check if a and b are within some small relative tolerance of each other and return if + ! yes. Note that if a and b are both very small numbers, then multiplying by a small + ! tolerance can cause underflow. This is why we check absolute tolerance first. + if (absDiff < max(abs(a), abs(b)) * FP_REL_TOL) return + + ! If reached here, a and b are not within absolute or relative tolerance of each other. + ! update equal = .false. + equal = .false. + + end function isEqual_defReal + + !! + !! Returns .true. if all floating point numbers in an array are equal to a given value. + !! + !! Due to floating point artihmetic and rounding-off errors being slightly different + !! across different architectures (eg, Intel vs ARM), it is necessary to use some small + !! tolerances to assert equality between two floating point numbers. These tolerances + !! are specified in numPrecision.f90. + !! + pure function isEqual_defRealArray(array, b) result(equal) + real(defReal), dimension(:), intent(in) :: array + real(defReal), intent(in) :: b + logical(defBool) :: equal + integer(shortInt) :: i + real(defReal) :: a, absDiff + + ! Initialise equal = .true. and loop over all element in the array. + equal = .true. + do i = 1, size(array) + ! Retrieve current element of the array and check for perfect (to the bit) equality. + ! Cycle to the next element if yes. + a = array(i) + if (a == b) cycle + + ! Compute the absolute value of the difference between the two floating point numbers. + ! Note that if a and b are both very large and of opposite signs this can cause overflow. + absDiff = abs(a - b) + + ! Check if absDiff is less than some absolute very small tolerance first and cycle if yes. + if (absDiff < floatTol) cycle + + ! Check if a and b are within some small relative tolerance of each other and cycle if + ! yes. Note that if a and b are both very small numbers, then multiplying by a small + ! tolerance can cause underflow. This is why we check absolute tolerance first. + if (absDiff < max(abs(a), abs(b)) * FP_REL_TOL) cycle + + ! If reached here, a and b are not within absolute or relative tolerance of each other. + ! update equal = .false. and return. + equal = .false. + return + + end do + + end function isEqual_defRealArray + !! !! Concatenate strings from an array into a single long character (tape). Asjusts left and trims !! elements of char Array. Adds a blank at the end of a line @@ -1122,17 +1206,6 @@ subroutine rotationMatrix(matrix, phi, theta, psi) end subroutine rotationMatrix - !! - !! Dot product for 3D vector - !! - pure function dotProduct(a,b) result(x) - real(defReal),dimension(3), intent(in) :: a,b - real(defReal) :: x - - x = a(1)*b(1) + a(2)*b(2) + a(3)*b(3) - - end function dotProduct - !! !! Cross product for 3D vectors !! diff --git a/Tallies/TallyClerks/collisionClerk_class.f90 b/Tallies/TallyClerks/collisionClerk_class.f90 index 67cec49af..1a04641c7 100644 --- a/Tallies/TallyClerks/collisionClerk_class.f90 +++ b/Tallies/TallyClerks/collisionClerk_class.f90 @@ -221,9 +221,9 @@ subroutine reportInColl(self, p, xsData, mem, virtual) ! Calculate flux with the right cross section according to virtual collision handling if (self % handleVirtual) then - flux = p % w / xsData % getTrackingXS(p, p % matIdx(), TRACKING_XS) + flux = p % w / xsData % getTrackingXS(p, p % getMatIdx(), TRACKING_XS) else - flux = p % w / xsData % getTotalMatXS(p, p % matIdx()) + flux = p % w / xsData % getTotalMatXS(p, p % getMatIdx()) end if ! Calculate bin address diff --git a/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 b/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 index b6182d5cb..7f8378f50 100644 --- a/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 +++ b/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 @@ -182,7 +182,7 @@ subroutine reportInColl(self, p, xsData, mem, virtual) if (virtual) return ! Get material or return if it is not a neutron - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) if (.not.associated(mat)) return diff --git a/Tallies/TallyClerks/dancoffBellClerk_class.f90 b/Tallies/TallyClerks/dancoffBellClerk_class.f90 index 3cf626505..90d56cdcc 100644 --- a/Tallies/TallyClerks/dancoffBellClerk_class.f90 +++ b/Tallies/TallyClerks/dancoffBellClerk_class.f90 @@ -199,7 +199,7 @@ subroutine reportTrans(self, p, xsData, mem) if(.not.self % filter % isPass(state)) return ! Find end material type; Exit if not fuel or moderator - T_end = self % materialSet % getOrDefault(p % matIdx(), OUTSIDE) + T_end = self % materialSet % getOrDefault(p % getMatIdx(), OUTSIDE) if(T_end == OUTSIDE) return ! Obtain starting and ending weights diff --git a/Tallies/TallyClerks/keffImplicitClerk_class.f90 b/Tallies/TallyClerks/keffImplicitClerk_class.f90 index 008c50e02..c789a2fd4 100644 --- a/Tallies/TallyClerks/keffImplicitClerk_class.f90 +++ b/Tallies/TallyClerks/keffImplicitClerk_class.f90 @@ -172,17 +172,17 @@ subroutine reportInColl(self, p, xsData, mem, virtual) if ((.not. self % handleVirtual) .and. virtual) return ! Ensure we're not in void (could happen when scoring virtual collisions) - if (p % matIdx() == VOID_MAT) return + if (p % getMatIdx() == VOID_MAT) return ! Calculate flux with the right cross section according to virtual collision handling if (self % handleVirtual) then - flux = p % w / xsData % getTrackingXS(p, p % matIdx(), TRACKING_XS) + flux = p % w / xsData % getTrackingXS(p, p % getMatIdx(), TRACKING_XS) else - flux = p % w / xsData % getTotalMatXS(p, p % matIdx()) + flux = p % w / xsData % getTotalMatXS(p, p % getMatIdx()) end if ! Get material pointer - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) if (.not.associated(mat)) then call fatalError(Here,'Unrecognised type of material was retrived from nuclearDatabase') end if diff --git a/Tallies/TallyClerks/mgXsClerk_class.f90 b/Tallies/TallyClerks/mgXsClerk_class.f90 index 80ea66204..e563c9c2d 100644 --- a/Tallies/TallyClerks/mgXsClerk_class.f90 +++ b/Tallies/TallyClerks/mgXsClerk_class.f90 @@ -259,18 +259,18 @@ subroutine reportInColl(self, p, xsData, mem, virtual) ! Calculate flux with the right cross section according to virtual collision handling if (self % handleVirtual) then - flux = p % w / xsData % getTrackingXS(p, p % matIdx(), TRACKING_XS) + flux = p % w / xsData % getTrackingXS(p, p % getMatIdx(), TRACKING_XS) else - flux = p % w / xsData % getTotalMatXS(p, p % matIdx()) + flux = p % w / xsData % getTotalMatXS(p, p % getMatIdx()) end if ! Check if the particle is in void. This call might happen when handling virtual collisions. ! This is relevant in the case of homogenising materials that include void: the flux ! in void will be different than zero, and the zero reaction rates have to be averaged - if (p % matIdx() /= VOID_MAT) then + if (p % getMatIdx() /= VOID_MAT) then ! Get material pointer - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) if (.not.associated(mat)) then call fatalError(Here,'Unrecognised type of material was retrived from nuclearDatabase') end if diff --git a/Tallies/TallyClerks/simpleFMClerk_class.f90 b/Tallies/TallyClerks/simpleFMClerk_class.f90 index a4e026aee..1114f3b51 100644 --- a/Tallies/TallyClerks/simpleFMClerk_class.f90 +++ b/Tallies/TallyClerks/simpleFMClerk_class.f90 @@ -208,10 +208,10 @@ subroutine reportInColl(self, p, xsData, mem, virtual) if ((.not. self % handleVirtual) .and. virtual) return ! Ensure we're not in void (could happen when scoring virtual collisions) - if (p % matIdx() == VOID_MAT) return + if (p % getMatIdx() == VOID_MAT) return ! Get material pointer - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) if (.not.associated(mat)) then call fatalError(Here,'Unrecognised type of material was retrived from nuclearDatabase') end if @@ -221,9 +221,9 @@ subroutine reportInColl(self, p, xsData, mem, virtual) ! Calculate flux with the right cross section according to virtual collision handling if (self % handleVirtual) then - flux = p % w / xsData % getTrackingXS(p, p % matIdx(), TRACKING_XS) + flux = p % w / xsData % getTrackingXS(p, p % getMatIdx(), TRACKING_XS) else - flux = p % w / xsData % getTotalMatXS(p, p % matIdx()) + flux = p % w / xsData % getTotalMatXS(p, p % getMatIdx()) end if ! Find starting index in the map diff --git a/Tallies/TallyMaps/Maps1D/directionMap_class.f90 b/Tallies/TallyMaps/Maps1D/directionMap_class.f90 index a1ce82ed9..fe20947bb 100644 --- a/Tallies/TallyMaps/Maps1D/directionMap_class.f90 +++ b/Tallies/TallyMaps/Maps1D/directionMap_class.f90 @@ -2,7 +2,7 @@ module directionMap_class use numPrecision use universalVariables, only : valueOutsideArray, X_AXIS, Y_AXIS, Z_AXIS - use genericProcedures, only : fatalError, dotProduct, numToChar + use genericProcedures, only : fatalError, numToChar use dictionary_class, only : dictionary use grid_class, only : grid use particle_class, only : particleState diff --git a/Tallies/TallyMaps/Maps1D/radialMap_class.f90 b/Tallies/TallyMaps/Maps1D/radialMap_class.f90 index 5477f67bb..870a1719b 100644 --- a/Tallies/TallyMaps/Maps1D/radialMap_class.f90 +++ b/Tallies/TallyMaps/Maps1D/radialMap_class.f90 @@ -2,7 +2,7 @@ module radialMap_class use numPrecision use universalVariables, only : valueOutsideArray, X_AXIS, Y_AXIS, Z_AXIS - use genericProcedures, only : fatalError, dotProduct, numToChar + use genericProcedures, only : fatalError, numToChar use dictionary_class, only : dictionary use grid_class, only : grid use particle_class, only : particleState diff --git a/Tallies/TallyMaps/cylindricalMap_class.f90 b/Tallies/TallyMaps/cylindricalMap_class.f90 index 7d326b64d..c83cb7d74 100644 --- a/Tallies/TallyMaps/cylindricalMap_class.f90 +++ b/Tallies/TallyMaps/cylindricalMap_class.f90 @@ -2,7 +2,7 @@ module cylindricalMap_class use numPrecision use universalVariables, only : valueOutsideArray, X_AXIS, Y_AXIS, Z_AXIS - use genericProcedures, only : fatalError, dotProduct, numToChar + use genericProcedures, only : fatalError, numToChar use dictionary_class, only : dictionary use grid_class, only : grid use particle_class, only : particleState diff --git a/Tallies/TallyResponses/macroResponse_class.f90 b/Tallies/TallyResponses/macroResponse_class.f90 index 59012772f..77c84bdf1 100644 --- a/Tallies/TallyResponses/macroResponse_class.f90 +++ b/Tallies/TallyResponses/macroResponse_class.f90 @@ -124,10 +124,10 @@ function get(self, p, xsData) result(val) ! Return zero if particle is not neutron or if the particle is in void if (p % type /= P_NEUTRON) return - if (p % matIdx() == VOID_MAT) return + if (p % getMatIdx() == VOID_MAT) return ! Get pointer to active material data - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) ! Return if material is not a neutronMaterial if (.not.associated(mat)) return diff --git a/Tallies/TallyResponses/microResponse_class.f90 b/Tallies/TallyResponses/microResponse_class.f90 index 225c20fce..764690f99 100644 --- a/Tallies/TallyResponses/microResponse_class.f90 +++ b/Tallies/TallyResponses/microResponse_class.f90 @@ -156,7 +156,7 @@ function get(self, p, xsData) result(val) ! Return zero if particle is not neutron or if the particle is in void if (p % type /= P_NEUTRON) return - if (p % matIdx() == VOID_MAT) return + if (p % getMatIdx() == VOID_MAT) return ! Get pointer to active material data mat => neutronMaterial_CptrCast(xsData % getMaterial(self % matIdx)) diff --git a/Tallies/TallyResponses/weightResponse_class.f90 b/Tallies/TallyResponses/weightResponse_class.f90 index ac637bf80..ecfff0058 100644 --- a/Tallies/TallyResponses/weightResponse_class.f90 +++ b/Tallies/TallyResponses/weightResponse_class.f90 @@ -78,15 +78,15 @@ function get(self, p, xsData) result(val) if(p % type /= P_NEUTRON) return ! Get pointer to active material data - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) ! 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) + val = xsData % getTotalMatXS(p, p % getMatIdx()) / (p % w) else - val = xsData % getTotalMatXS(p, p % matIdx()) * ((p % w) ** (self % moment - 1)) + val = xsData % getTotalMatXS(p, p % getMatIdx()) * ((p % w) ** (self % moment - 1)) end if end function get diff --git a/TransportOperator/transportOperatorDT_class.f90 b/TransportOperator/transportOperatorDT_class.f90 index 568e161ec..89e39e0b5 100644 --- a/TransportOperator/transportOperatorDT_class.f90 +++ b/TransportOperator/transportOperatorDT_class.f90 @@ -54,7 +54,7 @@ subroutine deltaTracking(self, p, tally, thisCycle, nextCycle) character(100), parameter :: Here = 'deltaTracking (transportOperatorDT_class.f90)' ! Get majorant XS inverse: 1/Sigma_majorant - majorant_inv = ONE / self % xsData % getTrackingXS(p, p % matIdx(), MAJORANT_XS) + majorant_inv = ONE / self % xsData % getTrackingXS(p, p % getMatIdx(), MAJORANT_XS) ! Should never happen! Prevents Inf distances if (abs(majorant_inv) > huge(majorant_inv)) call fatalError(Here, "Majorant is 0") @@ -66,26 +66,26 @@ subroutine deltaTracking(self, p, tally, thisCycle, nextCycle) call self % geom % teleport(p % coords, distance) ! If particle has leaked, exit - if (p % matIdx() == OUTSIDE_FILL) then + if (p % getMatIdx() == OUTSIDE_FILL) then p % fate = LEAK_FATE p % isDead = .true. return end if ! Check for void - if (p % matIdx() == VOID_MAT) then + if (p % getMatIdx() == VOID_MAT) then call tally % reportInColl(p, .true.) cycle DTLoop end if ! Give error if the particle somehow ended in an undefined material - if (p % matIdx() == UNDEF_MAT) then + if (p % getMatIdx() == UNDEF_MAT) then print *, p % rGlobal() call fatalError(Here, "Particle is in undefined material") end if ! Obtain the local cross-section - sigmaT = self % xsData % getTrackMatXS(p, p % matIdx()) + sigmaT = self % xsData % getTrackMatXS(p, p % getMatIdx()) ! Roll RNG to determine if the collision is real or virtual ! Exit the loop if the collision is real, report collision if virtual diff --git a/TransportOperator/transportOperatorHT_class.f90 b/TransportOperator/transportOperatorHT_class.f90 index e7ea82435..9be6ae2ae 100644 --- a/TransportOperator/transportOperatorHT_class.f90 +++ b/TransportOperator/transportOperatorHT_class.f90 @@ -55,10 +55,10 @@ subroutine tracking_selection(self, p, tally, thisCycle, nextCycle) character(100), parameter :: Here = 'hybridTracking (transportOIperatorHT_class.f90)' ! Get majornat XS inverse: 1/Sigma_majorant - majorant_inv = ONE / self % xsData % getTrackingXS(p, p % matIdx(), MAJORANT_XS) + majorant_inv = ONE / self % xsData % getTrackingXS(p, p % getMatIdx(), MAJORANT_XS) ! Obtain the local cross-section - sigmaT = self % xsData % getTrackMatXS(p, p % matIdx()) + sigmaT = self % xsData % getTrackMatXS(p, p % getMatIdx()) ! Calculate ratio between local cross-section and majorant ratio = sigmaT*majorant_inv @@ -85,7 +85,7 @@ subroutine deltaTracking(self, p, tally, thisCycle, nextCycle) character(100), parameter :: Here = 'deltaTracking (transportOperatorHT_class.f90)' ! Get majorant XS inverse: 1/Sigma_majorant - majorant_inv = ONE / self % xsData % getTrackingXS(p, p % matIdx(), MAJORANT_XS) + majorant_inv = ONE / self % xsData % getTrackingXS(p, p % getMatIdx(), MAJORANT_XS) ! Should never happen! Prevents Inf distances if (abs(majorant_inv) > huge(majorant_inv)) call fatalError(Here, "Majorant is 0") @@ -97,26 +97,26 @@ subroutine deltaTracking(self, p, tally, thisCycle, nextCycle) call self % geom % teleport(p % coords, distance) ! If particle has leaked exit - if (p % matIdx() == OUTSIDE_FILL) then + if (p % getMatIdx() == OUTSIDE_FILL) then p % fate = LEAK_FATE p % isDead = .true. return end if ! Check for void - if(p % matIdx() == VOID_MAT) then + if(p % getMatIdx() == VOID_MAT) then call tally % reportInColl(p, .true.) cycle DTLoop end if ! Give error if the particle somehow ended in an undefined material - if (p % matIdx() == UNDEF_MAT) then + if (p % getMatIdx() == UNDEF_MAT) then print *, p % rGlobal() call fatalError(Here, "Particle is in undefined material") end if ! Obtain the local cross-section - sigmaT = self % xsData % getTrackMatXS(p, p % matIdx()) + sigmaT = self % xsData % getTrackMatXS(p, p % getMatIdx()) ! Roll RNG to determine if the collision is real or virtual ! Exit the loop if the collision is real, report collision if virtual @@ -148,11 +148,11 @@ subroutine surfaceTracking(self, p, tally, thisCycle, nextCycle) STLoop: do ! Obtain the local cross-section - if (p % matIdx() == VOID_MAT) then + if (p % getMatIdx() == VOID_MAT) then dist = INFINITY else - sigmaT = self % xsData % getTrackingXS(p, p % matIdx(), MATERIAL_XS) + sigmaT = self % xsData % getTrackingXS(p, p % getMatIdx(), MATERIAL_XS) dist = -log( p % pRNG % get()) / sigmaT ! Should never happen! Catches NaN distances @@ -170,13 +170,13 @@ subroutine surfaceTracking(self, p, tally, thisCycle, nextCycle) call tally % reportPath(p, dist) ! Kill particle if it has leaked - if (p % matIdx() == OUTSIDE_FILL) then + if (p % getMatIdx() == 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 + if (p % getMatIdx() == UNDEF_MAT) then print *, p % rGlobal() call fatalError(Here, "Particle is in undefined material") end if diff --git a/TransportOperator/transportOperatorST_class.f90 b/TransportOperator/transportOperatorST_class.f90 index 1ef7a138b..358e417d4 100644 --- a/TransportOperator/transportOperatorST_class.f90 +++ b/TransportOperator/transportOperatorST_class.f90 @@ -59,11 +59,11 @@ subroutine surfaceTracking(self, p, tally, thisCycle, nextCycle) STLoop: do ! Obtain the local cross-section - if (p % matIdx() == VOID_MAT) then + if (p % getMatIdx() == VOID_MAT) then dist = INFINITY else - sigmaT = self % xsData % getTrackingXS(p, p % matIdx(), MATERIAL_XS) + sigmaT = self % xsData % getTrackingXS(p, p % getMatIdx(), MATERIAL_XS) dist = -log( p % pRNG % get()) / sigmaT ! Should never happen! Catches NaN distances @@ -87,13 +87,13 @@ subroutine surfaceTracking(self, p, tally, thisCycle, nextCycle) call tally % reportPath(p, dist) ! Kill particle if it has leaked - if (p % matIdx() == OUTSIDE_FILL) then + if (p % getMatIdx() == 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 + if (p % getMatIdx() == UNDEF_MAT) then print *, p % rGlobal() call fatalError(Here, "Particle is in undefined material") end if From e7d5281225f75770a658f4dd17475b97c629285e Mon Sep 17 00:00:00 2001 From: Nathan Date: Thu, 24 Oct 2024 11:21:35 +0100 Subject: [PATCH 03/10] Small corrections --- .../collisionProcessor_inter.f90 | 2 +- .../neutronCEimp_class.f90 | 2 +- .../neutronCEstd_class.f90 | 2 +- .../neutronMGimp_class.f90 | 2 +- .../neutronMGstd_class.f90 | 2 +- .../Surfaces/QuadSurfaces/aPlane_class.f90 | 4 +- Geometry/Surfaces/QuadSurfaces/cone_class.f90 | 4 +- .../Surfaces/QuadSurfaces/cylinder_class.f90 | 4 +- .../Surfaces/QuadSurfaces/plane_class.f90 | 6 +- Geometry/Surfaces/box_class.f90 | 4 +- Geometry/Surfaces/squareCylinder_class.f90 | 4 +- Geometry/Surfaces/truncCylinder_class.f90 | 6 +- .../mgNeutronData/mgNeutronMaterial_inter.f90 | 2 +- ParticleObjects/Tests/particle_test.f90 | 4 +- ParticleObjects/particle_class.f90 | 44 ++++++------ SharedModules/genericProcedures.f90 | 70 ++++++++++--------- Tallies/TallyClerks/collisionClerk_class.f90 | 4 +- .../collisionProbabilityClerk_class.f90 | 2 +- .../TallyClerks/dancoffBellClerk_class.f90 | 2 +- .../TallyClerks/keffImplicitClerk_class.f90 | 8 +-- Tallies/TallyClerks/mgXsClerk_class.f90 | 8 +-- Tallies/TallyClerks/simpleFMClerk_class.f90 | 8 +-- .../TallyResponses/macroResponse_class.f90 | 4 +- .../TallyResponses/microResponse_class.f90 | 2 +- .../TallyResponses/weightResponse_class.f90 | 6 +- .../transportOperatorDT_class.f90 | 10 +-- .../transportOperatorHT_class.f90 | 22 +++--- .../transportOperatorST_class.f90 | 8 +-- 28 files changed, 124 insertions(+), 122 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 b/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 index f917fba04..f14c3da75 100644 --- a/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 +++ b/CollisionOperator/CollisionProcessors/collisionProcessor_inter.f90 @@ -119,7 +119,7 @@ subroutine collide(self, p, tally, thisCycle, nextCycle) character(100),parameter :: Here = 'collide (collisionProcessor.f90)' ! Load material index into data package - collDat % matIdx = p % getMatIdx() + collDat % matIdx = p % matIdx() ! Choose collision nuclide and general type (Scatter, Capture or Fission) call self % sampleCollision(p, tally, collDat, thisCycle, nextCycle) diff --git a/CollisionOperator/CollisionProcessors/neutronCEimp_class.f90 b/CollisionOperator/CollisionProcessors/neutronCEimp_class.f90 index 5cb346f01..ea42f32ad 100644 --- a/CollisionOperator/CollisionProcessors/neutronCEimp_class.f90 +++ b/CollisionOperator/CollisionProcessors/neutronCEimp_class.f90 @@ -243,7 +243,7 @@ subroutine sampleCollision(self, p, tally, collDat, thisCycle, nextCycle) if(.not.associated(self % xsData)) call fatalError(Here, 'There is no active Neutron CE data!') ! Verify and load material pointer - self % mat => ceNeutronMaterial_CptrCast( self % xsData % getMaterial( p % getMatIdx())) + self % mat => ceNeutronMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) if(.not.associated(self % mat)) call fatalError(Here, 'Material is not ceNeutronMaterial') ! Select collision nuclide diff --git a/CollisionOperator/CollisionProcessors/neutronCEstd_class.f90 b/CollisionOperator/CollisionProcessors/neutronCEstd_class.f90 index 86012f367..dba85ee80 100644 --- a/CollisionOperator/CollisionProcessors/neutronCEstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/neutronCEstd_class.f90 @@ -163,7 +163,7 @@ subroutine sampleCollision(self, p, tally, collDat, thisCycle, nextCycle) if (.not.associated(self % xsData)) call fatalError(Here, 'There is no active Neutron CE data!') ! Verify and load material pointer - self % mat => ceNeutronMaterial_CptrCast(self % xsData % getMaterial(p % getMatIdx())) + self % mat => ceNeutronMaterial_CptrCast(self % xsData % getMaterial(p % matIdx())) if (.not.associated(self % mat)) call fatalError(Here, 'Material is not ceNeutronMaterial') ! Select collision nuclide diff --git a/CollisionOperator/CollisionProcessors/neutronMGimp_class.f90 b/CollisionOperator/CollisionProcessors/neutronMGimp_class.f90 index 768b7fd7a..bc2155c22 100644 --- a/CollisionOperator/CollisionProcessors/neutronMGimp_class.f90 +++ b/CollisionOperator/CollisionProcessors/neutronMGimp_class.f90 @@ -136,7 +136,7 @@ subroutine sampleCollision(self, p, tally, collDat, thisCycle, nextCycle) if(.not.associated(self % xsData)) call fatalError(Here, "Failed to get active database for MG Neutron") ! Get and verify material pointer - self % mat => mgNeutronMaterial_CptrCast( self % xsData % getMaterial( p % getMatIdx())) + self % mat => mgNeutronMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG Neutron Material") ! Select Main reaction channel diff --git a/CollisionOperator/CollisionProcessors/neutronMGstd_class.f90 b/CollisionOperator/CollisionProcessors/neutronMGstd_class.f90 index 5909649da..b816c6fe6 100644 --- a/CollisionOperator/CollisionProcessors/neutronMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/neutronMGstd_class.f90 @@ -103,7 +103,7 @@ subroutine sampleCollision(self, p, tally, collDat, thisCycle, nextCycle) if(.not.associated(self % xsData)) call fatalError(Here, "Failed to get active database for MG Neutron") ! Get and verify material pointer - self % mat => mgNeutronMaterial_CptrCast( self % xsData % getMaterial( p % getMatIdx())) + self % mat => mgNeutronMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG Neutron Material") ! Select Main reaction channel diff --git a/Geometry/Surfaces/QuadSurfaces/aPlane_class.f90 b/Geometry/Surfaces/QuadSurfaces/aPlane_class.f90 index 3a7443bf9..2d581752c 100644 --- a/Geometry/Surfaces/QuadSurfaces/aPlane_class.f90 +++ b/Geometry/Surfaces/QuadSurfaces/aPlane_class.f90 @@ -2,7 +2,7 @@ module aPlane_class use numPrecision use universalVariables, only : X_AXIS, Y_AXIS, Z_AXIS, INF - use genericProcedures, only : fatalError, isEqual + use genericProcedures, only : fatalError, areEqual use dictionary_class, only : dictionary use quadSurface_inter, only : quadSurface use surface_inter, only : kill_super => kill @@ -198,7 +198,7 @@ pure function going(self, r, u) result(halfspace) ua = u(self % axis) ! Special case of parallel direction. Particle stays in its current halfspace. - if (isEqual(ua, ZERO)) then + if (areEqual(ua, ZERO)) then halfspace = (r(self % axis) - self % a0) >= ZERO return diff --git a/Geometry/Surfaces/QuadSurfaces/cone_class.f90 b/Geometry/Surfaces/QuadSurfaces/cone_class.f90 index bef9d5178..39d2f22b7 100644 --- a/Geometry/Surfaces/QuadSurfaces/cone_class.f90 +++ b/Geometry/Surfaces/QuadSurfaces/cone_class.f90 @@ -2,7 +2,7 @@ module cone_class use numPrecision use universalVariables, only : SURF_TOL, INF, X_AXIS, Y_AXIS, Z_AXIS - use genericProcedures, only : fatalError, numToChar, isEqual + use genericProcedures, only : fatalError, numToChar, areEqual use dictionary_class, only : dictionary use quadSurface_inter, only : quadSurface use surface_inter, only : kill_super => kill @@ -419,7 +419,7 @@ pure function going(self, r, u) result(halfspace) proj = dot_product(norm,u) ! Parallel direction. Need to use position to determine halfspace. - if (isEqual(proj, ZERO)) then + if (areEqual(proj, ZERO)) then halfspace = self % evaluate(r) >= ZERO return diff --git a/Geometry/Surfaces/QuadSurfaces/cylinder_class.f90 b/Geometry/Surfaces/QuadSurfaces/cylinder_class.f90 index 5a32d3683..9d133b7da 100644 --- a/Geometry/Surfaces/QuadSurfaces/cylinder_class.f90 +++ b/Geometry/Surfaces/QuadSurfaces/cylinder_class.f90 @@ -2,7 +2,7 @@ module cylinder_class use numPrecision use universalVariables, only : SURF_TOL, INF, X_AXIS, Y_AXIS, Z_AXIS - use genericProcedures, only : fatalError, numToChar, isEqual + use genericProcedures, only : fatalError, numToChar, areEqual use dictionary_class, only : dictionary use quadSurface_inter, only : quadSurface use surface_inter, only : kill_super => kill @@ -242,7 +242,7 @@ pure function distance(self, r, u) result(d) delta = k*k - a*c ! Technically delta/4 ! Calculate the distance - if (delta < ZERO .or. isEqual(a, ZERO)) then ! No intersection + if (delta < ZERO .or. areEqual(a, ZERO)) then ! No intersection d = INF else if (abs(c) < self % surfTol()) then ! Point at a surface diff --git a/Geometry/Surfaces/QuadSurfaces/plane_class.f90 b/Geometry/Surfaces/QuadSurfaces/plane_class.f90 index 1890ac995..e06336f5f 100644 --- a/Geometry/Surfaces/QuadSurfaces/plane_class.f90 +++ b/Geometry/Surfaces/QuadSurfaces/plane_class.f90 @@ -2,7 +2,7 @@ module plane_class use numPrecision use universalVariables, only : X_AXIS, Y_AXIS, Z_AXIS, INF - use genericProcedures, only : fatalError, numToChar, isEqual + use genericProcedures, only : fatalError, numToChar, areEqual use dictionary_class, only : dictionary use quadSurface_inter, only : quadSurface use surface_inter, only : kill_super => kill @@ -154,7 +154,7 @@ pure function distance(self, r, u) result(d) k = dot_product(u, self % norm) c = self % evaluate(r) - if (isEqual(k, ZERO) .or. abs(c) < self % surfTol()) then ! Parallel or at the surface + if (areEqual(k, ZERO) .or. abs(c) < self % surfTol()) then ! Parallel or at the surface d = INF else @@ -183,7 +183,7 @@ pure function going(self, r, u) result(halfspace) proj = dot_product(u, self % norm) ! Special case of parallel direction. Particle stays in its current halfspace - if (isEqual(proj, ZERO)) then + if (areEqual(proj, ZERO)) then halfspace = self % evaluate(r) >= ZERO return diff --git a/Geometry/Surfaces/box_class.f90 b/Geometry/Surfaces/box_class.f90 index a35a7c54b..cc468d60a 100644 --- a/Geometry/Surfaces/box_class.f90 +++ b/Geometry/Surfaces/box_class.f90 @@ -2,7 +2,7 @@ module box_class use numPrecision use universalVariables - use genericProcedures, only : fatalError, numToChar, swap, isEqual + use genericProcedures, only : fatalError, numToChar, swap, areEqual use dictionary_class, only : dictionary use surface_inter, only : surface, kill_super => kill @@ -265,7 +265,7 @@ pure function going(self, r, u) result(halfspace) proj = u(maxCom) * sign(ONE, rl(maxCom)) ! Parallel direction. Need to use position to determine halfspace. - if (isEqual(proj, ZERO)) then + if (areEqual(proj, ZERO)) then halfspace = self % evaluate(r) >= ZERO return diff --git a/Geometry/Surfaces/squareCylinder_class.f90 b/Geometry/Surfaces/squareCylinder_class.f90 index ff3897c93..349fbb3e6 100644 --- a/Geometry/Surfaces/squareCylinder_class.f90 +++ b/Geometry/Surfaces/squareCylinder_class.f90 @@ -2,7 +2,7 @@ module squareCylinder_class use numPrecision use universalVariables - use genericProcedures, only : fatalError, numToChar, swap, isEqual + use genericProcedures, only : fatalError, numToChar, swap, areEqual use dictionary_class, only : dictionary use surface_inter, only : surface, kill_super => kill @@ -314,7 +314,7 @@ pure function going(self, r, u) result(halfspace) proj = ul(maxCom) * sign(ONE, rl(maxCom)) ! Parallel direction. Need to use position to determine halfspace - if (isEqual(proj, ZERO)) then + if (areEqual(proj, ZERO)) then halfspace = self % evaluate(r) >= ZERO return diff --git a/Geometry/Surfaces/truncCylinder_class.f90 b/Geometry/Surfaces/truncCylinder_class.f90 index 9d59ae4a4..5b5442abf 100644 --- a/Geometry/Surfaces/truncCylinder_class.f90 +++ b/Geometry/Surfaces/truncCylinder_class.f90 @@ -2,7 +2,7 @@ module truncCylinder_class use numPrecision use universalVariables - use genericProcedures, only : fatalError, numToChar, swap, isEqual + use genericProcedures, only : fatalError, numToChar, swap, areEqual use dictionary_class, only : dictionary use surface_inter, only : surface, kill_super => kill @@ -227,7 +227,7 @@ pure function distance(self, r, u) result(d) delta = k*k - a*c1 ! Technically delta/4 ! Find closes & furthest distance - if (delta <= ZERO .or. isEqual(a, ZERO)) then ! No intersection + if (delta <= ZERO .or. areEqual(a, ZERO)) then ! No intersection far = INF near = sign(INF, c1) ! If ray is parallel inside the cylinder it must be fully contained @@ -329,7 +329,7 @@ pure function going(self, r, u) result(halfspace) end if ! Parallel direction. Need to use position to determine halfspace. - if (isEqual(proj, ZERO)) then + if (areEqual(proj, ZERO)) then halfspace = c >= ZERO return diff --git a/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 b/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 index f1a0e32af..888898857 100644 --- a/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 +++ b/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 @@ -119,7 +119,7 @@ subroutine getMacroXSs_byP(self, xss, p) !! !! Here it is necessary to store p % matIdx() in a dedicated variable to avoid compilation errors with gfortran >= 13.2 !! - matIdx = p % getMatIdx() + matIdx = p % matIdx() associate (matCache => cache_materialCache(matIdx)) if (matCache % G_tail /= p % G) then diff --git a/ParticleObjects/Tests/particle_test.f90 b/ParticleObjects/Tests/particle_test.f90 index 3760b5a73..0913229bc 100644 --- a/ParticleObjects/Tests/particle_test.f90 +++ b/ParticleObjects/Tests/particle_test.f90 @@ -223,7 +223,7 @@ subroutine testMiscAccess(this) @assertEqual(3, this % p_CE % nesting(), 'Nesting Level') ! Level 3 - matIdx = this % p_CE % getMatIdx() + matIdx = this % p_CE % matIdx() cellIdx = this % p_CE % getCellIdx() uniIdx = this % p_CE % getUniIdx() @@ -262,7 +262,7 @@ subroutine testSetMatIdx(this) call this % p_CE % setMatIdx(3) - @assertEqual(3, this % p_CE % getMatIdx()) + @assertEqual(3, this % p_CE % matIdx()) end subroutine testSetMatIdx diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index 7e34c9938..77b0248ca 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -132,7 +132,7 @@ module particle_class procedure :: nesting procedure :: getCellIdx procedure :: getUniIdx - procedure :: getMatIdx + procedure :: matIdx procedure, non_overridable :: getType ! Enquiry about physical state @@ -394,13 +394,13 @@ end function getUniIdx !! !! Return current material index !! - pure function getMatIdx(self) result(matIdx) + pure function matIdx(self) result(idx) class(particle), intent(in) :: self - integer(shortInt) :: matIdx + integer(shortInt) :: idx - matIdx = self % coords % matIdx + idx = self % coords % matIdx - end function getMatIdx + end function matIdx !! !! Return one of the particle Tpes defined in universal variables @@ -667,28 +667,28 @@ end subroutine particleState_fromParticle !! Define equal operation on phase coordinates !! Phase coords are equal if all their components are the same !! - function equal_particleState(LHS,RHS) result(equal) + function equal_particleState(LHS,RHS) result(isEqual) class(particleState), intent(in) :: LHS class(particleState), intent(in) :: RHS - logical(defBool) :: equal - - equal = .true. - equal = equal .and. LHS % wgt == RHS % wgt - equal = equal .and. all(LHS % r == RHS % r) - equal = equal .and. all(LHS % dir == RHS % dir) - equal = equal .and. LHS % time == RHS % time - equal = equal .and. LHS % isMG .eqv. RHS % isMG - equal = equal .and. LHS % type == RHS % type - equal = equal .and. LHS % matIdx == RHS % matIdx - equal = equal .and. LHS % cellIdx == RHS % cellIdx - equal = equal .and. LHS % uniqueID == RHS % uniqueID - equal = equal .and. LHS % collisionN == RHS % collisionN - equal = equal .and. LHS % broodID == RHS % broodID + logical(defBool) :: isEqual + + isEqual = .true. + isEqual = isEqual .and. LHS % wgt == RHS % wgt + isEqual = isEqual .and. all(LHS % r == RHS % r) + isEqual = isEqual .and. all(LHS % dir == RHS % dir) + isEqual = isEqual .and. LHS % time == RHS % time + isEqual = isEqual .and. LHS % isMG .eqv. RHS % isMG + isEqual = isEqual .and. LHS % type == RHS % type + isEqual = isEqual .and. LHS % matIdx == RHS % matIdx + isEqual = isEqual .and. LHS % cellIdx == RHS % cellIdx + isEqual = isEqual .and. LHS % uniqueID == RHS % uniqueID + isEqual = isEqual .and. LHS % collisionN == RHS % collisionN + isEqual = isEqual .and. LHS % broodID == RHS % broodID if( LHS % isMG ) then - equal = equal .and. LHS % G == RHS % G + isEqual = isEqual .and. LHS % G == RHS % G else - equal = equal .and. LHS % E == RHS % E + isEqual = isEqual .and. LHS % E == RHS % E end if end function equal_particleState diff --git a/SharedModules/genericProcedures.f90 b/SharedModules/genericProcedures.f90 index c9d9b6564..a5b7623e7 100644 --- a/SharedModules/genericProcedures.f90 +++ b/SharedModules/genericProcedures.f90 @@ -91,9 +91,9 @@ module genericProcedures module procedure concatenateArrays_Real end interface - interface isEqual - module procedure isEqual_defReal - module procedure isEqual_defRealArray + interface areEqual + module procedure areEqual_defReal + module procedure areEqual_defRealArray end interface contains @@ -599,84 +599,86 @@ function concatenateArrays_Real(array1,array2) result(out) end function concatenateArrays_Real !! - !! Returns .true. if two floating point numbers are equal. + !! Returns .true. if value and target are equal. !! !! Due to floating point artihmetic and rounding-off errors being slightly different !! across different architectures (eg, Intel vs ARM), it is necessary to use some small !! tolerances to assert equality between two floating point numbers. These tolerances !! are specified in numPrecision.f90. !! - elemental function isEqual_defReal(a, b) result(equal) - real(defReal), intent(in) :: a, b + elemental function areEqual_defReal(value, target) result(equal) + real(defReal), intent(in) :: value, target logical(defBool) :: equal real(defReal) :: absDiff ! Initialise equal = .true. and check for perfect (to the bit) equality, since we can ! return early in this case. equal = .true. - if (a == b) return + if (value == target) return ! Compute the absolute value of the difference between the two floating point numbers. - ! Note that if a and b are both very large and of opposite signs this can cause overflow. - absDiff = abs(a - b) + ! Note that if value and target are both very large and of opposite signs this can + ! cause overflow. + absDiff = abs(value - target) ! Check if absDiff is less than some absolute very small tolerance first and return if yes. if (absDiff < floatTol) return - ! Check if a and b are within some small relative tolerance of each other and return if - ! yes. Note that if a and b are both very small numbers, then multiplying by a small - ! tolerance can cause underflow. This is why we check absolute tolerance first. - if (absDiff < max(abs(a), abs(b)) * FP_REL_TOL) return + ! Check if value and target are within some small relative tolerance of each other and + ! return if yes. Note that if value and target are both very small numbers, then multiplying + ! by a small tolerance can cause underflow. This is why we check absolute tolerance first. + if (absDiff < max(abs(value), abs(target)) * FP_REL_TOL) return - ! If reached here, a and b are not within absolute or relative tolerance of each other. - ! update equal = .false. + ! If reached here, value and target are not within absolute or relative tolerance of each + ! other. Update equal = .false. equal = .false. - end function isEqual_defReal + end function areEqual_defReal !! - !! Returns .true. if all floating point numbers in an array are equal to a given value. + !! Returns .true. if all elements of an array are equal to target. !! !! Due to floating point artihmetic and rounding-off errors being slightly different !! across different architectures (eg, Intel vs ARM), it is necessary to use some small !! tolerances to assert equality between two floating point numbers. These tolerances !! are specified in numPrecision.f90. !! - pure function isEqual_defRealArray(array, b) result(equal) + pure function areEqual_defRealArray(array, target) result(equal) real(defReal), dimension(:), intent(in) :: array - real(defReal), intent(in) :: b + real(defReal), intent(in) :: target logical(defBool) :: equal integer(shortInt) :: i - real(defReal) :: a, absDiff + real(defReal) :: value, absDiff ! Initialise equal = .true. and loop over all element in the array. equal = .true. do i = 1, size(array) ! Retrieve current element of the array and check for perfect (to the bit) equality. ! Cycle to the next element if yes. - a = array(i) - if (a == b) cycle + value = array(i) + if (value == target) cycle ! Compute the absolute value of the difference between the two floating point numbers. - ! Note that if a and b are both very large and of opposite signs this can cause overflow. - absDiff = abs(a - b) + ! Note that if value and target are both very large and of opposite signs this can + ! cause overflow. + absDiff = abs(value - target) ! Check if absDiff is less than some absolute very small tolerance first and cycle if yes. if (absDiff < floatTol) cycle - ! Check if a and b are within some small relative tolerance of each other and cycle if - ! yes. Note that if a and b are both very small numbers, then multiplying by a small - ! tolerance can cause underflow. This is why we check absolute tolerance first. - if (absDiff < max(abs(a), abs(b)) * FP_REL_TOL) cycle + ! Check if value and targer are within some small relative tolerance of each other and + ! cycle if yes. Note that if value and target are both very small numbers, then multiplying + ! by a small tolerance can cause underflow. This is why we check absolute tolerance first. + if (absDiff < max(abs(value), abs(target)) * FP_REL_TOL) cycle - ! If reached here, a and b are not within absolute or relative tolerance of each other. - ! update equal = .false. and return. + ! If reached here, value and target are not within absolute or relative tolerance of each + ! other. Update equal = .false. and return. equal = .false. return end do - end function isEqual_defRealArray + end function areEqual_defRealArray !! !! Concatenate strings from an array into a single long character (tape). Asjusts left and trims @@ -830,12 +832,12 @@ end subroutine replaceChar !! !! Compares strings for equality. Ignores leading blanks. !! - elemental function charCmp(char1, char2) result(areEqual) + elemental function charCmp(char1, char2) result(isEqual) character(*), intent(in) :: char1 character(*), intent(in) :: char2 - logical(defBool) :: areEqual + logical(defBool) :: isEqual - areEqual = (trim(adjustl(char1)) == trim(adjustl(char2))) + isEqual = (trim(adjustl(char1)) == trim(adjustl(char2))) end function charCmp diff --git a/Tallies/TallyClerks/collisionClerk_class.f90 b/Tallies/TallyClerks/collisionClerk_class.f90 index 1a04641c7..67cec49af 100644 --- a/Tallies/TallyClerks/collisionClerk_class.f90 +++ b/Tallies/TallyClerks/collisionClerk_class.f90 @@ -221,9 +221,9 @@ subroutine reportInColl(self, p, xsData, mem, virtual) ! Calculate flux with the right cross section according to virtual collision handling if (self % handleVirtual) then - flux = p % w / xsData % getTrackingXS(p, p % getMatIdx(), TRACKING_XS) + flux = p % w / xsData % getTrackingXS(p, p % matIdx(), TRACKING_XS) else - flux = p % w / xsData % getTotalMatXS(p, p % getMatIdx()) + flux = p % w / xsData % getTotalMatXS(p, p % matIdx()) end if ! Calculate bin address diff --git a/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 b/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 index 7f8378f50..b6182d5cb 100644 --- a/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 +++ b/Tallies/TallyClerks/collisionProbabilityClerk_class.f90 @@ -182,7 +182,7 @@ subroutine reportInColl(self, p, xsData, mem, virtual) if (virtual) return ! Get material or return if it is not a neutron - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) if (.not.associated(mat)) return diff --git a/Tallies/TallyClerks/dancoffBellClerk_class.f90 b/Tallies/TallyClerks/dancoffBellClerk_class.f90 index 90d56cdcc..3cf626505 100644 --- a/Tallies/TallyClerks/dancoffBellClerk_class.f90 +++ b/Tallies/TallyClerks/dancoffBellClerk_class.f90 @@ -199,7 +199,7 @@ subroutine reportTrans(self, p, xsData, mem) if(.not.self % filter % isPass(state)) return ! Find end material type; Exit if not fuel or moderator - T_end = self % materialSet % getOrDefault(p % getMatIdx(), OUTSIDE) + T_end = self % materialSet % getOrDefault(p % matIdx(), OUTSIDE) if(T_end == OUTSIDE) return ! Obtain starting and ending weights diff --git a/Tallies/TallyClerks/keffImplicitClerk_class.f90 b/Tallies/TallyClerks/keffImplicitClerk_class.f90 index c789a2fd4..008c50e02 100644 --- a/Tallies/TallyClerks/keffImplicitClerk_class.f90 +++ b/Tallies/TallyClerks/keffImplicitClerk_class.f90 @@ -172,17 +172,17 @@ subroutine reportInColl(self, p, xsData, mem, virtual) if ((.not. self % handleVirtual) .and. virtual) return ! Ensure we're not in void (could happen when scoring virtual collisions) - if (p % getMatIdx() == VOID_MAT) return + if (p % matIdx() == VOID_MAT) return ! Calculate flux with the right cross section according to virtual collision handling if (self % handleVirtual) then - flux = p % w / xsData % getTrackingXS(p, p % getMatIdx(), TRACKING_XS) + flux = p % w / xsData % getTrackingXS(p, p % matIdx(), TRACKING_XS) else - flux = p % w / xsData % getTotalMatXS(p, p % getMatIdx()) + flux = p % w / xsData % getTotalMatXS(p, p % matIdx()) end if ! Get material pointer - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) if (.not.associated(mat)) then call fatalError(Here,'Unrecognised type of material was retrived from nuclearDatabase') end if diff --git a/Tallies/TallyClerks/mgXsClerk_class.f90 b/Tallies/TallyClerks/mgXsClerk_class.f90 index e563c9c2d..80ea66204 100644 --- a/Tallies/TallyClerks/mgXsClerk_class.f90 +++ b/Tallies/TallyClerks/mgXsClerk_class.f90 @@ -259,18 +259,18 @@ subroutine reportInColl(self, p, xsData, mem, virtual) ! Calculate flux with the right cross section according to virtual collision handling if (self % handleVirtual) then - flux = p % w / xsData % getTrackingXS(p, p % getMatIdx(), TRACKING_XS) + flux = p % w / xsData % getTrackingXS(p, p % matIdx(), TRACKING_XS) else - flux = p % w / xsData % getTotalMatXS(p, p % getMatIdx()) + flux = p % w / xsData % getTotalMatXS(p, p % matIdx()) end if ! Check if the particle is in void. This call might happen when handling virtual collisions. ! This is relevant in the case of homogenising materials that include void: the flux ! in void will be different than zero, and the zero reaction rates have to be averaged - if (p % getMatIdx() /= VOID_MAT) then + if (p % matIdx() /= VOID_MAT) then ! Get material pointer - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) if (.not.associated(mat)) then call fatalError(Here,'Unrecognised type of material was retrived from nuclearDatabase') end if diff --git a/Tallies/TallyClerks/simpleFMClerk_class.f90 b/Tallies/TallyClerks/simpleFMClerk_class.f90 index 1114f3b51..a4e026aee 100644 --- a/Tallies/TallyClerks/simpleFMClerk_class.f90 +++ b/Tallies/TallyClerks/simpleFMClerk_class.f90 @@ -208,10 +208,10 @@ subroutine reportInColl(self, p, xsData, mem, virtual) if ((.not. self % handleVirtual) .and. virtual) return ! Ensure we're not in void (could happen when scoring virtual collisions) - if (p % getMatIdx() == VOID_MAT) return + if (p % matIdx() == VOID_MAT) return ! Get material pointer - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) if (.not.associated(mat)) then call fatalError(Here,'Unrecognised type of material was retrived from nuclearDatabase') end if @@ -221,9 +221,9 @@ subroutine reportInColl(self, p, xsData, mem, virtual) ! Calculate flux with the right cross section according to virtual collision handling if (self % handleVirtual) then - flux = p % w / xsData % getTrackingXS(p, p % getMatIdx(), TRACKING_XS) + flux = p % w / xsData % getTrackingXS(p, p % matIdx(), TRACKING_XS) else - flux = p % w / xsData % getTotalMatXS(p, p % getMatIdx()) + flux = p % w / xsData % getTotalMatXS(p, p % matIdx()) end if ! Find starting index in the map diff --git a/Tallies/TallyResponses/macroResponse_class.f90 b/Tallies/TallyResponses/macroResponse_class.f90 index 77c84bdf1..59012772f 100644 --- a/Tallies/TallyResponses/macroResponse_class.f90 +++ b/Tallies/TallyResponses/macroResponse_class.f90 @@ -124,10 +124,10 @@ function get(self, p, xsData) result(val) ! Return zero if particle is not neutron or if the particle is in void if (p % type /= P_NEUTRON) return - if (p % getMatIdx() == VOID_MAT) return + if (p % matIdx() == VOID_MAT) return ! Get pointer to active material data - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) + mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) ! Return if material is not a neutronMaterial if (.not.associated(mat)) return diff --git a/Tallies/TallyResponses/microResponse_class.f90 b/Tallies/TallyResponses/microResponse_class.f90 index 764690f99..225c20fce 100644 --- a/Tallies/TallyResponses/microResponse_class.f90 +++ b/Tallies/TallyResponses/microResponse_class.f90 @@ -156,7 +156,7 @@ function get(self, p, xsData) result(val) ! Return zero if particle is not neutron or if the particle is in void if (p % type /= P_NEUTRON) return - if (p % getMatIdx() == VOID_MAT) return + if (p % matIdx() == VOID_MAT) return ! Get pointer to active material data mat => neutronMaterial_CptrCast(xsData % getMaterial(self % matIdx)) diff --git a/Tallies/TallyResponses/weightResponse_class.f90 b/Tallies/TallyResponses/weightResponse_class.f90 index ecfff0058..ac637bf80 100644 --- a/Tallies/TallyResponses/weightResponse_class.f90 +++ b/Tallies/TallyResponses/weightResponse_class.f90 @@ -78,15 +78,15 @@ function get(self, p, xsData) result(val) if(p % type /= P_NEUTRON) return ! Get pointer to active material data - mat => neutronMaterial_CptrCast(xsData % getMaterial(p % getMatIdx())) + 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 % getMatIdx()) / (p % w) + val = xsData % getTotalMatXS(p, p % matIdx()) / (p % w) else - val = xsData % getTotalMatXS(p, p % getMatIdx()) * ((p % w) ** (self % moment - 1)) + val = xsData % getTotalMatXS(p, p % matIdx()) * ((p % w) ** (self % moment - 1)) end if end function get diff --git a/TransportOperator/transportOperatorDT_class.f90 b/TransportOperator/transportOperatorDT_class.f90 index 89e39e0b5..568e161ec 100644 --- a/TransportOperator/transportOperatorDT_class.f90 +++ b/TransportOperator/transportOperatorDT_class.f90 @@ -54,7 +54,7 @@ subroutine deltaTracking(self, p, tally, thisCycle, nextCycle) character(100), parameter :: Here = 'deltaTracking (transportOperatorDT_class.f90)' ! Get majorant XS inverse: 1/Sigma_majorant - majorant_inv = ONE / self % xsData % getTrackingXS(p, p % getMatIdx(), MAJORANT_XS) + majorant_inv = ONE / self % xsData % getTrackingXS(p, p % matIdx(), MAJORANT_XS) ! Should never happen! Prevents Inf distances if (abs(majorant_inv) > huge(majorant_inv)) call fatalError(Here, "Majorant is 0") @@ -66,26 +66,26 @@ subroutine deltaTracking(self, p, tally, thisCycle, nextCycle) call self % geom % teleport(p % coords, distance) ! If particle has leaked, exit - if (p % getMatIdx() == OUTSIDE_FILL) then + if (p % matIdx() == OUTSIDE_FILL) then p % fate = LEAK_FATE p % isDead = .true. return end if ! Check for void - if (p % getMatIdx() == VOID_MAT) then + if (p % matIdx() == VOID_MAT) then call tally % reportInColl(p, .true.) cycle DTLoop end if ! Give error if the particle somehow ended in an undefined material - if (p % getMatIdx() == UNDEF_MAT) then + 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 % getTrackMatXS(p, p % getMatIdx()) + sigmaT = self % xsData % getTrackMatXS(p, p % matIdx()) ! Roll RNG to determine if the collision is real or virtual ! Exit the loop if the collision is real, report collision if virtual diff --git a/TransportOperator/transportOperatorHT_class.f90 b/TransportOperator/transportOperatorHT_class.f90 index 9be6ae2ae..e7ea82435 100644 --- a/TransportOperator/transportOperatorHT_class.f90 +++ b/TransportOperator/transportOperatorHT_class.f90 @@ -55,10 +55,10 @@ subroutine tracking_selection(self, p, tally, thisCycle, nextCycle) character(100), parameter :: Here = 'hybridTracking (transportOIperatorHT_class.f90)' ! Get majornat XS inverse: 1/Sigma_majorant - majorant_inv = ONE / self % xsData % getTrackingXS(p, p % getMatIdx(), MAJORANT_XS) + majorant_inv = ONE / self % xsData % getTrackingXS(p, p % matIdx(), MAJORANT_XS) ! Obtain the local cross-section - sigmaT = self % xsData % getTrackMatXS(p, p % getMatIdx()) + sigmaT = self % xsData % getTrackMatXS(p, p % matIdx()) ! Calculate ratio between local cross-section and majorant ratio = sigmaT*majorant_inv @@ -85,7 +85,7 @@ subroutine deltaTracking(self, p, tally, thisCycle, nextCycle) character(100), parameter :: Here = 'deltaTracking (transportOperatorHT_class.f90)' ! Get majorant XS inverse: 1/Sigma_majorant - majorant_inv = ONE / self % xsData % getTrackingXS(p, p % getMatIdx(), MAJORANT_XS) + majorant_inv = ONE / self % xsData % getTrackingXS(p, p % matIdx(), MAJORANT_XS) ! Should never happen! Prevents Inf distances if (abs(majorant_inv) > huge(majorant_inv)) call fatalError(Here, "Majorant is 0") @@ -97,26 +97,26 @@ subroutine deltaTracking(self, p, tally, thisCycle, nextCycle) call self % geom % teleport(p % coords, distance) ! If particle has leaked exit - if (p % getMatIdx() == OUTSIDE_FILL) then + if (p % matIdx() == OUTSIDE_FILL) then p % fate = LEAK_FATE p % isDead = .true. return end if ! Check for void - if(p % getMatIdx() == VOID_MAT) then + if(p % matIdx() == VOID_MAT) then call tally % reportInColl(p, .true.) cycle DTLoop end if ! Give error if the particle somehow ended in an undefined material - if (p % getMatIdx() == UNDEF_MAT) then + 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 % getTrackMatXS(p, p % getMatIdx()) + sigmaT = self % xsData % getTrackMatXS(p, p % matIdx()) ! Roll RNG to determine if the collision is real or virtual ! Exit the loop if the collision is real, report collision if virtual @@ -148,11 +148,11 @@ subroutine surfaceTracking(self, p, tally, thisCycle, nextCycle) STLoop: do ! Obtain the local cross-section - if (p % getMatIdx() == VOID_MAT) then + if (p % matIdx() == VOID_MAT) then dist = INFINITY else - sigmaT = self % xsData % getTrackingXS(p, p % getMatIdx(), MATERIAL_XS) + sigmaT = self % xsData % getTrackingXS(p, p % matIdx(), MATERIAL_XS) dist = -log( p % pRNG % get()) / sigmaT ! Should never happen! Catches NaN distances @@ -170,13 +170,13 @@ subroutine surfaceTracking(self, p, tally, thisCycle, nextCycle) call tally % reportPath(p, dist) ! Kill particle if it has leaked - if (p % getMatIdx() == OUTSIDE_FILL) then + 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 % getMatIdx() == UNDEF_MAT) then + if (p % matIdx() == UNDEF_MAT) then print *, p % rGlobal() call fatalError(Here, "Particle is in undefined material") end if diff --git a/TransportOperator/transportOperatorST_class.f90 b/TransportOperator/transportOperatorST_class.f90 index 358e417d4..1ef7a138b 100644 --- a/TransportOperator/transportOperatorST_class.f90 +++ b/TransportOperator/transportOperatorST_class.f90 @@ -59,11 +59,11 @@ subroutine surfaceTracking(self, p, tally, thisCycle, nextCycle) STLoop: do ! Obtain the local cross-section - if (p % getMatIdx() == VOID_MAT) then + if (p % matIdx() == VOID_MAT) then dist = INFINITY else - sigmaT = self % xsData % getTrackingXS(p, p % getMatIdx(), MATERIAL_XS) + sigmaT = self % xsData % getTrackingXS(p, p % matIdx(), MATERIAL_XS) dist = -log( p % pRNG % get()) / sigmaT ! Should never happen! Catches NaN distances @@ -87,13 +87,13 @@ subroutine surfaceTracking(self, p, tally, thisCycle, nextCycle) call tally % reportPath(p, dist) ! Kill particle if it has leaked - if (p % getMatIdx() == OUTSIDE_FILL) then + 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 % getMatIdx() == UNDEF_MAT) then + if (p % matIdx() == UNDEF_MAT) then print *, p % rGlobal() call fatalError(Here, "Particle is in undefined material") end if From ea8003c31fc7b18ef8d64fabaa2bd79ae2698003 Mon Sep 17 00:00:00 2001 From: Nathan Ravoisin Date: Sun, 27 Oct 2024 19:42:59 +0000 Subject: [PATCH 04/10] Update SharedModules/genericProcedures.f90 Co-authored-by: Paul Cosgrove --- SharedModules/genericProcedures.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/SharedModules/genericProcedures.f90 b/SharedModules/genericProcedures.f90 index a5b7623e7..35aa910dd 100644 --- a/SharedModules/genericProcedures.f90 +++ b/SharedModules/genericProcedures.f90 @@ -638,7 +638,7 @@ end function areEqual_defReal !! !! Returns .true. if all elements of an array are equal to target. !! - !! Due to floating point artihmetic and rounding-off errors being slightly different + !! Due to floating point arithmetic and rounding-off errors being slightly different !! across different architectures (eg, Intel vs ARM), it is necessary to use some small !! tolerances to assert equality between two floating point numbers. These tolerances !! are specified in numPrecision.f90. From 9d59c70c1e2c79ebe867b4692df881b749efb93a Mon Sep 17 00:00:00 2001 From: Nathan Ravoisin Date: Sun, 27 Oct 2024 19:43:06 +0000 Subject: [PATCH 05/10] Update SharedModules/genericProcedures.f90 Co-authored-by: Paul Cosgrove --- SharedModules/genericProcedures.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/SharedModules/genericProcedures.f90 b/SharedModules/genericProcedures.f90 index 35aa910dd..8590cb27a 100644 --- a/SharedModules/genericProcedures.f90 +++ b/SharedModules/genericProcedures.f90 @@ -601,7 +601,7 @@ end function concatenateArrays_Real !! !! Returns .true. if value and target are equal. !! - !! Due to floating point artihmetic and rounding-off errors being slightly different + !! Due to floating point arithmetic and rounding-off errors being slightly different !! across different architectures (eg, Intel vs ARM), it is necessary to use some small !! tolerances to assert equality between two floating point numbers. These tolerances !! are specified in numPrecision.f90. From 61343a22bd525288e76fbb98079d53480893faeb Mon Sep 17 00:00:00 2001 From: Nathan Date: Mon, 28 Oct 2024 00:43:34 +0000 Subject: [PATCH 06/10] Installation doc update --- docs/Installation.rst | 371 +++++++++++++++++++++++++++++------------- 1 file changed, 261 insertions(+), 110 deletions(-) diff --git a/docs/Installation.rst b/docs/Installation.rst index 5eed6dbd8..4b103b0e2 100644 --- a/docs/Installation.rst +++ b/docs/Installation.rst @@ -6,106 +6,103 @@ Installation Requirements '''''''''''' -.. admonition:: Required +.. admonition:: **Required** Fortran Compiler Currently SCONE requires gfortran (>=8.3). Support for other compilers is pending. CMake - CMake cross-platform build system is used to run all configuration scripts. Version (>=3.10) + CMake is a cross-platform build system used to run all configuration scripts. Version (>=3.10) is required. - LAPACK and BLAS Libraries - For the moment, SCONE requires LAPACK and BLAS linear algebra libraries. However, they are - not used extensively in the code and this dependency will become optional or will be removed. - - GNU/Linux operating system - In principle any UNIX-like operating system should support SCONE. However people have - experienced some significant run-time bugs when running on MacOS. Since we do not have - an access to a Mackintosh we were not able to identify the problem yet. + For the moment, SCONE requires the linear algebra libraries LAPACK and BLAS. However, they are + not extensively used in the code and this dependency will become optional or be removed. -.. admonition:: Optional +.. admonition:: **Optional** pFUnit 4 test framework and Python interpreter - Both the unit and the integration tests in SCONE use pFUnit framework. To run it requires a - python interpreter. NOTE that version 4 (contrarily to the older 3.0) requires the use of - gfortran version 8.3 or newer. + Both the unit and the integration tests in SCONE use the pFUnit framework, which requires a + python interpreter to be run. NOTE: version 4 (contrarily to the older 3.0) requires the use of + gfortran version 8.3 or newer. -Getting gfortran -'''''''''''''''' -To verify that you have gfortran available by typing:: +Windows & Linux operating systems +================================= + +Installing gfortran +''''''''''''''''''' +Check that gfortran is available by typing:: gfortran --version -If you do not or its version is too old you will need to get it. If you have root -access to your machine you can your package manager to install gfortran. On -Debian/Ubuntu Linux a command like that will suffice:: +If you do not have gfortran, or if its version is too old you will need to get / update it. If you +have root access to your machine you may use your package manager to install / update gfortran. +On Debian / Ubuntu Linux distributions a command like the one below will suffice:: sudo apt-get install gfortran -On other operating systems it might different. You will need to -find information on how to use package manager in your Linux distribution. -Pre-compiled gfortran packages can be found +Other operating systems may require different commands, and you may need to find information on how +to use the package manager in your specific Linux distribution. Pre-compiled gfortran packages can be +found `here `_ -Without administrator privileges you may want to compile GCC from source. -Of course that requires having a C compiler. +Without administrator privileges you may need to compile GCC from source, which requires the use of a +C compiler. -#. Download the source code of GCC from one of the +#. Download the GCC source code from one of the `mirrors `_ -#. Extract the archive and use a provided script to download all prerequisites:: +#. Extract the archive and use the provided script to download all prerequisites:: tar -xf gcc-9.1.0.tar.gz cd gcc-9.1.0 ./contrib/download_prerequisites -#. Now configure the compilation. The command below is crude. We only set a `prefix` where +#. Now configure the compilation. The below command is crude. We only set a `prefix` where gcc will be installed after successful compilation and select languages (frontends) we want to - include. Documentation of the configure script is - `available `_ :: + include. Documentation of the `configure`` script is available + `here `_ :: ./configure --prefix=/path/to/install --enable-languages=c,c++,fortran -#. Providing that the configuration was successful, you can now start compiling - GCC. It is a large code base and the process can take as much as few hours. - To speed it up you can use parallel compilation with ``make -j 8`` assuming - that you have 8 processors available. You can use ``nproc`` in console to - check how many are available. When ready type:: +#. Providing that the configuration was successful, you can now compile GCC. + Note that it is a large code base and the process can take up to a few hours; + to speed it up you can use parallel compilation with ``make -j 8``, assuming + that you have 8 processor cores available. You can use ``nproc`` in the console + to check how many cores are available. When ready, type:: make -j8 make install -#. Once your finished now you need to modify some of your environmental - variables to allow OS to find the executables and relevant libraries. In your - `.bashrc`` add the following lines (depending on your install directory):: +#. Once compilation is complete, you will need to modify some of your environmental + variables to allow the operating system to find the executables and relevant + libraries. In your `.bashrc` file, add the following lines + (depending on your install directory):: export export PATH=/path/to/install/bin:$PATH export LD_LIBRARY_PATH=/path/to/install/lib64:$LD_LIBRARY_PATH -Getting CMake -''''''''''''' -If you have root access to your machine use package manager to obtain the latest -version of CMake. If you don't you can follow the instructions. +Installing CMake +'''''''''''''''' +If you have root access to your machine use your package manager to obtain the latest +version of CMake. Else, you can follow the instructions below. -#. Download the installation shell script for Linux from the - `website `_ e.g. `cmake-3.17.0-rc1-Linux-x86_64.sh`. +#. Download the installation shell script from the + `website `_ e.g. `cmake-3.17.0-rc1-Linux-x86_64.sh` for Linux. -#. Then you can install CMake by typing and following the instructions:: +#. Install CMake by typing and following the instructions:: bash ./cmake-3.17.0-rc1-Linux-x86_64.sh -#. Add the CMake to you ``PATH`` in ``.bashrc``:: +#. Add CMake to your ``PATH`` environmental variable in ``.bashrc``:: export PATH=/cmake/install/folder/bin:$PATH - Installing pFUnit ''''''''''''''''' -This is only required if the unit tests are to be build. +This is only required if unit tests are to be built. -#. Make sure python can be invoked by a command ``python`` by typing:: +#. Check that python can be invoked by typing:: python --version @@ -114,7 +111,7 @@ This is only required if the unit tests are to be build. git clone https://github.com/Goddard-Fortran-Ecosystem/pFUnit.git cd pFUnit -#. Create a build folder and compile the code:: +#. Create a build folder (e.g. build) and compile the source code using CMake:: mkdir build cd build @@ -122,30 +119,29 @@ This is only required if the unit tests are to be build. make tests make install -#. Export environmental variables required by pFUnit:: +#. Export environmental variables required by pFUnit in your ``.bashrc`` file:: export F90=gfortran export F90_VENDOR=GNU - LAPACK and BLAS ''''''''''''''' -If you have root access it is best to install these with your package manager. -Follow the instructions only if you want to compile LAPACK and BLAS from source +If you have root access it is recommended to install these with your package manager. +Follow the instructions below only if you want to compile LAPACK and BLAS from source. #. Download a version of LAPACK from `official website - `_. - -#. In some directory on your filesystem extract the archive. + `_ and extract the archive in some directory of your + filesystem. -#. Configure compilation with cmake by typing:: +#. Create a build directory (e.g. Build) and configure the compilation with CMake by + typing:: mkdir Build cd Build cmake ./.. -#. If you don't have a root access on your machine or you want to install LAPACK - to a custom directory, use ccmake to change CMAKE_INSTALL_PREFIX. In Build +#. If you don't have root access on your machine or want to install LAPACK + to a custom directory, use ccmake to change CMAKE_INSTALL_PREFIX. In the Build directory type:: ccmake ./.. @@ -153,108 +149,232 @@ Follow the instructions only if you want to compile LAPACK and BLAS from source Press [c] to configure Press [g] to generate and exit -#. Now compile LAPACK and install by typing:: +#. Now compile LAPACK and install it by typing:: make make install +macOS +===== + +Note: the installation tutorial for macOS assumes that you have root access to your +machine and makes use of the `Homebrew` package manager; however, you may use a +different package manager (e.g. `Anaconda`) if you are more familiar with it. + +#. Check that your Mac is running on macOS >= 15.0. You may check the version of your + operating system and update it if necessary by going into *System Settings* > *General* + > *Software Update*. + +#. Install `Xcode` from the App Store. `Xcode` contains crucial headers which are read + and interpreted when compiling software containing C / C++ languages. Once installed, + launch `Xcode` so that it can complete its initialisation. A dialog will be presented + indicating which Simulator runtimes are built-in, and which Simulator runtimes you may + download. Choose `Continue` to finish setting up `Xcode`. + +#. Open a new `Terminal` window. If `Terminal` is not docked, you may find it by opening + a new `Finder` window, then going to *Applications* > *Utilities*. + +#. Install `Homebrew` by typing the following command in your `Terminal` window:: + + /bin/bash -c "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/HEAD/install.sh)" + +#. Once `Homebrew` is installed, type the following command in your `Terminal` window. + This will install the latest versions of all the packages required to correctly set + up and run SCONE:: + + brew install gcc cmake python git openblas lapack libomp + +#. Close your `Terminal` window. Open a new `Finder` window and navigate to your `Home` directory + (⌘ + ⇧ + h). Display hidden files (⌘ + ⇧ + .) and find the ``.zprofile`` file (this is the macOS + equivalent of the ``.bashrc`` file on Linux distributions). Open it and insert **any of the + following lines which are not already present** (note: this depends on whether you have a Mac + running on an Intel CPU or an ARM -- Apple Silicon -- chip): + + * Intel:: + + # Setting PATH for Python 3.13. The original version is saved in .zprofile.pysave. + PATH="/Library/Frameworks/Python.framework/Versions/3.13/bin:${PATH}" + export PATH + + # Set shell environment for Homebrew. + eval "$(/usr/local/bin/brew shellenv)" + + # Export pFUnit installation folder. + export PFUNIT_DIR=~/pFUnit/build/ + + # Export environmental variables required by pFUnit. + export F90=gfortran + export F90_VENDOR=GNU + + # Export OpenMP root path and flags. + export OpenMP_ROOT=$(brew --prefix)/opt/libomp + export LDFLAGS="-L/usr/local/opt/libomp/lib" + export CPPFLAGS="-I/usr/local/opt/libomp/include" + + * ARM:: + + # Setting PATH for Python 3.13. The original version is saved in .zprofile.pysave. + PATH="/Library/Frameworks/Python.framework/Versions/3.13/bin:${PATH}" + export PATH + + # Set shell environment for Homebrew. + eval "$(/opt/homebrew/bin/brew shellenv)" + + # Export pFUnit installation folder. + export PFUNIT_DIR=~/pFUnit/build/ + + # Export environmental variables required by pFUnit. + export F90=gfortran + export F90_VENDOR=GNU + + # Export OpenMP root path and flags. + export OpenMP_ROOT=$(brew --prefix)/opt/libomp + export LDFLAGS="-L/opt/homebrew/opt/libomp/lib" + export CPPFLAGS="-I/opt/homebrew/opt/libomp/include" + +#. Save the changes you made in your ``.zprofile`` file and close it. + You may now hide hidden files (⌘ + ⇧ + .). + +#. Open a new `Terminal` window. By default, it should open in your `Home` directory, + but if not navigate to it by entering:: + + cd + +#. Download the pFUnit repository from Git, enter the source code repository and + create a build directory (e.g. build) by typing the following commands:: + + git clone https://github.com/Goddard-Fortran-Ecosystem/pFUnit.git + cd pFUnit + mkdir build + cd build + +#. Before proceeding, **make sure that the default C compiler is Apple Clang by entering + the following command**:: + + gcc --version + + If it is not, then you have an alias (symlink) pointing to another C compiler. In this + case, you have two options: + + * Remove the alias, which will default the C compiler back to Apple Clang for all future + compilations. To do so, open a new `Finder` window then open the ‘Go to Folder’ prompt + by pressing (⇧ + ⌘ + g) and entering /usr. Navigate to /local/bin, locate the `gcc` + alias and delete it. Once this is done, you may revert to your `Terminal` window and type:: + + gcc --version + + to ensure that the default C compiler is Apple Clang. Now initialise CMake (you should + still be in the build folder on your `Terminal`) by typing:: + + cmake ./.. + + * Initialise CMake by specifying which C compiler to use. In your `Terminal` window enter + the following:: + + cmake -D CMAKE_C_COMPILER=CLANG ./.. + +#. Compile tests and install by typing:: + + make tests + make install Compiling SCONE ''''''''''''''' -#. If you want to install with tests set PFUNIT_INSTALL environmental variable - to directory in which pFUnit was installed. It may be worth adding the line - to your ``.bashrc`` :: +#. If you want to install SCONE with unit tests, set the PFUNIT_INSTALL environmental + variable to the directory in which pFUnit was installed. It may be worth adding the + following line to your ``.bashrc`` file:: export PFUNIT_DIR=~/pFUnit/build/ #. If your LAPACK installation is not in default system directories use - LAPACK_INSTALL enviromental variable to help CMAKE find the library. e.g. :: + LAPACK_INSTALL enviromental variable to help CMake find the library, e.g. :: export LAPACK_INSTALL=~/LAPACK -#. Download the repository. Run the following commands:: +#. Download the SCONE repository using Git by typing:: git clone https://github.com/CambridgeNuclear/SCONE -#. Create build folder in the project directory (e.g. Build):: +#. Create a build folder (e.g. Build) in the project directory:: cd ./scone mkdir Build -#. Generate makefile with CMake and compile:: +#. Generate a make file with CMake and compile the source code:: cmake -E chdir ./Build cmake ./.. make -C Build -#. To switch off compilation of tests use the following commands:: +#. To switch off tests compilation use the following commands:: cmake -E chdir ./Build cmake ./.. -DBUILD_TESTS=OFF make -C Build -#. Note that you can use ccmake utility to modify avalible options and - regenerate your make file just type the following into your terminal and - follow the instructions:: +#. Note that you can use the ccmake utility to modify available options and + regenerate your make file by typing the following into your terminal and + following the instructions:: ccmake ./Build .. admonition:: CMake options - LTO - Enable link-time optimisation. It allows the compiler to perform extra optimisations between - different compilation units (modules in Fortran). It is crucial for performance in SCONE, since - it enables inlining of small type-bound procedures. Set to `ON` by default. To disable:: + LTO (Link-time optimisation) + Allows the compiler to perform extra optimisations between different compilation units + (modules in Fortran). It is crucial for performance in SCONE, since it allows inlining + of small type-bound procedures. `ON` by default. To disable it, compile with:: cmake .. -DLTO=OFF COVERAGE - Collect code coverage information. If `ON` it allows to use `lcov` and `genhtml` to create - an HTML coverage report. It is `OFF` by default. Enable with:: + Collects code coverage information. Allows the use of `lcov` and `genhtml` to create an + HTML coverage report if `ON`. `OFF` by default. To enable it, compile with:: cmake -DCOVERAGE=ON BUILD_TESTS - Build unit and integration tests. It is `ON` by default. If enabled, the pFUnit must be - installed and PFUNIT_INSTALL set. To disable tests:: + Builds unit and integration tests. Requires pFUnit to be installed and the PFUNIT_INSTALL + environmental variable to be set. `ON` by default. To disable it, compile with:: cmake -DBUILD_TESTS=OFF DEBUG - Enable extra run-time checks available in the compiler. It is `OFF` by default. To enable:: + Enables extra run-time checks available in the compiler. `OFF` by default. To enable it, + compile with:: cmake -DDEBUG=ON +Running automated tests +''''''''''''''''''''''' -Run Tests to Verify -''''''''''''''''''' - -If you compiled SCONE with tests enabled (you should by the way) you can now -verify that it works correctly by running the automated test suites. You -**must** execute the following commands from ``scone`` directory. Some -integration tests use files in ``IntegrationTestFiles`` and have hard-coded -relative paths. **Integration tests may fail if they are run from other -directory**. Run:: +If tests were enabled during the compilation of SCONE (recommended), you may now +verify that it correctly works by running the automated test suites. Note that some +integration tests use files in the ``IntegrationTestFiles`` directory and have +hard-coded relative paths. **As such, you must execute the following commands +from the** ``scone`` **directory. Integration tests may fail if they are run from +other directories**.:: ./Build/unitTests ./Build/integrationTests -This assume that ``Build`` is the build directory. If the tests were successful -that is great. If some of them failed it is troubling. Please open an Issue in -the online repository so we can try to resolve what is the problem. Provide at -least the following information: +This assumes that ``Build`` is the build directory. If any of the tests fail, +please open an issue `here `_ +so we can investigate the problem. Provide at least the following information: -#. Compiler Used (with version) -#. Operating System +#. Compiler used and version +#. Operating system -Unfortunately we do not have access to Intel Fortran compiler so we cannot test -SCONE with it. We are planning to add support for Flang soon. +Unfortunately, we do not have access to Intel Fortran compilers so we cannot test +SCONE on them. We are planning to add support for Flang soon. -Obtaining Nuclear Data +Obtaining nuclear data '''''''''''''''''''''' -SCONE requires ACE-formatted nuclear data. The JEFF-3.3 evaluation can be download from the -OACD NEA `website `__. In addition SCONE requires -its own library file. An example of it is given in *IntegrationTestFiles/testLib*. Its format is:: +SCONE requires ACE-formatted nuclear data to run actual simulations. The necessary data can be +downloaded from the OACD NEA `website `__. Please +make sure to download both the `Neutron` (293K) and `Neutron TSL` files in `ACE` format, and +extract the archives in some directory of your choice. In addition, SCONE requires its own library +file, whose format is given below:: ! This is a comment line ! Each line needs to contain three entries @@ -263,23 +383,54 @@ its own library file. An example of it is given in *IntegrationTestFiles/testLib 1001.03c; 4069; /1001JEF33.ace; ... -`Line Number` is the line in the file at which a particular data card begins. Each line cannot -contain more then a single entry. Each component must be delimited by a semi-colon. +Here, ``Line Number`` is the line in the file at which a particular data card begins. Each line cannot +contain more than one entry, and each component must be delimited by a ';'. An example of such a file +is given in *IntegrationTestFiles/testLib*. -To generate the library file from the collection of raw ACE files one can use the -``scripts/make_ace_lib.sh`` bash script. It can be run with the following command: +To generate the library file from the collection of downloaded raw ACE files, one can use the +``scripts/make_ace_lib.sh`` bash script, which can be run using the following command (To get extra +help, run the script without any arguments): .. code-block:: bash ./scripts/make_ace_lib.sh /path/lib.xsfile CE ./path_to_ace_files/*.ace -To get extra help run the script without any arguments. The ``CE`` letters allow to select between -searching for continuous energy neutron data cards and thermal scattering S(α,β) cards (SAB mode). -Sadly the script can search only for a single type of card in one pass. Thus to create a full -library with thermal data we need to do the following: +The ``CE`` letters allow to switch between searching for continuous energy (CE) and thermal scattering S(α,β) +(SAB) neutron data cards. Sadly, the script can search only for a single card type in one pass; thus, to create +a full library with thermal scattering data included one needs to run the following: .. code-block:: bash ./scripts/make_ace_lib.sh ./tempCE CE ./path_to_CE_ace_files/*.ace ./scripts/make_ace_lib.sh ./tempSAB SAB ./path_to_SAB_ace_files/*.ace cat tempCE tempSAB > fullLib.xsfile + +Running your first simulation with SCONE +'''''''''''''''''''''''''''''''''''''''' + +Once the ``fullLib.xsfile`` has been generated, we can run our first actual simulation. SCONE uses text files as +simulation inputs. Instances of such files are included in the ``InputFiles`` directory. For this example, we will +use the `JEZ` input file. Navigate to the ``InputFiles`` directory, open the `JEZ` file and locate the following +lines:: + + nuclearData { + + handles { + ceData { type aceNeutronDatabase; aceLibrary $SCONE_ACE;} + } + + ... + +You may replace the ``$SCONE_ACE`` environmental variable in the `JEZ` file with the absolute path to the ``fullLib.xsfile`` +file or, better yet, export this variable in your ``.bashrc`` / ``.zprofile`` file (depending on your OS) by adding the +following line:: + + export SCONE_ACE=path_to_fullLib.xsfile + +and saving the changes in either case. Note that if you export this variable in your ``.bashrc`` / ``.zprofile`` file, you +will need to close and re-open your `Terminal` window to apply the changes. Once this is done, from your `Terminal` window +navigate to the ``SCONE/Build`` directory and run the following command:: + + ./scone.out ../InputFiles/JEZ + +which will run SCONE using the `JEZ` input file. Congratulations on running your first SCONE simulation! \ No newline at end of file From 1ab379fa2750e72e146dc8cb9be1a4712b8830ee Mon Sep 17 00:00:00 2001 From: Nathan Date: Mon, 28 Oct 2024 00:53:12 +0000 Subject: [PATCH 07/10] Small changes --- docs/Installation.rst | 77 ++++++++++++++++++++++--------------------- 1 file changed, 40 insertions(+), 37 deletions(-) diff --git a/docs/Installation.rst b/docs/Installation.rst index 4b103b0e2..0826ae4f7 100644 --- a/docs/Installation.rst +++ b/docs/Installation.rst @@ -6,7 +6,7 @@ Installation Requirements '''''''''''' -.. admonition:: **Required** +.. admonition:: Required Fortran Compiler Currently SCONE requires gfortran (>=8.3). Support for other compilers is pending. @@ -19,7 +19,7 @@ Requirements For the moment, SCONE requires the linear algebra libraries LAPACK and BLAS. However, they are not extensively used in the code and this dependency will become optional or be removed. -.. admonition:: **Optional** +.. admonition:: Optional pFUnit 4 test framework and Python interpreter Both the unit and the integration tests in SCONE use the pFUnit framework, which requires a @@ -31,12 +31,13 @@ Windows & Linux operating systems Installing gfortran ''''''''''''''''''' + Check that gfortran is available by typing:: gfortran --version -If you do not have gfortran, or if its version is too old you will need to get / update it. If you -have root access to your machine you may use your package manager to install / update gfortran. +If you do not have gfortran, or if its version is too old you will need to get/update it. If you +have root access to your machine you may use your package manager to install/update gfortran. On Debian / Ubuntu Linux distributions a command like the one below will suffice:: sudo apt-get install gfortran @@ -49,8 +50,7 @@ found Without administrator privileges you may need to compile GCC from source, which requires the use of a C compiler. -#. Download the GCC source code from one of the - `mirrors `_ +#. Download the GCC source code from one of the `mirrors `_ #. Extract the archive and use the provided script to download all prerequisites:: @@ -65,7 +65,7 @@ C compiler. ./configure --prefix=/path/to/install --enable-languages=c,c++,fortran -#. Providing that the configuration was successful, you can now compile GCC. +#. Provided that the configuration was successful, you can now compile GCC. Note that it is a large code base and the process can take up to a few hours; to speed it up you can use parallel compilation with ``make -j 8``, assuming that you have 8 processor cores available. You can use ``nproc`` in the console @@ -76,14 +76,15 @@ C compiler. #. Once compilation is complete, you will need to modify some of your environmental variables to allow the operating system to find the executables and relevant - libraries. In your `.bashrc` file, add the following lines - (depending on your install directory):: + libraries. In your ``.bashrc`` file, add the following lines (depending on your + install directory):: export export PATH=/path/to/install/bin:$PATH export LD_LIBRARY_PATH=/path/to/install/lib64:$LD_LIBRARY_PATH Installing CMake '''''''''''''''' + If you have root access to your machine use your package manager to obtain the latest version of CMake. Else, you can follow the instructions below. @@ -100,6 +101,7 @@ version of CMake. Else, you can follow the instructions below. Installing pFUnit ''''''''''''''''' + This is only required if unit tests are to be built. #. Check that python can be invoked by typing:: @@ -126,6 +128,7 @@ This is only required if unit tests are to be built. LAPACK and BLAS ''''''''''''''' + If you have root access it is recommended to install these with your package manager. Follow the instructions below only if you want to compile LAPACK and BLAS from source. @@ -192,45 +195,45 @@ different package manager (e.g. `Anaconda`) if you are more familiar with it. * Intel:: - # Setting PATH for Python 3.13. The original version is saved in .zprofile.pysave. - PATH="/Library/Frameworks/Python.framework/Versions/3.13/bin:${PATH}" - export PATH + # Setting PATH for Python 3.13. The original version is saved in .zprofile.pysave. + PATH="/Library/Frameworks/Python.framework/Versions/3.13/bin:${PATH}" + export PATH - # Set shell environment for Homebrew. - eval "$(/usr/local/bin/brew shellenv)" + # Set shell environment for Homebrew. + eval "$(/usr/local/bin/brew shellenv)" - # Export pFUnit installation folder. - export PFUNIT_DIR=~/pFUnit/build/ + # Export pFUnit installation folder. + export PFUNIT_DIR=~/pFUnit/build/ - # Export environmental variables required by pFUnit. - export F90=gfortran - export F90_VENDOR=GNU + # Export environmental variables required by pFUnit. + export F90=gfortran + export F90_VENDOR=GNU - # Export OpenMP root path and flags. - export OpenMP_ROOT=$(brew --prefix)/opt/libomp - export LDFLAGS="-L/usr/local/opt/libomp/lib" - export CPPFLAGS="-I/usr/local/opt/libomp/include" + # Export OpenMP root path and flags. + export OpenMP_ROOT=$(brew --prefix)/opt/libomp + export LDFLAGS="-L/usr/local/opt/libomp/lib" + export CPPFLAGS="-I/usr/local/opt/libomp/include" * ARM:: - # Setting PATH for Python 3.13. The original version is saved in .zprofile.pysave. - PATH="/Library/Frameworks/Python.framework/Versions/3.13/bin:${PATH}" - export PATH + # Setting PATH for Python 3.13. The original version is saved in .zprofile.pysave. + PATH="/Library/Frameworks/Python.framework/Versions/3.13/bin:${PATH}" + export PATH - # Set shell environment for Homebrew. - eval "$(/opt/homebrew/bin/brew shellenv)" + # Set shell environment for Homebrew. + eval "$(/opt/homebrew/bin/brew shellenv)" - # Export pFUnit installation folder. - export PFUNIT_DIR=~/pFUnit/build/ + # Export pFUnit installation folder. + export PFUNIT_DIR=~/pFUnit/build/ - # Export environmental variables required by pFUnit. - export F90=gfortran - export F90_VENDOR=GNU + # Export environmental variables required by pFUnit. + export F90=gfortran + export F90_VENDOR=GNU - # Export OpenMP root path and flags. - export OpenMP_ROOT=$(brew --prefix)/opt/libomp - export LDFLAGS="-L/opt/homebrew/opt/libomp/lib" - export CPPFLAGS="-I/opt/homebrew/opt/libomp/include" + # Export OpenMP root path and flags. + export OpenMP_ROOT=$(brew --prefix)/opt/libomp + export LDFLAGS="-L/opt/homebrew/opt/libomp/lib" + export CPPFLAGS="-I/opt/homebrew/opt/libomp/include" #. Save the changes you made in your ``.zprofile`` file and close it. You may now hide hidden files (⌘ + ⇧ + .). From 2a4a6116f0e080aecc0545542b2c540174e0a677 Mon Sep 17 00:00:00 2001 From: Nathan Date: Mon, 28 Oct 2024 01:08:09 +0000 Subject: [PATCH 08/10] Small changes --- docs/Installation.rst | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/docs/Installation.rst b/docs/Installation.rst index 0826ae4f7..e4870033d 100644 --- a/docs/Installation.rst +++ b/docs/Installation.rst @@ -26,8 +26,8 @@ Requirements python interpreter to be run. NOTE: version 4 (contrarily to the older 3.0) requires the use of gfortran version 8.3 or newer. -Windows & Linux operating systems -================================= +Linux distributions +------------------- Installing gfortran ''''''''''''''''''' @@ -38,14 +38,13 @@ Check that gfortran is available by typing:: If you do not have gfortran, or if its version is too old you will need to get/update it. If you have root access to your machine you may use your package manager to install/update gfortran. -On Debian / Ubuntu Linux distributions a command like the one below will suffice:: +On Debian/Ubuntu distributions a command like the one below will suffice:: sudo apt-get install gfortran Other operating systems may require different commands, and you may need to find information on how to use the package manager in your specific Linux distribution. Pre-compiled gfortran packages can be -found -`here `_ +found `here `_ Without administrator privileges you may need to compile GCC from source, which requires the use of a C compiler. @@ -158,7 +157,7 @@ Follow the instructions below only if you want to compile LAPACK and BLAS from s make install macOS -===== +----- Note: the installation tutorial for macOS assumes that you have root access to your machine and makes use of the `Homebrew` package manager; however, you may use a @@ -169,7 +168,7 @@ different package manager (e.g. `Anaconda`) if you are more familiar with it. > *Software Update*. #. Install `Xcode` from the App Store. `Xcode` contains crucial headers which are read - and interpreted when compiling software containing C / C++ languages. Once installed, + and interpreted when compiling software containing C/C++ languages. Once installed, launch `Xcode` so that it can complete its initialisation. A dialog will be presented indicating which Simulator runtimes are built-in, and which Simulator runtimes you may download. Choose `Continue` to finish setting up `Xcode`. @@ -282,7 +281,7 @@ different package manager (e.g. `Anaconda`) if you are more familiar with it. make install Compiling SCONE -''''''''''''''' +--------------- #. If you want to install SCONE with unit tests, set the PFUNIT_INSTALL environmental variable to the directory in which pFUnit was installed. It may be worth adding the @@ -348,14 +347,14 @@ Compiling SCONE cmake -DDEBUG=ON Running automated tests -''''''''''''''''''''''' +----------------------- If tests were enabled during the compilation of SCONE (recommended), you may now verify that it correctly works by running the automated test suites. Note that some integration tests use files in the ``IntegrationTestFiles`` directory and have hard-coded relative paths. **As such, you must execute the following commands from the** ``scone`` **directory. Integration tests may fail if they are run from -other directories**.:: +other directories**.: ./Build/unitTests ./Build/integrationTests @@ -371,7 +370,7 @@ Unfortunately, we do not have access to Intel Fortran compilers so we cannot tes SCONE on them. We are planning to add support for Flang soon. Obtaining nuclear data -'''''''''''''''''''''' +---------------------- SCONE requires ACE-formatted nuclear data to run actual simulations. The necessary data can be downloaded from the OACD NEA `website `__. Please @@ -391,7 +390,7 @@ contain more than one entry, and each component must be delimited by a ';'. An e is given in *IntegrationTestFiles/testLib*. To generate the library file from the collection of downloaded raw ACE files, one can use the -``scripts/make_ace_lib.sh`` bash script, which can be run using the following command (To get extra +``scripts/make_ace_lib.sh`` bash script, which can be run using the following command (to get extra help, run the script without any arguments): .. code-block:: bash @@ -409,7 +408,7 @@ a full library with thermal scattering data included one needs to run the follow cat tempCE tempSAB > fullLib.xsfile Running your first simulation with SCONE -'''''''''''''''''''''''''''''''''''''''' +---------------------------------------- Once the ``fullLib.xsfile`` has been generated, we can run our first actual simulation. SCONE uses text files as simulation inputs. Instances of such files are included in the ``InputFiles`` directory. For this example, we will @@ -425,12 +424,12 @@ lines:: ... You may replace the ``$SCONE_ACE`` environmental variable in the `JEZ` file with the absolute path to the ``fullLib.xsfile`` -file or, better yet, export this variable in your ``.bashrc`` / ``.zprofile`` file (depending on your OS) by adding the +file or, better yet, export this variable in your ``.bashrc``/``.zprofile`` file (depending on your OS) by adding the following line:: export SCONE_ACE=path_to_fullLib.xsfile -and saving the changes in either case. Note that if you export this variable in your ``.bashrc`` / ``.zprofile`` file, you +and saving the changes in either case. Note that if you export this variable in your ``.bashrc``/``.zprofile`` file, you will need to close and re-open your `Terminal` window to apply the changes. Once this is done, from your `Terminal` window navigate to the ``SCONE/Build`` directory and run the following command:: From 1be926b79e6980761b2aa184c91007001e2fb64e Mon Sep 17 00:00:00 2001 From: Nathan Date: Mon, 28 Oct 2024 09:49:12 +0000 Subject: [PATCH 09/10] Installation doc small changes --- docs/Installation.rst | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/docs/Installation.rst b/docs/Installation.rst index e4870033d..8d1aa81f8 100644 --- a/docs/Installation.rst +++ b/docs/Installation.rst @@ -19,6 +19,10 @@ Requirements For the moment, SCONE requires the linear algebra libraries LAPACK and BLAS. However, they are not extensively used in the code and this dependency will become optional or be removed. + UNIX operating system + In principles, SCONE is supported on any UNIX-like operating system. This includes Linux + distributions such as Ubuntu or Debian, and macOS. + .. admonition:: Optional pFUnit 4 test framework and Python interpreter @@ -30,7 +34,7 @@ Linux distributions ------------------- Installing gfortran -''''''''''''''''''' +################### Check that gfortran is available by typing:: @@ -82,7 +86,7 @@ C compiler. export LD_LIBRARY_PATH=/path/to/install/lib64:$LD_LIBRARY_PATH Installing CMake -'''''''''''''''' +################ If you have root access to your machine use your package manager to obtain the latest version of CMake. Else, you can follow the instructions below. @@ -99,9 +103,9 @@ version of CMake. Else, you can follow the instructions below. export PATH=/cmake/install/folder/bin:$PATH Installing pFUnit -''''''''''''''''' +################# -This is only required if unit tests are to be built. +Note: the following is only required if unit tests are to be built. #. Check that python can be invoked by typing:: @@ -126,7 +130,7 @@ This is only required if unit tests are to be built. export F90_VENDOR=GNU LAPACK and BLAS -''''''''''''''' +############### If you have root access it is recommended to install these with your package manager. Follow the instructions below only if you want to compile LAPACK and BLAS from source. @@ -354,7 +358,7 @@ verify that it correctly works by running the automated test suites. Note that s integration tests use files in the ``IntegrationTestFiles`` directory and have hard-coded relative paths. **As such, you must execute the following commands from the** ``scone`` **directory. Integration tests may fail if they are run from -other directories**.: +other directories**. ./Build/unitTests ./Build/integrationTests From 96566f6dc67b9049136cbb2f2b582971b0a11152 Mon Sep 17 00:00:00 2001 From: Nathan Date: Mon, 28 Oct 2024 09:56:22 +0000 Subject: [PATCH 10/10] Installation final corrections --- docs/Installation.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/Installation.rst b/docs/Installation.rst index 8d1aa81f8..2a18b82db 100644 --- a/docs/Installation.rst +++ b/docs/Installation.rst @@ -194,7 +194,7 @@ different package manager (e.g. `Anaconda`) if you are more familiar with it. (⌘ + ⇧ + h). Display hidden files (⌘ + ⇧ + .) and find the ``.zprofile`` file (this is the macOS equivalent of the ``.bashrc`` file on Linux distributions). Open it and insert **any of the following lines which are not already present** (note: this depends on whether you have a Mac - running on an Intel CPU or an ARM -- Apple Silicon -- chip): + running on an Intel CPU or an ARM - Apple Silicon - chip): * Intel:: @@ -358,7 +358,7 @@ verify that it correctly works by running the automated test suites. Note that s integration tests use files in the ``IntegrationTestFiles`` directory and have hard-coded relative paths. **As such, you must execute the following commands from the** ``scone`` **directory. Integration tests may fail if they are run from -other directories**. +other directories**:: ./Build/unitTests ./Build/integrationTests