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 InitZoneAirSetpoints
! SUBROUTINE INFORMATION:
! AUTHOR Russell Taylor
! DATE WRITTEN September 1998
! MODIFIED November 2004, M. J. Witte additional report variables
! MODIFIED L.Gu, May 2006
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes the data for the zone air setpoints.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger events.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEquipment, ONLY: ZoneEquipConfig, ZoneEquipInputsFilled
USE DataSurfaces, ONLY: Surface
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='InitZoneAirSetpoints: '
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Loop, ZoneNum
LOGICAL,SAVE :: MyOneTimeFlag = .TRUE.
LOGICAL,SAVE :: MyEnvrnFlag = .TRUE.
LOGICAL,SAVE :: MyDayFlag = .TRUE.
LOGICAL, SAVE :: ErrorsFound=.false.
LOGICAL, SAVE :: ControlledZonesChecked=.false.
LOGICAL :: FirstSurfFlag
INTEGER :: TRefFlag ! Flag for Reference Temperature process in Zones
INTEGER :: SurfNum
! FLOW:
IF (MyOneTimeFlag) THEN
ALLOCATE(TempZoneThermostatSetPoint(NumOfZones))
TempZoneThermostatSetPoint=0.0d0
ALLOCATE(ZoneThermostatSetPointHi(NumOfZones))
ZoneThermostatSetPointHi=0.0d0
ALLOCATE(ZoneThermostatSetPointLo(NumOfZones))
ZoneThermostatSetPointLo=0.0d0
ALLOCATE(LoadCorrectionFactor(NumOfZones)) !PH 3/3/04
LoadCorrectionFactor=0.0d0
ALLOCATE(TempControlType(NumOfZones))
TempControlType=0
If (NumComfortControlledZones > 0) then
ALLOCATE(ComfortControlType(NumOfZones))
ComfortControlType=0
ALLOCATE(ZoneComfortControlsFanger(NumOfZones))
End If
ALLOCATE(ZoneSetPointLast(NumOfZones))
ZoneSetPointLast=0.0d0
ALLOCATE(Setback(NumOfZones))
Setback=.false.
ALLOCATE(DeadbandOrSetback(NumOfZones))
DeadbandOrSetback=.false.
ALLOCATE(CurDeadbandOrSetback(NumOfZones))
CurDeadbandOrSetback=.false.
ALLOCATE(SNLoadHeatEnergy(NumOfZones))
SNLoadHeatEnergy=0.0d0
ALLOCATE(SNLoadCoolEnergy(NumOfZones))
SNLoadCoolEnergy=0.0d0
ALLOCATE(SNLoadHeatRate(NumOfZones))
SNLoadHeatRate=0.0d0
ALLOCATE(SNLoadCoolRate(NumOfZones))
SNLoadCoolRate=0.0d0
ALLOCATE(SNLoadPredictedRate(NumOfZones))
SNLoadPredictedRate=0.0d0
ALLOCATE(SNLoadPredictedHSPRate(NumOfZones))
SNLoadPredictedHSPRate=0.0d0
ALLOCATE(SNLoadPredictedCSPRate(NumOfZones))
SNLoadPredictedCSPRate=0.0d0
ALLOCATE(MoisturePredictedRate(NumOfZones))
MoisturePredictedRate=0.0d0
ALLOCATE(WZoneTimeMinus1(NumOfZones))
WZoneTimeMinus1=0.0d0
ALLOCATE(WZoneTimeMinus2(NumOfZones))
WZoneTimeMinus2=0.0d0
ALLOCATE(WZoneTimeMinus3(NumOfZones))
WZoneTimeMinus3=0.0d0
ALLOCATE(WZoneTimeMinus4(NumOfZones))
WZoneTimeMinus4=0.0d0
ALLOCATE(DSWZoneTimeMinus1(NumOfZones))
DSWZoneTimeMinus1=0.0d0
ALLOCATE(DSWZoneTimeMinus2(NumOfZones))
DSWZoneTimeMinus2=0.0d0
ALLOCATE(DSWZoneTimeMinus3(NumOfZones))
DSWZoneTimeMinus3=0.0d0
ALLOCATE(DSWZoneTimeMinus4(NumOfZones))
DSWZoneTimeMinus4=0.0d0
ALLOCATE(ZoneAirHumRatTemp(NumOfZones))
ZoneAirHumRatTemp=0.0d0
ALLOCATE(WZoneTimeMinus1Temp(NumOfZones))
WZoneTimeMinus1Temp=0.0d0
ALLOCATE(WZoneTimeMinus2Temp(NumOfZones))
WZoneTimeMinus2Temp=0.0d0
ALLOCATE(WZoneTimeMinus3Temp(NumOfZones))
WZoneTimeMinus3Temp=0.0d0
ALLOCATE(WZoneTimeMinusP(NumOfZones))
WZoneTimeMinusP=0.0d0
ALLOCATE(TempIndZnLd(NumOfZones))
TempIndZnLd=0.0d0
ALLOCATE(TempDepZnLd(NumOfZones))
TempDepZnLd=0.0d0
ALLOCATE(NonAirSystemResponse(NumOfZones))
NonAirSystemResponse=0.0d0
ALLOCATE(SysDepZoneLoads(NumOfZones))
SysDepZoneLoads=0.0d0
ALLOCATE(SysDepZoneLoadsLagged(NumOfZones))
SysDepZoneLoadsLagged=0.0d0
ALLOCATE(ZoneAirRelHum(NumOfZones))
ZoneAirRelHum=0.0d0
ALLOCATE(ZoneWMX(NumOfZones))
ZoneWMX = 0.0d0
ALLOCATE(ZoneWM2(NumOfZones))
ZoneWM2 = 0.0d0
ALLOCATE(ZoneT1(NumOfZones))
ZoneT1=0.0d0
ALLOCATE(ZoneW1(NumOfZones))
ZoneW1=0.0d0
ALLOCATE(ListSNLoadHeatEnergy(NumOfZoneLists))
ListSNLoadHeatEnergy=0.0d0
ALLOCATE(ListSNLoadCoolEnergy(NumOfZoneLists))
ListSNLoadCoolEnergy=0.0d0
ALLOCATE(ListSNLoadHeatRate(NumOfZoneLists))
ListSNLoadHeatRate=0.0d0
ALLOCATE(ListSNLoadCoolRate(NumOfZoneLists))
ListSNLoadCoolRate=0.0d0
ALLOCATE(GroupSNLoadHeatEnergy(NumOfZoneGroups))
GroupSNLoadHeatEnergy=0.0d0
ALLOCATE(GroupSNLoadCoolEnergy(NumOfZoneGroups))
GroupSNLoadCoolEnergy=0.0d0
ALLOCATE(GroupSNLoadHeatRate(NumOfZoneGroups))
GroupSNLoadHeatRate=0.0d0
ALLOCATE(GroupSNLoadCoolRate(NumOfZoneGroups))
GroupSNLoadCoolRate=0.0d0
ALLOCATE(AIRRAT(NumOfZones))
AIRRAT = 0.0d0
ALLOCATE(ZTM1(NumOfZones))
ZTM1 = 0.0d0
ALLOCATE(ZTM2(NumOfZones))
ZTM2 = 0.0d0
ALLOCATE(ZTM3(NumOfZones))
ZTM3 = 0.0d0
! Allocate Derived Types
ALLOCATE(ZoneSysEnergyDemand(NumOfZones))
ALLOCATE(ZoneSysMoistureDemand(NumOfZones))
DO Loop = 1, NumOfZones
FirstSurfFlag=.true.
DO SurfNum = Zone(Loop)%SurfaceFirst,Zone(Loop)%SurfaceLast
IF (.NOT. Surface(SurfNum)%HeatTransSurf) CYCLE ! Skip non-heat transfer surfaces
IF (FirstSurfFlag) THEN
TrefFlag = Surface(SurfNum)%TAirRef
FirstSurfFlag=.false.
END IF
! for each particular zone, the reference air temperature(s) should be the same
! (either mean air, bulk air, or supply air temp).
IF (Surface(SurfNum)%TAirRef /= TrefFlag) THEN
CALL ShowWarningError('Different reference air temperatures for difference surfaces encountered in zone '// &
TRIM(Zone(Loop)%Name))
END IF
ENDDO
ENDDO
! CurrentModuleObject='Zone'
DO Loop = 1, NumOfZones
CALL SetupOutputVariable('Zone Air System Sensible Heating Energy [J]',SNLoadHeatEnergy(Loop), &
'System','Sum',Zone(Loop)%Name,ResourceTypeKey='ENERGYTRANSFER', &
EndUseKey='Heating',GroupKey='Building',ZoneKey=Zone(Loop)%Name, &
ZoneMult=Zone(Loop)%Multiplier, &
ZoneListMult=Zone(Loop)%ListMultiplier)
CALL SetupOutputVariable('Zone Air System Sensible Cooling Energy [J]',SNLoadCoolEnergy(Loop), &
'System','Sum',Zone(Loop)%Name,ResourceTypeKey='ENERGYTRANSFER', &
EndUseKey='Cooling',GroupKey='Building',ZoneKey=Zone(Loop)%Name, &
ZoneMult=Zone(Loop)%Multiplier, &
ZoneListMult=Zone(Loop)%ListMultiplier)
CALL SetupOutputVariable('Zone Air System Sensible Heating Rate [W]',SNLoadHeatRate(Loop),'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Air System Sensible Cooling Rate [W]',SNLoadCoolRate(Loop),'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Air Temperature [C]',Zt(Loop),'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Thermostat Air Temperature [C]',TempTstatAir(Loop),'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Air Humidity Ratio []',ZoneAirHumRat(Loop),'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Air Relative Humidity [%]',ZoneAirRelHum(Loop),'System', &
'Average',Zone(Loop)%Name)
! This output variable is for the predicted Heating/Cooling load for the zone which can be compared to actual load
! These report variables are not multiplied by zone and group multipliers
CALL SetupOutputVariable('Zone Predicted Sensible Load to Setpoint Heat Transfer Rate [W]', SNLoadPredictedRate(Loop), &
'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Predicted Sensible Load to Heating Setpoint Heat Transfer Rate [W]', &
SNLoadPredictedHSPRate(Loop), &
'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Predicted Sensible Load to Cooling Setpoint Heat Transfer Rate [W]', &
SNLoadPredictedCSPRate(Loop), &
'System','Average',Zone(Loop)%Name)
! This output variable is for the predicted moisture load for the zone with humidity controlled specified.
CALL SetupOutputVariable('Zone Predicted Moisture Load Moisture Transfer Rate [kgWater/s]', MoisturePredictedRate(Loop), &
'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Predicted Moisture Load to Humidifying Setpoint Moisture Transfer Rate [kgWater/s]', &
ZoneSysMoistureDemand(Loop)%OutputRequiredToHumidifyingSP,'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Predicted Moisture Load to Dehumidifying Setpoint Moisture Transfer Rate [kgWater/s]', &
ZoneSysMoistureDemand(Loop)%OutputRequiredToDehumidifyingSP,'System','Average',Zone(Loop)%Name)
! Zone thermostat setpoints
CALL SetupOutputVariable('Zone Thermostat Control Type []', &
TempControlType(Loop), &
'Zone','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Thermostat Heating Setpoint Temperature [C]', &
ZoneThermostatSetPointLo(Loop), &
'Zone','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Thermostat Cooling Setpoint Temperature [C]', &
ZoneThermostatSetPointHi(Loop), &
'Zone','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Predicted Sensible Load Room Air Correction Factor [ ]', &
LoadCorrectionFactor(loop), &
'System','Average',Zone(Loop)%Name)
If (ALLOCATED(StageZoneLogic)) Then
If (StageZoneLogic(Loop)) Then
CALL SetupOutputVariable('Zone Thermostat Staged Number []', &
ZoneSysEnergyDemand(Loop)%StageNum,'System','Average',Zone(Loop)%Name)
End If
End If
END DO ! Loop
! Thermal comfort control output
If (NumComfortControlledZones > 0) then
! CurrentModuleObject='ZoneControl:Thermostat:ThermalComfort'
DO Loop = 1, NumComfortControlledZones
ZoneNum = ComfortControlledZone(Loop)%ActualZoneNum
CALL SetupOutputVariable('Zone Thermal Comfort Control Type []', &
ComfortControlType(ZoneNum), 'Zone','Average',Zone(ZoneNum)%Name)
CALL SetupOutputVariable('Zone Thermal Comfort Control Fanger Low Setpoint PMV []', &
ZoneComfortControlsFanger(ZoneNum)%LowPMV, 'Zone','Average',Zone(ZoneNum)%Name)
CALL SetupOutputVariable('Zone Thermal Comfort Control Fanger High Setpoint PMV []', &
ZoneComfortControlsFanger(ZoneNum)%HighPMV, 'Zone','Average',Zone(ZoneNum)%Name)
END DO
End If
! CurrentModuleObject='ZoneList'
DO Loop = 1, NumOfZoneLists
CALL SetupOutputVariable('Zone List Sensible Heating Energy [J]',ListSNLoadHeatEnergy(Loop), &
'System','Sum',ZoneList(Loop)%Name)
CALL SetupOutputVariable('Zone List Sensible Cooling Energy [J]',ListSNLoadCoolEnergy(Loop), &
'System','Sum',ZoneList(Loop)%Name)
CALL SetupOutputVariable('Zone List Sensible Heating Rate [W]',ListSNLoadHeatRate(Loop),'System','Average', &
ZoneList(Loop)%Name)
CALL SetupOutputVariable('Zone List Sensible Cooling Rate [W]',ListSNLoadCoolRate(Loop),'System','Average', &
ZoneList(Loop)%Name)
END DO ! Loop
! CurrentModuleObject='ZoneGroup'
DO Loop = 1, NumOfZoneGroups
CALL SetupOutputVariable('Zone Group Sensible Heating Energy [J]',GroupSNLoadHeatEnergy(Loop), &
'System','Sum',ZoneGroup(Loop)%Name)
CALL SetupOutputVariable('Zone Group Sensible Cooling Energy [J]',GroupSNLoadCoolEnergy(Loop), &
'System','Sum',ZoneGroup(Loop)%Name)
CALL SetupOutputVariable('Zone Group Sensible Heating Rate [W]',GroupSNLoadHeatRate(Loop),'System','Average', &
ZoneGroup(Loop)%Name)
CALL SetupOutputVariable('Zone Group Sensible Cooling Rate [W]',GroupSNLoadCoolRate(Loop),'System','Average', &
ZoneGroup(Loop)%Name)
END DO ! Loop
MyOneTimeFlag = .FALSE.
END IF
! Do the Begin Environment initializations
IF (MyEnvrnFlag .AND. BeginEnvrnFlag) THEN
AIRRAT = 0.0d0
ZTM1 = 0.0d0
ZTM2 = 0.0d0
ZTM3 = 0.0d0
WZoneTimeMinus1 = OutHumRat
WZoneTimeMinus2 = OutHumRat
WZoneTimeMinus3 = OutHumRat
WZoneTimeMinus4 = OutHumRat
WZoneTimeMinusP = OutHumRat
DSWZoneTimeMinus1 = OutHumRat
DSWZoneTimeMinus2 = OutHumRat
DSWZoneTimeMinus3 = OutHumRat
DSWZoneTimeMinus4 = OutHumRat
WZoneTimeMinus1Temp = 0.0d0
WZoneTimeMinus2Temp = 0.0d0
WZoneTimeMinus3Temp = 0.0d0
ZoneAirHumRatTemp = 0.0d0
TempZoneThermostatSetPoint = 0.0d0
ZoneThermostatSetPointHi = 0.0d0
ZoneThermostatSetPointLo = 0.0d0
LoadCorrectionFactor = 1.d0 !PH 3/3/04
TempControlType = 0
ZoneSysEnergyDemand(1:NumOfZones)%RemainingOutputRequired = 0.0d0
ZoneSysEnergyDemand(1:NumOfZones)%TotalOutputRequired = 0.0d0
ZoneSysMoistureDemand(1:NumOfZones)%RemainingOutputRequired = 0.0d0
ZoneSysMoistureDemand(1:NumOfZones)%TotalOutputRequired = 0.0d0
DO ZoneNum = 1, NumOfZones
IF (ALLOCATED(ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequired)) &
ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequired = 0.d0
IF (ALLOCATED(ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequiredToHeatingSP)) &
ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequiredToHeatingSP = 0.d0
IF (ALLOCATED(ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequiredToCoolingSP)) &
ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequiredToCoolingSP = 0.d0
IF (ALLOCATED(ZoneSysMoistureDemand(ZoneNum)%SequencedOutputRequired)) &
ZoneSysMoistureDemand(ZoneNum)%SequencedOutputRequired = 0.d0
IF (ALLOCATED(ZoneSysMoistureDemand(ZoneNum)%SequencedOutputRequiredToHumidSP)) &
ZoneSysMoistureDemand(ZoneNum)%SequencedOutputRequiredToHumidSP = 0.d0
IF (ALLOCATED(ZoneSysMoistureDemand(ZoneNum)%SequencedOutputRequiredToDehumidSP)) &
ZoneSysMoistureDemand(ZoneNum)%SequencedOutputRequiredToDehumidSP = 0.d0
ENDDO
DeadbandOrSetback = .FALSE.
SNLoadHeatEnergy = 0.0d0
SNLoadCoolEnergy = 0.0d0
SNLoadHeatRate = 0.0d0
SNLoadCoolRate = 0.0d0
SNLoadPredictedRate = 0.0d0
SNLoadPredictedHSPRate = 0.0d0
SNLoadPredictedCSPRate = 0.0d0
MoisturePredictedRate = 0.0d0
TempIndZnLd = 0.0d0
TempDepZnLd = 0.0d0
NonAirSystemResponse = 0.0d0
SysDepZoneLoads = 0.0d0
SysDepZoneLoadsLagged = 0.0d0
ZoneAirRelHum = 0.0d0
Zone%NoHeatToReturnAir = .FALSE.
ZoneT1 = 0.0d0
ZoneW1 = OutHumRat
ZoneWMX = OutHumRat
ZoneWM2 = OutHumRat
MyEnvrnFlag = .FALSE.
END IF
IF (.NOT. BeginEnvrnFlag) THEN
MyEnvrnFlag=.TRUE.
END IF
! Do the Begin Day initializations
IF (MyDayFlag .AND. BeginDayFlag) THEN
MyDayFlag=.FALSE.
END IF
IF (.NOT. BeginDayFlag) THEN
MyDayFlag=.TRUE.
END IF
DO Loop = 1, NumTempControlledZones
IF (ZoneEquipInputsFilled .and. .not. ControlledZonesChecked) THEN
IF (.not. VerifyControlledZoneForThermostat(TempControlledZone(Loop)%ZoneName)) THEN
CALL ShowSevereError(RoutineName//'Zone="'//TRIM(TempControlledZone(Loop)%ZoneName)//'" has specified a'// &
' Thermostatic control but is not a controlled zone.')
CALL ShowContinueError('...must have a ZoneHVAC:EquipmentConnections specification for this zone.')
ErrorsFound=.true.
ENDIF
ENDIF
IF (TempControlledZone(Loop)%ManageDemand) THEN
ZoneNum = TempControlledZone(Loop)%ActualZoneNum
SELECT CASE(TempControlType(ZoneNum))
CASE (0) ! Uncontrolled
CASE (SingleHeatingSetPoint)
IF (TempZoneThermostatSetPoint(ZoneNum) > TempControlledZone(Loop)%HeatingResetLimit) THEN
TempZoneThermostatSetPoint(ZoneNum) = TempControlledZone(Loop)%HeatingResetLimit
ZoneThermostatSetPointLo(ZoneNum) = TempZoneThermostatSetPoint(ZoneNum)
END IF
CASE (SingleCoolingSetPoint)
IF (TempZoneThermostatSetPoint(ZoneNum) < TempControlledZone(Loop)%CoolingResetLimit) THEN
TempZoneThermostatSetPoint(ZoneNum) = TempControlledZone(Loop)%CoolingResetLimit
ZoneThermostatSetPointHi(ZoneNum) = TempZoneThermostatSetPoint(ZoneNum)
END IF
CASE (SingleHeatCoolSetPoint)
IF ((TempZoneThermostatSetPoint(ZoneNum) > TempControlledZone(Loop)%HeatingResetLimit) &
.OR. (TempZoneThermostatSetPoint(ZoneNum) < TempControlledZone(Loop)%CoolingResetLimit)) THEN
TempControlType(ZoneNum) = DualSetPointWithDeadBand
ZoneThermostatSetPointLo(ZoneNum) = TempZoneThermostatSetPoint(ZoneNum)
ZoneThermostatSetPointHi(ZoneNum) = TempZoneThermostatSetPoint(ZoneNum)
IF (ZoneThermostatSetPointLo(ZoneNum) > TempControlledZone(Loop)%HeatingResetLimit) &
ZoneThermostatSetPointLo(ZoneNum) = TempControlledZone(Loop)%HeatingResetLimit
IF (ZoneThermostatSetPointHi(ZoneNum) < TempControlledZone(Loop)%CoolingResetLimit) &
ZoneThermostatSetPointHi(ZoneNum) = TempControlledZone(Loop)%CoolingResetLimit
END IF
CASE (DualSetPointWithDeadBand)
IF (ZoneThermostatSetPointLo(ZoneNum) > TempControlledZone(Loop)%HeatingResetLimit) &
ZoneThermostatSetPointLo(ZoneNum) = TempControlledZone(Loop)%HeatingResetLimit
IF (ZoneThermostatSetPointHi(ZoneNum) < TempControlledZone(Loop)%CoolingResetLimit) &
ZoneThermostatSetPointHi(ZoneNum) = TempControlledZone(Loop)%CoolingResetLimit
CASE DEFAULT
! Do nothing
END SELECT
END IF
END DO
DO Loop = 1, NumComfortControlledZones
IF (ZoneEquipInputsFilled .and. .not. ControlledZonesChecked) THEN
IF (.not. VerifyControlledZoneForThermostat(ComfortControlledZone(Loop)%ZoneName)) THEN
CALL ShowSevereError(RoutineName//'Zone="'//TRIM(ComfortControlledZone(Loop)%ZoneName)//'" has specified a'// &
' Comfort control but is not a controlled zone.')
CALL ShowContinueError('...must have a ZoneHVAC:EquipmentConnections specification for this zone.')
ErrorsFound=.true.
ENDIF
ENDIF
IF (ComfortControlledZone(Loop)%ManageDemand) THEN
ZoneNum = ComfortControlledZone(Loop)%ActualZoneNum
SELECT CASE(ComfortControlType(ZoneNum))
CASE (0) ! Uncontrolled
CASE (SglHeatSetPointFanger)
IF (TempZoneThermostatSetPoint(ZoneNum) >= ComfortControlledZone(Loop)%HeatingResetLimit) THEN
TempZoneThermostatSetPoint(ZoneNum) = ComfortControlledZone(Loop)%HeatingResetLimit
ZoneThermostatSetPointLo(ZoneNum) = TempZoneThermostatSetPoint(ZoneNum)
TempControlType(ZoneNum) = SingleHeatingSetPoint
END IF
CASE (SglCoolSetPointFanger)
IF (TempZoneThermostatSetPoint(ZoneNum) <= ComfortControlledZone(Loop)%CoolingResetLimit) THEN
TempZoneThermostatSetPoint(ZoneNum) = ComfortControlledZone(Loop)%CoolingResetLimit
ZoneThermostatSetPointHi(ZoneNum) = TempZoneThermostatSetPoint(ZoneNum)
TempControlType(ZoneNum) = SingleCoolingSetPoint
END IF
CASE (SglHCSetPointFanger)
IF ((TempZoneThermostatSetPoint(ZoneNum) >= ComfortControlledZone(Loop)%HeatingResetLimit) &
.OR. (TempZoneThermostatSetPoint(ZoneNum) <= ComfortControlledZone(Loop)%CoolingResetLimit)) THEN
TempControlType(ZoneNum) = DualSetPointWithDeadBand
ZoneThermostatSetPointLo(ZoneNum) = TempZoneThermostatSetPoint(ZoneNum)
ZoneThermostatSetPointHi(ZoneNum) = TempZoneThermostatSetPoint(ZoneNum)
IF (ZoneThermostatSetPointLo(ZoneNum) >= ComfortControlledZone(Loop)%HeatingResetLimit) &
ZoneThermostatSetPointLo(ZoneNum) = ComfortControlledZone(Loop)%HeatingResetLimit
IF (ZoneThermostatSetPointHi(ZoneNum) <= ComfortControlledZone(Loop)%CoolingResetLimit) &
ZoneThermostatSetPointHi(ZoneNum) = ComfortControlledZone(Loop)%CoolingResetLimit
END IF
CASE (DualSetPointFanger)
TempControlType(ZoneNum) = DualSetPointWithDeadBand
IF (ZoneThermostatSetPointLo(ZoneNum) >= ComfortControlledZone(Loop)%HeatingResetLimit) &
ZoneThermostatSetPointLo(ZoneNum) = ComfortControlledZone(Loop)%HeatingResetLimit
IF (ZoneThermostatSetPointHi(ZoneNum) <= ComfortControlledZone(Loop)%CoolingResetLimit) &
ZoneThermostatSetPointHi(ZoneNum) = ComfortControlledZone(Loop)%CoolingResetLimit
CASE DEFAULT
! Do nothing
END SELECT
END IF !Demand manager
END DO
DO Loop = 1, NumTempControlledZones
IF (TempControlledZone(Loop)%EMSOverrideHeatingSetpointOn) THEN
ZoneNum = TempControlledZone(Loop)%ActualZoneNum
SELECT CASE(TempControlType(ZoneNum))
CASE (0) ! Uncontrolled
CASE (SingleHeatingSetPoint)
TempZoneThermostatSetPoint(ZoneNum) = TempControlledZone(Loop)%EMSOverrideHeatingSetpointValue
ZoneThermostatSetPointLo(ZoneNum) = TempControlledZone(Loop)%EMSOverrideHeatingSetpointValue
CASE (SingleCoolingSetPoint)
! do nothing
CASE (SingleHeatCoolSetPoint)
TempZoneThermostatSetPoint(ZoneNum) = TempControlledZone(Loop)%EMSOverrideHeatingSetpointValue
ZoneThermostatSetPointLo(ZoneNum) = TempControlledZone(Loop)%EMSOverrideHeatingSetpointValue
CASE (DualSetPointWithDeadBand)
ZoneThermostatSetPointLo(ZoneNum) = TempControlledZone(Loop)%EMSOverrideHeatingSetpointValue
CASE DEFAULT
! Do nothing
END SELECT
ENDIF
IF (TempControlledZone(Loop)%EMSOverrideCoolingSetpointOn) THEN
ZoneNum = TempControlledZone(Loop)%ActualZoneNum
SELECT CASE(TempControlType(ZoneNum))
CASE (0) ! Uncontrolled
CASE (SingleHeatingSetPoint)
! do nothing
CASE (SingleCoolingSetPoint)
TempZoneThermostatSetPoint(ZoneNum) = TempControlledZone(Loop)%EMSOverrideCoolingSetpointValue
ZoneThermostatSetPointHi(ZoneNum) = TempControlledZone(Loop)%EMSOverrideCoolingSetpointValue
CASE (SingleHeatCoolSetPoint)
TempZoneThermostatSetPoint(ZoneNum) = TempControlledZone(Loop)%EMSOverrideCoolingSetpointValue
ZoneThermostatSetPointHi(ZoneNum) = TempControlledZone(Loop)%EMSOverrideCoolingSetpointValue
CASE (DualSetPointWithDeadBand)
ZoneThermostatSetPointHi(ZoneNum) = TempControlledZone(Loop)%EMSOverrideCoolingSetpointValue
CASE DEFAULT
! Do nothing
END SELECT
ENDIF
ENDDO
DO Loop = 1, NumComfortControlledZones
IF (ComfortControlledZone(Loop)%EMSOverrideHeatingSetpointOn) THEN
ZoneNum = ComfortControlledZone(Loop)%ActualZoneNum
SELECT CASE(ComfortControlType(ZoneNum))
CASE (0) ! Uncontrolled
CASE (SglHeatSetPointFanger)
TempZoneThermostatSetPoint(ZoneNum) = ComfortControlledZone(Loop)%EMSOverrideHeatingSetpointValue
ZoneThermostatSetPointLo(ZoneNum) = ComfortControlledZone(Loop)%EMSOverrideHeatingSetpointValue
CASE (SglCoolSetPointFanger)
! do nothing
CASE (SglHCSetPointFanger)
TempZoneThermostatSetPoint(ZoneNum) = ComfortControlledZone(Loop)%EMSOverrideHeatingSetpointValue
ZoneThermostatSetPointLo(ZoneNum) = ComfortControlledZone(Loop)%EMSOverrideHeatingSetpointValue
CASE (DualSetPointFanger)
ZoneThermostatSetPointLo(ZoneNum) = ComfortControlledZone(Loop)%EMSOverrideHeatingSetpointValue
CASE DEFAULT
! Do nothing
END SELECT
ENDIF
IF (ComfortControlledZone(Loop)%EMSOverrideCoolingSetpointOn) THEN
ZoneNum = ComfortControlledZone(Loop)%ActualZoneNum
SELECT CASE(ComfortControlType(ZoneNum))
CASE (0) ! Uncontrolled
CASE (SglHeatSetPointFanger)
! do nothing
CASE (SglCoolSetPointFanger)
TempZoneThermostatSetPoint(ZoneNum) = ComfortControlledZone(Loop)%EMSOverrideCoolingSetpointValue
ZoneThermostatSetPointHi(ZoneNum) = ComfortControlledZone(Loop)%EMSOverrideCoolingSetpointValue
CASE (SglHCSetPointFanger)
TempZoneThermostatSetPoint(ZoneNum) = ComfortControlledZone(Loop)%EMSOverrideCoolingSetpointValue
ZoneThermostatSetPointHi(ZoneNum) = ComfortControlledZone(Loop)%EMSOverrideCoolingSetpointValue
CASE (DualSetPointFanger)
ZoneThermostatSetPointHi(ZoneNum) = ComfortControlledZone(Loop)%EMSOverrideCoolingSetpointValue
CASE DEFAULT
! Do nothing
END SELECT
ENDIF
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError('InitZoneAirSetpoints - program terminates due to previous condition.')
ENDIF
IF (ZoneEquipInputsFilled) THEN
ControlledZonesChecked=.true.
ENDIF
RETURN
END SUBROUTINE InitZoneAirSetpoints