diff --git a/perl/Galacticus/Build/SourceTree/Process/InputParametersValidate.pm b/perl/Galacticus/Build/SourceTree/Process/InputParametersValidate.pm index 4ad1e407ab..07b20b0a8c 100644 --- a/perl/Galacticus/Build/SourceTree/Process/InputParametersValidate.pm +++ b/perl/Galacticus/Build/SourceTree/Process/InputParametersValidate.pm @@ -112,7 +112,7 @@ sub Process_InputParametersValidate { } $code .= " call ".$result."%allowedParameters(".$variableName.",'".$source."',.false.)\n"; # Perform the check. - $code .= " if (.not.".$functionClassName."DsblVldtn) call ".$source."%checkParameters(".$variableName.(exists($node->{'directive'}->{'multiParameters'}) ? ",".$multiNames : "").")\n"; + $code .= " if (.not.".$functionClassName."DsblVldtn) call ".$source."%checkParameters(allowedParameterNames=".$variableName.(exists($node->{'directive'}->{'multiParameters'}) ? ",allowedMultiParameterNames=".$multiNames : "").")\n"; $code .= " if (allocated(".$variableName.")) deallocate(".$variableName.")\n"; # Insert new code. my $codeNode = diff --git a/perl/Galacticus/Build/SourceTree/Process/ObjectBuilder.pm b/perl/Galacticus/Build/SourceTree/Process/ObjectBuilder.pm index c04d44ffac..6961892b77 100755 --- a/perl/Galacticus/Build/SourceTree/Process/ObjectBuilder.pm +++ b/perl/Galacticus/Build/SourceTree/Process/ObjectBuilder.pm @@ -117,7 +117,8 @@ sub Process_ObjectBuilder { $defaultXML =~ s/\s*\n\s*//g; $defaultXML =~ s/\s{2,}/ /g; $builderCode .= " if (.not.parametersCurrent%isPresent('".$parameterName."')) then\n"; - $builderCode .= " parametersDefault=inputParameters(var_str('".$defaultXML."'),allowedParameterNames=['".$parameterName."'],noOutput=.true.)\n"; + $builderCode .= " allowedNames_(1)='".$parameterName."'\n"; + $builderCode .= " parametersDefault=inputParameters(var_str('".$defaultXML."'),allowedParameterNames=allowedNames_,noOutput=.true.)\n"; $builderCode .= " call parametersDefault%parametersGroupCopy(parametersCurrent)\n"; $builderCode .= " parametersCurrent => parametersDefault\n"; $builderCode .= " parametersDefaultCreated=.true.\n"; @@ -343,12 +344,31 @@ sub Process_ObjectBuilder { variables => [ "parametersDefault" ], attributes => [ "target" ] }, + { + intrinsic => "type" , + type => "varying_string" , + variables => [ "allowedNames_" ], + attributes => [ "dimension(1)" ] + }, { intrinsic => "logical" , variables => [ "parametersDefaultCreated" ] } ); &Galacticus::Build::SourceTree::Parse::Declarations::AddDeclarations($node->{'parent'},\@declarations); + my $usesNode = + { + type => "moduleUse", + moduleUse => + { + ISO_Varying_String => + { + intrinsic => 0, + only => {"varying_string" => 1, "assignment(=)" => 1} + } + } + }; + &Galacticus::Build::SourceTree::Parse::ModuleUses::AddUses($node->{'parent'},$usesNode); # Record that we have added the necessary declarations to the parent. $node->{'parent'}->{'objectBuilderDefaultDeclarations'} = 1; } diff --git a/source/intergalactic_medium.state.file.F90 b/source/intergalactic_medium.state.file.F90 index 5b09e3b135..0ca02004b1 100644 --- a/source/intergalactic_medium.state.file.F90 +++ b/source/intergalactic_medium.state.file.F90 @@ -248,45 +248,47 @@ subroutine fileReadData(self) class (intergalacticMediumStateFile), intent(inout) :: self integer :: fileFormatVersion , iRedshift, & & extrapolationAllowed - type (hdf5Object ) :: file ! Check if data has yet to be read. - if (.not.self%dataRead) then - if (.not.File_Exists(char(self%fileName))) call Error_Report('Unable to find intergalactic medium state file "' //char(self%fileName)//'"'//{introspection:location}) - !$ call hdf5Access%set() - ! Open the file. - call file%openFile(char(self%fileName),readOnly=.true.) - ! Check the file format version of the file. - call file%readAttribute('fileFormat',fileFormatVersion) - if (fileFormatVersion /= fileFormatVersionCurrent) call Error_Report('file format version is out of date'//{introspection:location}) - ! Check if extrapolation is allowed. - self%extrapolationType=extrapolationTypeAbort - if (file%hasAttribute('extrapolationAllowed')) then - call file%readAttribute('extrapolationAllowed',extrapolationAllowed) - if (extrapolationAllowed /= 0) self%extrapolationType=extrapolationTypeExtrapolate - end if - call file%readAttribute('fileFormat',fileFormatVersion) - ! Read the data. - call file%readDataset('redshift' ,self%timeTable ) - call file%readDataset('electronFraction' ,self%electronFractionTable ) - call file%readDataset('hIonizedFraction' ,self%ionizedHydrogenFractionTable) - call file%readDataset('heIonizedFraction',self%ionizedHeliumFractionTable ) - call file%readDataset('matterTemperature',self%temperatureTable ) - call file%close ( ) - !$ call hdf5Access%unset() - self%redshiftCount=size(self%timeTable) - ! Convert redshifts to times. - do iRedshift=1,self%redshiftCount - self%timeTable(iRedshift)=self%cosmologyFunctions_%cosmicTime(self%cosmologyFunctions_%expansionFactorFromRedshift(self%timeTable(iRedshift))) - end do - ! Build interpolators. - self%interpolatorElectronFraction =interpolator(self%timeTable,self%electronFractionTable ,extrapolationType=self%extrapolationType) - self%interpolatorTemperature =interpolator(self%timeTable,self%temperatureTable ,extrapolationType=self%extrapolationType) - self%interpolatorIonizedHydrogenFraction=interpolator(self%timeTable,self%ionizedHydrogenFractionTable,extrapolationType=self%extrapolationType) - self%interpolatorIonizedHeliumFraction =interpolator(self%timeTable,self%ionizedHeliumFractionTable ,extrapolationType=self%extrapolationType) - ! Flag that data has now been read. - self%dataRead=.true. - end if + if (self%dataRead) return + block + type(hdf5Object) :: file + + if (.not.File_Exists(char(self%fileName))) call Error_Report('Unable to find intergalactic medium state file "' //char(self%fileName)//'"'//{introspection:location}) + !$ call hdf5Access%set() + ! Open the file. + call file%openFile(char(self%fileName),readOnly=.true.) + ! Check the file format version of the file. + call file%readAttribute('fileFormat',fileFormatVersion) + if (fileFormatVersion /= fileFormatVersionCurrent) call Error_Report('file format version is out of date'//{introspection:location}) + ! Check if extrapolation is allowed. + self%extrapolationType=extrapolationTypeAbort + if (file%hasAttribute('extrapolationAllowed')) then + call file%readAttribute('extrapolationAllowed',extrapolationAllowed) + if (extrapolationAllowed /= 0) self%extrapolationType=extrapolationTypeExtrapolate + end if + call file%readAttribute('fileFormat',fileFormatVersion) + ! Read the data. + call file%readDataset('redshift' ,self%timeTable ) + call file%readDataset('electronFraction' ,self%electronFractionTable ) + call file%readDataset('hIonizedFraction' ,self%ionizedHydrogenFractionTable) + call file%readDataset('heIonizedFraction',self%ionizedHeliumFractionTable ) + call file%readDataset('matterTemperature',self%temperatureTable ) + call file%close ( ) + !$ call hdf5Access%unset() + self%redshiftCount=size(self%timeTable) + ! Convert redshifts to times. + do iRedshift=1,self%redshiftCount + self%timeTable(iRedshift)=self%cosmologyFunctions_%cosmicTime(self%cosmologyFunctions_%expansionFactorFromRedshift(self%timeTable(iRedshift))) + end do + ! Build interpolators. + self%interpolatorElectronFraction =interpolator(self%timeTable,self%electronFractionTable ,extrapolationType=self%extrapolationType) + self%interpolatorTemperature =interpolator(self%timeTable,self%temperatureTable ,extrapolationType=self%extrapolationType) + self%interpolatorIonizedHydrogenFraction=interpolator(self%timeTable,self%ionizedHydrogenFractionTable,extrapolationType=self%extrapolationType) + self%interpolatorIonizedHeliumFraction =interpolator(self%timeTable,self%ionizedHeliumFractionTable ,extrapolationType=self%extrapolationType) + ! Flag that data has now been read. + self%dataRead=.true. + end block return end subroutine fileReadData diff --git a/source/output.analyses.mass_function_stellar.Bernardi_SDSS.F90 b/source/output.analyses.mass_function_stellar.Bernardi_SDSS.F90 index e1e813c98f..855e8d59ac 100644 --- a/source/output.analyses.mass_function_stellar.Bernardi_SDSS.F90 +++ b/source/output.analyses.mass_function_stellar.Bernardi_SDSS.F90 @@ -296,6 +296,7 @@ function massFunctionStellarBernardi2013SDSSConstructorInternal(cosmologyFunctio + @@ -312,7 +313,8 @@ subroutine massFunctionStellarBernardi2013SDSSDestructor(self) type(outputAnalysisMassFunctionStellarBernardi2013SDSS), intent(inout) :: self !![ - + + !!] return end subroutine massFunctionStellarBernardi2013SDSSDestructor diff --git a/source/output.analyses.mass_function_stellar.GAMA.F90 b/source/output.analyses.mass_function_stellar.GAMA.F90 index e8e84d7f57..cee42d9b04 100644 --- a/source/output.analyses.mass_function_stellar.GAMA.F90 +++ b/source/output.analyses.mass_function_stellar.GAMA.F90 @@ -338,7 +338,7 @@ function massFunctionStellarBaldry2012GAMAConstructorInternal(cosmologyFunctions - + @@ -356,7 +356,8 @@ subroutine massFunctionStellarBaldry2012GAMADestructor(self) type(outputAnalysisMassFunctionStellarBaldry2012GAMA), intent(inout) :: self !![ - + + !!] return end subroutine massFunctionStellarBaldry2012GAMADestructor diff --git a/source/output.analyses.mass_function_stellar.PRIMUS.F90 b/source/output.analyses.mass_function_stellar.PRIMUS.F90 index c06496119b..d83014e057 100644 --- a/source/output.analyses.mass_function_stellar.PRIMUS.F90 +++ b/source/output.analyses.mass_function_stellar.PRIMUS.F90 @@ -367,6 +367,7 @@ function massFunctionStellarPRIMUSConstructorInternal(cosmologyFunctions_,gravit + @@ -383,7 +384,8 @@ subroutine massFunctionStellarPRIMUSDestructor(self) type(outputAnalysisMassFunctionStellarPRIMUS), intent(inout) :: self !![ - + + !!] return end subroutine massFunctionStellarPRIMUSDestructor diff --git a/source/output.analyses.mass_function_stellar.SDSS.F90 b/source/output.analyses.mass_function_stellar.SDSS.F90 index 43b6e3cde3..cbcbbe5b45 100644 --- a/source/output.analyses.mass_function_stellar.SDSS.F90 +++ b/source/output.analyses.mass_function_stellar.SDSS.F90 @@ -323,6 +323,7 @@ function massFunctionStellarSDSSConstructorInternal(cosmologyFunctions_,gravitat + @@ -339,7 +340,8 @@ subroutine massFunctionStellarSDSSDestructor(self) type(outputAnalysisMassFunctionStellarSDSS), intent(inout) :: self !![ - + + !!] return end subroutine massFunctionStellarSDSSDestructor diff --git a/source/output.analyses.mass_function_stellar.UKIDSS_UDS.F90 b/source/output.analyses.mass_function_stellar.UKIDSS_UDS.F90 index 3db903c970..1dec54edd5 100644 --- a/source/output.analyses.mass_function_stellar.UKIDSS_UDS.F90 +++ b/source/output.analyses.mass_function_stellar.UKIDSS_UDS.F90 @@ -345,6 +345,7 @@ function massFunctionStellarUKIDSSUDSConstructorInternal(cosmologyFunctions_,gra + @@ -361,7 +362,8 @@ subroutine massFunctionStellarUKIDSSUDSDestructor(self) type(outputAnalysisMassFunctionStellarUKIDSSUDS), intent(inout) :: self !![ - + + !!] return end subroutine massFunctionStellarUKIDSSUDSDestructor diff --git a/source/output.analyses.mass_function_stellar.ULTRAVISTA.F90 b/source/output.analyses.mass_function_stellar.ULTRAVISTA.F90 index df76812cff..4824b901ed 100644 --- a/source/output.analyses.mass_function_stellar.ULTRAVISTA.F90 +++ b/source/output.analyses.mass_function_stellar.ULTRAVISTA.F90 @@ -382,7 +382,8 @@ subroutine massFunctionStellarULTRAVISTADestructor(self) type(outputAnalysisMassFunctionStellarULTRAVISTA), intent(inout) :: self !![ - + + !!] return end subroutine massFunctionStellarULTRAVISTADestructor diff --git a/source/output.analyses.mass_function_stellar.VIPERS.F90 b/source/output.analyses.mass_function_stellar.VIPERS.F90 index ac8d785837..7230c2d2ca 100644 --- a/source/output.analyses.mass_function_stellar.VIPERS.F90 +++ b/source/output.analyses.mass_function_stellar.VIPERS.F90 @@ -345,6 +345,7 @@ function massFunctionStellarVIPERSConstructorInternal(cosmologyFunctions_,gravit + @@ -361,7 +362,8 @@ subroutine massFunctionStellarVIPERSDestructor(self) type(outputAnalysisMassFunctionStellarVIPERS), intent(inout) :: self !![ - + + !!] return end subroutine massFunctionStellarVIPERSDestructor diff --git a/source/output.analyses.mass_function_stellar.ZFOURGE.F90 b/source/output.analyses.mass_function_stellar.ZFOURGE.F90 index 435b6e20b7..85126722cf 100644 --- a/source/output.analyses.mass_function_stellar.ZFOURGE.F90 +++ b/source/output.analyses.mass_function_stellar.ZFOURGE.F90 @@ -378,6 +378,7 @@ function massFunctionStellarZFOURGEConstructorInternal(cosmologyFunctions_,gravi + @@ -394,7 +395,8 @@ subroutine massFunctionStellarZFOURGEDestructor(self) type(outputAnalysisMassFunctionStellarZFOURGE), intent(inout) :: self !![ - + + !!] return end subroutine massFunctionStellarZFOURGEDestructor diff --git a/source/posterior_sampling.simulation.particle_swarm.F90 b/source/posterior_sampling.simulation.particle_swarm.F90 index 6ae7b7be80..28cecb4ce2 100644 --- a/source/posterior_sampling.simulation.particle_swarm.F90 +++ b/source/posterior_sampling.simulation.particle_swarm.F90 @@ -40,22 +40,22 @@ Implementation of a posterior sampling simulation class which implements the particle swarm algorithm. !!} private - type (modelParameterList ), pointer, dimension(:) :: modelParametersActive_ => null(), modelParametersInactive_ => null() - class (posteriorSampleLikelihoodClass ), pointer :: posteriorSampleLikelihood_ => null() - class (posteriorSampleConvergenceClass ), pointer :: posteriorSampleConvergence_ => null() - class (posteriorSampleStoppingCriterionClass), pointer :: posteriorSampleStoppingCriterion_ => null() - class (posteriorSampleStateClass ), pointer :: posteriorSampleState_ => null() - class (posteriorSampleStateInitializeClass ), pointer :: posteriorSampleStateInitialize_ => null() - class (randomNumberGeneratorClass ), pointer :: randomNumberGenerator_ => null() - integer :: parameterCount , stepsMaximum , & - & reportCount , logFlushCount - double precision :: accelerationCoefficientPersonal , accelerationCoefficientGlobal , & - & inertiaWeight , velocityCoefficient , & - & velocityCoefficientInitial - logical :: isInteractive , resume , & - & appendLogs - type (varying_string ) :: logFileRoot , interactionRoot , & - & logFilePreviousRoot + type (modelParameterList ), allocatable, dimension(:) :: modelParametersActive_ , modelParametersInactive_ + class (posteriorSampleLikelihoodClass ), pointer :: posteriorSampleLikelihood_ => null() + class (posteriorSampleConvergenceClass ), pointer :: posteriorSampleConvergence_ => null() + class (posteriorSampleStoppingCriterionClass), pointer :: posteriorSampleStoppingCriterion_ => null() + class (posteriorSampleStateClass ), pointer :: posteriorSampleState_ => null() + class (posteriorSampleStateInitializeClass ), pointer :: posteriorSampleStateInitialize_ => null() + class (randomNumberGeneratorClass ), pointer :: randomNumberGenerator_ => null() + integer :: parameterCount , stepsMaximum , & + & reportCount , logFlushCount + double precision :: accelerationCoefficientPersonal , accelerationCoefficientGlobal, & + & inertiaWeight , velocityCoefficient , & + & velocityCoefficientInitial + logical :: isInteractive , resume , & + & appendLogs + type (varying_string ) :: logFileRoot , interactionRoot , & + & logFilePreviousRoot contains !![ @@ -300,14 +300,16 @@ function particleSwarmConstructorInternal(modelParametersActive_,modelParameters allocate(self%modelParametersActive_ (size(modelParametersActive_ ))) allocate(self%modelParametersInactive_(size(modelParametersInactive_))) - self%modelParametersActive_ =modelParametersActive_ - self%modelParametersInactive_=modelParametersInactive_ do i=1,size(modelParametersActive_ ) + self%modelParametersActive_ (i) = modelParameterList ( ) + self%modelParametersActive_ (i)%modelParameter_ => modelParametersActive_ (i)%modelParameter_ !![ !!] end do do i=1,size(modelParametersInactive_) + self%modelParametersInactive_(i) = modelParameterList ( ) + self%modelParametersInactive_(i)%modelParameter_ => modelParametersInactive_(i)%modelParameter_ !![ !!] @@ -334,19 +336,21 @@ subroutine particleSwarmDestructor(self) !!] - if (associated(self%modelParametersActive_ )) then + if (allocated(self%modelParametersActive_ )) then do i=1,size(self%modelParametersActive_ ) !![ !!] end do + deallocate(self%modelParametersActive_ ) end if - if (associated(self%modelParametersInactive_)) then + if (allocated(self%modelParametersInactive_)) then do i=1,size(self%modelParametersInactive_) !![ !!] end do + deallocate(self%modelParametersInactive_) end if return end subroutine particleSwarmDestructor @@ -828,12 +832,12 @@ subroutine particleSwarmDescriptorSpecial(self,descriptor) type (inputParameters ), intent(inout) :: descriptor integer :: i - if (associated(self%modelParametersActive_ )) then + if (allocated(self%modelParametersActive_ )) then do i=1,size(self%modelParametersActive_ ) call self%modelParametersActive_ (i)%modelParameter_%descriptor(descriptor) end do end if - if (associated(self%modelParametersInactive_)) then + if (allocated(self%modelParametersInactive_)) then do i=1,size(self%modelParametersInactive_) call self%modelParametersInactive_(i)%modelParameter_%descriptor(descriptor) end do diff --git a/source/statistics.distributions.normal.F90 b/source/statistics.distributions.normal.F90 index bb8a38cb66..820228bfc3 100644 --- a/source/statistics.distributions.normal.F90 +++ b/source/statistics.distributions.normal.F90 @@ -116,6 +116,7 @@ Constructor for the {\normalfont \ttfamily normal} 1D distribution function clas + !!] return end function normalConstructorParameters diff --git a/source/utility.input_parameters.F90 b/source/utility.input_parameters.F90 index db6a19aa76..7c55bca04e 100644 --- a/source/utility.input_parameters.F90 +++ b/source/utility.input_parameters.F90 @@ -276,7 +276,7 @@ function inputParametersConstructorVarStr(xmlString,allowedParameterNames,output implicit none type (inputParameters) :: self type (varying_string ) , intent(in ) :: xmlString - character(len=* ), dimension(:), intent(in ), optional :: allowedParameterNames + type (varying_string ), dimension(:), intent(in ), optional :: allowedParameterNames type (hdf5Object ), target , intent(in ), optional :: outputParametersGroup logical , intent(in ), optional :: noOutput type (node ), pointer :: doc , parameterNode @@ -320,7 +320,7 @@ function inputParametersConstructorFileChar(fileName,allowedParameterNames,outpu implicit none type (inputParameters) :: self character(len=* ) , intent(in ) :: fileName - character(len=* ), dimension(:), intent(in ), optional :: allowedParameterNames + type (varying_string ), dimension(:), intent(in ), optional :: allowedParameterNames type (hdf5Object ), target , intent(in ), optional :: outputParametersGroup logical , intent(in ), optional :: noOutput type (node ), pointer :: doc , parameterNode @@ -393,12 +393,12 @@ function inputParametersConstructorNode(parametersNode,allowedParameterNames,out implicit none type (inputParameters) :: self type (node ), pointer , intent(in ) :: parametersNode - character(len=* ), dimension(:), intent(in ), optional :: allowedParameterNames + type (varying_string ), dimension(:), intent(in ), optional :: allowedParameterNames type (hdf5Object ), target , intent(in ), optional :: outputParametersGroup logical , intent(in ), optional :: noOutput , noBuild type (node ), pointer :: versionElement - type (varying_string ), dimension(:), allocatable :: allowedParameterNamesCombined , allowedParameterNamesTmp - integer :: allowedParameterFromFileCount , allowedParameterCount + type (varying_string ), dimension(:), allocatable , save :: allowedParameterNamesGlobal + !$omp threadprivate(allowedParameterNamesGlobal) character(len= 10 ) :: versionLabel type (varying_string ) :: message !![ @@ -457,29 +457,8 @@ function inputParametersConstructorNode(parametersNode,allowedParameterNames,out !$ call hdf5Access%unset() end if ! Get allowed parameter names. - call knownParameterNames(allowedParameterNamesCombined) - allowedParameterFromFileCount=size(allowedParameterNamesCombined) - ! Add in parameter names explicitly listed. - if (present(allowedParameterNames)) then - allowedParameterCount=size(allowedParameterNames) - if (allocated(allowedParameterNamesCombined)) then - call Move_Alloc(allowedParameterNamesCombined,allowedParameterNamesTmp) - allocate(allowedParameterNamesCombined(size(allowedParameterNamesTmp)+size(allowedParameterNames))) - allowedParameterNamesCombined( & - & 1 : & - & allowedParameterFromFileCount & - & )=allowedParameterNamesTmp - allowedParameterNamesCombined( & - & allowedParameterFromFileCount+1 : & - & allowedParameterFromFileCount+allowedParameterCount & - & )=allowedParameterNames - deallocate(allowedParameterNamesTmp) - else - allocate(allowedParameterNamesCombined(size(allowedParameterNames))) - allowedParameterNamesCombined=allowedParameterNames - end if - end if - if (.not.allocated(allowedParameterNamesCombined)) allocate(allowedParameterNamesCombined(0)) + if (.not.allocated(allowedParameterNamesGlobal)) & + & call knownParameterNames(allowedParameterNamesGlobal) ! Check for version information. !$omp critical (FoX_DOM_Access) if (XML_Path_Exists(self%rootNode,"version")) then @@ -498,7 +477,7 @@ function inputParametersConstructorNode(parametersNode,allowedParameterNames,out end if !$omp end critical (FoX_DOM_Access) ! Check parameters. - call self%checkParameters(allowedParameterNamesCombined) + call self%checkParameters(allowedParameterNamesGlobal=allowedParameterNamesGlobal,allowedParameterNames=allowedParameterNames) return end function inputParametersConstructorNode @@ -972,7 +951,7 @@ function inputParameterGet(self) return end function inputParameterGet - subroutine inputParametersCheckParameters(self,allowedParameterNames,allowedMultiParameterNames) + subroutine inputParametersCheckParameters(self,allowedParameterNamesGlobal,allowedParameterNames,allowedMultiParameterNames) use :: Error , only : Error_Report use :: Display , only : displayIndent , displayMagenta , displayMessage , displayReset , & & displayUnindent , displayVerbosity, enumerationVerbosityLevelEncode, verbosityLevelSilent @@ -983,28 +962,30 @@ subroutine inputParametersCheckParameters(self,allowedParameterNames,allowedMult use :: Regular_Expressions, only : regEx use :: String_Handling , only : String_Levenshtein_Distance implicit none - class (inputParameters ) , intent(inout) :: self - type (varying_string ), dimension(:), intent(in ), optional :: allowedParameterNames - type (varying_string ), dimension(:), intent(in ), optional :: allowedMultiParameterNames - type (node ), pointer :: node_ , ignoreWarningsNode , & - & node__ - type (inputParameter ), pointer :: currentParameter - type (regEx ), save :: regEx_ + class (inputParameters ) , intent(inout) :: self + type (varying_string ), dimension(:), intent(in ), optional, target :: allowedParameterNamesGlobal, allowedParameterNames, & + & allowedMultiParameterNames + type (node ) , pointer :: node_ , ignoreWarningsNode , & + & node__ + type (inputParameter ) , pointer :: currentParameter + type (varying_string ), dimension(:) , pointer :: allowedParameterNames_ + type (regEx ), save :: regEx_ !$omp threadprivate(regEx_) - logical :: warningsFound , parameterMatched , & - & verbose , ignoreWarnings , & - & isException , hasAttribute_ - type (enumerationInputParameterErrorStatusType) :: errorStatus - integer :: allowedParametersCount , status , & - & distance , distanceMinimum , & - & j - character(len=1024 ) :: parameterValue - character(len=1024 ) :: unknownName , allowedParameterName, & - & parameterNameGuess , unknownNamePath - type (varying_string ) :: message , verbosityLevel - type (integerHash ) :: parameterNamesSeen - type (DOMException ) :: exception - + logical :: warningsFound , parameterMatched , & + & verbose , ignoreWarnings , & + & isException , hasAttribute_ , & + & haveAllowedNames + type (enumerationInputParameterErrorStatusType) :: errorStatus + integer :: allowedParametersCount , status , & + & distance , distanceMinimum , & + & i , j + character(len=1024 ) :: parameterValue + character(len=1024 ) :: unknownName , allowedParameterName , & + & parameterNameGuess , unknownNamePath + type (varying_string ) :: message , verbosityLevel + type (integerHash ) :: parameterNamesSeen + type (DOMException ) :: exception + ! Determine whether we should be verbose. verbose=displayVerbosity() > verbosityLevelSilent if (self%isPresent('verbosityLevel')) then @@ -1037,13 +1018,20 @@ subroutine inputParametersCheckParameters(self,allowedParameterNames,allowedMult & call Error_Report("unable to parse attribute 'ignoreWarnings' in parameter ["//trim(unknownName)//"]"//{introspection:location}) end if ! Check for a match with allowed parameter names. + haveAllowedNames=present(allowedParameterNamesGlobal).or.present(allowedParameterNames) + parameterMatched=.not.haveAllowedNames allowedParametersCount=0 - if (present(allowedParameterNames)) allowedParametersCount=size(allowedParameterNames) - if (allowedParametersCount > 0) then - parameterMatched=.false. - j=1 - do while (.not.parameterMatched .and. j <= allowedParametersCount) - allowedParameterName=allowedParameterNames(j) + do i=1,2 + select case (i) + case (1) + if (.not.present(allowedParameterNamesGlobal)) cycle + allowedParameterNames_ => allowedParameterNamesGlobal + case (2) + if (.not.present(allowedParameterNames)) cycle + allowedParameterNames_ => allowedParameterNames + end select + do j=1,size(allowedParameterNames_) + allowedParameterName=allowedParameterNames_(j) if (allowedParameterName(1:6) == "regEx:") then regEx_=regEx(allowedParameterName(7:len_trim(allowedParameterName))) !$omp critical (FoX_DOM_Access) @@ -1055,11 +1043,9 @@ subroutine inputParametersCheckParameters(self,allowedParameterNames,allowedMult parameterMatched=(getNodeName(node_) == trim(allowedParameterName)) !$omp end critical (FoX_DOM_Access) end if - j=j+1 + if (parameterMatched) exit end do - else - parameterMatched=.true. - end if + end do ! Report on warnings. if ( & & ( & @@ -1086,7 +1072,7 @@ subroutine inputParametersCheckParameters(self,allowedParameterNames,allowedMult !$omp end critical (FoX_DOM_Access) call displayMessage(message) end if - if (allowedParametersCount > 0 .and. .not.parameterMatched .and. .not.ignoreWarnings .and. verbose) then + if (haveAllowedNames .and. .not.parameterMatched .and. .not.ignoreWarnings .and. verbose) then node__ => getParentNode(node_) unknownNamePath = "" !$omp critical (FoX_DOM_Access) @@ -1099,14 +1085,24 @@ subroutine inputParametersCheckParameters(self,allowedParameterNames,allowedMult end do !$omp end critical (FoX_DOM_Access) distanceMinimum=-1 - do j=1,allowedParametersCount - allowedParameterName=allowedParameterNames(j) - if (allowedParameterName(1:6) == "regEx:") cycle - distance=String_Levenshtein_Distance(trim(unknownName),trim(allowedParameterName)) - if (distance < distanceMinimum .or. 0 > distanceMinimum) then - distanceMinimum =distance - parameterNameGuess=allowedParameterName - end if + do i=1,2 + select case (i) + case (1) + if (.not.present(allowedParameterNamesGlobal)) cycle + allowedParameterNames_ => allowedParameterNamesGlobal + case (2) + if (.not.present(allowedParameterNames)) cycle + allowedParameterNames_ => allowedParameterNames + end select + do j=1,size(allowedParameterNames_) + allowedParameterName=allowedParameterNames_(j) + if (allowedParameterName(1:6) == "regEx:") cycle + distance=String_Levenshtein_Distance(trim(unknownName),trim(allowedParameterName)) + if (distance < distanceMinimum .or. 0 > distanceMinimum) then + distanceMinimum =distance + parameterNameGuess=allowedParameterName + end if + end do end do if (verbose) then message='unrecognized parameter ['//trim(unknownName)//' in '//trim(unknownNamePath)//']'