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) | :: | CBVAVNum | |||
real(kind=r64), | intent(inout) | :: | OnOffAirFlowRatio | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 SetAverageAirFlow(CBVAVNum,OnOffAirFlowRatio, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN July 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Set the average air mass flow rates for this time step
! Set OnOffAirFlowRatio to be used by DX coils
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE MixedAir, ONLY: SimOAMixer
USE Psychrometrics, ONLY: PsyCpAirFnWTdb
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataZoneEnergyDemands, ONLY: ZoneSysEnergyDemand
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: CBVAVNum ! Index to CBVAV system
REAL(r64) , INTENT (INOUT) :: OnOffAirFlowRatio ! Ratio of compressor ON airflow to average airflow over timestep
LOGICAL, INTENT (IN) :: FirstHVACIteration ! Flag denoting the first pass on the air loop simulation
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InletNode ! Inlet node number for CBVAVNum
INTEGER :: OutletNode ! Outlet node number for CBVAVNum
INTEGER :: MixerMixedAirNode ! Mixed air node number in OA mixer
INTEGER :: MixerOutsideAirNode ! Outside air node number in OA mixer
INTEGER :: MixerReliefAirNode ! Relief air node number in OA mixer
INTEGER :: MixerInletAirNode ! Mixed air node number in OA mixer
REAL(r64) :: AverageUnitMassFlow ! Average system air mass flow rate over time step [kg/s]
REAL(r64) :: AverageOAMassFlow ! Average outdoor air mass flow rate over time step [kg/s]
REAL(r64) :: CpSupplyAir ! Specific heat of outlet air [J/kg-K]
REAL(r64) :: CpZoneAir ! Specific heat of zone air [J/kg-K]
REAL(r64) :: DeltaCpTemp ! Temperature difference from supply air to zone air [C]
REAL(r64) :: ZoneMassFlow ! Zone mass flow rate required to meet zone load [kg/s]
REAL(r64) :: SystemMassFlow ! System mass flow rate required for all zones [kg/s]
INTEGER :: ZoneNum ! Index to zone
REAL(r64) :: ZoneLoad ! Zone load calculated by ZoneTempPredictor [W]
REAL(r64) :: QToHeatSetPt ! Load to heating setpoint [W]
REAL(r64) :: QToCoolSetPt ! Load to cooling setpoint [W]
INTEGER :: ZoneNodeNum ! Actual zone number
INTEGER :: BoxOutletNodeNum ! Zone supply air inlet node number
InletNode = CBVAV(CBVAVNum)%AirInNode
OutletNode = CBVAV(CBVAVNum)%AirOutNode
MixerMixedAirNode = CBVAV(CBVAVNum)%MixerMixedAirNode
MixerOutsideAirNode = CBVAV(CBVAVNum)%MixerOutsideAirNode
MixerReliefAirNode = CBVAV(CBVAVNum)%MixerReliefAirNode
MixerInletAirNode = CBVAV(CBVAVNum)%MixerInletAirNode
SystemMassFlow = 0.0d0
CpSupplyAir = PsyCpAirFnWTdb(Node(OutletNode)%HumRat,Node(OutletNode)%Temp)
! Determine zone air flow
DO ZoneNum = 1, CBVAV(CBVAVNum)%NumControlledZones
ZoneNodeNum = CBVAV(CBVAVNum)%ActualZoneNodeNum(ZoneNum)
BoxOutletNodeNum = CBVAV(CBVAVNum)%CBVAVBoxOutletNode(ZoneNum)
IF ((CBVAV(CBVAVNum)%ZoneSequenceCoolingNum(ZoneNum) > 0) .AND. (CBVAV(CBVAVNum)%ZoneSequenceHeatingNum(ZoneNum) > 0)) THEN
QToCoolSetPt = ZoneSysEnergyDemand(CBVAV(CBVAVNum)%ControlledZoneNum(ZoneNum))%&
SequencedOutputRequiredToCoolingSP(CBVAV(CBVAVNum)%ZoneSequenceCoolingNum(ZoneNum))
QToHeatSetPt = ZoneSysEnergyDemand(CBVAV(CBVAVNum)%ControlledZoneNum(ZoneNum))%&
SequencedOutputRequiredToHeatingSP(CBVAV(CBVAVNum)%ZoneSequenceHeatingNum(ZoneNum))
IF (QToHeatSetPt > 0.d0 .AND. QToCoolSetPt > 0.d0) THEN
ZoneLoad = QToHeatSetPt
ELSEIF (QToHeatSetPt < 0.d0 .AND. QToCoolSetPt < 0.d0) THEN
ZoneLoad = QToCoolSetPt
ELSEIF (QToHeatSetPt <= 0.d0 .AND. QToCoolSetPt >= 0.d0) THEN
ZoneLoad = 0.d0
ENDIF
ELSE
ZoneLoad = ZoneSysEnergyDemand(CBVAV(CBVAVNum)%ControlledZoneNum(ZoneNum))%RemainingOutputRequired
QToHeatSetPt = ZoneSysEnergyDemand(CBVAV(CBVAVNum)%ControlledZoneNum(ZoneNum))%OutputRequiredToHeatingSP
ENDIF
CpZoneAir = PsyCpAirFnWTdb(Node(ZoneNodeNum)%HumRat,Node(ZoneNodeNum)%Temp)
DeltaCpTemp = CpSupplyAir*Node(OutletNode)%Temp - CpZoneAir*Node(ZoneNodeNum)%Temp
!Need to check DeltaCpTemp and ensure that it is not zero
IF(DeltaCpTemp .NE. 0.0d0) THEN ! .AND. .NOT. CurDeadBandOrSetback(ZoneNum))THEN
ZoneMassFlow = ZoneLoad/DeltaCpTemp
ELSE
! reset to 0 so we don't add in the last zone's mass flow rate
ZoneMassFlow = 0.0d0
END IF
SystemMassFlow = SystemMassFlow + &
MAX(Node(BoxOutletNodeNum)%MassFlowRateMin,MIN(ZoneMassFlow,Node(BoxOutletNodeNum)%MassFlowRateMax))
END DO
AverageUnitMassFlow = CompOnMassFlow
AverageOAMassFlow = OACompOnMassFlow
FanSpeedRatio = CompOnFlowRatio
Node(MixerInletAirNode) = Node(InletNode)
Node(MixerMixedAirNode)%MassFlowRateMin = 0.0d0
IF (GetCurrentScheduleValue(CBVAV(CBVAVNum)%SchedPtr) .EQ. 0.0d0 .OR. AverageUnitMassFlow .EQ. 0.0d0) THEN
Node(InletNode)%MassFlowRate = 0.0d0
Node(MixerOutsideAirNode)%MassFlowRate = 0.0d0
Node(MixerReliefAirNode)%MassFlowRate = 0.0d0
OnOffAirFlowRatio = 0.0d0
ByPassDuctFlowFraction = 0.0d0
ELSE
Node(MixerInletAirNode)%MassFlowRate = AverageUnitMassFlow
Node(MixerOutsideAirNode)%MassFlowRate = AverageOAMassFlow
Node(MixerReliefAirNode)%MassFlowRate = AverageOAMassFlow
IF (FirstHVACIteration) THEN
OnOffAirFlowRatio = 1.0d0
ByPassDuctFlowFraction = 0.0d0
ELSE
OnOffAirFlowRatio = 1.0d0
ByPassDuctFlowFraction = MAX(0.0d0,1.0d0 - (Node(InletNode)%MassFlowRate/AverageUnitMassFlow))
END IF
END IF
RETURN
END SUBROUTINE SetAverageAirFlow