Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE GetShadowingInput
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN July 1999
! MODIFIED B. Griffith, Nov 2012, add calculaton method
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the Shadowing Calculation object.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound,GetObjectItem,SameString
USE General, ONLY: RoundSigDigits
USE DataIPShortCuts
USE DataSystemVariables, ONLY: SutherlandHodgman,DetailedSkyDiffuseAlgorithm, &
DetailedSolarTimestepIntegration
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: fmta="(A)"
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER NumItems
INTEGER NumNumbers
INTEGER NumAlphas
INTEGER IOStat
rNumericArgs(1:4)=0.0d0 ! so if nothing gotten, defaults will be maintained.
cAlphaArgs(1)=' '
cAlphaArgs(2)=' '
cCurrentModuleObject='ShadowCalculation'
NumItems=GetNumObjectsFound(cCurrentModuleObject)
NumAlphas=0
NumNumbers=0
IF (NumItems > 1) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': More than 1 occurence of this object found, only first will be used.')
ENDIF
IF (NumItems /= 0) THEN
CALL GetObjectItem(cCurrentModuleObject,1,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ShadowingCalcFrequency=rNumericArgs(1)
ENDIF
IF (ShadowingCalcFrequency <= 0) THEN
! Set to default value
ShadowingCalcFrequency=20
ENDIF
IF (ShadowingCalcFrequency > 31) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': suspect '//trim(cNumericFieldNames(1)))
CALL ShowContinueError('Value entered=['//trim(RoundSigDigits(rNumericArgs(1),0))// &
'], Shadowing Calculations will be inaccurate.')
ENDIF
IF (rNumericArgs(2) > 199.d0) THEN
MAXHCS=rNumericArgs(2)
ELSE
MAXHCS=15000
ENDIF
IF (NumAlphas >= 1) THEN
IF (SameString(cAlphaArgs(1), 'AverageOverDaysInFrequency')) THEN
DetailedSolarTimestepIntegration = .FALSE.
cAlphaArgs(1) = 'AverageOverDaysInFrequency'
ELSEIF (SameString(cAlphaArgs(1), 'TimestepFrequency')) THEN
DetailedSolarTimestepIntegration = .TRUE.
cAlphaArgs(1) = 'TimestepFrequency'
ELSE
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//trim(cAlphaFieldNames(1)))
CALL ShowContinueError('Value entered="'//trim(cAlphaArgs(1))//'", AverageOverDaysInFrequency will be used.')
DetailedSolarTimestepIntegration = .FALSE.
cAlphaArgs(1) = 'AverageOverDaysInFrequency'
ENDIF
ELSE
DetailedSolarTimestepIntegration = .FALSE.
cAlphaArgs(1) = 'AverageOverDaysInFrequency'
ENDIF
IF (NumAlphas >= 2) THEN
IF (SameString(cAlphaArgs(2),'SutherlandHodgman')) THEN
SutherlandHodgman=.true.
cAlphaArgs(2)='SutherlandHodgman'
ELSEIF (SameString(cAlphaArgs(2),'ConvexWeilerAtherton')) THEN
SutherlandHodgman=.false.
cAlphaArgs(2)='ConvexWeilerAtherton'
ELSEIF (lAlphaFieldBlanks(2)) THEN
IF (.not. SutherlandHodgman) THEN ! if already set.
cAlphaArgs(2)='ConvexWeilerAtherton'
ELSE
cAlphaArgs(2)='SutherlandHodgman'
ENDIF
ELSE
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//trim(cAlphaFieldNames(2)))
IF (.not. SutherlandHodgman) THEN
CALL ShowContinueError('Value entered="'//trim(cAlphaArgs(2))//'", ConvexWeilerAtherton will be used.')
ELSE
CALL ShowContinueError('Value entered="'//trim(cAlphaArgs(2))//'", SutherlandHodgman will be used.')
ENDIF
ENDIF
ELSE
IF (.not. SutherlandHodgman) THEN
cAlphaArgs(2)='ConvexWeilerAtherton'
ELSE
cAlphaArgs(2)='SutherlandHodgman'
ENDIF
ENDIF
IF (NumAlphas >= 3) THEN
IF (SameString(cAlphaArgs(3),'SimpleSkyDiffuseModeling')) THEN
DetailedSkyDiffuseAlgorithm=.false.
cAlphaArgs(3)='SimpleSkyDiffuseModeling'
ELSEIF (SameString(cAlphaArgs(3),'DetailedSkyDiffuseModeling')) THEN
DetailedSkyDiffuseAlgorithm=.true.
cAlphaArgs(3)='DetailedSkyDiffuseModeling'
ELSEIF (lAlphaFieldBlanks(3)) THEN
DetailedSkyDiffuseAlgorithm=.false.
cAlphaArgs(3)='SimpleSkyDiffuseModeling'
ELSE
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//trim(cAlphaFieldNames(3)))
CALL ShowContinueError('Value entered="'//trim(cAlphaArgs(3))//'", SimpleSkyDiffuseModeling will be used.')
ENDIF
ELSE
cAlphaArgs(3)='SimpleSkyDiffuseModeling'
DetailedSkyDiffuseAlgorithm=.false.
ENDIF
IF (.not. DetailedSkyDiffuseAlgorithm .and. ShadingTransmittanceVaries .and. &
SolarDistribution /= MinimalShadowing) THEN
CALL ShowWarningError('GetShadowingInput: The shading transmittance for shading devices changes throughout the year.'// &
' Choose DetailedSkyDiffuseModeling in the '//trim(cCurrentModuleObject)//' object to remove this warning.')
CALL ShowContinueError('Simulation has been reset to use DetailedSkyDiffuseModeling. Simulation continues.')
DetailedSkyDiffuseAlgorithm=.true.
cAlphaArgs(2)='DetailedSkyDiffuseModeling'
IF (ShadowingCalcFrequency > 1) THEN
CALL ShowContinueError('Better accuracy may be gained by setting the '//trim(cNumericFieldNames(1))// &
' to 1 in the '//trim(cCurrentModuleObject)//' object.')
ENDIF
ELSEIF (DetailedSkyDiffuseAlgorithm) THEN
IF (.not. ShadingTransmittanceVaries .or. SolarDistribution == MinimalShadowing) THEN
CALL ShowWarningError('GetShadowingInput: DetailedSkyDiffuseModeling is chosen but not needed as'// &
' either the shading transmittance for shading devices does not change throughout the year')
CALL ShowContinueError(' or MinimalShadowing has been chosen.')
CALL ShowContinueError('Simulation should be set to use SimpleSkyDiffuseModeling, but is left at Detailed for simulation.')
CALL ShowContinueError('Choose SimpleSkyDiffuseModeling in the '//trim(cCurrentModuleObject)// &
' object to reduce computation time.')
ENDIF
ENDIF
Write(OutputFileInits,fmta) '! <Shadowing/Sun Position Calculations> [Annual Simulations], Calculation Method,'// &
'Value {days}, Allowable Number Figures in Shadow Overlap {}, Polygon Clipping Algorithm, '// &
'Sky Diffuse Modeling Algorithm'
Write(OutputFileInits,fmta) 'Shadowing/Sun Position Calculations,'// &
TRIM(cAlphaArgs(1))//','// &
TRIM(RoundSigDigits(ShadowingCalcFrequency))//','// &
TRIM(RoundSigDigits(MAXHCS))//','// &
trim(cAlphaArgs(2))//','//trim(cAlphaArgs(3))
RETURN
END SUBROUTINE GetShadowingInput