SUBROUTINE CalcUnitVentilator(UnitVentNum,ZoneNum,FirstHVACIteration,PowerMet,LatOutputProvided)
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN May 2000
! MODIFIED Don Shirey, Aug 2009 (LatOutputProvided)
! July 2012, Chandan Sharma - FSEC: Added zone sys avail managers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine mainly controls the action of the unit ventilator
! (or more exactly, it controls the amount of outside air brought in)
! based on the user input for controls and the defined controls
! algorithms. There are currently (at the initial creation of this
! subroutine) two control methods: variable percent (ASHRAE "Cycle I"
! or "Cycle II") and fixed temperature (ASHRAE "Cycle III").
! METHODOLOGY EMPLOYED:
! Unit is controlled based on user input and what is happening in the
! simulation. There are various cases to consider:
! 1. OFF: Unit is schedule off or there is no load on it. All flow
! rates are set to zero and the temperatures are set to zone conditions
! (except for the outside air inlet).
! 2. HEATING/VARIABLE PERCENT: The unit is on, there is a heating load,
! and variable percent control is specified. The outside air fraction
! is set to the minimum outside air fraction (schedule based) and the
! heating coil is activated.
! 3. HEATING/FIXED TEMPERATURE: The unit is on, there is a heating load,
! and fixed temperature control is specified. The outside air fraction
! is varied in an attempt to obtain a mixed air temperature equal to
! the user specified temperature (schedule based). The heating coil
! is activated, if necessary.
! 4. COOLING/NO COIL: The unit is on, there is a cooling load, and no
! coil is present or it has been scheduled off. Set the amount of
! outside air based on the control type. Simulate the "mixing box".
! 5. COOLING/WITH COIL: The unit is on, there is a cooling load, and
! a cooling coil is present and scheduled on. Tries to use outside
! air as best as possible and then calls a cooling coil
! Note: controls are strictly temperature based and do not factor
! humidity into the equation (not an enthalpy economy cycle but rather
! a simple return air economy cycle). In addition, temperature predictions
! are not strict energy balances here in the control routine though
! in the mixing routine an energy balance is preserved.
! REFERENCES:
! ASHRAE Systems and Equipment Handbook (SI), 1996. page 31.3
! USE STATEMENTS:
USE DataZoneEnergyDemands
USE HeatingCoils, ONLY : CheckHeatingCoilSchedule
USE WaterCoils, ONLY : CheckWaterCoilSchedule
USE HVACHXAssistedCoolingCoil, ONLY :CheckHXAssistedCoolingCoilSchedule
Use SteamCoils, ONLY: CheckSteamCoilSchedule
USE DataInterfaces, ONLY: ControlCompOutput
USE DataZoneEquipment, ONLY: UnitVentilator_Num
USE DataHVACGlobals, ONLY: ZoneCompTurnFansOn, ZoneCompTurnFansOff
USE PlantUtilities, ONLY: SetComponentFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(INOUT) :: UnitVentNum ! number of the current fan coil unit being simulated
INTEGER, INTENT(IN) :: ZoneNum ! number of zone being served
LOGICAL, INTENT(IN) :: FirstHVACIteration ! TRUE if 1st HVAC simulation of system timestep
REAL(r64), INTENT(OUT) :: PowerMet ! Sensible power supplied (W)
REAL(r64), INTENT (OUT) :: LatOutputProvided ! Latent power supplied (kg/s), negative = dehumidification
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: LowTempDiff = 0.1d0 ! Smallest allowed temperature difference for comparisons
! (below this value the temperatures are assumed equal)
REAL(r64), PARAMETER :: LowOAFracDiff = 0.01d0 ! Smallest allowed outside air fraction difference for comparison
! (below this value the fractions are assumed equal)
! INTERFACE BLOCK SPECIFICATIONS
! see use DataInterfaces
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AirMassFlow ! air mass flow rate [kg/sec]
INTEGER :: AirRelNode ! outside air relief node
INTEGER :: ControlNode ! the hot water or cold water inlet node
REAL(r64) :: ControlOffset ! tolerance for output control
INTEGER :: InletNode ! unit air inlet node
REAL(r64) :: MaxOAFrac ! maximum possible outside air fraction
REAL(r64) :: MaxWaterFlow ! maximum water flow for heating or cooling [kg/sec]
REAL(r64) :: MinOAFrac ! minimum possible outside air fraction
REAL(r64) :: MinWaterFlow ! minimum water flow for heating or cooling [kg/sec]
INTEGER :: OutletNode ! unit air outlet node
INTEGER :: OutsideAirNode ! outside air node
REAL(r64) :: QTotUnitOut ! total unit output [watts]
REAL(r64) :: QUnitOut ! heating or sens. cooling provided by fan coil unit [watts]
REAL(r64) :: Tdesired ! desired temperature after mixing inlet and outdoor air [degrees C]
REAL(r64) :: Tinlet ! temperature of air coming into the unit ventilator [degrees C]
REAL(r64) :: Toutdoor ! temperature of outdoor air being introduced into the unit ventilator [degrees C]
REAL(r64) :: MaxSteamFlow
REAL(r64) :: MinSteamFlow
REAL(r64) :: LatentOutput ! Latent (moisture) add/removal rate, negative is dehumidification [kg/s]
REAL(r64) :: SpecHumOut ! Specific humidity ratio of outlet air (kg moisture / kg moist air)
REAL(r64) :: SpecHumIn ! Specific humidity ratio of inlet air (kg moisture / kg moist air)
REAL(r64) :: mdot
SELECT CASE (UnitVent(UnitVentNum)%CoilOption)
CASE (BothOption)
SELECT CASE(UnitVent(UnitVentNum)%HCoilType)
CASE(Heating_WaterCoilType)
CALL CheckWaterCoilSchedule('Coil:Heating:Water',UnitVent(UnitVentNum)%HCoilName, &
UnitVent(UnitVentNum)%HCoilSchedValue,UnitVent(UnitVentNum)%HCoil_Index)
CASE(Heating_SteamCoilType)
CALL CheckSteamCoilSchedule('Coil:Heating:Steam',UnitVent(UnitVentNum)%HCoilName, &
UnitVent(UnitVentNum)%HCoilSchedValue,UnitVent(UnitVentNum)%HCoil_Index)
CASE(Heating_ElectricCoilType)
CALL CheckHeatingCoilSchedule('Coil:Heating:Electric',UnitVent(UnitVentNum)%HCoilName, &
UnitVent(UnitVentNum)%HCoilSchedValue,UnitVent(UnitVentNum)%HCoil_Index)
CASE(Heating_GasCoilType)
CALL CheckHeatingCoilSchedule('Coil:Heating:Gas',UnitVent(UnitVentNum)%HCoilName, &
UnitVent(UnitVentNum)%HCoilSchedValue,UnitVent(UnitVentNum)%HCoil_Index)
CASE DEFAULT
! CALL ShowFatalError('Illegal coil type='//TRIM(UnitVent(UnitVentNum)%HCoilType))
END SELECT
SELECT CASE(UnitVent(UnitVentNum)%CCoilType)
CASE(Cooling_CoilWaterCooling)
CALL CheckWaterCoilSchedule('Coil:Cooling:Water',UnitVent(UnitVentNum)%CCoilName, &
UnitVent(UnitVentNum)%CCoilSchedValue,UnitVent(UnitVentNum)%CCoil_Index)
CASE(Cooling_CoilDetailedCooling)
CALL CheckWaterCoilSchedule('Coil:Cooling:Water:DetailedGeometry',UnitVent(UnitVentNum)%CCoilName, &
UnitVent(UnitVentNum)%CCoilSchedValue,UnitVent(UnitVentNum)%CCoil_Index)
CASE(Cooling_CoilHXAssisted)
CALL CheckHXAssistedCoolingCoilSchedule('CoilSystem:Cooling:Water:HeatExchangerAssisted',UnitVent(UnitVentNum)%CCoilName, &
UnitVent(UnitVentNum)%CCoilSchedValue,UnitVent(UnitVentNum)%CCoil_Index)
CASE DEFAULT
! CALL ShowFatalError('Illegal coil type='//TRIM(UnitVent(UnitVentNum)%CCoilType))
END SELECT
CASE (HeatingOption)
SELECT CASE(UnitVent(UnitVentNum)%HCoilType)
CASE(Heating_WaterCoilType)
CALL CheckWaterCoilSchedule('Coil:Heating:Water',UnitVent(UnitVentNum)%HCoilName, &
UnitVent(UnitVentNum)%HCoilSchedValue,UnitVent(UnitVentNum)%HCoil_Index)
CASE(Heating_SteamCoilType)
CALL CheckSteamCoilSchedule('Coil:Heating:Steam',UnitVent(UnitVentNum)%HCoilName, &
UnitVent(UnitVentNum)%HCoilSchedValue,UnitVent(UnitVentNum)%HCoil_Index)
CASE(Heating_ElectricCoilType)
CALL CheckHeatingCoilSchedule('Coil:Heating:Electric',UnitVent(UnitVentNum)%HCoilName, &
UnitVent(UnitVentNum)%HCoilSchedValue,UnitVent(UnitVentNum)%HCoil_Index)
CASE(Heating_GasCoilType)
CALL CheckHeatingCoilSchedule('Coil:Heating:Gas',UnitVent(UnitVentNum)%HCoilName, &
UnitVent(UnitVentNum)%HCoilSchedValue,UnitVent(UnitVentNum)%HCoil_Index)
CASE DEFAULT
! CALL ShowFatalError('Illegal coil type='//TRIM(UnitVent(UnitVentNum)%HCoilType))
END SELECT
CASE (CoolingOption)
SELECT CASE(UnitVent(UnitVentNum)%CCoilType)
CASE(Cooling_CoilWaterCooling)
CALL CheckWaterCoilSchedule('Coil:Cooling:Water',UnitVent(UnitVentNum)%CCoilName, &
UnitVent(UnitVentNum)%CCoilSchedValue,UnitVent(UnitVentNum)%CCoil_Index)
CASE(Cooling_CoilDetailedCooling)
CALL CheckWaterCoilSchedule('Coil:Cooling:Water:DetailedGeometry',UnitVent(UnitVentNum)%CCoilName, &
UnitVent(UnitVentNum)%CCoilSchedValue,UnitVent(UnitVentNum)%CCoil_Index)
CASE(Cooling_CoilHXAssisted)
CALL CheckHXAssistedCoolingCoilSchedule('CoilSystem:Cooling:Water:HeatExchangerAssisted',UnitVent(UnitVentNum)%CCoilName, &
UnitVent(UnitVentNum)%CCoilSchedValue,UnitVent(UnitVentNum)%CCoil_Index)
CASE DEFAULT
! CALL ShowFatalError('Illegal coil type='//TRIM(UnitVent(UnitVentNum)%CCoilType))
END SELECT
CASE (NoneOption)
END SELECT
! FLOW:
FanElecPower = 0.0d0
! initialize local variables
ControlNode = 0
QUnitOut = 0.0d0
LatentOutput = 0.0d0
ControlOffset = 0.0d0
MaxWaterFlow = 0.0d0
MinWaterFlow = 0.0d0
InletNode = UnitVent(UnitVentNum)%AirInNode
OutletNode = UnitVent(UnitVentNum)%AirOutNode
OutsideAirNode = UnitVent(UnitVentNum)%OutsideAirNode
AirRelNode = UnitVent(UnitVentNum)%AirReliefNode
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired ! zone load needed
IF ( (ABS(QZnReq) < SmallLoad) .OR. &
(CurDeadBandOrSetback(ZoneNum)) .OR. &
(GetCurrentScheduleValue(UnitVent(UnitVentNum)%SchedPtr) <= 0).OR. &
((GetCurrentScheduleValue(UnitVent(UnitVentNum)%FanAvailSchedPtr) <= 0 &
.AND. .NOT. ZoneCompTurnFansOn) .OR. ZoneCompTurnFansOff) ) THEN
! Unit is off or has no load upon it; set the flow rates to zero and then
! simulate the components with the no flow conditions
AirMassFlow = Node(OutletNode)%MassFlowRate
HCoilOn = .FALSE.
IF (UnitVent(UnitVentNum)%HotControlNode > 0) THEN
mdot = 0.d0
Call SetComponentFlowRate( mdot, &
UnitVent(UnitVentNum)%HotControlNode, &
UnitVent(UnitVentNum)%HotCoilOutNodeNum, &
UnitVent(UnitVentNum)%HWLoopNum, &
UnitVent(UnitVentNum)%HWLoopSide, &
UnitVent(UnitVentNum)%HWBranchNum, &
UnitVent(UnitVentNum)%HWCompNum)
ENDIF
IF (UnitVent(UnitVentNum)%ColdControlNode > 0) THEN
mdot = 0.d0
Call SetComponentFlowRate( mdot, &
UnitVent(UnitVentNum)%ColdControlNode, &
UnitVent(UnitVentNum)%ColdCoilOutNodeNum, &
UnitVent(UnitVentNum)%CWLoopNum, &
UnitVent(UnitVentNum)%CWLoopSide, &
UnitVent(UnitVentNum)%CWBranchNum, &
UnitVent(UnitVentNum)%CWCompNum)
ENDIF
CALL CalcUnitVentilatorComponents(UnitVentNum,FirstHVACIteration,QUnitOut)
ELSE ! Unit is on-->this section is intended to control the outside air and the main
! result is to set the outside air flow rate variable OAMassFlowRate
IF (QZnReq > SmallLoad) THEN ! HEATING MODE
ControlNode = UnitVent(UnitVentNum)%HotControlNode
ControlOffset = UnitVent(UnitVentNum)%HotControlOffset
MaxWaterFlow = UnitVent(UnitVentNum)%MaxHotWaterFlow
MinWaterFlow = UnitVent(UnitVentNum)%MinHotWaterFlow
MaxSteamFlow = UnitVent(UnitVentNum)%MaxHotSteamFlow
MinSteamFlow = UnitVent(UnitVentNum)%MinHotSteamFlow
!On the first HVAC iteration the system values are given to the controller, but after that
! the demand limits are in place and there needs to be feedback to the Zone Equipment
If(.not. FirstHVACIteration .and. UnitVent(UnitVentNum)%HCoilType == Heating_WaterCoilType) Then
MaxWaterFlow = Node(ControlNode)%MassFlowRateMaxAvail
MinWaterFlow = Node(ControlNode)%MassFlowRateMinAvail
End If
If(.not. FirstHVACIteration .and. UnitVent(UnitVentNum)%HCoilType == Heating_SteamCoilType) Then
MaxSteamFlow = Node(ControlNode)%MassFlowRateMaxAvail
MinSteamFlow = Node(ControlNode)%MassFlowRateMinAvail
End If
HCoilOn = .TRUE.
If(Node(OutsideAirNode)%MassFlowRate > 0.0d0) Then
MinOAFrac = GetCurrentScheduleValue(UnitVent(UnitVentNum)%MinOASchedPtr) * &
(UnitVent(UnitVentNum)%MinOutAirMassFlow / Node(OutsideAirNode)%MassFlowRate)
Else
MinOAFrac = 0.0d0
End If
MinOAFrac = MIN(1.0d0,MAX(0.0d0,MinOAFrac))
IF ( (.NOT.UnitVent(UnitVentNum)%HCoilPresent) .OR. &
(UnitVent(UnitVentNum)%HCoilSchedValue <= 0.0d0) ) THEN
! In heating mode, but there is no coil to provide heating. This is handled
! differently than if there was a heating coil present. Fixed temperature
! will still try to vary the amount of outside air to meet the desired
! mixed air temperature, while variable percent will go to full ventilation
! when it is most advantageous.
SELECT CASE (UnitVent(UnitVentNum)%OAControlType)
Case (FixedOAControl)
! In this control type, the outdoor air flow rate is fixed to the minimum value
! which is equal to the maximum value, regardless of all the other conditions.
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (VariablePercent)
! This algorithm is probably a bit simplistic in that it just bounces
! back and forth between the maximum outside air and the minimum. In
! REAL(r64)ity, a system *might* vary between the two based on the load in
! the zone.
Tinlet = Node(InletNode)%Temp
Toutdoor = Node(OutsideAirNode)%Temp
IF (Tinlet >= Toutdoor) THEN
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Tinlet < Toutdoor
MaxOAFrac = GetCurrentScheduleValue(UnitVent(UnitVentNum)%MaxOASchedPtr)
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
CASE (FixedTemperature)
! In heating mode, the outside air for "fixed temperature" attempts
! to control the outside air fraction so that a desired temperature
! is met (if possible). If this desired temperature is between the
! outside air temperature and the zone air temperature (inlet air
! temperature), then this is possible. If not, the control will try
! to maximize the amount of air coming from the source that is closer
! in temperature to the desired temperature.
Tdesired = GetCurrentScheduleValue(UnitVent(UnitVentNum)%TempSchedPtr)
Tinlet = Node(InletNode)%Temp
Toutdoor = Node(OutsideAirNode)%Temp
MaxOAFrac = 1.0d0
IF (ABS(Tinlet-Toutdoor) <= LowTempDiff) THEN ! no difference in indoor and outdoor conditions-->set OA to minimum
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF (ABS(MaxOAFrac-MinOAFrac) <= LowOAFracDiff) THEN ! no difference in outside air fractions
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF ( ( (Tdesired <= Tinlet) .AND. (Tdesired >= Toutdoor) ) .OR. &
( (Tdesired >= Tinlet) .AND. (Tdesired <= Toutdoor) ) ) THEN
! Desired temperature is between the inlet and outdoor temperatures
! so vary the flow rate between no outside air and no recirculation air
! then applying the maximum and minimum limits the user has scheduled
! to make sure too much/little outside air is being introduced
OAMassFlowRate = ((Tdesired - Tinlet)/(Toutdoor - Tinlet))*Node(InletNode)%MassFlowRate
OAMassFlowRate = MAX(OAMassFlowRate,(MinOAFrac*Node(OutsideAirNode)%MassFlowRate))
OAMassFlowRate = MIN(OAMassFlowRate,(MaxOAFrac*Node(OutsideAirNode)%MassFlowRate))
ELSE IF ( (Tdesired < Tinlet) .AND. (Tdesired < Toutdoor) ) THEN
! Desired temperature is below both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet < Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE IF ( (Tdesired > Tinlet) .AND. (Tdesired > Toutdoor) ) THEN
! Desired temperature is above both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet > Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE
! It should NEVER get to this point, but just in case...
CALL ShowFatalError('ZoneHVAC:UnitVentilator simulation control: illogical condition for '// &
TRIM(UnitVent(UnitVentNum)%Name))
END IF
END SELECT
CALL CalcUnitVentilatorComponents(UnitVentNum,FirstHVACIteration,QUnitOut)
ELSE ! Coil/no coil block
! There is a heating load and there is a heating coil present (presumably).
! Variable percent will throttle outside air back to the minimum while
! fixed temperature will still try to vary the outside air amount to meet
! the desired mixed air temperature.
SELECT CASE (UnitVent(UnitVentNum)%OAControlType)
Case (FixedOAControl)
! In this control type, the outdoor air flow rate is fixed to the maximum value
! which is equal to the minimum value, regardless of all the other conditions.
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (VariablePercent)
! In heating mode, the outside air for "variable percent" control
! is set to the minimum value
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (FixedTemperature)
! In heating mode, the outside air for "fixed temperature" attempts
! to control the outside air fraction so that a desired temperature
! is met (if possible). If this desired temperature is between the
! outside air temperature and the zone air temperature (inlet air
! temperature), then this is possible. If not, the control will try
! to maximize the amount of air coming from the source that is closer
! in temperature to the desired temperature.
Tdesired = GetCurrentScheduleValue(UnitVent(UnitVentNum)%TempSchedPtr)
Tinlet = Node(InletNode)%Temp
Toutdoor = Node(OutsideAirNode)%Temp
MaxOAFrac = 1.0d0
IF (ABS(Tinlet-Toutdoor) <= LowTempDiff) THEN ! no difference in indoor and outdoor conditions-->set OA to minimum
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF (ABS(MaxOAFrac-MinOAFrac) <= LowOAFracDiff) THEN ! no difference in outside air fractions
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF ( ( (Tdesired <= Tinlet) .AND. (Tdesired >= Toutdoor) ) .OR. &
( (Tdesired >= Tinlet) .AND. (Tdesired <= Toutdoor) ) ) THEN
! Desired temperature is between the inlet and outdoor temperatures
! so vary the flow rate between no outside air and no recirculation air
! then applying the maximum and minimum limits the user has scheduled
! to make sure too much/little outside air is being introduced
OAMassFlowRate = ((Tdesired - Tinlet)/(Toutdoor - Tinlet))*Node(InletNode)%MassFlowRate
OAMassFlowRate = MAX(OAMassFlowRate,(MinOAFrac*Node(OutsideAirNode)%MassFlowRate))
OAMassFlowRate = MIN(OAMassFlowRate,(MaxOAFrac*Node(OutsideAirNode)%MassFlowRate))
ELSE IF ( (Tdesired < Tinlet) .AND. (Tdesired < Toutdoor) ) THEN
! Desired temperature is below both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet < Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE IF ( (Tdesired > Tinlet) .AND. (Tdesired > Toutdoor) ) THEN
! Desired temperature is above both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet > Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE
! It should NEVER get to this point, but just in case...
CALL ShowFatalError('ZoneHVAC:UnitVentilator simulation control: illogical condition for '// &
TRIM(UnitVent(UnitVentNum)%Name))
END IF
END SELECT
SELECT CASE (UnitVent(UnitVentNum)%HCoilType)
CASE (Heating_WaterCoilType)
! control water flow to obtain output matching QZnReq
CALL ControlCompOutput(CompName=UnitVent(UnitVentNum)%Name,CompType=cMO_UnitVentilator,CompNum=UnitVentNum, &
FirstHVACIteration=FirstHVACIteration,QZnReq=QZnReq, &
ActuatedNode=ControlNode,MaxFlow=MaxWaterFlow, &
MinFlow=MinWaterFlow,ControlOffSet=ControlOffset, &
ControlCompTypeNum=UnitVent(UnitVentNum)%ControlCompTypeNum, &
CompErrIndex=UnitVent(UnitVentNum)%CompErrIndex, &
LoopNum = UnitVent(UnitVentNum)%HWLoopNum, &
LoopSide = UnitVent(UnitVentNum)%HWLoopSide, &
BranchIndex = UnitVent(UnitVentNum)%HWBranchNum)
CASE (Heating_GasCoilType,Heating_ElectricCoilType,Heating_SteamCoilType)
CALL CalcUnitVentilatorComponents(UnitVentNum,FirstHVACIteration,QUnitOut)
END SELECT
END IF ! Coil/no coil block
ELSE ! COOLING MODE
ControlNode = UnitVent(UnitVentNum)%ColdControlNode
ControlOffset = UnitVent(UnitVentNum)%ColdControlOffset
MaxWaterFlow = UnitVent(UnitVentNum)%MaxColdWaterFlow
MinWaterFlow = UnitVent(UnitVentNum)%MinColdWaterFlow
!On the first HVAC iteration the system values are given to the controller, but after that
! the demand limits are in place and there needs to be feedback to the Zone Equipment
If((.not. FirstHVACIteration) .and. (ControlNode > 0) &
.and. (UnitVent(UnitVentNum)%CCoilPresent)) Then
MaxWaterFlow = Node(ControlNode)%MassFlowRateMaxAvail
MinWaterFlow = Node(ControlNode)%MassFlowRateMinAvail
End If
HCoilOn = .FALSE.
Tinlet = Node(InletNode)%Temp
Toutdoor = Node(OutsideAirNode)%Temp
If(Node(OutsideAirNode)%MassFlowRate > 0.0d0) Then
MinOAFrac = GetCurrentScheduleValue(UnitVent(UnitVentNum)%MinOASchedPtr) * &
(UnitVent(UnitVentNum)%MinOutAirMassFlow / Node(OutsideAirNode)%MassFlowRate)
Else
MinOAFrac = 0.0d0
End If
MinOAFrac = MIN(1.0d0,MAX(0.0d0,MinOAFrac))
IF ( (.NOT.UnitVent(UnitVentNum)%CCoilPresent) .OR. &
(UnitVent(UnitVentNum)%CCoilSchedValue <= 0.0d0) ) THEN
! In cooling mode, but there is no coil to provide cooling. This is handled
! differently than if there was a cooling coil present. Fixed temperature
! will still try to vary the amount of outside air to meet the desired
! mixed air temperature, while variable percent will go to full ventilation
! when it is most advantageous.
SELECT CASE (UnitVent(UnitVentNum)%OAControlType)
Case (FixedOAControl)
! In this control type, the outdoor air flow rate is fixed to the maximum value
! which is equal to the minimum value, regardless of all the other conditions.
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (VariablePercent)
! This algorithm is probably a bit simplistic in that it just bounces
! back and forth between the maximum outside air and the minimum. In
! REAL(r64)ity, a system *might* vary between the two based on the load in
! the zone. This simple flow control might cause some overcooling but
! chances are that if there is a cooling load and the zone temperature
! gets above the outside temperature that overcooling won't be significant.
IF (Tinlet <= Toutdoor) THEN
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Tinlet > Toutdoor
MaxOAFrac = GetCurrentScheduleValue(UnitVent(UnitVentNum)%MaxOASchedPtr)
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
CASE (FixedTemperature)
! This is basically the same algorithm as for the heating case...
Tdesired = GetCurrentScheduleValue(UnitVent(UnitVentNum)%TempSchedPtr)
MaxOAFrac = 1.0d0
IF (ABS(Tinlet-Toutdoor) <= LowTempDiff) THEN ! no difference in indoor and outdoor conditions-->set OA to minimum
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF (ABS(MaxOAFrac-MinOAFrac) <= LowOAFracDiff) THEN ! no difference in outside air fractions
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF ( ( (Tdesired <= Tinlet) .AND. (Tdesired >= Toutdoor) ) .OR. &
( (Tdesired >= Tinlet) .AND. (Tdesired <= Toutdoor) ) ) THEN
! Desired temperature is between the inlet and outdoor temperatures
! so vary the flow rate between no outside air and no recirculation air
! then applying the maximum and minimum limits the user has scheduled
! to make sure too much/little outside air is being introduced
OAMassFlowRate = ((Tdesired - Tinlet)/(Toutdoor - Tinlet))*Node(InletNode)%MassFlowRate
OAMassFlowRate = MAX(OAMassFlowRate,(MinOAFrac*Node(OutsideAirNode)%MassFlowRate))
OAMassFlowRate = MIN(OAMassFlowRate,(MaxOAFrac*Node(OutsideAirNode)%MassFlowRate))
ELSE IF ( (Tdesired < Tinlet) .AND. (Tdesired < Toutdoor) ) THEN
! Desired temperature is below both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet < Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE IF ( (Tdesired > Tinlet) .AND. (Tdesired > Toutdoor) ) THEN
! Desired temperature is above both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet > Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE
! It should NEVER get to this point, but just in case...
CALL ShowFatalError('ZoneHVAC:UnitVentilator simulation control: illogical condition for '// &
TRIM(UnitVent(UnitVentNum)%Name))
END IF
END SELECT
CALL CalcUnitVentilatorComponents(UnitVentNum,FirstHVACIteration,QUnitOut)
ELSE
! There is a cooling load and there is a cooling coil present (presumably).
! Variable percent will throttle outside air back to the minimum while
! fixed temperature will still try to vary the outside air amount to meet
! the desired mixed air temperature.
SELECT CASE (UnitVent(UnitVentNum)%OAControlType)
Case (FixedOAControl)
! In this control type, the outdoor air flow rate is fixed to the maximum value
! which is equal to the minimum value, regardless of all the other conditions.
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (VariablePercent)
! A cooling coil is present so let it try to do the cooling...
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (FixedTemperature)
! This is basically the same algorithm as for the heating case...
Tdesired = GetCurrentScheduleValue(UnitVent(UnitVentNum)%TempSchedPtr)
MaxOAFrac = 1.0d0
IF (ABS(Tinlet-Toutdoor) <= LowTempDiff) THEN ! no difference in indoor and outdoor conditions-->set OA to minimum
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF (ABS(MaxOAFrac-MinOAFrac) <= LowOAFracDiff) THEN ! no difference in outside air fractions
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF ( ( (Tdesired <= Tinlet) .AND. (Tdesired >= Toutdoor) ) .OR. &
( (Tdesired >= Tinlet) .AND. (Tdesired <= Toutdoor) ) ) THEN
! Desired temperature is between the inlet and outdoor temperatures
! so vary the flow rate between no outside air and no recirculation air
! then applying the maximum and minimum limits the user has scheduled
! to make sure too much/little outside air is being introduced
OAMassFlowRate = ((Tdesired - Tinlet)/(Toutdoor - Tinlet))*Node(InletNode)%MassFlowRate
OAMassFlowRate = MAX(OAMassFlowRate,(MinOAFrac*Node(OutsideAirNode)%MassFlowRate))
OAMassFlowRate = MIN(OAMassFlowRate,(MaxOAFrac*Node(OutsideAirNode)%MassFlowRate))
ELSE IF ( (Tdesired < Tinlet) .AND. (Tdesired < Toutdoor) ) THEN
! Desired temperature is below both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet < Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE IF ( (Tdesired > Tinlet) .AND. (Tdesired > Toutdoor) ) THEN
! Desired temperature is above both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet > Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE
! It should NEVER get to this point, but just in case...
CALL ShowFatalError('ZoneHVAC:UnitVentilator simulation control: illogical condition for '// &
TRIM(UnitVent(UnitVentNum)%Name))
END IF
END SELECT
! control water flow to obtain output matching QZnReq
HCoilOn = .FALSE.
CALL ControlCompOutput(CompName=UnitVent(UnitVentNum)%Name,CompType=cMO_UnitVentilator,CompNum=UnitVentNum, &
FirstHVACIteration=FirstHVACIteration,QZnReq=QZnReq, &
ActuatedNode=ControlNode,MaxFlow=MaxWaterFlow, &
MinFlow=MinWaterFlow,ControlOffSet=ControlOffset, &
ControlCompTypeNum=UnitVent(UnitVentNum)%ControlCompTypeNum, &
CompErrIndex=UnitVent(UnitVentNum)%CompErrIndex, &
LoopNum = UnitVent(UnitVentNum)%CWLoopNum, &
LoopSide = UnitVent(UnitVentNum)%CWLoopSide, &
BranchIndex = UnitVent(UnitVentNum)%CWBranchNum)
END IF
END IF ! ...end of HEATING/COOLING IF-THEN block
AirMassFlow = Node(OutletNode)%MassFlowRate
QUnitOut = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
END IF ! ...end of unit ON/OFF IF-THEN block
! CR9155 Remove specific humidity calculations
SpecHumOut = Node(OutletNode)%HumRat
SpecHumIn = Node(InletNode)%HumRat
LatentOutput = AirMassFlow * (SpecHumOut - SpecHumIn) ! Latent rate (kg/s), dehumid = negative
QTotUnitOut = AirMassFlow * (Node(OutletNode)%Enthalpy - Node(InletNode)%Enthalpy)
! Report variables...
UnitVent(UnitVentNum)%HeatPower = MAX(0.0d0,QUnitOut)
UnitVent(UnitVentNum)%SensCoolPower = ABS(MIN(0.0d0,QUnitOut))
UnitVent(UnitVentNum)%TotCoolPower = ABS(MIN(0.0d0,QTotUnitOut))
UnitVent(UnitVentNum)%ElecPower = FanElecPower
PowerMet = QUnitOut
LatOutputProvided = LatentOutput
RETURN
END SUBROUTINE CalcUnitVentilator