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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ZoneNum |
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 CalcPredictedSystemLoad(ZoneNum)
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN Nov 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calculates the predicted system load for a time step.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataLoopNode, ONLY: Node
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ZoneNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: LoadToHeatingSetPoint
REAL(r64) :: LoadToCoolingSetPoint
REAL(r64) :: ZoneSetPoint
! FLOW:
DeadBandOrSetback(ZoneNum) = .FALSE.
ZoneSetPoint = 0.0d0
LoadToHeatingSetPoint=0.0d0
LoadToCoolingSetPoint=0.0d0
SELECT CASE (TempControlType(ZoneNum))
CASE (0)
! Uncontrolled Zone
LoadToHeatingSetPoint = 0.0d0
LoadToCoolingSetPoint = 0.0d0
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = 0.0d0
CASE (SingleHeatingSetPoint)
! Determine zone load based on
! Qload + Qsys = 0 and Qsys = mCp(Tsys-Tzone)
! System Load Sign Convention:
! - -> Cooling required to reach setpoint
! + -> Heating required to reach setpoint
!PH 3/2/04 LoadToHeatingSetPoint = (TempDepZnLd(ZoneNum) * TempZoneThermostatSetPoint(ZoneNum) - TempIndZnLd(ZoneNum))
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
LoadToHeatingSetPoint = (TempDepZnLd(ZoneNum) * TempZoneThermostatSetPoint(ZoneNum) - TempIndZnLd(ZoneNum))
! Exact solution
CASE (UseAnalyticalSolution)
If (TempDepZnLd(ZoneNum) .eq. 0.0d0) Then ! B=0
LoadToHeatingSetPoint = AIRRAT(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum) - &
ZoneT1(ZoneNum)) - TempIndZnLd(ZoneNum)
Else
LoadToHeatingSetPoint = TempDepZnLd(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum) &
-ZoneT1(ZoneNum)*exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum))))/ &
(1.0d0-exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum))))-TempIndZnLd(ZoneNum)
End If
CASE (UseEulerMethod)
LoadToHeatingSetPoint = AIRRAT(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum)- &
ZoneT1(ZoneNum)) + TempDepZnLd(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum)) &
- TempIndZnLd(ZoneNum)
END SELECT
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = LoadToHeatingSetPoint
ZoneSetPoint = TempZoneThermostatSetPoint(ZoneNum)
LoadToCoolingSetPoint = LoadToHeatingSetPoint
! for consistency with the other cases, use LE instead of LT and don't subtract 1.0 Watt as a way of pushing the zero load
! case over the threshold
IF ((ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired) .LE. 0.0d0) DeadBandOrSetback(ZoneNum) = .TRUE.
CASE (SingleCoolingSetPoint)
!PH 3/2/04 LoadToCoolingSetPoint = (TempDepZnLd(ZoneNum) * TempZoneThermostatSetPoint(ZoneNum) - TempIndZnLd(ZoneNum))
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
LoadToCoolingSetPoint = (TempDepZnLd(ZoneNum) * &
(TempZoneThermostatSetPoint(ZoneNum)) - TempIndZnLd(ZoneNum))
CASE (UseAnalyticalSolution)
If (TempDepZnLd(ZoneNum) .eq. 0.0d0) Then ! B=0
LoadToCoolingSetPoint = AIRRAT(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum)- &
ZoneT1(ZoneNum)) - TempIndZnLd(ZoneNum)
Else
LoadToCoolingSetPoint = TempDepZnLd(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum) &
-ZoneT1(ZoneNum)*exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum)))) &
/(1.0d0-exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum)))) - TempIndZnLd(ZoneNum)
End If
CASE (UseEulerMethod)
LoadToCoolingSetPoint = AIRRAT(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum)- &
ZoneT1(ZoneNum)) + TempDepZnLd(ZoneNum)*TempZoneThermostatSetPoint(ZoneNum) - TempIndZnLd(ZoneNum)
END SELECT
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = LoadToCoolingSetPoint
ZoneSetPoint = TempZoneThermostatSetPoint(ZoneNum)
LoadToHeatingSetPoint = LoadToCoolingSetPoint
! for consistency with the other cases, use GE instead of GT and don't add 1.0 Watt as a way of pushing the zero load
! case over the threshold
IF ((ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired) .GE. 0.0d0) DeadBandOrSetback(ZoneNum) = .TRUE.
CASE (SingleHeatCoolSetPoint)
!PH 3/2/04 LoadToHeatingSetPoint = (TempDepZnLd(ZoneNum) * TempZoneThermostatSetPoint(ZoneNum) - TempIndZnLd(ZoneNum))
!PH 3/2/04 !LoadToCoolingSetPoint = (TempDepZnLd(ZoneNum) * TempZoneThermostatSetPoint(ZoneNum) - TempIndZnLd(ZoneNum))
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
LoadToHeatingSetPoint = (TempDepZnLd(ZoneNum) * &
(TempZoneThermostatSetPoint(ZoneNum)) - TempIndZnLd(ZoneNum))
LoadToCoolingSetPoint = (TempDepZnLd(ZoneNum) * &
(TempZoneThermostatSetPoint(ZoneNum)) - TempIndZnLd(ZoneNum))
! Exact solution
CASE (UseAnalyticalSolution)
If (TempDepZnLd(ZoneNum) .eq. 0.0d0) Then ! B=0
LoadToHeatingSetPoint = AIRRAT(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum)- &
ZoneT1(ZoneNum)) - TempIndZnLd(ZoneNum)
LoadToCoolingSetPoint = AIRRAT(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum)- &
ZoneT1(ZoneNum)) - TempIndZnLd(ZoneNum)
Else
LoadToHeatingSetPoint = TempDepZnLd(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum) &
-ZoneT1(ZoneNum)*exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum)))) &
/(1.0d0-exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum)))) - TempIndZnLd(ZoneNum)
LoadToCoolingSetPoint = TempDepZnLd(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum) &
-ZoneT1(ZoneNum)*exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum)))) &
/(1.0d0-exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum)))) - TempIndZnLd(ZoneNum)
End If
CASE (UseEulerMethod)
LoadToHeatingSetPoint = AIRRAT(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum) - &
ZoneT1(ZoneNum)) + TempDepZnLd(ZoneNum)*TempZoneThermostatSetPoint(ZoneNum) - TempIndZnLd(ZoneNum)
LoadToCoolingSetPoint = AIRRAT(ZoneNum)*(TempZoneThermostatSetPoint(ZoneNum) - &
ZoneT1(ZoneNum)) + TempDepZnLd(ZoneNum)*TempZoneThermostatSetPoint(ZoneNum) - TempIndZnLd(ZoneNum)
END SELECT
ZoneSetPoint = TempZoneThermostatSetPoint(ZoneNum)
!PH 3/2/04 ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = LoadToHeatingSetPoint ! = LoadToCoolingSetPoint
! Note that LoadToHeatingSetPoint is generally not equal to LoadToCoolingSetPoint
! when the heating and cooling set-points are equal if the zone is unmixed,
! e.g. displacement ventilation or UFAD, since the stratification is generally not the same in heating and cooling modes
! Possible combinations:
! 1/ LoadToHeatingSetPoint > 0 & LoadToCoolingSetPoint > 0 --> Heating required
! 2/ LoadToHeatingSetPoint > LoadToCoolingSetPoint --> Possible in the unmixed case but should be trapped
! as a poor choice of set-points
! 3/ LoadToHeatingSetPoint < 0 & LoadToCoolingSetPoint < 0 --> Cooling Required
! 4/ LoadToHeatingSetPoint <=0 & LoadToCoolingSetPoint >=0 --> Dead Band Operation ! includes zero load cases
! First trap bad set-points
IF (LoadToHeatingSetPoint .GT. LoadToCoolingSetPoint ) THEN
CALL ShowSevereError('SingleHeatCoolSetPoint: Effective heating set-point higher than effective cooling set-point - '// &
'use DualSetPointWithDeadBand if using unmixed air model')
CALL ShowContinueErrorTimeStamp('occurs in Zone='//TRIM(Zone(ZoneNum)%Name))
CALL ShowContinueError('LoadToHeatingSetPoint='//TRIM(RoundSigDigits(LoadToHeatingSetPoint,3))// &
', LoadToCoolingSetPoint='//TRIM(RoundSigDigits(LoadToCoolingSetPoint,3)))
CALL ShowContinueError('Zone TempDepZnLd='//TRIM(RoundSigDigits(TempDepZnLd(ZoneNum),2)))
CALL ShowContinueError('Zone TempIndZnLd='//TRIM(RoundSigDigits(TempIndZnLd(ZoneNum),2)))
CALL ShowContinueError('Zone ThermostatSetPoint='//TRIM(RoundSigDigits(TempZoneThermostatSetPoint(ZoneNum),2)))
CALL ShowFatalError('Program terminates due to above conditions.')
END IF
IF (LoadToHeatingSetPoint .GT. 0.0d0 .AND. LoadToCoolingSetPoint .GT. 0.0d0) THEN
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = LoadToHeatingSetPoint
ELSE IF (LoadToHeatingSetPoint .LT. 0.0d0 .AND. LoadToCoolingSetPoint .LT. 0.0d0) THEN
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = LoadToCoolingSetPoint
ELSE IF (LoadToHeatingSetPoint .LE. 0.0d0 .AND. LoadToCoolingSetPoint .GE. 0.0d0) THEN ! deadband includes zero loads
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = 0.0d0
IF(Zone(ZoneNum)%SystemZoneNodeNumber > 0) THEN
ZoneSetPoint = Node(Zone(ZoneNum)%SystemZoneNodeNumber)%Temp
ZoneSetPoint = MAX(ZoneSetPoint, ZoneThermostatSetPointLo(ZoneNum)) ! trap out of deadband
ZoneSetPoint = MIN(ZoneSetPoint, ZoneThermostatSetPointHi(ZoneNum)) ! trap out of deadband
END IF
DeadBandOrSetback(ZoneNum) = .TRUE.
ELSE ! this should never occur!
CALL ShowSevereError('SingleHeatCoolSetPoint: Unanticipated combination of heating and cooling loads - '// &
'report to EnergyPlus Development Team')
CALL ShowContinueErrorTimeStamp('occurs in Zone='//TRIM(Zone(ZoneNum)%Name))
CALL ShowContinueError('LoadToHeatingSetPoint='//TRIM(RoundSigDigits(LoadToHeatingSetPoint,3))// &
', LoadToCoolingSetPoint='//TRIM(RoundSigDigits(LoadToCoolingSetPoint,3)))
CALL ShowContinueError('Zone TempDepZnLd='//TRIM(RoundSigDigits(TempDepZnLd(ZoneNum),2)))
CALL ShowContinueError('Zone TempIndZnLd='//TRIM(RoundSigDigits(TempIndZnLd(ZoneNum),2)))
CALL ShowContinueError('Zone ThermostatSetPoint='//TRIM(RoundSigDigits(TempZoneThermostatSetPoint(ZoneNum),2)))
CALL ShowFatalError('Program terminates due to above conditions.')
END IF
CASE (DualSetPointWithDeadBand)
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
LoadToHeatingSetPoint = (TempDepZnLd(ZoneNum) * &
(ZoneThermostatSetPointLo(ZoneNum)) - TempIndZnLd(ZoneNum))
LoadToCoolingSetPoint = (TempDepZnLd(ZoneNum) * &
(ZoneThermostatSetPointHi(ZoneNum)) - TempIndZnLd(ZoneNum))
! Exact solution
CASE (UseAnalyticalSolution)
If (TempDepZnLd(ZoneNum) .eq. 0.0d0) Then ! B=0
LoadToHeatingSetPoint = AIRRAT(ZoneNum)*(ZoneThermostatSetPointLo(ZoneNum)- &
ZoneT1(ZoneNum)) - TempIndZnLd(ZoneNum)
LoadToCoolingSetPoint = AIRRAT(ZoneNum)*(ZoneThermostatSetPointHi(ZoneNum)- &
ZoneT1(ZoneNum)) - TempIndZnLd(ZoneNum)
Else
LoadToHeatingSetPoint = TempDepZnLd(ZoneNum)*(ZoneThermostatSetPointLo(ZoneNum) &
-ZoneT1(ZoneNum)*exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum))))/ &
(1.0d0-exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum)))) - TempIndZnLd(ZoneNum)
LoadToCoolingSetPoint = TempDepZnLd(ZoneNum)*(ZoneThermostatSetPointHi(ZoneNum) &
-ZoneT1(ZoneNum)*exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum))))/ &
(1.0d0-exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum)))) - TempIndZnLd(ZoneNum)
End If
CASE (UseEulerMethod)
LoadToHeatingSetPoint = AIRRAT(ZoneNum)*(ZoneThermostatSetPointLo(ZoneNum)- &
ZoneT1(ZoneNum)) + TempDepZnLd(ZoneNum)*ZoneThermostatSetPointLo(ZoneNum) - TempIndZnLd(ZoneNum)
LoadToCoolingSetPoint = AIRRAT(ZoneNum)*(ZoneThermostatSetPointHi(ZoneNum)- &
ZoneT1(ZoneNum)) + TempDepZnLd(ZoneNum)*ZoneThermostatSetPointHi(ZoneNum) - TempIndZnLd(ZoneNum)
END SELECT
! Possible combinations:
! 1/ LoadToHeatingSetPoint > 0 & LoadToCoolingSetPoint > 0 --> Heating required
! 2/ LoadToHeatingSetPoint > LoadToCoolingSetPoint --> Possible in the unmixed case but should be trapped
! as a poor choice of set-points
! 3/ LoadToHeatingSetPoint < 0 & LoadToCoolingSetPoint < 0 --> Cooling Required
! 4/ LoadToHeatingSetPoint <=0 & LoadToCoolingSetPoint >=0 --> Dead Band Operation - includes zero load cases
! First trap bad set-points
IF (LoadToHeatingSetPoint .GT. LoadToCoolingSetPoint ) THEN
CALL ShowSevereError('DualSetPointWithDeadBand: Effective heating set-point higher than effective cooling set-point - '// &
'increase deadband if using unmixed air model')
CALL ShowContinueErrorTimeStamp('occurs in Zone='//TRIM(Zone(ZoneNum)%Name))
CALL ShowContinueError('LoadToHeatingSetPoint='//TRIM(RoundSigDigits(LoadToHeatingSetPoint,3))// &
', LoadToCoolingSetPoint='//TRIM(RoundSigDigits(LoadToCoolingSetPoint,3)))
CALL ShowContinueError('Zone TempDepZnLd='//TRIM(RoundSigDigits(TempDepZnLd(ZoneNum),2)))
CALL ShowContinueError('Zone TempIndZnLd='//TRIM(RoundSigDigits(TempIndZnLd(ZoneNum),2)))
CALL ShowContinueError('Zone Heating ThermostatSetPoint='//TRIM(RoundSigDigits(ZoneThermostatSetPointLo(ZoneNum),2)))
CALL ShowContinueError('Zone Cooling ThermostatSetPoint='//TRIM(RoundSigDigits(ZoneThermostatSetPointHi(ZoneNum),2)))
CALL ShowFatalError('Program terminates due to above conditions.')
END IF
IF (LoadToHeatingSetPoint .GT. 0.0d0 .AND. LoadToCoolingSetPoint .GT. 0.0d0) THEN
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = LoadToHeatingSetPoint
ZoneSetPoint = ZoneThermostatSetPointLo(ZoneNum)
ELSE IF (LoadToHeatingSetPoint .LT. 0.0d0 .AND. LoadToCoolingSetPoint .LT. 0.0d0) THEN
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = LoadToCoolingSetPoint
ZoneSetPoint = ZoneThermostatSetPointHi(ZoneNum)
ELSE IF (LoadToHeatingSetPoint .LE. 0.0d0 .AND. LoadToCoolingSetPoint .GE. 0.0d0) THEN ! deadband includes zero loads
! this turns out to cause instabilities sometimes? that lead to setpoint errors if predictor is off.
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = 0.0d0
IF(Zone(ZoneNum)%SystemZoneNodeNumber > 0) THEN
ZoneSetPoint = Node(Zone(ZoneNum)%SystemZoneNodeNumber)%Temp
ZoneSetPoint = MAX(ZoneSetPoint, ZoneThermostatSetPointLo(ZoneNum)) ! trap out of deadband
ZoneSetPoint = MIN(ZoneSetPoint, ZoneThermostatSetPointHi(ZoneNum)) ! trap out of deadband
END IF
DeadBandOrSetback(ZoneNum) = .TRUE.
ELSE ! this should never occur!
CALL ShowSevereError('DualSetPointWithDeadBand: Unanticipated combination of heating and cooling loads - '// &
'report to EnergyPlus Development Team')
CALL ShowContinueErrorTimeStamp('occurs in Zone='//TRIM(Zone(ZoneNum)%Name))
CALL ShowContinueError('LoadToHeatingSetPoint='//TRIM(RoundSigDigits(LoadToHeatingSetPoint,3))// &
', LoadToCoolingSetPoint='//TRIM(RoundSigDigits(LoadToCoolingSetPoint,3)))
CALL ShowContinueError('Zone Heating Set-point='//TRIM(RoundSigDigits(ZoneThermostatSetPointLo(ZoneNum),2)))
CALL ShowContinueError('Zone Cooling Set-point='//TRIM(RoundSigDigits(ZoneThermostatSetPointHi(ZoneNum),2)))
CALL ShowContinueError('Zone TempDepZnLd='//TRIM(RoundSigDigits(TempDepZnLd(ZoneNum),2)))
CALL ShowContinueError('Zone TempIndZnLd='//TRIM(RoundSigDigits(TempIndZnLd(ZoneNum),2)))
CALL ShowContinueError('Zone ThermostatSetPoint='//TRIM(RoundSigDigits(TempZoneThermostatSetPoint(ZoneNum),2)))
CALL ShowFatalError('Program terminates due to above conditions.')
END IF
END SELECT
! Staged control zone
IF (NumStageCtrZone > 0) THEN
If (StageZoneLogic(ZoneNum)) Then
If (ZoneSysEnergyDemand(ZoneNum)%StageNum ==0) Then ! No load
LoadToHeatingSetPoint = 0.0d0
LoadToCoolingSetPoint = 0.0d0
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = 0.0d0
IF(Zone(ZoneNum)%SystemZoneNodeNumber > 0) THEN
ZoneSetPoint = Node(Zone(ZoneNum)%SystemZoneNodeNumber)%Temp
ZoneSetPoint = MAX(ZoneSetPoint, ZoneThermostatSetPointLo(ZoneNum)) ! trap out of deadband
ZoneSetPoint = MIN(ZoneSetPoint, ZoneThermostatSetPointHi(ZoneNum)) ! trap out of deadband
END IF
DeadBandOrSetback(ZoneNum) = .TRUE.
Else If (ZoneSysEnergyDemand(ZoneNum)%StageNum <0) Then ! Cooling load
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
LoadToCoolingSetPoint = (TempDepZnLd(ZoneNum) * &
(ZoneThermostatSetPointHi(ZoneNum)) - TempIndZnLd(ZoneNum))
CASE (UseAnalyticalSolution)
If (TempDepZnLd(ZoneNum) .eq. 0.0d0) Then ! B=0
LoadToCoolingSetPoint = AIRRAT(ZoneNum)*(ZoneThermostatSetPointHi(ZoneNum)- &
ZoneT1(ZoneNum)) - TempIndZnLd(ZoneNum)
Else
LoadToCoolingSetPoint = TempDepZnLd(ZoneNum)*(ZoneThermostatSetPointHi(ZoneNum) &
-ZoneT1(ZoneNum)*exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum)))) &
/(1.0d0-exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum)))) - TempIndZnLd(ZoneNum)
End If
CASE (UseEulerMethod)
LoadToCoolingSetPoint = AIRRAT(ZoneNum)*(ZoneThermostatSetPointHi(ZoneNum)- &
ZoneT1(ZoneNum)) + TempDepZnLd(ZoneNum)*ZoneThermostatSetPointHi(ZoneNum) - TempIndZnLd(ZoneNum)
END SELECT
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = LoadToCoolingSetPoint
ZoneSetPoint = ZoneThermostatSetPointHi(ZoneNum)
LoadToHeatingSetPoint = LoadToCoolingSetPoint
IF ((ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired) .GE. 0.0) DeadBandOrSetback(ZoneNum) = .TRUE.
Else ! Heating load
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
LoadToHeatingSetPoint = (TempDepZnLd(ZoneNum) * ZoneThermostatSetPointLo(ZoneNum) - TempIndZnLd(ZoneNum))
! Exact solution
CASE (UseAnalyticalSolution)
If (TempDepZnLd(ZoneNum) .eq. 0.0d0) Then ! B=0
LoadToHeatingSetPoint = AIRRAT(ZoneNum)*(ZoneThermostatSetPointLo(ZoneNum) - &
ZoneT1(ZoneNum)) - TempIndZnLd(ZoneNum)
Else
LoadToHeatingSetPoint = TempDepZnLd(ZoneNum)*(ZoneThermostatSetPointLo(ZoneNum) &
-ZoneT1(ZoneNum)*exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum))))/ &
(1.0d0-exp(MIN(700.d0,-TempDepZnLd(ZoneNum)/AIRRAT(ZoneNum))))-TempIndZnLd(ZoneNum)
End If
CASE (UseEulerMethod)
LoadToHeatingSetPoint = AIRRAT(ZoneNum)*(ZoneThermostatSetPointLo(ZoneNum)- &
ZoneT1(ZoneNum)) + TempDepZnLd(ZoneNum)*(ZoneThermostatSetPointLo(ZoneNum)) &
- TempIndZnLd(ZoneNum)
END SELECT
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = LoadToHeatingSetPoint
ZoneSetPoint = ZoneThermostatSetPointLo(ZoneNum)
LoadToCoolingSetPoint = LoadToHeatingSetPoint
IF ((ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired) .LE. 0.0) DeadBandOrSetback(ZoneNum) = .TRUE.
End If
End If
End If
!If the ZoneNodeNum has been set for a Controlled Zone, then the zone setpoint is placed on the node.
IF(Zone(ZoneNum)%SystemZoneNodeNumber > 0) THEN
Node(Zone(ZoneNum)%SystemZoneNodeNumber)%TempSetPoint = ZoneSetPoint
END IF
IF(ZoneSetPoint .GT. ZoneSetPointLast(ZoneNum))THEN
SetBack(ZoneNum) = .TRUE.
ELSE
SetBack(ZoneNum) = .FALSE.
END IF
ZoneSetPointLast(ZoneNum) = ZoneSetPoint
! Save the unmultiplied zone load to a report variable
SNLoadPredictedRate(ZoneNum) = ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired * LoadCorrectionFactor(ZoneNum)
SNLoadPredictedHSPRate(ZoneNum) = LoadToHeatingSetPoint * LoadCorrectionFactor(ZoneNum)
SNLoadPredictedCSPRate(ZoneNum) = LoadToCoolingSetPoint * LoadCorrectionFactor(ZoneNum)
CurDeadBandOrSetback(ZoneNum) = DeadBandOrSetback(ZoneNum)
! Apply the Zone Multiplier and Load Correction factor to the total zone load
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired = ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired &
* Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier * LoadCorrectionFactor(ZoneNum)
ZoneSysEnergyDemand(ZoneNum)%OutputRequiredToHeatingSP = LoadToHeatingSetPoint &
* Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier * LoadCorrectionFactor(ZoneNum)
ZoneSysEnergyDemand(ZoneNum)%OutputRequiredToCoolingSP = LoadToCoolingSetPoint &
* Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier * LoadCorrectionFactor(ZoneNum)
!init each sequenced demand to the full output
IF (ALLOCATED(ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequired)) &
ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequired = & ! array assignment
ZoneSysEnergyDemand(ZoneNum)%TotalOutputRequired
IF (ALLOCATED(ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequiredToHeatingSP)) &
ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequiredToHeatingSP = & ! array assignment
ZoneSysEnergyDemand(ZoneNum)%OutputRequiredToHeatingSP
IF (ALLOCATED(ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequiredToCoolingSP)) &
ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequiredToCoolingSP = & ! array assignment
ZoneSysEnergyDemand(ZoneNum)%OutputRequiredToCoolingSP
RETURN
END SUBROUTINE CalcPredictedSystemLoad