Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ExNum | |||
logical, | intent(in) | :: | HXUnitOn | |||
logical, | intent(in), | optional | :: | EconomizerFlag | ||
logical, | intent(in), | optional | :: | HighHumCtrlFlag |
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 CalcAirToAirPlateHeatExch(ExNum, HXUnitOn, EconomizerFlag, HighHumCtrlFlag)
! SUBROUTINE INFORMATION:
! AUTHOR Michael Wetter
! DATE WRITTEN March 1999
! MODIFIED F. Buhl Nov 2000, R. Raustad - FSEC, Feb 2009 - added economizer flags
! Both the economizer and high humidity control flags can disable the HX
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculate the outlet conditions for an air to air plate heat
! exchanger given the inlet conditions.
! METHODOLOGY EMPLOYED:
! This is a static heat exchanger model. No geometrical input data
! is needed. No knowledge of h*A values is needed except the ratio
! of the primary side to the secondary side convective heat transfer
! coefficient times the exchanger surface area. Effectiveness - NTU
! heat exchanger formulas are used.
! The time varying load is calculated based on the variation of the
! convective heat transfer coefficient.The variation is a function of
! mass flow rate and inlet temperature. An iterative solution is only
! required during initialization in one specific flow arrangement. During
! the time steps the solution is explicit. The iteration is done with
! the Regula Falsi algorithm. Convergence is always achieved.
! REFERENCES:
! M. Wetter, Simulation Model Air-to-Air Plate Heat Exchanger
! LBNL Report 42354, 1999.
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: ExNum ! number of the current heat exchanger being simulated
LOGICAL, INTENT (IN) :: HXUnitOn ! flag to simulate heat exchager heat recovery
LOGICAL, OPTIONAL, INTENT (IN) :: EconomizerFlag ! economizer flag pass by air loop or OA sys
LOGICAL, OPTIONAL, INTENT (IN) :: HighHumCtrlFlag ! high humidity control flag passed by airloop or OA sys
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: UnitOn ! unit on flag
REAL(r64) :: SupByPassMassFlow ! supply air mass flow rate bypassing unit [kg/s]
REAL(r64) :: UnitSupMassFlow ! supply air mass flow rate passing through the unit [kg/s]
REAL(r64) :: SecByPassMassFlow ! secondary air mass flow rate bypassing unit [kg/s]
REAL(r64) :: UnitSecMassFlow ! secondary air mass flow rate passing through the unit [kg/s]
REAL(r64) :: QuotSup ! ratio of supply nominal m*T to actual m*T
REAL(r64) :: QuotExh ! ratio of secondary nominal m*T to actual m*T
REAL(r64) :: Deno ! denominator of UA calculation
REAL(r64) :: CSup ! supply air capacitance rate [J/C/s]
REAL(r64) :: CSec ! secondary air capacitance rate [J/C/s]
REAL(r64) :: CMin ! minimum air capacitance rate [J/C/s]
REAL(r64) :: Z ! Ratio of minimum air capacitance rate to maximum air capacitance rate
REAL(r64) :: NTU ! Number of heat transfer units
REAL(r64) :: Eps ! epsilon, the unit effectiveness
REAL(r64) :: UA ! present UA
REAL(r64) :: TempSupOut ! unit supply outlet temperature [C]
REAL(r64) :: HumRatSupOut ! unit supply outlet humidity ratio [kg water / kg dry air]
REAL(r64) :: EnthSupOut ! unit supply outlet enthalpy [J/kg]
REAL(r64) :: TempSupOutSat ! unit supply outlet temperature at saturation (at EnthSupOut) [C]
REAL(r64) :: QTrans ! heat transferred in the heat exchanger [W]
REAL(r64) :: ElecCons ! electricity consumption rate [W]
REAL(r64) :: TempSecOut ! unit secondary outlet temperature [C]
REAL(r64) :: HumRatSecOut ! unit secondary outlet humidity ratio [kg water / kg dry air]
REAL(r64) :: EnthSecOut ! unit secondary outlet enthalpy [J/kgC]
REAL(r64) :: TempSecOutSat ! unit secondary outlet temperature at saturation (at EnthsSecOut) [C]
REAL(r64) :: SensHeatRecRate ! sensible heat recovery rate to supply air (heating +, cooling -)
REAL(r64) :: LatHeatRecRate ! latent heat recovery rate to supply air (heating [humidify] +, cooling [dehumidify] -)
REAL(r64) :: TotHeatRecRate ! total heat recovery rate to supply air (heating +, cooling -)
LOGICAL :: EconomizerActiveFlag ! local representing the economizer status when PRESENT
LOGICAL :: HighHumCtrlActiveFlag ! local representing high humidity control when PRESENT
UnitOn = .TRUE.
QTrans = 0.0d0
ElecCons = 0.0d0
IF(PRESENT(EconomizerFlag))THEN
EconomizerActiveFlag = EconomizerFlag
ELSE
EconomizerActiveFlag = .FALSE.
END IF
IF(PRESENT(HighHumCtrlFlag))THEN
HighHumCtrlActiveFlag = HighHumCtrlFlag
ELSE
HighHumCtrlActiveFlag = .FALSE.
END IF
IF((EconomizerActiveFlag .OR. HighHumCtrlActiveFlag) .AND. &
ExchCond(ExNum)%EconoLockOut .EQ. EconoLockOut_Yes)THEN
UnitSupMassFlow = 0.0d0 ! set HX supply flow to 0, all supply air will go through supply bypass
UnitSecMassFlow = 0.0d0 ! set HX secondary flow to 0, all secondary air will got through secondary bypass
UnitOn = .FALSE. ! turn off HX calculations when in economizer mode
ELSE
! if economizer operation is not allowed, air always passes through HX
! if CompanionCoilNum > 0, air always passes through HX (no economizer operation allowed)
UnitSupMassFlow = MIN(ExchCond(ExNum)%NomSupAirMassFlow,ExchCond(ExNum)%SupInMassFlow)
UnitSecMassFlow = MIN(ExchCond(ExNum)%NomSecAirMassFlow,ExchCond(ExNum)%SecInMassFlow)
END IF
SupByPassMassFlow = MAX(0.0d0,ExchCond(ExNum)%SupInMassFlow - UnitSupMassFlow)
SecByPassMassFlow = MAX(0.0d0,ExchCond(ExNum)%SecInMassFlow - UnitSecMassFlow)
IF (GetCurrentScheduleValue(ExchCond(ExNum)%SchedPtr) .LE. 0.0d0) UnitOn = .FALSE.
IF (ExchCond(ExNum)%SupInMassFlow .LE. SmallMassFlow) UnitOn = .FALSE.
IF (ExchCond(ExNum)%SecInMassFlow .LE. SmallMassFlow) UnitOn = .FALSE.
IF (.NOT. HXUnitOn) UnitOn = .FALSE.
IF (UnitOn) THEN
! unit is on
! calculate the UA for this time step
QuotSup = SafeDiv( ExchCond(ExNum)%mTSup0, &
UnitSupMassFlow * ( ExchCond(ExNum)%SupInTemp + KELVZERO) )
QuotExh = SafeDiv( ExchCond(ExNum)%mTSec0, &
UnitSecMassFlow * ( ExchCond(ExNum)%SecInTemp + KELVZERO) )
Deno = QuotSup**0.78d0 + ExchCond(ExNum)%hARatio * QuotExh**0.78d0
UA = ExchCond(ExNum)%UA0 * ( ExchCond(ExNum)%hARatio + 1.d0 ) / Deno
! calculate the NTU
CSup = UnitSupMassFlow * PsyCpAirFnWTdb(ExchCond(ExNum)%SupInHumRat,ExchCond(ExNum)%SupInTemp)
CSec = UnitSecMassFlow * PsyCpAirFnWTdb(ExchCond(ExNum)%SecInHumRat,ExchCond(ExNum)%SecInTemp)
! note: no C can be zero since otherwise we wouldn't be here
IF (CSup < CSec) THEN
CMin = CSup
Z = CMin / CSec
ELSE
CMin = CSec
Z = CMin / CSup
END IF
NTU = UA / CMin
! Get the effectiveness
CALL CalculateEpsFromNTUandZ(NTU, Z, ExchCond(ExNum)%FlowArr, Eps)
! use the effectiveness to calculate the unit outlet conditions
TempSupOut = ExchCond(ExNum)%SupInTemp + Eps * CMin / CSup * (ExchCond(ExNum)%SecInTemp - ExchCond(ExNum)%SupInTemp)
QTrans = CSup * (TempSupOut - ExchCond(ExNum)%SupInTemp)
TempSecOut = ExchCond(ExNum)%SecInTemp - QTrans / CSec
HumRatSupOut = ExchCond(ExNum)%SupInHumRat
EnthSupOut = PsyHFnTdbW(TempSupOut,HumRatSupOut)
! check for saturation in supply outlet
TempSupOutSat = PsyTsatFnHPb(EnthSupOut,OutBaroPress)
IF (TempSupOutSat.GT.TempSupOut) THEN
TempSupOut = TempSupOutSat
HumRatSupOut = PsyWFnTdbH(TempSupOut,EnthSupOut)
END IF
HumRatSecOut = ExchCond(ExNum)%SecInHumRat
EnthSecOut = PsyHFnTdbW(TempSecOut,HumRatSecOut)
! check for saturation in secondary outlet
TempSecOutSat = PsyTsatFnHPb(EnthSecOut,OutBaroPress)
IF (TempSecOutSat.GT.TempSecOut) THEN
TempSecOut = TempSecOutSat
HumRatSecOut = PsyWFnTdbH(TempSecOut,EnthSecOut)
END IF
! calculate outlet conditions by mixing bypass air stream with air that went through the
! heat exchanger core.
ExchCond(ExNum)%SupOutEnth = (UnitSupMassFlow*EnthSupOut + SupByPassMassFlow*ExchCond(ExNum)%SupInEnth) &
/ ExchCond(ExNum)%SupInMassFlow
ExchCond(ExNum)%SupOutHumRat = (UnitSupMassFlow*HumRatSupOut + SupByPassMassFlow*ExchCond(ExNum)%SupInHumRat) &
/ ExchCond(ExNum)%SupInMassFlow
ExchCond(ExNum)%SupOutTemp = PsyTdbFnHW(ExchCond(ExNum)%SupOutEnth,ExchCond(ExNum)%SupOutHumRat)
ExchCond(ExNum)%SupOutMassFlow = ExchCond(ExNum)%SupInMassFlow
ExchCond(ExNum)%SecOutEnth = (UnitSecMassFlow*EnthSecOut + SecByPassMassFlow*ExchCond(ExNum)%SecInEnth) &
/ ExchCond(ExNum)%SecInMassFlow
ExchCond(ExNum)%SecOutHumRat = (UnitSecMassFlow*HumRatSecOut + SecByPassMassFlow*ExchCond(ExNum)%SecInHumRat) &
/ ExchCond(ExNum)%SecInMassFlow
ExchCond(ExNum)%SecOutTemp = PsyTdbFnHW(ExchCond(ExNum)%SecOutEnth,ExchCond(ExNum)%SecOutHumRat)
ExchCond(ExNum)%SecOutMassFlow = ExchCond(ExNum)%SecInMassFlow
ElecCons = ExchCond(ExNum)%NomElecPower
ELSE
! the unit is off. Pass through the air streams with no change
ExchCond(ExNum)%SupOutEnth = ExchCond(ExNum)%SupInEnth
ExchCond(ExNum)%SupOutHumRat = ExchCond(ExNum)%SupInHumRat
ExchCond(ExNum)%SupOutTemp = ExchCond(ExNum)%SupInTemp
ExchCond(ExNum)%SupOutMassFlow = ExchCond(ExNum)%SupInMassFlow
ExchCond(ExNum)%SecOutEnth = ExchCond(ExNum)%SecInEnth
ExchCond(ExNum)%SecOutHumRat = ExchCond(ExNum)%SecInHumRat
ExchCond(ExNum)%SecOutTemp = ExchCond(ExNum)%SecinTemp
ExchCond(ExNum)%SecOutMassFlow = ExchCond(ExNum)%SecInMassFlow
END IF
CSup = ExchCond(ExNum)%SupInMassFlow*PsyCpAirFnWTdb(ExchCond(ExNum)%SupInHumRat,ExchCond(ExNum)%SupInTemp)
SensHeatRecRate = CSup * (ExchCond(ExNum)%SupOutTemp - ExchCond(ExNum)%SupInTemp)
TotHeatRecRate = ExchCond(ExNum)%SupOutMassFlow * ( ExchCond(ExNum)%SupOutEnth - &
ExchCond(ExNum)%SupInEnth )
LatHeatRecRate = TotHeatRecRate - SensHeatRecRate
IF (SensHeatRecRate .GT. 0.0d0) THEN
ExchCond(ExNum)%SensHeatingRate = SensHeatRecRate
ExchCond(ExNum)%SensCoolingRate = 0.0d0
ELSE
ExchCond(ExNum)%SensHeatingRate = 0.0d0
ExchCond(ExNum)%SensCoolingRate = ABS(SensHeatRecRate)
END IF
IF (LatHeatRecRate .GT. 0.0d0) THEN
ExchCond(ExNum)%LatHeatingRate = LatHeatRecRate
ExchCond(ExNum)%LatCoolingRate = 0.0d0
ELSE
ExchCond(ExNum)%LatHeatingRate = 0.0d0
ExchCond(ExNum)%LatCoolingRate = ABS(LatHeatRecRate)
END IF
IF (TotHeatRecRate .GT. 0.0d0) THEN
ExchCond(ExNum)%TotHeatingRate = TotHeatRecRate
ExchCond(ExNum)%TotCoolingRate = 0.0d0
ELSE
ExchCond(ExNum)%TotHeatingRate = 0.0d0
ExchCond(ExNum)%TotCoolingRate = ABS(TotHeatRecRate)
END IF
ExchCond(ExNum)%ElecUseRate = ElecCons
RETURN
END SUBROUTINE CalcAirToAirPlateHeatExch