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.
SUBROUTINE CalcZoneAirComfortSetpoints
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN May 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine sets the thermal comfort setpoints for each controlled zone based on air tempeature
! obtained from thermal comfort models.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE General, ONLY: TrimSigDigits
USE ThermalComfort, ONLY: ManageThermalComfort
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: RelativeZoneNum
INTEGER :: ActualZoneNum
INTEGER :: ComfortControlSchedIndex
INTEGER :: SetPointComfortSchedIndex
INTEGER :: SetPointComfortSchedIndexHot
INTEGER :: SetPointComfortSchedIndexCold
INTEGER :: SchedNameIndex
INTEGER :: SchedTypeIndex
INTEGER :: PeopleNum
INTEGER :: ObjectCount
REAL(r64) :: PeopleCount
REAL(r64) :: SetPointLo
REAL(r64) :: SetPointHi
REAL(r64) :: NumberOccupants
REAL(r64) :: Tset
LOGICAL,SAVE :: FirstTimeFlag = .TRUE. ! Flag set to make sure you get input once
! FLOW:
! Call thermal comfort module to read zone control comfort object
IF (FirstTimeFlag) THEN
CALL ManageThermalComfort(InitializeOnly=.true.)
FirstTimeFlag = .FALSE.
END IF
ComfortControlType = 0 ! Default
DO RelativeZoneNum = 1, NumComfortControlledZones
ActualZoneNum = ComfortControlledZone(RelativeZoneNum)%ActualZoneNum
ComfortControlSchedIndex = ComfortControlledZone(RelativeZoneNum)%ComfortSchedIndex
ComfortControlType(ActualZoneNum) = GetCurrentScheduleValue(ComfortControlSchedIndex)
! Get PMV values
SELECT CASE (ComfortControlType(ActualZoneNum)) ! Is this missing the possibility of sometimes having no control on a zone
! during the simulation?
CASE (0) ! Uncontrolled for thermal comfort
ZoneComfortControlsFanger(ActualZoneNum)%LowPMV = -999.0d0
ZoneComfortControlsFanger(ActualZoneNum)%HighPMV = -999.0d0
CASE (SglHeatSetPointFanger)
SchedNameIndex = ComfortControlledZone(RelativeZoneNum)%SchIndx_SglHeatSetPointFanger
SchedTypeIndex = ComfortControlledZone(RelativeZoneNum)%ControlTypeSchIndx(SchedNameIndex)
SetPointComfortSchedIndex = SetPointSingleHeatingFanger(SchedTypeIndex)%PMVSchedIndex
ZoneComfortControlsFanger(ActualZoneNum)%FangerType = SglHeatSetPointFanger
ZoneComfortControlsFanger(ActualZoneNum)%LowPMV = GetCurrentScheduleValue(SetPointComfortSchedIndex)
ZoneComfortControlsFanger(ActualZoneNum)%HighPMV = -999.0d0
CASE (SglCoolSetPointFanger)
SchedNameIndex = ComfortControlledZone(RelativeZoneNum)%SchIndx_SglCoolSetPointFanger
SchedTypeIndex = ComfortControlledZone(RelativeZoneNum)%ControlTypeSchIndx(SchedNameIndex)
SetPointComfortSchedIndex = SetPointSingleCoolingFanger(SchedTypeIndex)%PMVSchedIndex
ZoneComfortControlsFanger(ActualZoneNum)%FangerType = SglCoolSetPointFanger
ZoneComfortControlsFanger(ActualZoneNum)%LowPMV = -999.0d0
ZoneComfortControlsFanger(ActualZoneNum)%HighPMV = GetCurrentScheduleValue(SetPointComfortSchedIndex)
CASE (SglHCSetPointFanger)
SchedNameIndex = ComfortControlledZone(RelativeZoneNum)%SchIndx_SglHCSetPointFanger
SchedTypeIndex = ComfortControlledZone(RelativeZoneNum)%ControlTypeSchIndx(SchedNameIndex)
SetPointComfortSchedIndex = SetPointSingleHeatCoolFanger(SchedTypeIndex)%PMVSchedIndex
ZoneComfortControlsFanger(ActualZoneNum)%FangerType = SglHCSetPointFanger
ZoneComfortControlsFanger(ActualZoneNum)%LowPMV = GetCurrentScheduleValue(SetPointComfortSchedIndex)
ZoneComfortControlsFanger(ActualZoneNum)%HighPMV = GetCurrentScheduleValue(SetPointComfortSchedIndex)
CASE (DualSetPointFanger)
SchedNameIndex = ComfortControlledZone(RelativeZoneNum)%SchIndx_DualSetPointFanger
SchedTypeIndex = ComfortControlledZone(RelativeZoneNum)%ControlTypeSchIndx(SchedNameIndex)
SetPointComfortSchedIndexHot = SetPointDualHeatCoolFanger(SchedTypeIndex)%HeatPMVSchedIndex
SetPointComfortSchedIndexCold = SetPointDualHeatCoolFanger(SchedTypeIndex)%CoolPMVSchedIndex
ZoneComfortControlsFanger(ActualZoneNum)%FangerType = DualSetPointFanger
ZoneComfortControlsFanger(ActualZoneNum)%LowPMV = GetCurrentScheduleValue(SetPointComfortSchedIndexHot)
ZoneComfortControlsFanger(ActualZoneNum)%HighPMV = GetCurrentScheduleValue(SetPointComfortSchedIndexCold)
If (ZoneComfortControlsFanger(ActualZoneNum)%LowPMV > ZoneComfortControlsFanger(ActualZoneNum)%HighPMV) then
ZoneComfortControlsFanger(ActualZoneNum)%DualPMVErrCount = ZoneComfortControlsFanger(ActualZoneNum)%DualPMVErrCount + 1
if (ZoneComfortControlsFanger(ActualZoneNum)%DualPMVErrCount < 2) then
CALL ShowWarningError('ThermostatSetpoint:ThermalComfort:Fanger:DualSetpoint: The heating PMV setpoint is above '// &
'the cooling PMV setpoint in '//TRIM(SetPointDualHeatCoolFanger(SchedTypeIndex)%Name))
CALL ShowContinueError('The zone dual heating PMV setpoint is set to the dual cooling PMV setpoint.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
else
CALL ShowRecurringWarningErrorAtEnd('The heating PMV setpoint is still above '// &
'the cooling PMV setpoint',ZoneComfortControlsFanger(ActualZoneNum)%DualPMVErrIndex, &
ZoneComfortControlsFanger(ActualZoneNum)%LowPMV, ZoneComfortControlsFanger(ActualZoneNum)%LowPMV)
end if
ZoneComfortControlsFanger(ActualZoneNum)%LowPMV = ZoneComfortControlsFanger(ActualZoneNum)%HighPMV
End If
CASE DEFAULT
CALL ShowSevereError('CalcZoneAirTempSetpoints: Illegal thermal control control type for Zone='// &
TRIM(Zone(ActualZoneNum)%Name)// &
', Found value='//TRIM(TrimSigDigits(ComfortControlType(ActualZoneNum)))// &
', in Schedule='//TRIM(COmfortControlledZone(RelativeZoneNum)%ControlTypeSchedName))
END SELECT
! Check Average method
SELECT CASE (ComfortControlledZone(RelativeZoneNum)%AverageMethodNum)
CASE (AverageMethodNum_NO)
PeopleNum = ComfortControlledZone(RelativeZoneNum)%SpecificObjectNum
If (ComfortControlType(ActualZoneNum) == SglCoolSetPointFanger) then
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%HighPMV,SetPointLo)
Else
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%LowPMV,SetPointLo)
End If
If (ComfortControlType(ActualZoneNum) == DualSetPointFanger) &
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%HighPMV,SetPointHi)
CASE (AverageMethodNum_SPE)
PeopleNum = ComfortControlledZone(RelativeZoneNum)%SpecificObjectNum
If (ComfortControlType(ActualZoneNum) == SglCoolSetPointFanger) then
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%HighPMV,SetPointLo)
Else
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%LowPMV,SetPointLo)
End If
If (ComfortControlType(ActualZoneNum) == DualSetPointFanger) &
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%HighPMV,SetPointHi)
CASE (AverageMethodNum_OBJ)
ObjectCount = 0
SetPointLo = 0.0d0
SetPointHi = 0.0d0
Do PeopleNum=1,TotPeople
If (ActualZoneNum == People(PeopleNum)%ZonePtr) then
ObjectCount=ObjectCount+1
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%LowPMV,Tset)
SetPointLo = SetPointLo + Tset
If (ComfortControlType(ActualZoneNum) == DualSetPointFanger) then
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%HighPMV,Tset)
SetPointHi = SetPointHi + Tset
End If
End IF
End Do
SetPointLo = SetPointLo/ObjectCount
If (ComfortControlType(ActualZoneNum) == DualSetPointFanger) SetPointHi = SetPointHi/ObjectCount
CASE (AverageMethodNum_PEO)
PeopleCount = 0.0d0
SetPointLo = 0.0d0
SetPointHi = 0.0d0
Do PeopleNum=1,TotPeople
If (ActualZoneNum == People(PeopleNum)%ZonePtr) then
NumberOccupants = People(PeopleNum)%NumberOfPeople * GetCurrentScheduleValue(People(PeopleNum)%NumberOfPeoplePtr)
PeopleCount=PeopleCount+NumberOccupants
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%LowPMV,Tset)
SetPointLo = SetPointLo + Tset*NumberOccupants
If (ComfortControlType(ActualZoneNum) == DualSetPointFanger) then
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%HighPMV,Tset)
SetPointHi = SetPointHi+ Tset*NumberOccupants
End If
End If
End Do
If (PeopleCount > 0) then
SetPointLo = SetPointLo/PeopleCount
If (ComfortControlType(ActualZoneNum) == DualSetPointFanger) SetPointHi = SetPointHi/PeopleCount
Else
! reccurring warnings
! ComfortControlledZone(RelativeZoneNum)%PeopleAverageErrCount = &
! ComfortControlledZone(RelativeZoneNum)%PeopleAverageErrCount + 1
if (ComfortControlledZone(RelativeZoneNum)%PeopleAverageErrIndex == 0) then
Call ShowWarningMessage('ZoneControl:Thermostat:ThermalComfort: The total number of people in Zone = '// &
Trim(Zone(ActualZoneNum)%Name)//' is zero. The People Average option is not used.')
Call ShowContinueError('The Object Average option is used instead. Simulation continues .....')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
end if
Call ShowRecurringWarningErrorAtEnd('ZoneControl:Thermostat:ThermalComfort: The total number of people in Zone = '// &
Trim(Zone(ActualZoneNum)%Name)//' is still zero. The People Average option is not used', &
ComfortControlledZone(RelativeZoneNum)%PeopleAverageErrIndex, PeopleCount, PeopleCount)
ObjectCount = 0
SetPointLo = 0.0d0
SetPointHi = 0.0d0
Do PeopleNum=1,TotPeople
If (ActualZoneNum == People(PeopleNum)%ZonePtr) then
ObjectCount=ObjectCount+1
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%LowPMV,Tset)
SetPointLo = SetPointLo + Tset
If (ComfortControlType(ActualZoneNum) == DualSetPointFanger) then
CALL GetComfortSetpoints(PeopleNum, RelativeZoneNum, ZoneComfortControlsFanger(ActualZoneNum)%HighPMV,Tset)
SetPointHi = SetPointHi + Tset
End If
End IF
End Do
SetPointLo = SetPointLo/ObjectCount
If (ComfortControlType(ActualZoneNum) == DualSetPointFanger) SetPointHi = SetPointHi/ObjectCount
End If
END SELECT
! Assign setpoint
SELECT CASE (ComfortControlType(ActualZoneNum)) ! Is this missing the possibility of sometimes having no control on a zone
! during the simulation?
CASE (0) ! Uncontrolled for thermal comfort
SELECT CASE (TempControlType(ActualZoneNum))
CASE (SingleHeatingSetPoint)
ZoneThermostatSetPointHi(ActualZoneNum) = 0.0d0
CASE (SingleCoolingSetPoint)
ZoneThermostatSetPointLo(ActualZoneNum) = 0.0d0
END SELECT
CASE (SglHeatSetPointFanger)
If (SetPointLo < ComfortControlledZone(RelativeZoneNum)%TdbMinSetPoint) then
SetPointLo = ComfortControlledZone(RelativeZoneNum)%TdbMinSetPoint
! ComfortControlledZone(RelativeZoneNum)%TdbMinErrCount = ComfortControlledZone(RelativeZoneNum)%TdbMinErrCount + 1
if (ComfortControlledZone(RelativeZoneNum)%TdbMinErrIndex < 2) then
CALL ShowWarningMessage('ThermostatSetpoint:ThermalComfort:Fanger:SingleHeating temperature is below '// &
'the Minimum dry-bulb temperature setpoint '//TRIM(ComfortControlledZone(RelativeZoneNum)%Name))
CALL ShowContinueError('The zone heating setpoint is set to the Minimum dry-bulb temperature setpoint')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
end if
CALL ShowRecurringWarningErrorAtEnd('ThermostatSetpoint:ThermalComfort:Fanger:SingleHeating temperature is still'// &
' below the Minimum dry-bulb temperature setpoint ...', &
ComfortControlledZone(RelativeZoneNum)%TdbMinErrIndex, SetPointLo, SetPointLo)
End If
TempZoneThermostatSetPoint(ActualZoneNum) = SetPointLo
ZoneThermostatSetPointLo(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
TempControlType(ActualZoneNum) = SingleHeatingSetPoint
CASE (SglCoolSetPointFanger)
If (SetPointLo > ComfortControlledZone(RelativeZoneNum)%TdbMaxSetPoint) then
SetPointLo = ComfortControlledZone(RelativeZoneNum)%TdbMaxSetPoint
! ComfortControlledZone(RelativeZoneNum)%TdbMaxErrCount = ComfortControlledZone(RelativeZoneNum)%TdbMaxErrCount + 1
if (ComfortControlledZone(RelativeZoneNum)%TdbMaxErrIndex == 0) then
CALL ShowWarningMessage('ThermostatSetpoint:ThermalComfort:Fanger:SingleCooling temperature is above '// &
'the Maximum dry-bulb temperature setpoint '//TRIM(ComfortControlledZone(RelativeZoneNum)%Name))
CALL ShowContinueError('The zone cooling setpoint is set to the Maximum dry-bulb temperature setpoint')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
end if
CALL ShowRecurringWarningErrorAtEnd('ThermostatSetpoint:ThermalComfort:Fanger:SingleCooling temperature is still'// &
' above the Maximum dry-bulb temperature setpoint ...', &
ComfortControlledZone(RelativeZoneNum)%TdbMaxErrIndex, SetPointLo, SetPointLo)
End If
TempZoneThermostatSetPoint(ActualZoneNum) = SetPointLo
ZoneThermostatSetPointHi(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
TempControlType(ActualZoneNum) = SingleCoolingSetPoint
CASE (SglHCSetPointFanger)
If (ComfortControlledZone(RelativeZoneNum)%TdbMaxSetPoint == ComfortControlledZone(RelativeZoneNum)%TdbMinSetPoint) then
SetPointLo = ComfortControlledZone(RelativeZoneNum)%TdbMaxSetPoint
End If
If (SetPointLo > ComfortControlledZone(RelativeZoneNum)%TdbMaxSetPoint) &
SetPointLo = ComfortControlledZone(RelativeZoneNum)%TdbMaxSetPoint
If (SetPointLo < ComfortControlledZone(RelativeZoneNum)%TdbMinSetPoint) &
SetPointLo = ComfortControlledZone(RelativeZoneNum)%TdbMinSetPoint
If (SetPointLo < ComfortControlledZone(RelativeZoneNum)%TdbMinSetPoint .or. &
SetPointLo > ComfortControlledZone(RelativeZoneNum)%TdbMaxSetPoint) then
! ComfortControlledZone(RelativeZoneNum)%TdbHCErrCount = ComfortControlledZone(RelativeZoneNum)%TdbHCErrCount + 1
if (ComfortControlledZone(RelativeZoneNum)%TdbHCErrIndex == 0) then
CALL ShowWarningMessage('ThermostatSetpoint:ThermalComfort:Fanger:SingleHeatingOrCooling temperature is above '// &
'the Maximum or below the Minimum dry-bulb temperature setpoint '// &
TRIM(ComfortControlledZone(RelativeZoneNum)%Name))
CALL ShowContinueError('The zone setpoint is set to the Maximum dry-bulb temperature setpoint if above or ' &
//'the Minimum dry-bulb temperature setpoint if below')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
end if
CALL ShowRecurringWarningErrorAtEnd('ThermostatSetpoint:ThermalComfort:Fanger:SingleHeatingOrCooling '// &
'temperature is still beyond the range between Maximum and Minimum dry-bulb temperature setpoint ...', &
ComfortControlledZone(RelativeZoneNum)%TdbHCErrIndex, SetPointLo, SetPointLo)
End If
TempZoneThermostatSetPoint(ActualZoneNum) = SetPointLo
ZoneThermostatSetPointHi(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
ZoneThermostatSetPointLo(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
TempControlType(ActualZoneNum) = SingleHeatCoolSetPoint
CASE (DualSetPointFanger)
If (SetPointLo < ComfortControlledZone(RelativeZoneNum)%TdbMinSetPoint) then
SetPointLo = ComfortControlledZone(RelativeZoneNum)%TdbMinSetPoint
! ComfortControlledZone(RelativeZoneNum)%TdbDualMinErrCount = ComfortControlledZone(RelativeZoneNum)%TdbDualMinErrCount+1
if (ComfortControlledZone(RelativeZoneNum)%TdbDualMinErrIndex == 0) then
CALL ShowWarningMessage('ThermostatSetpoint:ThermalComfort:Fanger:DualSetpoint temperature is below '// &
'the Minimum dry-bulb temperature setpoint '//TRIM(ComfortControlledZone(RelativeZoneNum)%Name))
CALL ShowContinueError('The zone dual heating setpoint is set to the Minimum dry-bulb temperature setpoint')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
end if
CALL ShowRecurringWarningErrorAtEnd('ThermostatSetpoint:ThermalComfort:Fanger:DualSetpoint temperature is still'// &
' below the Minimum dry-bulb temperature setpoint ...', &
ComfortControlledZone(RelativeZoneNum)%TdbDualMinErrIndex, SetPointLo, SetPointLo)
End If
If (SetPointHi > ComfortControlledZone(RelativeZoneNum)%TdbMaxSetPoint) then
SetPointHi = ComfortControlledZone(RelativeZoneNum)%TdbMaxSetPoint
! ComfortControlledZone(RelativeZoneNum)%TdbDualMaxErrCount = ComfortControlledZone(RelativeZoneNum)%TdbDualMaxErrCount + 1
if (ComfortControlledZone(RelativeZoneNum)%TdbDualMaxErrIndex == 0) then
CALL ShowWarningMessage('ThermostatSetpoint:ThermalComfort:Fanger:DualSetpoint temperature is above '// &
'the Maximum dry-bulb temperature setpoint '//TRIM(ComfortControlledZone(RelativeZoneNum)%Name))
CALL ShowContinueError('The zone dual cooling setpoint is set to the Maximum dry-bulb temperature setpoint')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
end if
CALL ShowRecurringWarningErrorAtEnd('ThermostatSetpoint:ThermalComfort:Fanger:DualSetpoint temperature is still'// &
' above the Maximum dry-bulb temperature setpoint ...', &
ComfortControlledZone(RelativeZoneNum)%TdbDualMaxErrIndex, SetPointLo, SetPointLo)
End If
ZoneThermostatSetPointLo(ActualZoneNum) = SetPointLo
ZoneThermostatSetPointHi(ActualZoneNum) = SetPointHi
TempControlType(ActualZoneNum) = DualSetPointWithDeadBand
CASE DEFAULT
CALL ShowSevereError('CalcZoneAirComfortSetpoints: Illegal thermal control control type for Zone='// &
TRIM(Zone(ActualZoneNum)%Name)// &
', Found value='//TRIM(TrimSigDigits(ComfortControlType(ActualZoneNum)))// &
', in Schedule='//TRIM(ComfortControlledZone(ActualZoneNum)%ControlTypeSchedName))
END SELECT
END DO
RETURN
END SUBROUTINE CalcZoneAirComfortSetpoints