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.
Adding up zone inlet/outlet nodes is not working correctly. When imbalance flow occurs, the difference is placed on the zone return node even when there is nothing connected to it.
Add in return node mass flow rate to total exhaust
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | StandAloneERVNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(out) | :: | SensLoadMet | |||
real(kind=r64), | intent(out) | :: | LatentMassLoadMet |
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 CalcStandAloneERV(StandAloneERVNum,FirstHVACIteration,SensLoadMet,LatentMassLoadMet)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad, FSEC
! DATE WRITTEN June 2003
! MODIFIED Don Shirey, Aug 2009 (LatentMassLoadMet)
! July 2012, Chandan Sharma - FSEC: Added zone sys avail managers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulate the components making up the Stand Alone ERV unit.
! METHODOLOGY EMPLOYED:
! Simulates the unit components sequentially in the air flow direction.
! REFERENCES:
! na
! USE STATEMENTS:
USE Fans, ONLY: SimulateFanComponents
USE HeatRecovery, ONLY: SimHeatRecovery
USE Psychrometrics, ONlY: PsyHFnTdbW
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE General, ONLY: RoundSigDigits
USE DataAirLoop, ONLY: OAControllerInfo
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: StandAloneERVNum ! Unit index in ERV data structure
LOGICAL, INTENT (IN) :: FirstHVACIteration ! flag for 1st HVAC iteration in the time step
REAL(r64), INTENT (OUT) :: SensLoadMet ! sensible zone load met by unit (W)
REAL(r64), INTENT (OUT) :: LatentMassLoadMet ! latent zone load met by unit (kg/s), dehumid = negative
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: SupOutletNode ! unit supply air outlet node
INTEGER :: ExhaustInletNode ! unit exhaust air inlet node
INTEGER :: SupInletNode ! unit supply air inlet node
REAL(r64) :: AirMassFlow ! total mass flow through supply side of the ERV (supply air outlet node)
REAL(r64) :: MinHumRatio ! minimum humidity ratio for calculating sensible load met
! (so enthalpy routines work without error)
REAL(r64) :: TotLoadMet ! total zone load met by unit (W)
REAL(r64) :: LatLoadMet ! latent zone load met by unit (W)
LOGICAL :: HXUnitOn ! flag to operate heat exchanger heat recovery
LOGICAL :: EconomizerFlag ! economizer signal from OA controller
LOGICAL :: HighHumCtrlFlag ! high humditiy control signal from OA controller
! INTEGER :: ControlledZoneNum ! index to controlled zones
! INTEGER :: ExhaustNodeNum ! index to exhaust nodes in controlled zones
! INTEGER :: SupplyNodeNum ! index to supply nodes in controlled zone
! LOGICAL :: ExhaustNodeFound ! used in controlled zone exhaust node search
REAL(r64) :: TotalExhaustMassFlow ! total exhaust air mass flow rate in controlled zone
REAL(r64) :: TotalSupplyMassFlow ! total supply air mass flow rate in controlled zone
SupInletNode = StandAloneERV(StandAloneERVNum)%SupplyAirInletNode
SupOutletNode = StandAloneERV(StandAloneERVNum)%SupplyAirOutletNode
ExhaustInletNode = StandAloneERV(StandAloneERVNum)%ExhaustAirInletNode
! Stand alone ERV's HX is ON by default
HXUnitOn = .TRUE.
! Get stand alone ERV's controller economizer and high humidity control status
IF(StandAloneERV(StandAloneERVNum)%ControllerNameDefined)THEN
EconomizerFlag = OAControllerInfo(StandAloneERV(StandAloneERVNum)%ControllerIndex)%EconoActive
HighHumCtrlFlag = OAControllerInfo(StandAloneERV(StandAloneERVNum)%ControllerIndex)%HighHumCtrlActive
ELSE
EconomizerFlag = .FALSE.
HighHumCtrlFlag = .FALSE.
END IF
CALL SimHeatRecovery(StandAloneERV(StandAloneERVNum)%HeatExchangerName,FirstHVACIteration, &
StandAloneERV(StandAloneERVNum)%HeatExchangerIndex, ContFanCycCoil, HXUnitEnable=HXUnitOn, &
EconomizerFlag = EconomizerFlag, HighHumCtrlFlag = HighHumCtrlFlag)
StandAloneERV(StandAloneERVNum)%ElecUseRate = AirToAirHXElecPower
CALL SimulateFanComponents(StandAloneERV(StandAloneERVNum)%SupplyAirFanName,FirstHVACIteration, &
StandAloneERV(StandAloneERVNum)%SupplyAirFanIndex, &
ZoneCompTurnFansOn =ZoneCompTurnFansOn,ZoneCompTurnFansOff =ZoneCompTurnFansOff)
StandAloneERV(StandAloneERVNum)%ElecUseRate = StandAloneERV(StandAloneERVNum)%ElecUseRate + FanElecPower
CALL SimulateFanComponents(StandAloneERV(StandAloneERVNum)%ExhaustAirFanName,FirstHVACIteration, &
StandAloneERV(StandAloneERVNum)%ExhaustAirFanIndex)
StandAloneERV(StandAloneERVNum)%ElecUseRate = StandAloneERV(StandAloneERVNum)%ElecUseRate + FanElecPower
MinHumRatio = Node(ExhaustInletNode)%HumRat
IF(Node(SupOutletNode)%HumRat .LT. Node(ExhaustInletNode)%HumRat) MinHumRatio = Node(SupOutletNode)%HumRat
AirMassFlow = Node(SupOutletNode)%MassFlowRate
SensLoadMet = AirMassFlow * (PsyHFnTdbW(Node(SupOutletNode)%Temp,MinHumRatio) &
- PsyHFnTdbW(Node(ExhaustInletNode)%Temp,MinHumRatio))
TotLoadMet = AirMassFlow * (PsyHFnTdbW(Node(SupOutletNode)%Temp,Node(SupOutletNode)%HumRat) &
- PsyHFnTdbW(Node(ExhaustInletNode)%Temp,Node(ExhaustInletNode)%HumRat))
LatLoadMet = TotLoadMet - SensLoadMet ! watts
LatentMassLoadMet = AirMassFlow * (Node(SupOutletNode)%HumRat - Node(ExhaustInletNode)%HumRat) ! kg/s, dehumidification = negative
IF(SensLoadMet .LT. 0.0d0) THEN
StandAloneERV(StandAloneERVNum)%SensCoolingRate = ABS(SensLoadMet)
StandAloneERV(StandAloneERVNum)%SensHeatingRate = 0.0d0
ELSE
StandAloneERV(StandAloneERVNum)%SensCoolingRate = 0.0d0
StandAloneERV(StandAloneERVNum)%SensHeatingRate = SensLoadMet
END IF
IF(TotLoadMet .LT. 0.0d0) THEN
StandAloneERV(StandAloneERVNum)%TotCoolingRate = ABS(TotLoadMet)
StandAloneERV(StandAloneERVNum)%TotHeatingRate = 0.0d0
ELSE
StandAloneERV(StandAloneERVNum)%TotCoolingRate = 0.0d0
StandAloneERV(StandAloneERVNum)%TotHeatingRate = TotLoadMet
END IF
IF(LatLoadMet .LT. 0.0d0) THEN
StandAloneERV(StandAloneERVNum)%LatCoolingRate = ABS(LatLoadMet)
StandAloneERV(StandAloneERVNum)%LatHeatingRate = 0.0d0
ELSE
StandAloneERV(StandAloneERVNum)%LatCoolingRate = 0.0d0
StandAloneERV(StandAloneERVNum)%LatHeatingRate = LatLoadMet
END IF
! Provide a one time message when exhaust flow rate is greater than supply flow rate
IF ( StandAloneERV(StandAloneERVNum)%FlowError .AND. .NOT. WarmupFlag) THEN
!! Adding up zone inlet/outlet nodes is not working correctly. When imbalance flow occurs, the difference
!! is placed on the zone return node even when there is nothing connected to it.
! IF(StandAloneERV(StandAloneERVNum)%ControlledZoneNum .GT. 0)THEN
! TotalExhaustMassFlow = 0.0
! DO ExhaustNodeNum = 1, ZoneEquipConfig(StandAloneERV(StandAloneERVNum)%ControlledZoneNum)%NumExhaustNodes
! TotalExhaustMassFlow = TotalExhaustMassFlow + &
! Node(ZoneEquipConfig(StandAloneERV(StandAloneERVNum)%ControlledZoneNum)%ExhaustNode(ExhaustNodeNum))%MassFlowRate
! END DO
! ELSE
! DO ControlledZoneNum = 1, NumOfControlledZones
! TotalExhaustMassFlow = 0.0
! ExhaustNodeFound = .FALSE.
! DO ExhaustNodeNum = 1, ZoneEquipConfig(ControlledZoneNum)%NumExhaustNodes
! TotalExhaustMassFlow = TotalExhaustMassFlow + &
! Node(ZoneEquipConfig(ControlledZoneNum)%ExhaustNode(ExhaustNodeNum))%MassFlowRate
! IF(ZoneEquipConfig(ControlledZoneNum)%ExhaustNode(ExhaustNodeNum) .EQ. ExhaustInletNode) THEN
! ExhaustNodeFound = .TRUE.
! StandAloneERV(StandAloneERVNum)%ControlledZoneNum = ControlledZoneNum
! END IF
! END DO
! IF(ExhaustNodeFound)EXIT
! END DO
! END IF
!
! IF(StandAloneERV(StandAloneERVNum)%ControlledZoneNum .GT. 0)THEN
!! Add in return node mass flow rate to total exhaust
! IF(ZoneEquipConfig(StandAloneERV(StandAloneERVNum)%ControlledZoneNum)%ReturnAirNode .GT. 0)THEN
! TotalExhaustMassFlow = TotalExhaustMassFlow + &
! Node(ZoneEquipConfig(StandAloneERV(StandAloneERVNum)%ControlledZoneNum)%ReturnAirNode)%MassFlowRate
! END IF
! TotalSupplyMassFlow = 0.0
! DO SupplyNodeNum = 1, ZoneEquipConfig(StandAloneERV(StandAloneERVNum)%ControlledZoneNum)%NumInletNodes
! TotalSupplyMassFlow = TotalSupplyMassFlow + &
! Node(ZoneEquipConfig(StandAloneERV(StandAloneERVNum)%ControlledZoneNum)%InletNode(SupplyNodeNum))%MassFlowRate
! END DO
!
TotalExhaustMassFlow = Node(ExhaustInletNode)%MassFlowRate
TotalSupplyMassFlow = Node(SupInletNode)%MassFlowRate
IF ( TotalExhaustMassFlow > TotalSupplyMassFlow ) THEN
CALL ShowWarningError('For '//TRIM(StandAloneERV(StandAloneERVNum)%UnitType)//' "'// &
TRIM(StandAloneERV(StandAloneERVNum)%Name)// &
'" there is unbalanced exhaust air flow.')
CALL ShowContinueError('... The exhaust air mass flow rate = ' &
//TRIM(RoundSigDigits(Node(ExhaustInletNode)%MassFlowRate,6)))
CALL ShowContinueError('... The supply air mass flow rate = ' &
//TRIM(RoundSigDigits(Node(SupInletNode)%MassFlowRate,6)))
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('... Unless there is balancing infiltration / ventilation air flow, this will result in')
CALL ShowContinueError('... load due to induced outside air being neglected in the simulation.')
StandAloneERV(StandAloneERVNum)%FlowError = .FALSE.
END IF
! END IF
END IF
RETURN
END SUBROUTINE CalcStandAloneERV