diff --git a/perl/Galacticus/Build/SourceTree/Process/FunctionClass.pm b/perl/Galacticus/Build/SourceTree/Process/FunctionClass.pm index 08a747b1cb..b79b985196 100644 --- a/perl/Galacticus/Build/SourceTree/Process/FunctionClass.pm +++ b/perl/Galacticus/Build/SourceTree/Process/FunctionClass.pm @@ -999,7 +999,7 @@ CODE $rankMaximum = $rank if ( $rank > $rankMaximum ); } - foreach my $variableName ( @{$declaration->{'variables'}} ) { + foreach my $variableName ( @{$declaration->{'variableNames'}} ) { $assignments .= "if (allocated(self%".$variableName.")) then\n" if ( grep {$_ eq "allocatable"} @{$declaration->{'attributes'}} ); for(my $i=1;$i<=$rank;++$i) { @@ -1239,7 +1239,7 @@ CODE $rankMaximum = $rank if ( $rank > $rankMaximum ); } - foreach my $variableName ( @{$declaration->{'variables'}} ) { + foreach my $variableName ( @{$declaration->{'variableNames'}} ) { for(my $i=1;$i<=$rank;++$i) { $assignments .= (" " x $i)."do i".$i."=lbound(self%".$variableName.",dim=".$i."),ubound(self%".$variableName.",dim=".$i.")\n"; } diff --git a/perl/Galacticus/Build/SourceTree/Process/ObjectBuilder.pm b/perl/Galacticus/Build/SourceTree/Process/ObjectBuilder.pm index e8825281a6..e028bc0430 100755 --- a/perl/Galacticus/Build/SourceTree/Process/ObjectBuilder.pm +++ b/perl/Galacticus/Build/SourceTree/Process/ObjectBuilder.pm @@ -182,6 +182,7 @@ sub Process_ObjectBuilder { $builderCode .= " call ".$node->{'directive'}->{'name'}."%autoHook()\n"; $builderCode .= $debugMessage; $builderCode .= $copyLoopClose; + $builderCode .= " call Warn('Using default class for parameter ''['//char(parametersCurrent%path())//'".$parameterName."]''')\n"; $builderCode .= " end if\n"; } if ( exists($node->{'directive'}->{'parameterName'}) ) { @@ -220,19 +221,25 @@ sub Process_ObjectBuilder { type => "moduleUse", moduleUse => { - "Input_Parameters" => + "Input_Parameters" => { intrinsic => 0, only => {inputParameter => 1} + }, + "Error" => + { + intrinsic => 0, + only => {Warn => 1} + }, + "ISO_Varying_String" => + { + intrinsic => 0, + only => {char => 1} } } }; - $usesNode->{'moduleUse'}->{'ISO_Varying_String'} = - { - intrinsic => 0, - only => {var_str => 1} - } - if ( $parametersDefaultRequired ); + $usesNode->{'moduleUse'}->{'ISO_Varying_String'}->{'only'}->{'var_str'} = 1 + if ( $parametersDefaultRequired ); $usesNode->{'moduleUse'}->{$moduleName} = { intrinsic => 0, diff --git a/source/merger_trees.operators.particulate.F90 b/source/merger_trees.operators.particulate.F90 index e8d5467aaa..670c6d899a 100644 --- a/source/merger_trees.operators.particulate.F90 +++ b/source/merger_trees.operators.particulate.F90 @@ -134,23 +134,23 @@ function particulateConstructorParameters(parameters) result(self) type (inputParameters ), intent(inout) :: parameters type (varying_string ) :: outputFileName integer (kind_int8 ) :: idMultiplier - double precision :: massParticle , radiusTruncateOverRadiusVirial , & - & timeSnapshot , energyDistributionPointsPerDecade, & - & lengthSoftening , toleranceRelativeSmoothing , & + double precision :: massParticle , radiusTruncateOverRadiusVirial , & + & timeSnapshot , energyDistributionPointsPerDecade, & + & lengthSoftening , toleranceRelativeSmoothing , & & toleranceMass - logical :: satelliteOffset , nonCosmological , & - & positionOffset , addHubbleFlow , & - & haloIdToParticleType , sampleParticleNumber , & + logical :: satelliteOffset , nonCosmological , & + & positionOffset , addHubbleFlow , & + & haloIdToParticleType , sampleParticleNumber , & & subtractRandomOffset - integer :: selection , chunkSize , & + integer :: selection , chunkSize , & & kernelSoftening class (cosmologyParametersClass ), pointer :: cosmologyParameters_ class (cosmologyFunctionsClass ), pointer :: cosmologyFunctions_ class (darkMatterHaloScaleClass ), pointer :: darkMatterHaloScale_ class (darkMatterProfileDMOClass ), pointer :: darkMatterProfileDMO_ class (galacticStructureClass ), pointer :: galacticStructure_ - type (inputParameters ), pointer :: parametersRoot - type (varying_string ) :: selectionText , kernelSofteningText + type (inputParameters ), pointer :: parametersRoot => null() + type (varying_string ) :: selectionText , kernelSofteningText !![ @@ -521,8 +521,8 @@ subroutine particulateOperatePreEvolution(self,tree) !$omp do reduction(+: positionRandomOffset, velocityRandomOffset) do i=1,particleCountActual !$ if (OMP_Get_Thread_Num() == 0) then - call displayCounter(max(1,int(100.0d0*dble(counter)/dble(particleCountActual))),isNew=isNew,verbosity=verbosityLevelStandard) - isNew=.false. + call displayCounter(max(1,int(100.0d0*dble(counter)/dble(particleCountActual))),isNew=isNew,verbosity=verbosityLevelStandard) + isNew=.false. !$ end if !$omp atomic counter=counter+1 diff --git a/source/utility.input_parameters.F90 b/source/utility.input_parameters.F90 index 1ca6db391e..686ebd8a80 100644 --- a/source/utility.input_parameters.F90 +++ b/source/utility.input_parameters.F90 @@ -31,6 +31,8 @@ module Input_Parameters use :: ISO_Varying_String, only : varying_string use :: Kind_Numbers , only : kind_int8 use :: String_Handling , only : char + use :: Hashes , only : integerHash + use :: Locks , only : ompLock private public :: inputParameters, inputParameter, inputParameterList @@ -105,6 +107,14 @@ module Input_Parameters procedure :: get => inputParameterGet end type inputParameter + !![ + + + + + + !!] + type :: inputParameters private type (node ), pointer, public :: document => null() @@ -114,7 +124,9 @@ module Input_Parameters type (inputParameters), pointer, public :: parent => null() logical :: outputParametersCopied = .false., outputParametersTemporary=.false., & & isNull = .false. - contains + type (integerHash ), allocatable :: warnedDefaults + type (ompLock ), pointer :: lock => null() + contains !![ @@ -134,6 +146,8 @@ module Input_Parameters + + !!] final :: inputParametersFinalize @@ -157,6 +171,8 @@ module Input_Parameters procedure :: serializeToXML => inputParametersSerializeToXML procedure :: addParameter => inputParametersAddParameter procedure :: reset => inputParametersReset + procedure :: path => inputParametersPath + procedure :: lockReinitialize => inputParametersLockReinitialize end type inputParameters interface inputParameters @@ -229,14 +245,18 @@ function inputParametersConstructorNull() implicit none type(inputParameters) :: inputParametersConstructorNull - inputParametersConstructorNull%document => createDocument ( & - & getImplementation() , & - & qualifiedName ="parameters", & - & docType =null() & - & ) - inputParametersConstructorNull%rootNode => getDocumentElement(inputParametersConstructorNull%document) - inputParametersConstructorNull%parameters => null() - inputParametersConstructorNull%isNull = .true. + allocate(inputParametersConstructorNull%warnedDefaults) + allocate(inputParametersConstructorNull%lock ) + inputParametersConstructorNull%document => createDocument ( & + & getImplementation() , & + & qualifiedName ="parameters", & + & docType =null() & + & ) + inputParametersConstructorNull%rootNode => getDocumentElement(inputParametersConstructorNull%document) + inputParametersConstructorNull%parameters => null ( ) + inputParametersConstructorNull%warnedDefaults = integerHash ( ) + inputParametersConstructorNull%lock = ompLock ( ) + inputParametersConstructorNull%isNull = .true. !$omp critical (FoX_DOM_Access) call setLiveNodeLists(inputParametersConstructorNull%document,.false.) !$omp end critical (FoX_DOM_Access) @@ -363,6 +383,16 @@ function inputParametersConstructorCopy(parameters) inputParametersConstructorCopy = inputParameters(parameters%rootNode ,noOutput=.true.,noBuild=.true.) inputParametersConstructorCopy%parameters => parameters%parameters inputParametersConstructorCopy%parent => parameters%parent + if (allocated(parameters%warnedDefaults)) then + if (allocated(inputParametersConstructorCopy%warnedDefaults)) deallocate(inputParametersConstructorCopy%warnedDefaults) + allocate(inputParametersConstructorCopy%warnedDefaults) + inputParametersConstructorCopy%warnedDefaults=parameters%warnedDefaults + end if + if (associated(parameters%lock)) then + nullify(inputParametersConstructorCopy%lock) + allocate(inputParametersConstructorCopy%lock) + inputParametersConstructorCopy%lock=ompLock() + end if return end function inputParametersConstructorCopy @@ -370,11 +400,11 @@ function inputParametersConstructorNode(parametersNode,allowedParameterNames,out !!{ Constructor for the {\normalfont \ttfamily inputParameters} class from an FoX node. !!} - use :: Display , only : displayGreen , displayMessage, displayReset + use :: Display , only : displayGreen , displayMessage , displayReset use :: File_Utilities , only : File_Name_Temporary - use :: FoX_dom , only : getOwnerDocument , node , setLiveNodeLists + use :: FoX_dom , only : getOwnerDocument , node , setLiveNodeLists use :: Error , only : Error_Report - use :: ISO_Varying_String, only : assignment(=) , char , operator(//) , operator(/=) + use :: ISO_Varying_String, only : assignment(=) , char , operator(//) , operator(/=) use :: String_Handling , only : String_Strip use :: IO_XML , only : XML_Get_First_Element_By_Tag_Name, XML_Path_Exists, getTextContent => getTextContentTS use :: Display , only : displayMessage @@ -396,11 +426,15 @@ function inputParametersConstructorNode(parametersNode,allowedParameterNames,out !!] #include "os.inc" - - inputParametersConstructorNode%isNull = .false. - inputParametersConstructorNode%document => getOwnerDocument(parametersNode) - inputParametersConstructorNode%rootNode => parametersNode - inputParametersConstructorNode%parent => null ( ) + + allocate(inputParametersConstructorNode%warnedDefaults) + allocate(inputParametersConstructorNode%lock ) + inputParametersConstructorNode%isNull = .false. + inputParametersConstructorNode%document => getOwnerDocument(parametersNode) + inputParametersConstructorNode%rootNode => parametersNode + inputParametersConstructorNode%parent => null ( ) + inputParametersConstructorNode%warnedDefaults = integerHash ( ) + inputParametersConstructorNode%lock = ompLock ( ) !$omp critical (FoX_DOM_Access) call setLiveNodeLists(inputParametersConstructorNode%document,.false.) if (.not.noBuild_) then @@ -663,6 +697,8 @@ subroutine inputParametersFinalize(self) nullify(self%rootNode ) nullify(self%parameters) nullify(self%parent ) + if (allocated (self%warnedDefaults)) deallocate(self%warnedDefaults) + if (associated(self%lock )) deallocate(self%lock ) !$ call hdf5Access%set() if (self%outputParameters%isOpen().and..not.self%outputParametersCopied) then if (self%outputParametersTemporary) then @@ -929,7 +965,6 @@ subroutine inputParametersCheckParameters(self,allowedParameterNames,allowedMult & getNodeName , hasAttribute , inException , node use :: ISO_Varying_String , only : assignment(=) , char , operator(//) , operator(==) use :: Regular_Expressions, only : regEx - use :: Hashes , only : integerHash use :: String_Handling , only : String_Levenshtein_Distance implicit none class (inputParameters) , intent(inout) :: self @@ -1333,7 +1368,8 @@ function inputParametersSubParameters(self,parameterName,requireValue,requirePre use :: FoX_dom , only : node use :: Error , only : Error_Report use :: HDF5_Access , only : hdf5Access - use :: ISO_Varying_String, only : assignment(=), char, operator(//) + use :: IO_HDF5 , only : ioHDF5AccessInitialize + use :: ISO_Varying_String, only : assignment(=) , char, operator(//) use :: String_Handling , only : operator(//) implicit none type (inputParameters) :: inputParametersSubParameters @@ -1344,11 +1380,12 @@ function inputParametersSubParameters(self,parameterName,requireValue,requirePre type (inputParameter ), pointer :: parameterNode integer :: copyCount type (varying_string ) :: groupName - !![ !!] + ! The HDF5 access lock may not yet have been initialized. Ensure it is before using it. + call ioHDF5AccessInitialize() if (.not.self%isPresent(parameterName,requireValue)) then if (requirePresent_) then call Error_Report('parameter ['//trim(parameterName)//'] not found'//{introspection:location}) @@ -1373,22 +1410,45 @@ function inputParametersSubParameters(self,parameterName,requireValue,requirePre return end function inputParametersSubParameters + function inputParametersPath(self) + !!{ + Return the path to the given parameters. + !!} + use :: FoX_dom , only : getNodeName + use :: ISO_Varying_String, only : assignment(=), operator(//) + implicit none + type (varying_string ) :: inputParametersPath + class(inputParameters), intent(inout), target :: self + type (inputParameter ), pointer :: parameterNode + + parameterNode => self%parameters + inputParametersPath = "" + do while (associated(parameterNode)) + if (associated(parameterNode%content)) inputParametersPath=inputParametersPath//getNodeName(parameterNode%content)//"/" + parameterNode => parameterNode%parent + end do + return + end function inputParametersPath + recursive subroutine inputParametersValueName{Type¦label}(self,parameterName,parameterValue,defaultValue,errorStatus,writeOutput,copyInstance) !!{ Return the value of the parameter specified by name. !!} - use :: FoX_dom , only : hasAttribute, node - use :: Error , only : Error_Report - use :: HDF5_Access, only : hdf5Access + use :: FoX_dom , only : hasAttribute, getNodeName + use :: Error , only : Error_Report, Warn + use :: HDF5_Access , only : hdf5Access + use :: ISO_Varying_String, only : char implicit none - class (inputParameters), intent(inout) :: self + class (inputParameters), intent(inout), target :: self character (len=* ), intent(in ) :: parameterName {Type¦intrinsic} , intent( out) :: parameterValue {Type¦intrinsic} , intent(in ), optional :: defaultValue integer , intent( out), optional :: errorStatus integer , intent(in ), optional :: copyInstance logical , intent(in ), optional :: writeOutput + type (inputParameters), pointer :: parametersRoot type (inputParameter ), pointer :: parameterNode + type (varying_string ) :: parameterPath !![ !!] @@ -1397,6 +1457,17 @@ recursive subroutine inputParametersValueName{Type¦label}(self,parameterName,pa parameterNode => self%node(parameterName,copyInstance=copyInstance) call self%value(parameterNode,parameterValue,errorStatus,writeOutput) else if (present(defaultValue)) then + parametersRoot => self + do while (associated(parametersRoot%parent)) + parametersRoot => parametersRoot%parent + end do + parameterPath=self%path() + call parametersRoot%lock%set() + if (.not.parametersRoot%warnedDefaults%exists(parameterPath)) then + call Warn("Using default value for parameter '["//char(parameterPath)//parameterName//"]'") + call parametersRoot%warnedDefaults%set(parameterPath,1) + end if + call parametersRoot%lock%unset() parameterValue=defaultValue ! Write the parameter file to an HDF5 object. if (self%outputParameters%isOpen().and.writeOutput_) then @@ -1815,4 +1886,19 @@ subroutine inputParametersReset(self) return end subroutine inputParametersReset + subroutine inputParametersLockReinitialize(self) + !!{ + Reinitialize the OpenMP lock. + !!} + implicit none + class(inputParameters), intent(inout) :: self + + if (associated(self%lock)) then + nullify(self%lock) + allocate(self%lock) + self%lock=ompLock() + end if + return + end subroutine inputParametersLockReinitialize + end module Input_Parameters diff --git a/testSuite/test-methods.xml b/testSuite/test-methods.xml index ab8e43e68e..0e4e5ecf68 100644 --- a/testSuite/test-methods.xml +++ b/testSuite/test-methods.xml @@ -47,7 +47,7 @@ - + @@ -62,52 +62,52 @@ - + - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + - - - - + + + + - - - + + + - + @@ -156,32 +156,32 @@ - + - + - - + + - + - + - - + + - - - + + + @@ -189,38 +189,38 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + @@ -444,27 +444,27 @@ - - - - + + + + - - + + - - + + - - + + @@ -535,33 +535,33 @@ 0.9.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -592,14 +592,14 @@ - - - - - - - - + + + + + + + + @@ -620,39 +620,39 @@ - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + - - - - + + + + - - - + + + @@ -687,39 +687,39 @@ - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + - - - - + + + + - - - + + + @@ -731,39 +731,39 @@ - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + - - - - + + + + - - - + + + @@ -775,8 +775,8 @@ - - + + @@ -830,16 +830,16 @@ - - + + - + - + @@ -900,10 +900,10 @@ 0.9.4 - + - + @@ -1027,7 +1027,7 @@ - + @@ -1035,22 +1035,22 @@ - + - + - + - + @@ -1069,29 +1069,29 @@ - + - + - + - + - + @@ -1112,29 +1112,29 @@ - + - + - + - + - + @@ -1154,29 +1154,29 @@ - + - + - + - + - + @@ -1256,7 +1256,7 @@ - + @@ -1321,18 +1321,18 @@ - + - + - - + + @@ -1361,7 +1361,7 @@ - + @@ -1378,12 +1378,12 @@ - - + + - - + + @@ -1445,55 +1445,55 @@ - - + + - - - + + + - - + + - - - - - + + + + + - - - - - + + + + + - - - - - - - - - - + + + + + + + + + + - + - + @@ -1536,15 +1536,15 @@ - + - + - + @@ -1596,9 +1596,9 @@ - + - + @@ -1639,9 +1639,9 @@ - + - + @@ -1685,9 +1685,9 @@ - + - + @@ -1730,9 +1730,9 @@ - + - + @@ -1775,9 +1775,9 @@ - + - + @@ -1820,9 +1820,9 @@ - + - + @@ -1839,17 +1839,17 @@ - 2 - 0.9.4 + 2 + 0.9.4 - - - - + + + + @@ -1871,11 +1871,10 @@ - + - + - @@ -1916,9 +1915,9 @@ - + - + @@ -1971,15 +1970,15 @@ - + - + - + @@ -2034,9 +2033,9 @@ - + - + @@ -2119,9 +2118,9 @@ 0.9.4 - + - + @@ -2157,7 +2156,7 @@ - + @@ -2165,15 +2164,15 @@ - - - + + + - + @@ -2181,11 +2180,11 @@ - - - - - + + + + + @@ -2197,34 +2196,34 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -2267,15 +2266,15 @@ - - + + - + @@ -2292,7 +2291,7 @@ - +