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) | :: | WaterThermalTankNum |
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 CalcWaterThermalTankMixed(WaterThermalTankNum)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN January 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulates a well-mixed, single node water heater tank.
! METHODOLOGY EMPLOYED:
! This model uses analytical calculations based on the differential equation describing the tank energy
! balance. The model operates in three different modes: heating, floating, and venting. Temperatures and
! energies change dynamically over the timestep. The final reported tank temperature is the average over
! the timestep. The final reported heat rates are averages based on the total energy transfer over the
! timestep.
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
USE DataGlobals, ONLY: TimeStep, TimeStepZone, WarmupFlag, HourOfDay
USE DataInterfaces, ONLY: ShowWarningError, ShowContinueError, ShowContinueErrorTimeStamp, ShowWarningMessage, &
ShowRecurringWarningErrorAtEnd
USE DataHVACGlobals, ONLY: SysTimeElapsed, TimeStepSys
USE FluidProperties, ONLY: GetDensityGlycol, GetSpecificHeatGlycol
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: WaterThermalTankNum ! Water Heater being simulated
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: TimeElapsed ! Fraction of the current hour that has elapsed (h)
REAL(r64) :: SetpointTemp ! Current setpoint temperature (C)
REAL(r64) :: DeadBandTemp ! Heating: Minimum tank temperature (SetpointTemp - DeadbandDeltaTemp) (C)
! Cooling: Maximum Tank temperature (SetpointTemp + DeadbandDeltaTemp) (C)
REAL(r64) :: MaxTemp ! Maximum tank temperature before venting (C)
REAL(r64) :: AmbientTemp ! Current ambient air temperature around tank (C)
REAL(r64) :: TankMass ! Mass of water in tank (kg)
REAL(r64) :: LossCoeff ! Loss coefficient to ambient environment (W/K)
REAL(r64) :: LossFracToZone ! Fraction of losses added to the zone as a gain
REAL(r64) :: TankTemp ! Instantaneous tank temperature (C)
REAL(r64) :: NewTankTemp ! Predicted new tank temperature (C)
REAL(r64) :: TankTempAvg ! Average tank temperature over the timestep (C)
REAL(r64) :: Cp ! Specific heat of water (J/kg K)
REAL(r64) :: Quse ! Heating rate due to use side mass flow (W)
REAL(r64) :: Qsource ! Heating rate due to source side mass flow (W)
REAL(r64) :: Qloss ! Heating rate due to ambient environment (W)
REAL(r64) :: Qlosszone ! Heating rate of fraction of losses added to the zone as a gain (W)
REAL(r64) :: Qheat ! Net heating rate for non-temp dependent sources, i.e. heater and parasitics (W)
REAL(r64) :: Qheater ! Heating rate of the burner or electric heating element (W)
REAL(r64) :: Qmaxcap ! Maximum capacity heating rate of the burner or electric heating element (W)
REAL(r64) :: Qmincap ! Minimum capacity heating rate of the burner or electric heating element (W)
REAL(r64) :: Qoffcycfuel ! Fuel consumption rate of off-cycle parasitics (W)
REAL(r64) :: Qoffcycheat ! Heating rate of fraction of off-cycle parasitics added to the tank (W)
REAL(r64) :: Qoncycfuel ! Fuel consumption rate on-cycle parasitics added to the tank (W)
REAL(r64) :: Qoncycheat ! Heating rate of fraction of on-cycle parasitics added to the tank (W)
REAL(r64) :: Qneeded ! Heating rate needed to recover or maintain the setpoint temperature (W)
REAL(r64) :: Qunmet ! The difference between Qneeded and Qheater (W)
REAL(r64) :: Qvent ! Heating rate due to venting because tank exceeded max temperature limit (W)
REAL(r64) :: Qnet ! Net heat transfer rate including everything (W)
REAL(r64) :: Qfuel ! Heating rate for fuel consumed (W)
REAL(r64) :: UseInletTemp ! Use side inlet temperature (C)
REAL(r64) :: UseMassFlowRate ! Use side flow rate, including effectiveness factor (kg/s)
REAL(r64) :: MinMassFlowRate ! Minimum use side flow rate required before heater is enabled (kg/s)
REAL(r64) :: SourceInletTemp ! Source side inlet temperature (C)
REAL(r64) :: SourceMassFlowRate ! Source side flow rate, including effectiveness factor (kg/s)
INTEGER :: Mode ! Indicator for current operating mode (HeatMode=1 | FloatMode=0 | VentMode=-1)
REAL(r64) :: SecInTimeStep ! Seconds in one timestep (s)
REAL(r64) :: TimeRemaining ! Time remaining in the current timestep (s)
REAL(r64) :: TimeNeeded ! Time needed to reach the next substep (s)
INTEGER :: CycleOnCount ! Number of times heater cycles on in the current time step
INTEGER :: MaxCycles ! Maximum number of cycles allowed before exiting loop
REAL(r64) :: Runtime ! Time that heater is running (s)
REAL(r64) :: RTF ! Runtime fraction, fraction of timestep that heater is running
REAL(r64) :: PLR ! Part load ratio, fraction of maximum heater capacity
REAL(r64) :: PLRsum ! Integrated part load ratio over the timestep (J)
REAL(r64) :: PLF ! Part load factor, modifies thermal efficiency to get total energy efficiency
REAL(r64) :: Tsum ! Integrated tank temp over the timestep, dividing by time gives the average (C s)
REAL(r64) :: deltaTsum ! Change in integrated tank temperature, dividing by time gives the average (C s)
REAL(r64) :: Eloss ! Energy change due to ambient losses over the timestep (J)
REAL(r64) :: Elosszone ! Energy change to the zone due to ambient losses over the timestep (J)
REAL(r64) :: Euse ! Energy change due to use side mass flow over the timestep (J)
REAL(r64) :: Esource ! Energy change due to source side mass flow over the timestep (J)
REAL(r64) :: Eheater ! Energy change due to the heater over the timestep (J)
REAL(r64) :: Eoncycfuel ! Fuel energy consumed by on-cycle parasitics over the timestep (J)
REAL(r64) :: Eoffcycfuel ! Fuel energy consumed by off-cycle parasitics over the timestep (J)
REAL(r64) :: Event ! Energy change due to venting over the timestep (J)
REAL(r64) :: Eneeded ! Energy change needed over the timestep (J)
REAL(r64) :: Eunmet ! Energy change unmet over the timestep (J)
REAL(r64) :: Efuel ! Energy change for fuel consumed over the timestep (J)
LOGICAL :: SetpointRecovered ! Flag to indicate when setpoint is recovered for the first time
REAL(r64) :: rho
INTEGER :: DummyWaterIndex = 1
! FLOW:
TimeElapsed = HourOfDay + TimeStep * TimeStepZone + SysTimeElapsed
IF (WaterThermalTank(WaterThermalTankNum)%TimeElapsed /= TimeElapsed) THEN
! The simulation has advanced to the next system timestep. Save conditions from the end of the previous system
! timestep for use as the initial conditions of each iteration that does not advance the system timestep.
WaterThermalTank(WaterThermalTankNum)%SavedTankTemp = WaterThermalTank(WaterThermalTankNum)%TankTemp
WaterThermalTank(WaterThermalTankNum)%SavedMode = WaterThermalTank(WaterThermalTankNum)%Mode
! Save outlet temperatures for demand-side flow control
WaterThermalTank(WaterThermalTankNum)%SavedUseOutletTemp = WaterThermalTank(WaterThermalTankNum)%UseOutletTemp
WaterThermalTank(WaterThermalTankNum)%SavedSourceOutletTemp = WaterThermalTank(WaterThermalTankNum)%SourceOutletTemp
WaterThermalTank(WaterThermalTankNum)%TimeElapsed = TimeElapsed
END IF
TankTemp = WaterThermalTank(WaterThermalTankNum)%SavedTankTemp
Mode = WaterThermalTank(WaterThermalTankNum)%SavedMode
Qmaxcap = WaterThermalTank(WaterThermalTankNum)%MaxCapacity
Qmincap = WaterThermalTank(WaterThermalTankNum)%MinCapacity
Qoffcycfuel = WaterThermalTank(WaterThermalTankNum)%OffCycParaLoad
Qoffcycheat = Qoffcycfuel * WaterThermalTank(WaterThermalTankNum)%OffCycParaFracToTank
Qoncycfuel = WaterThermalTank(WaterThermalTankNum)%OnCycParaLoad
Qoncycheat = Qoncycfuel * WaterThermalTank(WaterThermalTankNum)%OnCycParaFracToTank
SetpointTemp = WaterThermalTank(WaterThermalTankNum)%SetpointTemp
DeadBandTemp = SetpointTemp - WaterThermalTank(WaterThermalTankNum)%DeadbandDeltaTemp
MaxTemp = WaterThermalTank(WaterThermalTankNum)%TankTempLimit
AmbientTemp = WaterThermalTank(WaterThermalTankNum)%AmbientTemp
UseInletTemp = WaterThermalTank(WaterThermalTankNum)%UseInletTemp
UseMassFlowRate = WaterThermalTank(WaterThermalTankNum)%UseMassFlowRate * &
WaterThermalTank(WaterThermalTankNum)%UseEffectiveness
MinMassFlowRate = WaterThermalTank(WaterThermalTankNum)%MassFlowRateMin
SourceInletTemp = WaterThermalTank(WaterThermalTankNum)%SourceInletTemp
SourceMassFlowRate = WaterThermalTank(WaterThermalTankNum)%SourceMassFlowRate * &
WaterThermalTank(WaterThermalTankNum)%SourceEffectiveness
IF (WaterThermalTank(WaterThermalTankNum)%UseSidePlantLoopNum > 0) THEN
rho = GetDensityGlycol(PlantLoop(WaterThermalTank(WaterThermalTankNum)%UseSidePlantLoopNum)%FluidName, &
TankTemp, &
PlantLoop(WaterThermalTank(WaterThermalTankNum)%UseSidePlantLoopNum)%FluidIndex, &
'CalcWaterThermalTankMixed')
ELSE
rho = GetDensityGlycol('WATER', TankTemp, DummyWaterIndex, 'CalcWaterThermalTankMixed')
ENDIF
TankMass = rho * WaterThermalTank(WaterThermalTankNum)%Volume
IF (WaterThermalTank(WaterThermalTankNum)%UseSidePlantLoopNum > 0) THEN
Cp = GetSpecificHeatGlycol(PlantLoop(WaterThermalTank(WaterThermalTankNum)%UseSidePlantLoopNum)%FluidName, &
TankTemp, &
PlantLoop(WaterThermalTank(WaterThermalTankNum)%UseSidePlantLoopNum)%FluidIndex, &
'CalcWaterThermalTankMixed')
ELSE
Cp = GetSpecificHeatGlycol('WATER', TankTemp, DummyWaterIndex, 'CalcWaterThermalTankMixed')
ENDIF
SecInTimeStep = TimeStepSys * SecInHour
TimeRemaining = SecInTimeStep
TimeNeeded = 0.0d0
CycleOnCount = 0
MaxCycles = SecInTimeStep
Runtime = 0.0d0
SetpointRecovered = .FALSE.
Tsum = 0.0d0
Eloss = 0.0d0
Elosszone = 0.0d0
Euse = 0.0d0
Esource = 0.0d0
Eheater = 0.0d0
Event = 0.0d0
Eneeded = 0.0d0
Eunmet = 0.0d0
Efuel = 0.0d0
Eoncycfuel = 0.0d0
Eoffcycfuel = 0.0d0
PLR = 0.0d0
PLRSum = 0.0d0
Qheat = 0.0d0
Qheater = 0.0d0
Qvent = 0.0d0
Qneeded = 0.0d0
Qunmet = 0.0d0
Qnet = 0.0d0
Qfuel = 0.0d0
! Calculate steady-state heat rates
Quse = UseMassFlowRate * Cp * (UseInletTemp - SetpointTemp)
Qsource = SourceMassFlowRate * Cp * (SourceInletTemp - SetpointTemp)
DO WHILE (TimeRemaining > 0.0d0)
TimeNeeded = 0.0d0
NewTankTemp = TankTemp
SELECT CASE (Mode)
CASE (HeatMode) ! Heater is on
! Calculate heat rate needed to maintain the setpoint at steady-state conditions
LossCoeff = WaterThermalTank(WaterThermalTankNum)%OnCycLossCoeff
LossFracToZone = WaterThermalTank(WaterThermalTankNum)%OnCycLossFracToZone
Qloss = LossCoeff * (AmbientTemp - SetpointTemp)
Qneeded = -Quse - Qsource - Qloss - Qoncycheat
IF (TankTemp > SetpointTemp) THEN
! Heater is not needed after all, possibly due to step change in scheduled SetpointTemp
Qheater = 0.0d0
Qunmet = 0.0d0
Mode = FloatMode
CYCLE
ELSE IF (TankTemp < SetpointTemp) THEN
! Attempt to recover to the setpoint as quickly as possible by using maximum heater capacity
! Qneeded is calculated above
! Qneeded does not account for the extra energy needed to recover to the setpoint
Qheater = Qmaxcap
Qunmet = MAX(Qneeded - Qheater,0.0d0)
Qheat = Qoncycheat + Qheater
! Calculate time needed to recover to the setpoint at maximum heater capacity
TimeNeeded = CalcTimeNeeded(TankTemp, SetpointTemp, AmbientTemp, UseInletTemp, SourceInletTemp, &
TankMass, Cp, UseMassFlowRate, SourceMassFlowRate, LossCoeff, Qheat)
IF (TimeNeeded > TimeRemaining) THEN
! Heater is at maximum capacity and heats for all of the remaining time
! Setpoint temperature WILL NOT be recovered
TimeNeeded = TimeRemaining
NewTankTemp = CalcTankTemp(TankTemp, AmbientTemp, UseInletTemp, SourceInletTemp, TankMass, &
Cp, UseMassFlowRate, SourceMassFlowRate, LossCoeff, Qheat, TimeNeeded)
ELSE ! TimeNeeded <= TimeRemaining
! Heater is at maximum capacity but will not heat for all of the remaining time (at maximum anyway)
! Setpoint temperature WILL be recovered
NewTankTemp = SetpointTemp
SetpointRecovered = .TRUE.
END IF ! TimeNeeded > TimeRemaining
ELSE ! TankTemp == SetpointTemp
! Attempt to maintain the setpoint by using the needed heater capacity (modulating, if allowed)
IF (Qneeded <= 0.0d0) THEN
! Heater is not needed
Qneeded = 0.0d0
Qheater = 0.0d0
Qunmet = 0.0d0
Mode = FloatMode
CYCLE
ELSE IF (Qneeded < Qmincap) THEN
! Heater is required at less than the minimum capacity
! If cycling, Qmincap = Qmaxcap. Once the setpoint is reached, heater will almost always be shut off here
SELECT CASE (WaterThermalTank(WaterThermalTankNum)%ControlType)
CASE (ControlTypeCycle)
! Control will cycle on and off based on DeadBandTemp
Qheater = 0.0d0
Qunmet = 0.0d0
Mode = FloatMode
CYCLE
CASE (ControlTypeModulate)
! Control will cycle on and off based on DeadBandTemp until Qneeded > Qmincap again
Qheater = 0.0d0
Qunmet = Qneeded
Mode = FloatMode
CYCLE
!CASE (ControlTypeModulateWithOverheat) ! Not yet implemented
! Calculate time to reach steady-state temp; check for venting at MaxTemp limit
!Qheater = Qmincap
!CASE (ControlTypeModulateWithUnderheat) ! Not yet implemented
! Heater must not come back on until Qneeded >= Qmincap
!Mode = FloatMode
END SELECT
ELSE IF (Qneeded <= Qmaxcap) THEN
! Heater can exactly meet the needed heat rate (usually by modulating) and heats for all of the remaining time
! Setpoint temperature WILL be maintained
TimeNeeded = TimeRemaining
Qheater = Qneeded
Qunmet = 0.0d0
NewTankTemp = SetpointTemp
ELSE ! Qneeded > Qmaxcap
! Heater is at maximum capacity and heats for all of the remaining time
! Setpoint temperature WILL NOT be maintained
TimeNeeded = TimeRemaining
Qheater = Qmaxcap
Qunmet = Qneeded - Qheater
Qheat = Qoncycheat + Qheater
NewTankTemp = CalcTankTemp(TankTemp, AmbientTemp, UseInletTemp, SourceInletTemp, TankMass, &
Cp, UseMassFlowRate, SourceMassFlowRate, LossCoeff, Qheat, TimeNeeded)
END IF ! Qneeded > Qmaxcap
END IF ! TankTemp > SetpointTemp
! Update summed values
Eneeded = Eneeded + Qneeded * TimeNeeded
Eheater = Eheater + Qheater * TimeNeeded
Eunmet = Eunmet + Qunmet * TimeNeeded
Eoncycfuel = Eoncycfuel + Qoncycfuel * TimeNeeded
IF (Qmaxcap > 0.0d0) PLR = Qheater / Qmaxcap
PLF = PartLoadFactor(WaterThermalTankNum, PLR)
Efuel = Efuel + Qheater * TimeNeeded / (PLF * WaterThermalTank(WaterThermalTankNum)%Efficiency)
Runtime = Runtime + TimeNeeded
PLRsum = PLRsum + PLR * TimeNeeded
IF (.NOT. WaterThermalTank(WaterThermalTankNum)%FirstRecoveryDone) THEN
WaterThermalTank(WaterThermalTankNum)%FirstRecoveryFuel = WaterThermalTank(WaterThermalTankNum)%FirstRecoveryFuel &
+ Efuel + Eoffcycfuel + Eoncycfuel
IF (SetpointRecovered) WaterThermalTank(WaterThermalTankNum)%FirstRecoveryDone = .TRUE.
END IF
CASE (FloatMode, CoolMode) ! Heater is off
! Calculate heat rate needed to maintain the setpoint at steady-state conditions
LossCoeff = WaterThermalTank(WaterThermalTankNum)%OffCycLossCoeff
LossFracToZone = WaterThermalTank(WaterThermalTankNum)%OffCycLossFracToZone
Qloss = LossCoeff * (AmbientTemp - SetpointTemp)
Qneeded = -Quse - Qsource - Qloss - Qoffcycheat
! This section really needs to work differently depending on ControlType
! CYCLE will look at TankTemp, MODULATE will look at Qneeded
IF ((TankTemp < DeadBandTemp) .AND. (.NOT. WaterThermalTank(WaterThermalTankNum)%IsChilledWaterTank)) THEN
! Tank temperature is already below the minimum, possibly due to step change in scheduled SetpointTemp
Mode = HeatMode
CycleOnCount = CycleOnCount + 1
CYCLE
ELSEIF(( TankTemp >= DeadBandTemp) .AND. (.NOT. WaterThermalTank(WaterThermalTankNum)%IsChilledWaterTank)) THEN
Qheat = Qoffcycheat
! Calculate time needed for tank temperature to fall to minimum (setpoint - deadband)
TimeNeeded = CalcTimeNeeded(TankTemp, DeadBandTemp, AmbientTemp, UseInletTemp, SourceInletTemp, &
TankMass, Cp, UseMassFlowRate, SourceMassFlowRate, LossCoeff, Qheat)
IF (TimeNeeded <= TimeRemaining) THEN
! Heating will be needed in this timestep
NewTankTemp = DeadBandTemp
Mode = HeatMode
CycleOnCount = CycleOnCount + 1
ELSE ! TimeNeeded > TimeRemaining
! Heating will not be needed for all of the remaining time
NewTankTemp = CalcTankTemp(TankTemp, AmbientTemp, UseInletTemp, SourceInletTemp, TankMass, &
Cp, UseMassFlowRate, SourceMassFlowRate, LossCoeff, Qheat, TimeRemaining)
IF ( (NewTankTemp < MaxTemp) .OR. (WaterThermalTank(WaterThermalTankNum)%IsChilledWaterTank) )THEN
! Neither heating nor venting is needed for all of the remaining time
TimeNeeded = TimeRemaining
ELSE ! NewTankTemp >= MaxTemp
! Venting will be needed in this timestep
! Calculate time needed for tank temperature to rise to the maximum
TimeNeeded = CalcTimeNeeded(TankTemp, MaxTemp, AmbientTemp, UseInletTemp, SourceInletTemp, &
TankMass, Cp, UseMassFlowRate, SourceMassFlowRate, LossCoeff, Qheat)
NewTankTemp = MaxTemp
Mode = VentMode
END IF ! NewTankTemp >= MaxTemp
END IF ! TimeNeeded <= TimeRemaining
ELSEIF(( TankTemp > DeadBandTemp) .AND. (WaterThermalTank(WaterThermalTankNum)%IsChilledWaterTank)) THEN
Mode = CoolMode
Qheat = 0.0D0
NewTankTemp = CalcTankTemp(TankTemp, AmbientTemp, UseInletTemp, SourceInletTemp, TankMass, &
Cp, UseMassFlowRate, SourceMassFlowRate, LossCoeff, Qheat, TimeRemaining)
TimeNeeded = TimeRemaining
ELSEIF(( TankTemp <= DeadBandTemp) .AND. (WaterThermalTank(WaterThermalTankNum)%IsChilledWaterTank)) THEN
IF (TankTemp < SetpointTemp) Mode = FloatMode
Qheat = 0.0D0
NewTankTemp = CalcTankTemp(TankTemp, AmbientTemp, UseInletTemp, SourceInletTemp, TankMass, &
Cp, UseMassFlowRate, SourceMassFlowRate, LossCoeff, Qheat, TimeRemaining)
TimeNeeded = TimeRemaining
END IF ! TankTemp vs DeadBandTemp for heaters and chilled water tanks
! Update summed values
Eneeded = Eneeded + Qneeded * TimeNeeded
Eunmet = Eunmet + Qunmet * TimeNeeded ! Qunmet may be propagated thru from the previous iteration
Eoffcycfuel = Eoffcycfuel + Qoffcycfuel * TimeNeeded
CASE (VentMode) ! Excess heat is vented
LossCoeff = WaterThermalTank(WaterThermalTankNum)%OffCycLossCoeff
LossFracToZone = WaterThermalTank(WaterThermalTankNum)%OffCycLossFracToZone
Qheat = Qoffcycheat
NewTankTemp = CalcTankTemp(TankTemp, AmbientTemp, UseInletTemp, SourceInletTemp, TankMass, &
Cp, UseMassFlowRate, SourceMassFlowRate, LossCoeff, Qheat, TimeRemaining)
IF (NewTankTemp < MaxTemp) THEN
! Venting is no longer needed because conditions have changed
Mode = FloatMode
CYCLE
ELSE ! NewTankTemp >= MaxTemp
TimeNeeded = TimeRemaining
! Calculate the steady-state venting rate needed to maintain the tank at maximum temperature
Qloss = LossCoeff * (AmbientTemp - MaxTemp)
Quse = UseMassFlowRate * Cp * (UseInletTemp - MaxTemp)
Qsource = SourceMassFlowRate * Cp * (SourceInletTemp - MaxTemp)
Qvent = -Quse - Qsource - Qloss - Qoffcycheat
NewTankTemp = MaxTemp
END IF ! NewTankTemp < MaxTemp
! Update summed values
Event = Event + Qvent * TimeNeeded
Eoffcycfuel = Eoffcycfuel + Qoffcycfuel * TimeNeeded
CASE DEFAULT
! No default
END SELECT
deltaTsum = CalcTempIntegral(TankTemp, NewTankTemp, AmbientTemp, UseInletTemp, SourceInletTemp, TankMass, Cp, &
UseMassFlowRate, SourceMassFlowRate, LossCoeff, Qheat, TimeNeeded)
! Update summed values
Tsum = Tsum + deltaTsum
Eloss = Eloss + LossCoeff * (AmbientTemp * TimeNeeded - deltaTsum)
Elosszone = Elosszone + LossFracToZone * LossCoeff * (AmbientTemp * TimeNeeded - deltaTsum)
Euse = Euse + UseMassFlowRate * Cp * (UseInletTemp * TimeNeeded - deltaTsum)
Esource = Esource + SourceMassFlowRate * Cp * (SourceInletTemp * TimeNeeded - deltaTsum)
TankTemp = NewTankTemp ! Update tank temperature
TimeRemaining = TimeRemaining - TimeNeeded
IF (CycleOnCount > MaxCycles) THEN
IF (.NOT. WarmupFlag) THEN
IF (WaterThermalTank(WaterThermalTankNum)%MaxCycleErrorIndex == 0) THEN
CALL ShowWarningError('WaterHeater:Mixed = '//TRIM(WaterThermalTank(WaterThermalTankNum)%Name)// &
': Heater is cycling on and off more than once per second.')
CALL ShowContinueError('Try increasing Deadband Temperature Difference or Tank Volume')
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('WaterHeater:Mixed = '//TRIM(WaterThermalTank(WaterThermalTankNum)%Name)// &
' Heater is cycling on and off more than once per second:', &
WaterThermalTank(WaterThermalTankNum)%MaxCycleErrorIndex)
END IF
EXIT
END IF ! CycleOnCount > MaxCycles
END DO ! TimeRemaining > 0.0
! Calculate average values over the timestep based on summed values, Q > 0 is a gain to the tank, Q < 0 is a loss to the tank
TankTempAvg = Tsum / SecInTimeStep
Qloss = Eloss / SecInTimeStep
Qlosszone = Elosszone / SecInTimeStep
Quse = Euse / SecInTimeStep
Qsource = Esource / SecInTimeStep
Qheater = Eheater / SecInTimeStep
Qoffcycfuel = Eoffcycfuel / SecInTimeStep
Qoffcycheat = Qoffcycfuel * WaterThermalTank(WaterThermalTankNum)%OffCycParaFracToTank
Qoncycfuel = Eoncycfuel / SecInTimeStep
Qoncycheat = Qoncycfuel * WaterThermalTank(WaterThermalTankNum)%OnCycParaFracToTank
Qvent = Event / SecInTimeStep
Qneeded = Eneeded / SecInTimeStep
Qunmet = Eunmet / SecInTimeStep
RTF = Runtime / SecInTimeStep
PLR = PLRSum / SecInTimeStep
IF (WaterThermalTank(WaterThermalTankNum)%ControlType == ControlTypeCycle) THEN
! Recalculate Part Load Factor and fuel energy based on Runtime Fraction, instead of Part Load Ratio
PLF = PartLoadFactor(WaterThermalTankNum, RTF)
Efuel = Eheater / (PLF * WaterThermalTank(WaterThermalTankNum)%Efficiency)
END IF
Qfuel = Efuel / SecInTimeStep
WaterThermalTank(WaterThermalTankNum)%Mode = Mode ! Operating mode for carry-over to next timestep
WaterThermalTank(WaterThermalTankNum)%TankTemp = TankTemp ! Final tank temperature for carry-over to next timestep
WaterThermalTank(WaterThermalTankNum)%TankTempAvg = TankTempAvg ! Average tank temperature over the timestep for reporting
WaterThermalTank(WaterThermalTankNum)%UseOutletTemp = TankTempAvg ! Because entire tank is at same temperature
WaterThermalTank(WaterThermalTankNum)%SourceOutletTemp = TankTempAvg ! Because entire tank is at same temperature
WaterThermalTank(WaterThermalTankNum)%LossRate = Qloss
WaterThermalTank(WaterThermalTankNum)%UseRate = Quse
WaterThermalTank(WaterThermalTankNum)%SourceRate = Qsource
WaterThermalTank(WaterThermalTankNum)%OffCycParaRateToTank = Qoffcycheat
WaterThermalTank(WaterThermalTankNum)%OnCycParaRateToTank = Qoncycheat
WaterThermalTank(WaterThermalTankNum)%TotalDemandRate = -Quse - Qsource - Qloss - Qoffcycheat - Qoncycheat
WaterThermalTank(WaterThermalTankNum)%HeaterRate = Qheater
WaterThermalTank(WaterThermalTankNum)%UnmetRate = Qunmet
WaterThermalTank(WaterThermalTankNum)%VentRate = Qvent
WaterThermalTank(WaterThermalTankNum)%NetHeatTransferRate = Quse + Qsource + Qloss + Qoffcycheat + Qoncycheat + Qheater + Qvent
WaterThermalTank(WaterThermalTankNum)%CycleOnCount = CycleOnCount
WaterThermalTank(WaterThermalTankNum)%RuntimeFraction = RTF
WaterThermalTank(WaterThermalTankNum)%PartLoadRatio = PLR
WaterThermalTank(WaterThermalTankNum)%FuelRate = Qfuel
WaterThermalTank(WaterThermalTankNum)%OffCycParaFuelRate = Qoffcycfuel
WaterThermalTank(WaterThermalTankNum)%OnCycParaFuelRate = Qoncycfuel
! Add water heater skin losses and venting losses to ambient zone, if specified
IF (WaterThermalTank(WaterThermalTankNum)%AmbientTempZone > 0) &
WaterThermalTank(WaterThermalTankNum)%AmbientZoneGain = -Qlosszone - Qvent
RETURN
END SUBROUTINE CalcWaterThermalTankMixed