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.
CALL ShowContinueErrorTimeStamp('Air volume flow rate ratio = '//TRIM(RoundSigDigits(HXAirVolFlowRatio,3))//'.') ELSE CALL ShowRecurringWarningErrorAtEnd(TRIM(OutAirUnit(OAUnitNum)%Name)//& ': Air mass balance is required by other outdoor air units, ZoneMixing, ZoneCrossMixing, or other air flow control inputs.'& , OutAirUnit(OAUnitNum)%UnBalancedErrIndex)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(inout) | :: | OAUnitNum | |||
integer, | intent(in) | :: | ZoneNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(out) | :: | PowerMet | |||
real(kind=r64), | intent(out) | :: | LatOutputProvided |
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 CalcOutdoorAirUnit(OAUnitNum,ZoneNum,FirstHVACIteration,PowerMet,LatOutputProvided)
! SUBROUTINE INFORMATION:
! AUTHOR Young Tae Chae, Rick Strand
! DATE WRITTEN June 2008
! MODIFIED 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 outdoor air unit
! (or more exactly, it controls the coil outlet temperature of the unit)
! based on the user input for controls and the defined controls
! algorithms.
! METHODOLOGY EMPLOYED:
! Outdoor air unit is controlled based on user input and what is happening in the
! simulation.
! 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 cycle).
! REFERENCES:
! ASHRAE Systems and Equipment Handbook (SI), 1996. page 31.3
! USE STATEMENTS:
USE DataZoneEnergyDemands
USE DataEnvironment, ONLY : OutDryBulbTemp, OutWetBulbTemp, EnvironmentName, CurMnDy, OutBaroPress
USE DataHeatBalFanSys, ONLY : MAT,ZoneAirHumRat
USE DataLoopNode, ONLY : Node
USE ScheduleManager, ONLY : GetCurrentScheduleValue
USE HeatingCoils, ONLY : CheckHeatingCoilSchedule
USE WaterCoils, ONLY : CheckWaterCoilSchedule
USE HVACHXAssistedCoolingCoil, ONLY : CheckHXAssistedCoolingCoilSchedule
Use SteamCoils, ONLY : CheckSteamCoilSchedule
USE Fans, ONLY : SimulateFanComponents
USE DataHVACGlobals, ONLY : ZoneCompTurnFansOn, ZoneCompTurnFansOff
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(INOUT) :: OAUnitNum ! number of the current 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 ! power supplied
REAL(r64), INTENT (OUT) :: LatOutputProvided ! Latent power supplied (kg/s), negative = dehumidification
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='ZoneHVAC:OutdoorAirUnit'
INTEGER :: CompNum
CHARACTER(len=MaxNameLength) :: EquipType
CHARACTER(len=MaxNameLength) :: EquipName
CHARACTER(len=MaxNameLength) :: CtrlName
LOGICAL :: Sim
LOGICAL :: ReSim
REAL(r64) :: DesOATemp ! Design OA Temp degree C
REAL(r64) :: AirMassFlow ! air mass flow rate [kg/s]
INTEGER :: ControlNode ! the hot water or cold water inlet node
INTEGER :: InletNode ! Unit air inlet node
INTEGER :: SFanOutletNode ! Unit supply fan outlet node
INTEGER :: ZoneAirInNode ! zone supply air node
REAL(r64) :: MaxWaterFlow ! maximum water flow for heating or cooling [kg/sec]
REAL(r64) :: MinWaterFlow ! minimum water flow for heating or cooling [kg/sec]
INTEGER :: OutletNode ! 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) :: LatLoadMet ! heating or sens. cooling provided by fan coil unit [watts]
REAL(r64) :: MinHumRat ! desired temperature after mixing inlet and outdoor air [degrees C]
REAL(r64) :: SetpointTemp ! temperature that will be used to control the radiant system [Celsius]
REAL(r64) :: HiCtrlTemp ! Current high point in setpoint temperature range
REAL(r64) :: LoCtrlTemp ! Current low point in setpoint temperature range
REAL(r64) :: CpFan ! Intermediate calculational variable for specific heat of air <<NOV9 Updated
REAL(r64) :: airinent ! RE-calcualte the Enthalpy of supply air
REAL(r64) :: outsideent ! RE-calculate the Enthalpy of outdoor air
REAL(r64) :: AirOutletTemp
INTEGER :: OperatingMode =0
INTEGER :: UnitControlType =0
REAL(r64) :: OutSideAirEnt ! Specific humidity ratio of outlet air (kg moisture / kg moist air)
REAL(r64) :: ZoneSupAirEnt ! Specific humidity ratio of inlet air (kg moisture / kg moist air)
! Latent output
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) :: OAMassFlowRate
REAL(r64) :: EAMassFlowRate
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
LOGICAL :: FatalErrorFlag
REAL(r64) :: ZoneAirEnt ! zone air enthalphy J/kg
! FLOW:
FanElecPower = 0.0D0
! initialize local variables
ControlNode = 0
QUnitOut = 0.0D0
IF (OutAirUnit(OAUnitNum)%ExtFan ) InletNode = OutAirUnit(OAUnitNum)%AirInletNode
SFanOutletNode = OutAirUnit(OAUnitNum)%SFanOutletNode
OutletNode = OutAirUnit(OAUnitNum)%AirOutletNode
OutsideAirNode = OutAirUnit(OAUnitNum)%OutsideAirNode
OperatingMode = OutAirUnit(OAUnitNum)%OperatingMode
UnitControltype = OutAirUnit(OAUnitNum)%ControlType
AirOutletTemp =0.0d0
OutAirUnit(OAUnitNum)%CompOutSetTemp=0.0d0
OutAirUnit(OAUnitNum)%FanEffect=.FALSE.
IF ((GetCurrentScheduleValue(OutAirUnit(OAUnitNum)%SchedPtr) <= 0) .OR. &
(GetCurrentScheduleValue(OutAirUnit(OAUnitNum)%OutAirSchedPtr) <= 0) .OR. &
(GetCurrentScheduleValue(OutAirUnit(OAUnitNum)%SFanAvailSchedPtr) <= 0) .AND. &
.NOT. ZoneCompTurnFansOn .OR. ZoneCompTurnFansOff) THEN
! System is off or has no load upon the unit; set the flow rates to zero and then
! simulate the components with the no flow conditions
IF (OutAirUnit(OAUnitNum)%ExtFan ) Node(InletNode)%MassFlowRate = 0.0d0
IF (OutAirUnit(OAUnitNum)%ExtFan ) Node(InletNode)%MassFlowRateMaxAvail = 0.0d0
IF (OutAirUnit(OAUnitNum)%ExtFan ) Node(InletNode)%MassFlowRateMinAvail = 0.0d0
Node(SFanOutletNode)%MassFlowRate = 0.0d0
Node(SFanOutletNode)%MassFlowRateMaxAvail = 0.0d0
Node(SFanOutletNode)%MassFlowRateMinAvail = 0.0d0
Node(OutletNode)%MassFlowRate = 0.0d0
Node(OutletNode)%MassFlowRateMaxAvail = 0.0d0
Node(OutletNode)%MassFlowRateMinAvail = 0.0d0
Node(OutsideAirNode)%MassFlowRate = 0.0d0
Node(OutsideAirNode)%MassFlowRateMaxAvail = 0.0d0
Node(OutsideAirNode)%MassFlowRateMinAvail = 0.0d0
AirMassFlow = Node(SFanOutletNode)%MassFlowRate
! Node condition
IF (OutAirUnit(OAUnitNum)%ExtFan ) THEN
Node(InletNode)%Temp = MAT(ZoneNum)
Node(SFanOutletNode)%Temp = Node(InletNode)%Temp
ELSE
Node(SFanOutletNode)%Temp = MAT(ZoneNum)
ENDIF
Node(OutletNode)%Temp = Node(SFanOutletNode)%Temp
IF (OutAirUnit(OAUnitNum)%FanPlace .EQ. BlowThru) THEN
CALL SimulateFanComponents(OutAirUnit(OAUnitNum)%SFanName,FirstHVACIteration,OutAirUnit(OAUnitNum)%SFan_Index, &
ZoneCompTurnFansOn = ZoneCompTurnFansOn,ZoneCompTurnFansOff = ZoneCompTurnFansOff)
OutAirUnit(OAUnitNum)%ElecFanRate=OutAirUnit(OAUnitNum)%ElecFanRate+FanElecPower
CALL SimZoneOutAirUnitComps(OAUnitNum,FirstHVACIteration)
IF (OutAirUnit(OAUnitNum)%ExtFan ) CALL SimulateFanComponents(OutAirUnit(OAUnitNum)%ExtFanName, &
FirstHVACIteration,OutAirUnit(OAUnitNum)%ExtFan_Index)
ELSE IF(OutAirUnit(OAUnitNum)%FanPlace .EQ. DrawThru) THEN
CALL SimZoneOutAirUnitComps(OAUnitNum,FirstHVACIteration)
CALL SimulateFanComponents(OutAirUnit(OAUnitNum)%SFanName,FirstHVACIteration,OutAirUnit(OAUnitNum)%SFan_Index, &
ZoneCompTurnFansOn = ZoneCompTurnFansOn,ZoneCompTurnFansOff = ZoneCompTurnFansOff)
IF (OutAirUnit(OAUnitNum)%ExtFan ) CALL SimulateFanComponents(OutAirUnit(OAUnitNum)%ExtFanName, &
FirstHVACIteration,OutAirUnit(OAUnitNum)%ExtFan_Index)
END IF
ELSE ! System On
!Flowrate Check
IF(Node(OutsideAirNode)%MassFlowRate > 0.0d0) Then
Node(OutsideAirNode)%MassFlowRate= OutAirUnit(OAUnitNum)%OutAirMassFlow
ENDIF
!Fan Positioning Check
IF (OutAirUnit(OAUnitNum)%ExtFan ) THEN
Node(InletNode)%MassFlowRate=OutAirUnit(OAUnitNum)%ExtAirMassFlow
END IF
!Air mass balance check (removed because exhaust and supply can be imbalanced
! IF ((Node(InletNode)%MassFlowRate > Node(OutsideAirNode)%MassFlowRate) &
! .OR.(Node(InletNode)%MassFlowRate < Node(OutsideAirNode)%MassFlowRate)) THEN
! OutAirUnit(OAUnitNum)%UnBalancedErrCount = OutAirUnit(OAUnitNum)%UnBalancedErrCount + 1
! IF (OutAirUnit(OAUnitNum)%UnBalancedErrCount .EQ. 1) THEN
! CALL ShowWarningError('Air mass flow between zone supply and exhaust is not balanced')
! CALL ShowContinueError('Occurs in ' // 'ZoneHVAC:OutdoorAirUnit' // ' Object=' &
! //TRIM(OutAirUnit(OAUnitNum)%Name))
! CALL ShowContinueError('Air mass balance is required by other outdoor air units,'// &
! 'ZoneMixing, ZoneCrossMixing, or other air flow control inputs.')
!!
!! CALL ShowContinueErrorTimeStamp('Air volume flow rate ratio = '//TRIM(RoundSigDigits(HXAirVolFlowRatio,3))//'.')
!!ELSE
!! CALL ShowRecurringWarningErrorAtEnd(TRIM(OutAirUnit(OAUnitNum)%Name)//&
!! ': Air mass balance is required by other outdoor air units, ZoneMixing, ZoneCrossMixing, or other air flow control inputs.'&
!! , OutAirUnit(OAUnitNum)%UnBalancedErrIndex)
! END IF
! END IF
IF (OutAirUnit(OAUnitNum)%FanPlace .EQ. BlowThru) THEN
CALL SimulateFanComponents(OutAirUnit(OAUnitNum)%SFanName,FirstHVACIteration,OutAirUnit(OAUnitNum)%SFan_Index)
DesOATemp = Node(SFanOutletNode)%Temp
ELSE IF(OutAirUnit(OAUnitNum)%FanPlace .EQ. DrawThru) THEN
DesOATemp = Node(OutsideAirNode)%Temp
END IF
!Control type check
SELECT CASE (UnitControlType)
CASE (Neutral)
SetpointTemp = MAT(ZoneNum)
!Neutral Control Condition
IF (DesOATemp == SetpointTemp) THEN
OutAirUnit(OAUnitNum)%OperatingMode = NeutralMode
AirOutletTemp = DesOATemp
OutAirUnit(OAUnitNum)%CompOutSetTemp=DesOATemp
Call SimZoneOutAirUnitComps(OAUnitNum,FirstHVACIteration)
ELSE
IF (DesOATemp < SetpointTemp) THEN ! Heating MODE
OutAirUnit(OAUnitNum)%OperatingMode = HeatingMode
AirOutletTemp = SetpointTemp
OutAirUnit(OAUnitNum)%CompOutSetTemp=AirOutletTemp
Call SimZoneOutAirUnitComps(OAUnitNum,FirstHVACIteration)
ELSE IF (DesOATemp > SetpointTemp) THEN !Cooling Mode
OutAirUnit(OAUnitNum)%OperatingMode = CoolingMode
AirOutletTemp = SetpointTemp
OutAirUnit(OAUnitNum)%CompOutSetTemp=AirOutletTemp
Call SimZoneOutAirUnitComps(OAUnitNum,FirstHVACIteration)
ENDIF
END IF
!SetPoint Temperature Condition
CASE (Temperature)
SetpointTemp = DesOATemp
HiCtrlTemp = GetCurrentScheduleValue(OutAirUnit(OAUnitNum)%HiCtrlTempSchedPtr)
LoCtrlTemp = GetCurrentScheduleValue(OutAirUnit(OAUnitNum)%LoCtrlTempSchedPtr)
IF ((DesOATemp <= HiCtrlTemp).AND.(DesOATemp >=LoCtrlTemp)) THEN
OutAirUnit(OAUnitNum)%OperatingMode = NeutralMode
AirOutletTemp = DesOATemp
OutAirUnit(OAUnitNum)%CompOutSetTemp=DesOATemp
Call SimZoneOutAirUnitComps(OAUnitNum,FirstHVACIteration)
ELSE
IF (SetpointTemp < LoCtrlTemp) THEN
OutAirUnit(OAUnitNum)%OperatingMode=HeatingMode
AirOutletTemp = LoCtrlTemp
OutAirUnit(OAUnitNum)%CompOutSetTemp=AirOutletTemp
Call SimZoneOutAirUnitComps(OAUnitNum,FirstHVACIteration)
ELSE IF (SetpointTemp > HiCtrlTemp) THEN
OutAirUnit(OAUnitNum)%OperatingMode = CoolingMode
AirOutletTemp = HiCtrlTemp
OutAirUnit(OAUnitNum)%CompOutSetTemp=AirOutletTemp
Call SimZoneOutAirUnitComps(OAUnitNum,FirstHVACIteration)
END IF
END IF
END SELECT
! Fan positioning
IF(OutAirUnit(OAUnitNum)%FanPlace .EQ. DrawThru) THEN
CALL SimulateFanComponents(OutAirUnit(OAUnitNum)%SFanName,FirstHVACIteration,OutAirUnit(OAUnitNum)%SFan_Index)
OutAirUnit(OAUnitNum)%FanEffect=.TRUE. !RE-Simulation to take over the supply fan effect
OutAirUnit(OAUnitNum)%FanCorTemp=(Node(Outletnode)%Temp-OutAirUnit(OAUnitNum)%CompOutSetTemp)
CALL SimZoneOutAirUnitComps(OAUnitNum,FirstHVACIteration)
CALL SimulateFanComponents(OutAirUnit(OAUnitNum)%SFanName,FirstHVACIteration,OutAirUnit(OAUnitNum)%SFan_Index)
OutAirUnit(OAUnitNum)%FanEffect=.FALSE.
END IF
IF (OutAirUnit(OAUnitNum)%ExtFan ) CALL SimulateFanComponents(OutAirUnit(OAUnitNum)%ExtFanName, &
FirstHVACIteration,OutAirUnit(OAUnitNum)%ExtFan_Index)
END IF ! ...end of system ON/OFF IF-THEN block
AirMassFlow = Node(OutletNode)%MassFlowRate
MinHumRat = MIN(Node(OutletNode)%HumRat,Node(OutAirUnit(OAUnitNum)%ZoneNodeNum)%HumRat)
AirInEnt = PsyHFnTdbW(Node(OutletNode)%Temp,MinHumRat) ! zone supply air node enthalpy
ZoneAirEnt = PsyHFnTdbW(Node(OutAirUnit(OAUnitNum)%ZoneNodeNum)%Temp,MinHumRat) ! zone air enthalpy
QUnitOut = AirMassFlow*(AirInEnt-ZoneAirEnt) ! Senscooling
! CR9155 Remove specific humidity calculations
SpecHumOut = Node(OutletNode)%HumRat
SpecHumIn = Node(OutAirUnit(OAUnitNum)%ZoneNodeNum)%HumRat
LatentOutput = AirMassFlow * (SpecHumOut - SpecHumIn) ! Latent rate (kg/s), dehumid = negative
ZoneAirEnT=PsyHFnTdbW(Node(OutAirUnit(OAUnitNum)%ZoneNodeNum)%Temp,Node(OutAirUnit(OAUnitNum)%ZoneNodeNum)%HumRat)
ZoneSupAirEnT=PsyHFnTdbW(Node(OutletNode)%Temp,Node(OutletNode)%HumRat)
QTotUnitOut = AirMassFlow * (ZoneSupAirEnt-ZoneAirEnT)
LatLoadMet = QTotUnitOut - QUnitOut ! watts
! Report variables...
IF(QUnitOut .LT. 0.0d0) THEN
OutAirUnit(OAUnitNum)%SensCoolingRate = ABS(QUnitOut)
OutAirUnit(OAUnitNum)%SensHeatingRate = 0.0d0
ELSE
OutAirUnit(OAUnitNum)%SensCoolingRate = 0.0d0
OutAirUnit(OAUnitNum)%SensHeatingRate = QUnitOut
END IF
IF(QTotUnitOut .LT. 0.0d0) THEN
OutAirUnit(OAUnitNum)%TotCoolingRate = ABS(QTotUnitOut)
OutAirUnit(OAUnitNum)%TotHeatingRate = 0.0d0
ELSE
OutAirUnit(OAUnitNum)%TotCoolingRate = 0.0d0
OutAirUnit(OAUnitNum)%TotHeatingRate = QTotUnitOut
END IF
IF(LatLoadMet .LT. 0.0d0) THEN
OutAirUnit(OAUnitNum)%LatCoolingRate = ABS(LatLoadMet)
OutAirUnit(OAUnitNum)%LatHeatingRate = 0.0d0
ELSE
OutAirUnit(OAUnitNum)%LatCoolingRate = 0.0d0
OutAirUnit(OAUnitNum)%LatHeatingRate = LatLoadMet
END IF
OutAirUnit(OAUnitNum)%ElecFanRate = FanElecPower
PowerMet = QUnitOut
LatOutputProvided = LatentOutput
RETURN
END SUBROUTINE CalcOutdoorAirUnit