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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | ErrorsFound |
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 GetScheduledSurfaceGains(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Simon Vidanovic
! DATE WRITTEN June 2013
! MODIFIED
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Loads scheduled surface gains for solar incident on interior side of the surfaces and absorbed solar energy in
! window layers
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
use DataIPShortCuts
use InputProcessor, only: GetObjectDefMaxArgs, GetObjectItem, VerifyName
use General, only: TrimSigDigits
use DataSurfaces, only: TotSurfaces, Surface, TotSurfIncSolSSG, SurfIncSolSSG, TotFenLayAbsSSG, FenLayAbsSSG
use DataHeatBalance, only: Construct, TotConstructs
use ScheduleManager, only: GetScheduleIndex
implicit none ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
logical, intent(inout) :: ErrorsFound ! If errors found in input
! SUBROUTINE PARAMETER DEFINITIONS:
character(len=*), parameter :: RoutineName = 'GetScheduledSurfaceGains: '
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
integer :: NumArgs
integer :: NumAlpha
integer :: NumNumeric
integer :: Loop
logical :: ErrorInName
logical :: IsBlank
integer :: IOStat
integer :: SurfNum
integer :: ConstrNum
integer :: ScheduleNum
integer :: i
integer :: NumOfScheduledLayers
integer :: NumOfConstrLayers
logical :: NumOfLayersMatch
integer :: iZone
!-----------------------------------------------------------------------
! SurfaceProperty:SolarIncidentInside
!-----------------------------------------------------------------------
cCurrentModuleObject='SurfaceProperty:SolarIncidentInside'
! Check if IDD definition is correct
call GetObjectDefMaxArgs(cCurrentModuleObject,NumArgs,NumAlpha,NumNumeric)
if (NumAlpha /= 4) then
call ShowSevereError(RoutineName//trim(cCurrentModuleObject)//': Object Definition indicates '// &
'not = 4 Alpha Objects, Number Indicated='//trim(TrimSigDigits(NumAlpha)))
ErrorsFound=.true.
endif
TotSurfIncSolSSG = GetNumObjectsFound(cCurrentModuleObject)
if (TotSurfIncSolSSG > 0) then
if (.not.allocated(SurfIncSolSSG)) then
allocate(SurfIncSolSSG(TotSurfIncSolSSG))
end if
do Loop=1, TotSurfIncSolSSG
call GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlpha,rNumericArgs,NumNumeric,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
call VerifyName(cAlphaArgs(1),SurfIncSolSSG%Name,Loop,ErrorInName,IsBlank,trim(cCurrentModuleObject)//' Name')
if (ErrorInName) then
call ShowContinueError('...each SurfaceProperty:SolarIncidentInside name must not duplicate other '//&
'SurfaceProperty:SolarIncidentInside name')
ErrorsFound=.true.
cycle
endif
SurfincSolSSG(Loop)%Name = cAlphaArgs(1)
! Assign surface number
SurfNum = FindIteminList(cAlphaArgs(2), Surface%Name, TotSurfaces)
if (SurfNum == 0) then
call ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//', object. Illegal value for '// &
trim(cAlphaFieldNames(2))//' has been found.')
call ShowContinueError(trim(cAlphaFieldNames(2))//' entered value = "'//trim(cAlphaArgs(2))// &
'" no corresponding surface (ref BuildingSurface:Detailed) has been found in the input file.')
ErrorsFound=.true.
else
SurfincSolSSG(Loop)%SurfPtr = SurfNum
end if
! Assign construction number
ConstrNum = FindIteminList(cAlphaArgs(3), Construct%Name, TotConstructs)
if (ConstrNum == 0) then
call ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//', object. Illegal value for '// &
trim(cAlphaFieldNames(3))//' has been found.')
call ShowContinueError(trim(cAlphaFieldNames(3))//' entered value = "'//trim(cAlphaArgs(3))// &
'" no corresponding construction (ref Construction) has been found in the input file.')
ErrorsFound=.true.
else
SurfincSolSSG(Loop)%ConstrPtr = ConstrNum
end if
! Assign schedule number
ScheduleNum = GetScheduleIndex(cAlphaArgs(4))
if (ScheduleNum == 0) then
call ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//', object. Illegal value for '// &
trim(cAlphaFieldNames(4))//' has been found.')
call ShowContinueError(trim(cAlphaFieldNames(4))//' entered value = "'//trim(cAlphaArgs(4))// &
'" no corresponding schedule has been found in the input file.')
ErrorsFound=.true.
else
SurfincSolSSG(Loop)%SchedPtr = ScheduleNum
end if
end do
end if
!-----------------------------------------------------------------------
! SurfaceProperty:SolarIncidentInside
!-----------------------------------------------------------------------
cCurrentModuleObject='ComplexFenestrationProperty:SolarAbsorbedLayers'
TotFenLayAbsSSG = GetNumObjectsFound(cCurrentModuleObject)
if (TotFenLayAbsSSG > 0) then
if (.not.allocated(FenLayAbsSSG)) then
allocate(FenLayAbsSSG(TotFenLayAbsSSG))
end if
do Loop=1, TotFenLayAbsSSG
call GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlpha,rNumericArgs,NumNumeric,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
call VerifyName(cAlphaArgs(1),FenLayAbsSSG%Name,Loop,ErrorInName,IsBlank,trim(cCurrentModuleObject)//' Name')
if (ErrorInName) then
call ShowContinueError('...each ComplexFenestrationProperty:SolarAbsorbedLayers name must not duplicate other '//&
'ComplexFenestrationProperty:SolarAbsorbedLayers name')
ErrorsFound=.true.
cycle
endif
FenLayAbsSSG(Loop)%Name = cAlphaArgs(1)
! Assign surface number
SurfNum = FindIteminList(cAlphaArgs(2), Surface%Name, TotSurfaces)
if (SurfNum == 0) then
call ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//', object. Illegal value for '// &
trim(cAlphaFieldNames(2))//' has been found.')
call ShowContinueError(trim(cAlphaFieldNames(2))//' entered value = "'//trim(cAlphaArgs(2))// &
'" no corresponding surface (ref BuildingSurface:Detailed) has been found in the input file.')
ErrorsFound=.true.
else
FenLayAbsSSG(Loop)%SurfPtr = SurfNum
end if
! Assign construction number
ConstrNum = FindIteminList(cAlphaArgs(3), Construct%Name, TotConstructs)
if (ConstrNum == 0) then
call ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//', object. Illegal value for '// &
trim(cAlphaFieldNames(3))//' has been found.')
call ShowContinueError(trim(cAlphaFieldNames(3))//' entered value = "'//trim(cAlphaArgs(3))// &
'" no corresponding construction (ref Construction) has been found in the input file.')
ErrorsFound=.true.
else
FenLayAbsSSG(Loop)%ConstrPtr = ConstrNum
NumOfScheduledLayers = NumAlpha - 3
NumOfLayersMatch = .false.
! Check if number of layers in construction matches number of layers in schedule surface gains object
if (NumOfScheduledLayers == Construct(ConstrNum)%TotSolidLayers) then
NumOfLayersMatch = .true.
end if
if (.not. NumOfLayersMatch) then
call ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//&
', object. Number of scheduled surface gains for each layer does not match number of layers'//&
' in referenced construction.')
call ShowContinueError(trim(cAlphaArgs(1))//' have '//trim(TrimSigDigits(NumOfScheduledLayers))//&
' scheduled layers and '//trim(cAlphaArgs(3))//' have '//trim(TrimSigDigits(Construct(ConstrNum)%TotSolidLayers))//&
' layers.')
ErrorsFound=.true.
end if
if (.not.allocated(FenLayAbsSSG(Loop)%SchedPtrs)) then
allocate(FenLayAbsSSG(Loop)%SchedPtrs(NumOfScheduledLayers))
end if
FenLayAbsSSG(Loop)%NumOfSched = NumOfScheduledLayers
do i = 1, NumOfScheduledLayers
ScheduleNum = GetScheduleIndex(cAlphaArgs(i + 3))
if (ScheduleNum == 0) then
call ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//&
', object. Illegal value for '//trim(cAlphaFieldNames(NumOfScheduledLayers + 3))//' has been found.')
call ShowContinueError(trim(cAlphaFieldNames(NumOfScheduledLayers + 3))//' entered value = "'//&
trim(cAlphaArgs(NumOfScheduledLayers + 3))//'" no corresponding schedule has been found in the input file.')
ErrorsFound=.true.
else
FenLayAbsSSG(Loop)%SchedPtrs(i) = ScheduleNum
end if
end do
end if
end do
end if
! Check if scheduled surface gains are assigined to each surface in every zone. If not then warning message to user will be
! issued
if ((TotSurfIncSolSSG > 0).or.(TotFenLayAbsSSG > 0)) then
do iZone = 1, NumOfZones
call CheckScheduledSurfaceGains(iZone)
end do
end if
END SUBROUTINE GetScheduledSurfaceGains