Economizer is active, so bypass heat exchange calcs. This applies to both flat plate and rotary HX's
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ExNum | |||
logical, | intent(in) | :: | HXUnitOn | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
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 CalcAirToAirGenericHeatExch(ExNum, HXUnitOn, FirstHVACIteration, EconomizerFlag, HighHumCtrlFlag)
! SUBROUTINE INFORMATION:
! AUTHOR Don Shirey
! DATE WRITTEN February 2003
! MODIFIED R. Raustad - FSEC, Feb 2009 - added economizer flags
! Both the economizer and high humidity control flags can disable the HX
! RE-ENGINEERED Richard Raustad, June 2003
! PURPOSE OF THIS SUBROUTINE:
! Calculate the outlet conditions for an air to air generic heat
! exchanger given the inlet conditions.
! METHODOLOGY EMPLOYED:
! This is a standard heat exchanger effectiveness model. No geometrical input data
! is needed. The model uses heat exchanger effectiveness performance data
! to calculate the air temperature and humidity ratio of the leaving
! supply and secondary air streams. Linear interpolation (or extrapolation)
! is assumed to obtain heat exchanger effectiveness at off-rated conditions.
!
! Economizer operation is allowed through the use of a Controller: Outside Air
! object.
! REFERENCES:
! ARI Standard 1060-2001,Rating Air-to-Air Heat Exchangers for Energy Recovery Ventilation Equipment, www.ari.org
! ASHRAE Standard 84, Method of Testing Air-To-Air Heat Exchangers, www.ashrae.org
! U.S. Environmental Protection Agency software "SAVES" -
! School Advanced Ventilation Engineering Software http://www.epa.gov/iaq/schooldesign/saves.html
! 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 exchanger heat recovery
LOGICAL, INTENT (IN) :: FirstHVACIteration ! first HVAC iteration flag
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:
REAL(r64), PARAMETER :: ErrorTol = 0.001d0 !error tolerence
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!
LOGICAL :: UnitOn ! unit on flag
LOGICAL :: FrostControlFlag ! unit is in frost control mode when TRUE
INTEGER :: SupOutNode
REAL(r64) :: Error ! iteration loop error variable
REAL(r64) :: Iter ! iteration counter
REAL(r64) :: ControlFraction ! fraction of effectiveness when rotary HX speed or plate bypass modulation is used for
! temperature control
REAL(r64) :: RhoSup ! supply air density at actual pressure, temperature and humidity conditions [kg/m3]
REAL(r64) :: RhoSec ! secondary air density at actual pressure, temperature and humidity conditions [kg/m3]
REAL(r64) :: RhoStd ! standard air density at actual pressure, 20C dry-bulb temp and 0.0 absolute humidity [kg/m3]
REAL(r64) :: CSup ! supply air heat capacity rate [W/K]
REAL(r64) :: CSec ! secondary air heat capacity rate [W/K]
REAL(r64) :: CMin ! minimum air heat capacity rate [W/K]
REAL(r64) :: QSensTrans ! sensible heat transferred by the heat exchanger [W]
REAL(r64) :: QTotTrans ! total heat (sensible + latent) transferred by the heat exchanger [W]
REAL(r64) :: TempSecOutSat ! secondary air outlet temperature at saturation (at EnthsSecOut) [C]
REAL(r64) :: HXSecAirVolFlowRate ! air volume flow rate of the secondary air stream through the heat exchanger [m3/sec]
REAL(r64) :: HXSupAirVolFlowRate ! air volume flow rate of the supply air stream through the heat exchanger [m3/sec]
REAL(r64) :: HXAvgAirVolFlowRate ! average air volume flow rate through the heat exchanger [m3/sec]
REAL(r64) :: HXAirVolFlowRatio ! ratio of avg actual air volume flow through HX to nominal HX air volume flow [-]
REAL(r64) :: HXTempSetPoint ! setpoint temperature at supply outlet node of HX when ControlToTemperatureSetpoint = Yes
REAL(r64) :: MassFlowSecIn ! secondary air mass flow rate at HX inlet
! REAL(r64) :: MassFlowSecOut ! secondary air mass flow rate at HX outlet
REAL(r64) :: MassFlowSupIn ! supply air mass flow rate at HX inlet
REAL(r64) :: MassFlowSupOut ! supply air mass flow rate through HX core outlet
REAL(r64) :: MassFlowSupBypass ! supply air bypass mass flow rate around HX core
REAL(r64) :: TempSupIn ! supply side temperature of air entering HX
REAL(r64) :: TempSupOut ! supply side temperature of air leaving HX core
REAL(r64) :: HumRatSupIn ! supply side humidity ratio of air entering HX
REAL(r64) :: TempSecIn ! secondary side temperature of air entering HX
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
! Initialize local variables
UnitOn = .TRUE.
FrostControlFlag = .FALSE.
QSensTrans = 0.0d0
QTotTrans = 0.0d0
ExchCond(ExNum)%DefrostFraction = 0.0d0
ExchCond(ExNum)%SensEffectiveness = 0.0d0
ExchCond(ExNum)%LatEffectiveness = 0.0d0
ExchCond(ExNum)%ElecUseRate = 0.0d0
ExchCond(ExNum)%SupOutTemp = ExchCond(ExNum)%SupInTemp
ExchCond(ExNum)%SecOutTemp = ExchCond(ExNum)%SecInTemp
ExchCond(ExNum)%SupOutHumRat = ExchCond(ExNum)%SupInHumRat
ExchCond(ExNum)%SecOutHumRat = ExchCond(ExNum)%SecInHumRat
ExchCond(ExNum)%SupOutEnth = ExchCond(ExNum)%SupInEnth
ExchCond(ExNum)%SecOutEnth = ExchCond(ExNum)%SecInEnth
SupOutNode = ExchCond(ExNum)%SupOutletNode
HXTempSetPoint = Node(SupOutNode)%TempSetPoint
IF(PRESENT(EconomizerFlag))THEN
EconomizerActiveFlag = EconomizerFlag
ELSE
EconomizerActiveFlag = .FALSE.
END IF
IF(PRESENT(HighHumCtrlFlag))THEN
HighHumCtrlActiveFlag = HighHumCtrlFlag
ELSE
HighHumCtrlActiveFlag = .FALSE.
END IF
! Determine mass flow through heat exchanger and mass flow being bypassed (only flat plate bypasses flow)
IF (((EconomizerActiveFlag .OR. HighHumCtrlActiveFlag) .AND. &
ExchCond(ExNum)%EconoLockOut .EQ. EconoLockOut_Yes) .AND. &
ExchCond(ExNum)%ExchConfigNum == PLATE) THEN
ExchCond(ExNum)%SupBypassMassFlow = ExchCond(ExNum)%SupInMassFlow
ExchCond(ExNum)%SupOutMassFlow = ExchCond(ExNum)%SupInMassFlow
ExchCond(ExNum)%SecBypassMassFlow = ExchCond(ExNum)%SecInMassFlow
ExchCond(ExNum)%SecOutMassFlow = ExchCond(ExNum)%SecInMassFlow
ELSE ! No bypass mass flow
ExchCond(ExNum)%SupOutMassFlow = ExchCond(ExNum)%SupInMassFlow
ExchCond(ExNum)%SecOutMassFlow = ExchCond(ExNum)%SecInMassFlow
ExchCond(ExNum)%SupBypassMassFlow = 0.0d0
ExchCond(ExNum)%SecBypassMassFlow = 0.0d0
END IF
! Unit is scheduled OFF, so bypass heat exchange calcs
IF (GetCurrentScheduleValue(ExchCond(ExNum)%SchedPtr) .LE. 0.0d0) UnitOn = .FALSE.
!! Economizer is active, so bypass heat exchange calcs. This applies to both flat plate and rotary HX's
IF ((EconomizerActiveFlag .OR. HighHumCtrlActiveFlag) .AND. &
ExchCond(ExNum)%EconoLockOut .EQ. EconoLockOut_Yes)THEN
UnitOn = .FALSE.
END IF
! Determine if unit is ON or OFF based on air mass flow through the supply and secondary airstreams and operation flag
IF (ExchCond(ExNum)%SupInMassFlow .LE. SmallMassFlow) UnitOn = .FALSE.
IF (ExchCond(ExNum)%SecInMassFlow .LE. SmallMassFlow) UnitOn = .FALSE.
IF (.NOT. HXUnitOn) UnitOn = .FALSE.
IF(ExchCond(ExNum)%NomSupAirVolFlow == 0.d0)UnitOn = .FALSE.
IF (UnitOn) THEN
! Unit is on.
! In the future, use actual node pressures in the following air density calls
RhoStd = PsyRhoAirFnPbTdbW(OutBaroPress,20.0d0, 0.0d0)
HXSupAirVolFlowRate = ExchCond(ExNum)%SupOutMassFlow/RhoStd ! volume flow using standard density
HXSecAirVolFlowRate = ExchCond(ExNum)%SecOutMassFlow/RhoStd
! Limit unbalanced volumetric flow ratio to 2:1
IF(.NOT. WarmupFlag .AND. .NOT. FirstHVACIteration)THEN
IF (HXSupAirVolFlowRate .NE. 0.0d0 .AND. HXSecAirVolFlowRate .NE. 0.0d0) THEN
IF (((HXSupAirVolFlowRate/HXSecAirVolFlowRate) .GT. 2.0d0).OR.((HXSecAirVolFlowRate/HXSupAirVolFlowRate) .GT. 2.0d0)) THEN
ExchCond(ExNum)%UnBalancedErrCount = ExchCond(ExNum)%UnBalancedErrCount + 1
IF (ExchCond(ExNum)%UnBalancedErrCount .LE. 2) THEN
CALL ShowSevereError(TRIM(cHXTypes(ExchCond(ExNum)%ExchTypeNum))//': "'//TRIM(ExchCond(ExNum)%Name)// &
'" unbalanced air volume flow ratio through the heat exchanger is greater than 2:1.')
CALL ShowContinueErrorTimeStamp('...HX Supply air to Exhaust air flow ratio = '// &
TRIM(RoundSigDigits(HXSupAirVolFlowRate/HXSecAirVolFlowRate,5))//'.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(cHXTypes(ExchCond(ExNum)%ExchTypeNum))// &
' "'//TRIM(ExchCond(ExNum)%Name)//'": Unbalanced air volume flow ratio exceeds '// &
' 2:1 warning continues. HX flow ratio statistics follow.' &
, ExchCond(ExNum)%UnBalancedErrIndex, HXSupAirVolFlowRate/HXSecAirVolFlowRate, &
HXSupAirVolFlowRate/HXSecAirVolFlowRate)
END IF
END IF
END IF
END IF
! Calculate average volumetric flow rate of the two air streams
HXAvgAirVolFlowRate = (HXSecAirVolFlowRate + HXSupAirVolFlowRate)/2.0d0
HXAirVolFlowRatio = HXAvgAirVolFlowRate/ExchCond(ExNum)%NomSupAirVolFlow
! Average air volume flow rate must be between 50% and 130% of nominal supply air volume flow
IF (HXAirVolFlowRatio .GT. 1.3d0 .OR. HXAirVolFlowRatio .LT. 0.5d0) THEN
IF(.NOT. WarmupFlag .AND. .NOT. FirstHVACIteration)THEN
ExchCond(ExNum)%LowFlowErrCount = ExchCond(ExNum)%LowFlowErrCount + 1
IF (ExchCond(ExNum)%LowFlowErrCount .EQ. 1) THEN
CALL ShowWarningError(TRIM(cHXTypes(ExchCond(ExNum)%ExchTypeNum))//' "'//TRIM(ExchCond(ExNum)%Name)//'"')
CALL ShowContinueError('Average air volume flow rate is <50% or >130% of the nominal HX supply air volume flow rate.')
CALL ShowContinueErrorTimeStamp('Air volume flow rate ratio = '//TRIM(RoundSigDigits(HXAirVolFlowRatio,3))//'.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(cHXTypes(ExchCond(ExNum)%ExchTypeNum))//' "'//TRIM(ExchCond(ExNum)%Name)//&
'": Average air volume flow rate is <50% or >130% warning continues. Air flow rate ratio statistics follow.' &
, ExchCond(ExNum)%LowFlowErrIndex, HXAirVolFlowRatio, HXAirVolFlowRatio)
END IF
END IF
END IF
! Determine heat exchanger effectiveness using avg air volume flow rate based on actual inlet air density
! Linearly interpolate and extrapolate (within limits) from effectiveness input values
RhoSup = PsyRhoAirFnPbTdbW(OutBaroPress,ExchCond(ExNum)%SupInTemp,ExchCond(ExNum)%SupInHumRat)
RhoSec = PsyRhoAirFnPbTdbW(OutBaroPress,ExchCond(ExNum)%SecInTemp,ExchCond(ExNum)%SecInHumRat)
HXSupAirVolFlowRate = ExchCond(ExNum)%SupOutMassFlow/RhoSup
HXSecAirVolFlowRate = ExchCond(ExNum)%SecOutMassFlow/RhoSec
HXAvgAirVolFlowRate = (HXSecAirVolFlowRate + HXSupAirVolFlowRate)/2.0d0
HXAirVolFlowRatio = HXAvgAirVolFlowRate/ExchCond(ExNum)%NomSupAirVolFlow
IF (ExchCond(ExNum)%SupInTemp .LT. ExchCond(ExNum)%SecInTemp) THEN
! Use heating effectiveness values
ExchCond(ExNum)%SensEffectiveness = ExchCond(ExNum)%HeatEffectSensible75 + &
(ExchCond(ExNum)%HeatEffectSensible100 - ExchCond(ExNum)%HeatEffectSensible75)* &
(HXAirVolFlowRatio - 0.75d0)/(1.d0 - 0.75d0)
ExchCond(ExNum)%LatEffectiveness = ExchCond(ExNum)%HeatEffectLatent75 + &
(ExchCond(ExNum)%HeatEffectLatent100 - ExchCond(ExNum)%HeatEffectLatent75)* &
(HXAirVolFlowRatio - 0.75d0)/(1.d0 - 0.75d0)
ELSE
! Use cooling effectiveness values
ExchCond(ExNum)%SensEffectiveness = ExchCond(ExNum)%CoolEffectSensible75 + &
(ExchCond(ExNum)%CoolEffectSensible100 - ExchCond(ExNum)%CoolEffectSensible75)* &
(HXAirVolFlowRatio - 0.75d0)/(1.d0 - 0.75d0)
ExchCond(ExNum)%LatEffectiveness = ExchCond(ExNum)%CoolEffectLatent75 + &
(ExchCond(ExNum)%CoolEffectLatent100 - ExchCond(ExNum)%CoolEffectLatent75)* &
(HXAirVolFlowRatio - 0.75d0)/(1.d0 - 0.75d0)
END IF
! Keep effectiveness between 0 and 1.0 ??
! HXOpSensEffect = MAX(MIN(HXOpSensEffect,1.0),0.0)
! HXOpLatEffect = MAX(MIN(HXOpLatEffect,1.0),0.0)
! The model should at least guard against negative numbers
ExchCond(ExNum)%SensEffectiveness = MAX(0.d0,ExchCond(ExNum)%SensEffectiveness)
ExchCond(ExNum)%LatEffectiveness = MAX(0.d0,ExchCond(ExNum)%LatEffectiveness)
! Use the effectiveness to calculate the air conditions exiting the heat exchanger (all air flow through the HX)
!
! Include EATR and OACF in the following calculations at some point
CSup = ExchCond(ExNum)%SupOutMassFlow * PsyCpAirFnWTdb(ExchCond(ExNum)%SupInHumRat,ExchCond(ExNum)%SupInTemp)
CSec = ExchCond(ExNum)%SecOutMassFlow * PsyCpAirFnWTdb(ExchCond(ExNum)%SecInHumRat,ExchCond(ExNum)%SecInTemp)
CMin = MIN(CSup, CSec)
ExchCond(ExNum)%SupOutTemp = ExchCond(ExNum)%SupInTemp + &
ExchCond(ExNum)%SensEffectiveness * CMin / CSup * (ExchCond(ExNum)%SecInTemp - ExchCond(ExNum)%SupInTemp)
ExchCond(ExNum)%SupOutHumRat = ExchCond(ExNum)%SupInHumRat + &
ExchCond(ExNum)%LatEffectiveness * CMin / CSup * (ExchCond(ExNum)%SecInHumRat - ExchCond(ExNum)%SupInHumRat)
ExchCond(ExNum)%SupOutEnth = PsyHFnTdbW(ExchCond(ExNum)%SupOutTemp,ExchCond(ExNum)%SupOutHumRat)
! Check for saturation in supply outlet and reset temp, then humidity ratio at constant enthalpy
IF (PsyTsatFnHPb(ExchCond(ExNum)%SupOutEnth,OutBaroPress).GT.ExchCond(ExNum)%SupOutTemp) THEN
ExchCond(ExNum)%SupOutTemp = PsyTsatFnHPb(ExchCond(ExNum)%SupOutEnth,OutBaroPress)
ExchCond(ExNum)%SupOutHumRat = PsyWFnTdbH(ExchCond(ExNum)%SupOutTemp,ExchCond(ExNum)%SupOutEnth)
END IF
QSensTrans = CSup * (ExchCond(ExNum)%SupInTemp - ExchCond(ExNum)%SupOutTemp)
ExchCond(ExNum)%SecOutTemp = ExchCond(ExNum)%SecInTemp + QSensTrans / CSec
QTotTrans = ExchCond(ExNum)%SupOutMassFlow * (ExchCond(ExNum)%SupInEnth - ExchCond(ExNum)%SupOutEnth)
ExchCond(ExNum)%SecOutEnth = ExchCond(ExNum)%SecInEnth + QTotTrans/ExchCond(ExNum)%SecOutMassFlow
ExchCond(ExNum)%SecOutHumRat = PsyWFnTdbH(ExchCond(ExNum)%SecOutTemp,ExchCond(ExNum)%SecOutEnth)
!
! Control the supply air outlet temperature to a setpoint for Heating Mode only
! (ControlFraction = 0 HX fully bypassed, ControlFraction = 1 air passed entirely through HX)
! (supply air stream bypass mass flow rate proportional to ControlFraction except when frost control is active)
IF(ExchCond(ExNum)%ControlToTemperatureSetPoint .AND. &
ExchCond(ExNum)%SupInTemp .LT. HXTempSetPoint)THEN
! IF secondary inlet temperature is above the supply inlet temperature, control to SP
IF(ExchCond(ExNum)%SecInTemp .GT. ExchCond(ExNum)%SupInTemp .AND. &
(ExchCond(ExNum)%SupInTemp - ExchCond(ExNum)%SupOutTemp).NE. 0.0d0)THEN
ControlFraction = MAX(0.0d0,MIN(1.0d0,(ExchCond(ExNum)%SupInTemp - HXTempSetPoint)/ &
(ExchCond(ExNum)%SupInTemp - ExchCond(ExNum)%SupOutTemp)))
ELSE
! ELSE fully bypass HX to maintain supply outlet temp as high as possible
ControlFraction = 0.0d0
ENDIF
IF (ExchCond(ExNum)%ExchConfigNum == ROTARY) THEN
! Rotory HX's never get bypassed, rotational speed is modulated
ExchCond(ExNum)%SensEffectiveness = ControlFraction * ExchCond(ExNum)%SensEffectiveness
ExchCond(ExNum)%LatEffectiveness = ControlFraction * ExchCond(ExNum)%LatEffectiveness
ELSE ! HX is a plate heat exchanger, bypass air to control SA temperature
Error = 1.0d0
Iter = 0.0d0
MassFlowSupIn = ExchCond(ExNum)%SupInMassFlow
MassFlowSupOut = ExchCond(ExNum)%SupOutMassFlow
MassFlowSupBypass = ExchCond(ExNum)%SupBypassMassFlow
MassFlowSecIn = ExchCond(ExNum)%SecInMassFlow
TempSupIn = ExchCond(ExNum)%SupInTemp
TempSupOut = ExchCond(ExNum)%SupOutTemp
HumRatSupIn = ExchCond(ExNum)%SupInHumRat
TempSecIn = ExchCond(ExNum)%SecInTemp
DO WHILE ((ABS(Error).GT.ErrorTol .AND. Iter.lt.10 .AND. ControlFraction.LT.1.0d0) &
.OR. Iter .eq. 1)
MassFlowSupOut = MassFlowSupIn*ControlFraction
MassFlowSupBypass = MassFlowSupIn*(1.d0-ControlFraction)
HXSupAirVolFlowRate = MassFlowSupOut/RhoSup
HXAvgAirVolFlowRate = (HXSecAirVolFlowRate + HXSupAirVolFlowRate)/2.0d0
HXAirVolFlowRatio = HXAvgAirVolFlowRate/ExchCond(ExNum)%NomSupAirVolFlow
CSup = MassFlowSupOut * PsyCpAirFnWTdb(HumRatSupIn,TempSupIn)
CMin = MIN(CSup,CSec)
IF (TempSupIn .LT. TempSecIn) THEN
! Use heating effectiveness values
ExchCond(ExNum)%SensEffectiveness = ExchCond(ExNum)%HeatEffectSensible75 + &
(ExchCond(ExNum)%HeatEffectSensible100 - ExchCond(ExNum)%HeatEffectSensible75)* &
(HXAirVolFlowRatio - 0.75d0)/(1.d0 - 0.75d0)
ExchCond(ExNum)%LatEffectiveness = ExchCond(ExNum)%HeatEffectLatent75 + &
(ExchCond(ExNum)%HeatEffectLatent100 - ExchCond(ExNum)%HeatEffectLatent75)* &
(HXAirVolFlowRatio - 0.75d0)/(1.d0 - 0.75d0)
ELSE
! Use cooling effectiveness values
ExchCond(ExNum)%SensEffectiveness = ExchCond(ExNum)%CoolEffectSensible75 + &
(ExchCond(ExNum)%CoolEffectSensible100 - ExchCond(ExNum)%CoolEffectSensible75)* &
(HXAirVolFlowRatio - 0.75d0)/(1.d0 - 0.75d0)
ExchCond(ExNum)%LatEffectiveness = ExchCond(ExNum)%CoolEffectLatent75 + &
(ExchCond(ExNum)%CoolEffectLatent100 - ExchCond(ExNum)%CoolEffectLatent75)* &
(HXAirVolFlowRatio - 0.75d0)/(1.d0 - 0.75d0)
END IF
IF(CSup .EQ. 0.0d0)THEN
! IF CSup = 0, then supply air mass flow rate = 0 and HX is fully bypassed. Fix divide by 0 error below DO loop.
CSup = 1.0d0
CMin = 0.0d0
EXIT
END IF
TempSupOut = (MassFlowSupOut * (TempSupIn + &
ExchCond(ExNum)%SensEffectiveness * CMin / CSup * (TempSecIn - TempSupIn)) +&
MassFlowSupBypass * TempSupIn)/MassFlowSupIn
Error = (TempSupOut - HXTempSetPoint)
! IF supply inlet temp = supply outlet temp, fully bypass HX - ELSE control to SP
IF(TempSupIn .NE. TempSupOut)THEN
ControlFraction = MAX(0.0d0,MIN(1.0d0,ControlFraction * (TempSupIn - HXTempSetPoint)/&
(TempSupIn - TempSupOut)))
ELSE IF(ABS(TempSupOut - HXTempSetPoint) .LT. ErrorTol)THEN
! IF TempSupIn = TempSupOut then TempSecIn = TempSupIn (ControlFraction = ?)
! Do nothing, variables in ELSE below have already been calculated
EXIT
ELSE
! or HX is fully bypassed (ControlFraction = 0) which actually should be caught in IF(CSup .EQ. 0.0)THEN above.
ControlFraction = 0.0d0
MassFlowSupOut = MassFlowSupIn*ControlFraction
MassFlowSupBypass = MassFlowSupIn*(1.d0-ControlFraction)
CSup = 1.0d0
CMin = 0.0d0
EXIT
END IF
Iter = Iter + 1
END DO
ExchCond(ExNum)%SupInMassFlow = MassFlowSupIn
ExchCond(ExNum)%SupOutMassFlow = MassFlowSupOut
ExchCond(ExNum)%SupBypassMassFlow = MassFlowSupBypass
ExchCond(ExNum)%SecInMassFlow = MassFlowSecIn
ExchCond(ExNum)%SupInTemp = TempSupIn
ExchCond(ExNum)%SupOutTemp = TempSupOut
ExchCond(ExNum)%SupInHumRat = HumRatSupIn
ExchCond(ExNum)%SecInTemp = TempSecIn
END IF ! ENDIF for "IF (ExchCond(ExNum)%ExchConfig == 'ROTARY') THEN"
ExchCond(ExNum)%SupOutTemp = ExchCond(ExNum)%SupInTemp + &
ExchCond(ExNum)%SensEffectiveness*CMin/CSup*(ExchCond(ExNum)%SecInTemp-ExchCond(ExNum)%SupInTemp)
ExchCond(ExNum)%SupOutHumRat = ExchCond(ExNum)%SupInHumRat + &
ExchCond(ExNum)%LatEffectiveness*CMin/CSup*(ExchCond(ExNum)%SecInHumRat-ExchCond(ExNum)%SupInHumRat)
ExchCond(ExNum)%SupOutEnth = PsyHFnTdbW(ExchCond(ExNum)%SupOutTemp,ExchCond(ExNum)%SupOutHumRat)
! Check for saturation in supply outlet and reset temp, then humidity ratio at constant enthalpy
IF (PsyTsatFnHPb(ExchCond(ExNum)%SupOutEnth,OutBaroPress).GT.ExchCond(ExNum)%SupOutTemp) THEN
ExchCond(ExNum)%SupOutTemp = PsyTsatFnHPb(ExchCond(ExNum)%SupOutEnth,OutBaroPress)
ExchCond(ExNum)%SupOutHumRat = PsyWFnTdbH(ExchCond(ExNum)%SupOutTemp,ExchCond(ExNum)%SupOutEnth)
END IF
QSensTrans = CSup * (ExchCond(ExNum)%SupInTemp - ExchCond(ExNum)%SupOutTemp)
ExchCond(ExNum)%SecOutTemp = ExchCond(ExNum)%SecInTemp + QSensTrans / CSec
QTotTrans = ExchCond(ExNum)%SupOutMassFlow * (ExchCond(ExNum)%SupInEnth - ExchCond(ExNum)%SupOutEnth)
ExchCond(ExNum)%SecOutEnth = ExchCond(ExNum)%SecInEnth + QTotTrans/ExchCond(ExNum)%SecOutMassFlow
ExchCond(ExNum)%SecOutHumRat = PsyWFnTdbH(ExchCond(ExNum)%SecOutTemp,ExchCond(ExNum)%SecOutEnth)
END IF !ENDIF for "IF(ExchCond(ExNum)%ControlToTemperatureSetPoint .AND... THEN, ELSE"
IF( (ExchCond(ExNum)%FrostControlType == 'MINIMUMEXHAUSTTEMPERATURE' .AND. &
ExchCond(ExNum)%SecOutTemp .LT. ExchCond(ExNum)%ThresholdTemperature) .OR. &
(ExchCond(ExNum)%FrostControlType == 'EXHAUSTAIRRECIRCULATION' .AND. &
ExchCond(ExNum)%SupInTemp .LE. ExchCond(ExNum)%ThresholdTemperature) .OR. &
(ExchCond(ExNum)%FrostControlType == 'EXHAUSTONLY' .AND. &
ExchCond(ExNum)%SupInTemp .LE. ExchCond(ExNum)%ThresholdTemperature))THEN
CALL FrostControl(ExNum)
FrostControlFlag = .TRUE.
END IF
! check for saturation in secondary outlet
TempSecOutSat = PsyTsatFnHPb(ExchCond(ExNum)%SecOutEnth,OutBaroPress)
IF (TempSecOutSat.GT.ExchCond(ExNum)%SecOutTemp) THEN
ExchCond(ExNum)%SecOutTemp = TempSecOutSat
ExchCond(ExNum)%SecOutHumRat = PsyWFnTdbH(ExchCond(ExNum)%SecOutTemp,ExchCond(ExNum)%SecOutEnth)
END IF
! calculate outlet conditions by mixing bypass air stream with air that went through the
! heat exchanger core. Perform this mixing only when no frost control is used or
! heat exchanger is not in frost control mode. Mixing similar to this is performed
! in the frost control subroutine when in frost control mode.
IF(.NOT. FrostControlFlag)THEN
ExchCond(ExNum)%SupOutEnth = (ExchCond(ExNum)%SupOutMassFlow*ExchCond(ExNum)%SupOutEnth &
+ ExchCond(ExNum)%SupBypassMassFlow*ExchCond(ExNum)%SupInEnth) &
/ ExchCond(ExNum)%SupInMassFlow
ExchCond(ExNum)%SupOutHumRat = (ExchCond(ExNum)%SupOutMassFlow*ExchCond(ExNum)%SupOutHumRat &
+ ExchCond(ExNum)%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 = (ExchCond(ExNum)%SecOutMassFlow*ExchCond(ExNum)%SecOutEnth &
+ ExchCond(ExNum)%SecBypassMassFlow*ExchCond(ExNum)%SecInEnth) &
/ ExchCond(ExNum)%SecInMassFlow
ExchCond(ExNum)%SecOutHumRat = (ExchCond(ExNum)%SecOutMassFlow*ExchCond(ExNum)%SecOutHumRat &
+ ExchCond(ExNum)%SecBypassMassFlow*ExchCond(ExNum)%SecInHumRat) &
/ ExchCond(ExNum)%SecInMassFlow
ExchCond(ExNum)%SecOutTemp = PsyTdbFnHW(ExchCond(ExNum)%SecOutEnth,ExchCond(ExNum)%SecOutHumRat)
ExchCond(ExNum)%SecOutMassFlow = ExchCond(ExNum)%SecInMassFlow
END IF
ExchCond(ExNum)%ElecUseRate = ExchCond(ExNum)%NomElecPower
END IF !ENDIF for "IF (UnitOn) THEN"
! Calculate heat transfer from the unit using the final supply inlet and supply outlet air conditions
CSup = ExchCond(ExNum)%SupOutMassFlow*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
! Set report variables based on sign of recovery rate
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
RETURN
END SUBROUTINE CalcAirToAirGenericHeatExch