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) | :: | ExNum | |||
logical, | intent(in) | :: | HXUnitOn | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | FanOpMode | |||
real(kind=r64), | intent(in) | :: | PartLoadRatio | |||
integer, | intent(in) | :: | CompanionCoilIndex | |||
logical, | intent(in) | :: | RegenInletIsOANode | |||
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 CalcDesiccantBalancedHeatExch(ExNum, HXUnitOn, FirstHVACIteration, FanOpMode, PartLoadRatio, &
CompanionCoilIndex, RegenInletIsOANode, EconomizerFlag, HighHumCtrlFlag)
! SUBROUTINE INFORMATION:
! AUTHOR Mangesh Basarkar, FSEC
! DATE WRITTEN January 2007
! MODIFIED 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 a balanced air-to-air desiccant heat exchanger
! given the inlet conditions and face velocity. Performance map is provided by user.
! METHODOLOGY EMPLOYED:
! This is an empirical heat exchanger model. The model uses heat exchanger performance data to
! calculate the air temperature and humidity ratio of the leaving upply and secondary air streams.
!
! Humidity control can enable/disable heat recovery through the use of the HXUnitOn Subroutine argument.
! REFERENCES:
! na
! USE STATEMENTS:
USE DXCoils, ONLY: DXCoilPartLoadRatio
USE DataLoopNode, ONLY: SensedNodeFlagValue
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, INTENT (IN) :: FirstHVACIteration ! First HVAC iteration flag
INTEGER, INTENT (IN) :: FanOpMode ! Supply air fan operating mode (1=cycling, 2=constant)
REAL(r64), INTENT (IN) :: PartLoadRatio ! Part load ratio requested of DX compressor
INTEGER, INTENT (IN) :: CompanionCoilIndex ! index of companion cooling coil
LOGICAL, INTENT (IN) :: RegenInletIsOANode ! Flag to determine if regen side inlet is OANode, if so this air stream cycles
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
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) :: TempSecOutSat ! secondary air outlet temperature at saturation (at EnthsSecOut) [C]
REAL(r64) :: SensHeatRecRate ! sensible heat recovery rate to supply air (heating +, cooling -)
REAL(r64) :: TotHeatRecRate ! total heat recovery rate to supply air (heating +, cooling -)
REAL(r64) :: ProcessSensHeatRecRate ! process sensible heat recovery rate (heating +, cooling -)
REAL(r64) :: ProcessTotHeatRecRate ! process total heat recovery rate (heating +, cooling -)
REAL(r64) :: ProcessLatHeatRecRate ! process latent heat recovery rate (heating [humidify] +, cooling [dehumidify] -)
REAL(r64) :: SupInMassFlow ! Supply side HX mass flow rate
REAL(r64) :: SecInMassFlow ! Secondary side HX mass flow rate
REAL(r64) :: Coeff1 ! coefficient1 to empirical model (used for both temperature and humidity ratio equations)
REAL(r64) :: Coeff2 ! coefficient2 to empirical model (used for both temperature and humidity ratio equations)
REAL(r64) :: Coeff3 ! coefficient3 to empirical model (used for both temperature and humidity ratio equations)
REAL(r64) :: Coeff4 ! coefficient4 to empirical model (used for both temperature and humidity ratio equations)
REAL(r64) :: Coeff5 ! coefficient5 to empirical model (used for both temperature and humidity ratio equations)
REAL(r64) :: Coeff6 ! coefficient6 to empirical model (used for both temperature and humidity ratio equations)
REAL(r64) :: Coeff7 ! coefficient7 to empirical model (used for both temperature and humidity ratio equations)
REAL(r64) :: Coeff8 ! coefficient8 to empirical model (used for both temperature and humidity ratio equations)
REAL(r64) :: BalFaceVelActual ! operating face velocity [m/s]
REAL(r64) :: FullLoadSupOutTemp ! empirical model supply outlet temperature [C]
REAL(r64) :: FullLoadSupOutHumRat ! empirical model supply outlet humidity ratio [kg/kg]
REAL(r64) :: FullLoadDeltaT ! empirical model heat exchanger delta temperature [C]
REAL(r64) :: FullLoadDeltaW ! empirical model heat exchanger delta humidity ratio [kg/kg]
REAL(r64) :: T_RegenInTemp ! empirical model supply (regen) inlet temperature for temperature equation [C]
REAL(r64) :: T_RegenInHumRat ! empirical model supply (regen) inlet humidity ratio for temperature equation [kg/kg]
REAL(r64) :: T_ProcInTemp ! empirical model secondary (process) inlet temperature for temperature equation [C]
REAL(r64) :: T_ProcInHumRat ! empirical model secondary (process) inlet humidity ratio for temperature equation [kg/kg]
REAL(r64) :: T_FaceVel ! empirical model face velocity for temperature equation [m/s]
REAL(r64) :: H_RegenInTemp ! empirical model supply (regen) inlet temperature for humidity ratio equation [C]
REAL(r64) :: H_RegenInHumRat ! empirical model supply (regen) inlet humidity ratio for humidity ratio equation [kg/kg]
REAL(r64) :: H_ProcInTemp ! empirical model secondary (process) inlet temperature for humidity ratio equation [C]
REAL(r64) :: H_ProcInHumRat ! empirical model secondary (process) inlet humidity ratio for humidity ratio equation [kg/kg]
REAL(r64) :: H_FaceVel ! empirical model face velocity for humidity ratio equation [m/s]
REAL(r64) :: MaxHumRatNeeded ! maximum humidity ratio setpoint for balanced desiccant HX [kg/kg]
REAL(r64) :: MinHumRatNeeded ! minimum humidity ratio setpoint for balanced desiccant HX [kg/kg]
REAL(r64) :: HXPartLoadRatio ! local heat exchanger part-load ratio
REAL(r64) :: TestSaturationEnthalpy ! enthalpy used to test for regeneration outlet condition over saturation curve (J/kg)
CHARACTER(len=32), SAVE :: ThisSub = 'CalcDesiccantBalancedHeatExch:'! Used to pass to Psyc routines
REAL(r64) :: AverageMassFlowRate ! average of supply (regen) and secondary (process) mass flow rates [kg/s]
LOGICAL :: EconomizerActiveFlag ! local representing the economizer status when PRESENT
LOGICAL :: HighHumCtrlActiveFlag ! local representing high humidity control when PRESENT
! Initialize local variables
UnitOn = .TRUE.
SensHeatRecRate = 0.0d0
TotHeatRecRate = 0.0d0
HXPartLoadRatio = PartLoadRatio
ExchCond(ExNum)%DefrostFraction = 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
ExchCond(ExNum)%SupOutMassFlow = ExchCond(ExNum)%SupInMassFlow
ExchCond(ExNum)%SecOutMassFlow = ExchCond(ExNum)%SecInMassFlow
AverageMassFlowRate = (ExchCond(ExNum)%SupOutMassFlow + ExchCond(ExNum)%SecOutMassFlow) / 2.0d0
IF(PRESENT(EconomizerFlag))THEN
EconomizerActiveFlag = EconomizerFlag
ELSE
EconomizerActiveFlag = .FALSE.
END IF
IF(PRESENT(HighHumCtrlFlag))THEN
HighHumCtrlActiveFlag = HighHumCtrlFlag
ELSE
HighHumCtrlActiveFlag = .FALSE.
END IF
! Unit is scheduled OFF, so bypass heat exchange calcs
IF (GetCurrentScheduleValue(ExchCond(ExNum)%SchedPtr) .LE. 0.0d0) UnitOn = .FALSE.
! 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 (HXPartLoadRatio .EQ. 0.0d0) UnitOn = .FALSE.
IF (.NOT. HXUnitOn) UnitOn = .FALSE.
IF ((EconomizerActiveFlag .OR. HighHumCtrlActiveFlag) .AND. &
ExchCond(ExNum)%EconoLockOut .EQ. EconoLockOut_Yes) UnitOn = .FALSE.
IF (UnitOn) THEN
! Use local variables to perform checks
SecInMassFlow = ExchCond(ExNum)%SecInMassFlow
SupInMassFlow = ExchCond(ExNum)%SupInMassFlow
! In constant fan mode, process air mass flow rate is full flow and supply (regen) air cycles based on PLR.
! If supply (regen) inlet is OA node, regen mass flow rate is proportional to PLR.
! If both of the above is true then boost local variable up to full flow
IF((FanOpMode .EQ. ContFanCycCoil) .AND. RegenInletIsOANode) THEN
SupInMassFlow = SupInMassFlow / HXPartLoadRatio
END IF
! for cycling fan case, boost both local variables up to full flow
IF(FanOpMode .EQ. CycFanCycCoil) THEN
SupInMassFlow = SupInMassFlow / HXPartLoadRatio ! supply = regen
SecInMassFlow = SecInMassFlow / HXPartLoadRatio ! secondary = process
END IF
! Check for balanced flow condition
CALL CheckForBalancedFlow(ExNum, SecInMassFlow, SupInMassFlow, FirstHVACIteration)
SELECT CASE (ExchCond(ExNum)%HeatExchPerfTypeNum)
CASE(BALANCEDHX_PERFDATATYPE1)
Coeff1 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%B1
Coeff2 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%B2
Coeff3 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%B3
Coeff4 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%B4
Coeff5 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%B5
Coeff6 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%B6
Coeff7 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%B7
Coeff8 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%B8
T_ProcInTemp = FullLoadOutAirTemp
T_ProcInHumRat = FullLoadOutAirHumRat
T_RegenInTemp = ExchCond(ExNum)%SupInTemp
T_RegenInHumRat = ExchCond(ExNum)%SupInHumRat
! Must use the same density used to convert volumetric flow rate to mass flow rate to get back to velocity
RhoStd = StdRhoAir !PsyRhoAirFnPbTdbW(StdBaroPress,20.0d0, 0.0d0)
BalFaceVelActual = SupInMassFlow / (RhoStd*ExchCond(ExNum)%FaceArea)
T_FaceVel = BalFaceVelActual
! Call model check routines only when HX is active, if coil is off these checks do not apply (no potential for heat transfer)
! Check RH limits and warn user if out of bounds (T_* not modified in subroutine)
CALL CheckModelBoundsRH_TempEq(ExNum, T_RegenInTemp, T_RegenInHumRat, T_ProcInTemp, T_ProcInHumRat, FirstHVACIteration)
! Check model boundaries and cap empirical model independent variables as needed (T_* may be modified on return from sub)
CALL CheckModelBoundsTempEq(ExNum, T_RegenInTemp, T_RegenInHumRat, T_ProcInTemp, T_ProcInHumRat, T_FaceVel, &
FirstHVACIteration)
IF(T_ProcInTemp .NE. 0.0d0 .AND. T_RegenInTemp .NE. 0.0d0)THEN
FullLoadSupOutTemp = Coeff1 + Coeff2 * T_RegenInHumRat + &
Coeff3 * T_RegenInTemp + &
Coeff4 * (T_RegenInHumRat/T_RegenInTemp) + &
Coeff5 * T_ProcInHumRat + &
Coeff6 * T_ProcInTemp + &
Coeff7 * (T_ProcInHumRat/T_ProcInTemp) + &
Coeff8 * T_FaceVel
! Check model boundary for supply (regen) temp and do not cap value if out of bounds, check that supply in temp > out temp
Call CheckModelBoundOutput_Temp(ExNum, ExchCond(ExNum)%SupInTemp, FullLoadSupOutTemp, FirstHVACIteration)
FullLoadDeltaT = FullLoadSupOutTemp - ExchCond(ExNum)%SupInTemp
ELSE
FullLoadDeltaT = 0.0d0
END IF
Coeff1 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%C1
Coeff2 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%C2
Coeff3 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%C3
Coeff4 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%C4
Coeff5 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%C5
Coeff6 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%C6
Coeff7 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%C7
Coeff8 = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%C8
H_ProcInTemp = FullLoadOutAirTemp
H_ProcInHumRat = FullLoadOutAirHumRat
H_RegenInTemp = ExchCond(ExNum)%SupInTemp
H_RegenInHumRat = ExchCond(ExNum)%SupInHumRat
H_FaceVel = BalFaceVelActual
! Call model check routines only when HX is active, if coil is off these checks do not apply (no potential for heat transfer)
! Check RH limits and warn user if out of bounds (H_* not modified in subroutine)
CALL CheckModelBoundsRH_HumRatEq(ExNum, H_RegenInTemp, H_RegenInHumRat, H_ProcInTemp, H_ProcInHumRat, FirstHVACIteration)
! Check model boundaries and cap empirical model independent variables as needed (H_* may be modified on return from sub)
CALL CheckModelBoundsHumRatEq(ExNum, H_RegenInTemp, H_RegenInHumRat, H_ProcInTemp, H_ProcInHumRat, H_FaceVel, &
FirstHVACIteration)
! Calc curve
IF(H_ProcInTemp .NE. 0.0d0 .AND. H_RegenInTemp .NE. 0.0d0)THEN
FullLoadSupOutHumRat = Coeff1 + Coeff2 * H_RegenInHumRat + &
Coeff3 * H_RegenInTemp + &
Coeff4 * (H_RegenInHumRat/H_RegenInTemp) + &
Coeff5 * H_ProcInHumRat + &
Coeff6 * H_ProcInTemp + &
Coeff7 * (H_ProcInHumRat/H_ProcInTemp) + &
Coeff8 * H_FaceVel
! Check model boundary for supply (regen) hum rat and do not cap value if out of bounds, check that supply in HR < out HR
Call CheckModelBoundOutput_HumRat(ExNum, ExchCond(ExNum)%SupInHumRat, FullLoadSupOutHumRat, FirstHVACIteration)
FullLoadDeltaW = FullLoadSupOutHumRat - ExchCond(ExNum)%SupInHumRat
ELSE
FullLoadDeltaW = 0.0d0
END IF
! Check for saturation in the model's calculated supply outlet and reset temp, then humidity ratio at constant enthalpy
! Reset delta T and delta W such that the model does not allow an outlet condition over saturation
TestSaturationEnthalpy = PsyHFnTdbW(FullLoadSupOutTemp,FullLoadSupOutHumRat,ThisSub//' TestSatSup')
IF (PsyTsatFnHPb(TestSaturationEnthalpy,OutBaroPress,ThisSub//' TSat').GT.FullLoadSupOutTemp) THEN
FullLoadSupOutTemp = PsyTsatFnHPb(TestSaturationEnthalpy,OutBaroPress,ThisSub//' TSat-FullLoadOutTemp')
FullLoadSupOutHumRat = PsyWFnTdbH(FullLoadSupOutTemp,TestSaturationEnthalpy,ThisSub//' TSat-FullLoadOutHumRat')
FullLoadDeltaT = FullLoadSupOutTemp - ExchCond(ExNum)%SupInTemp
FullLoadDeltaW = FullLoadSupOutHumRat - ExchCond(ExNum)%SupInHumRat
END IF
IF(.NOT. CalledFromParentObject)THEN
! calculate part-load ratio for HX
MaxHumRatNeeded = Node(ExchCond(ExNum)%SecOutletNode)%HumRatMax
MinHumRatNeeded = Node(ExchCond(ExNum)%SecOutletNode)%HumRatMin
! Calculate partload fraction of dehumidification capacity required to meet setpoint
! check the model output, if the regen delta W is positive, the process air stream is dehumidified
IF(FullLoadDeltaW .GT. 0)THEN
! check for a setpoint, if no setpoint then PLR remains at 1
IF(MaxHumRatNeeded .NE. SensedNodeFlagValue)THEN
IF (ExchCond(ExNum)%SecInHumRat .GT. MaxHumRatNeeded .AND. MaxHumRatNeeded .GT. 0.0d0) THEN
HXPartLoadRatio = (ExchCond(ExNum)%SecInHumRat - MaxHumRatNeeded) / FullLoadDeltaW
ELSE
HXPartLoadRatio = 0.0d0
END IF
END IF
! check the model output, if the regen delta W is negative, the process air stream is humidified
ELSE IF(FullLoadDeltaW .LT. 0)THEN
! check for a setpoint, if no setpoint then PLR remains at 1
IF(MinHumRatNeeded .NE. SensedNodeFlagValue)THEN
IF (ExchCond(ExNum)%SecInHumRat .LT. MinHumRatNeeded .AND. MinHumRatNeeded .GT. 0.0d0) THEN
HXPartLoadRatio = (ExchCond(ExNum)%SecInHumRat - MinHumRatNeeded) / FullLoadDeltaW
ELSE
HXPartLoadRatio = 0.0d0
END IF
END IF
END IF
HXPartLoadRatio = MAX(0.0d0,HXPartLoadRatio)
HXPartLoadRatio = MIN(1.0d0,HXPartLoadRatio)
ELSE IF (CompanionCoilIndex .GT. 0) THEN
HXPartLoadRatio = DXCoilPartLoadRatio(CompanionCoilIndex)
ENDIF
IF(FanOpMode .EQ. CycFanCycCoil .OR. RegenInletIsOANode)THEN
! Supply (regen) air stream mass flow rate is cycling and proportional to PLR, outlet conditions are full load conditions
ExchCond(ExNum)%SupOutTemp = ExchCond(ExNum)%SupInTemp + FullLoadDeltaT
ExchCond(ExNum)%SupOutHumRat = MIN(1.0d0,MAX(1.d-5,ExchCond(ExNum)%SupInHumRat + FullLoadDeltaW))
ELSE
! Supply (regen) air stream mass flow rate is constant and outlet conditions are averaged
ExchCond(ExNum)%SupOutTemp = ExchCond(ExNum)%SupInTemp + (FullLoadDeltaT * HXPartLoadRatio)
ExchCond(ExNum)%SupOutHumRat = MIN(1.0d0,MAX(1.d-5,ExchCond(ExNum)%SupInHumRat + (FullLoadDeltaW * HXPartLoadRatio)))
END IF
! for a balanced flow HX, use average mass flow rate and actual node conditions to calculate CSup and CSec
! the mass flow rate on the process and secondary side of HX may be imbalanced when the HX is used in the OA branch
! use the average mass flow rate to avoid psych warnings, mass flow rates will converge at the end of the iteration
! if the air mass flow rates do not converge, this model should not be used
CSup = AverageMassFlowRate * PsyCpAirFnWTdb(ExchCond(ExNum)%SupInHumRat,ExchCond(ExNum)%SupInTemp,ThisSub//' CSup')
CSec = AverageMassFlowRate * PsyCpAirFnWTdb(ExchCond(ExNum)%SecInHumRat,ExchCond(ExNum)%SecInTemp,ThisSub//' CSec')
ExchCond(ExNum)%SupOutEnth = PsyHFnTdbW(ExchCond(ExNum)%SupOutTemp,ExchCond(ExNum)%SupOutHumRat,ThisSub//' SupOutEnth')
SensHeatRecRate = CSup * (ExchCond(ExNum)%SupOutTemp - ExchCond(ExNum)%SupInTemp)
TotHeatRecRate = AverageMassFlowRate * (ExchCond(ExNum)%SupOutEnth - ExchCond(ExNum)%SupInEnth)
! now calculate process side heat transfer
ExchCond(ExNum)%SecOutEnth = ExchCond(ExNum)%SecInEnth - TotHeatRecRate/AverageMassFlowRate
ExchCond(ExNum)%SecOutTemp = ExchCond(ExNum)%SecInTemp - SensHeatRecRate/CSec
ExchCond(ExNum)%SecOutHumRat = PsyWFnTdbH(ExchCond(ExNum)%SecOutTemp,ExchCond(ExNum)%SecOutEnth,ThisSub//' SecOutHumRat')
! check for saturation in process (secondary) outlet
! The process outlet conditions should never be over the saturation curve for the balanced desiccant model
! although this may occur during warmup. This check is included here for consistency.
TempSecOutSat = PsyTsatFnHPb(ExchCond(ExNum)%SecOutEnth,OutBaroPress,ThisSub//' TestSatSec')
IF (TempSecOutSat.GT.ExchCond(ExNum)%SecOutTemp) THEN
ExchCond(ExNum)%SecOutTemp = TempSecOutSat
ExchCond(ExNum)%SecOutHumRat = &
PsyWFnTdbH(ExchCond(ExNum)%SecOutTemp,ExchCond(ExNum)%SecOutEnth,ThisSub//' TSat-SecOutHumRat')
END IF
ExchCond(ExNum)%ElecUseRate = BalDesDehumPerfData(ExchCond(ExNum)%PerfDataIndex)%NomElecPower * HXPartLoadRatio
CASE DEFAULT
END SELECT
END IF !ENDIF for "IF (UnitOn) THEN"
! Report the process side heat transfer
CSec = AverageMassFlowRate * PsyCpAirFnWTdb(ExchCond(ExNum)%SecInHumRat,ExchCond(ExNum)%SecInTemp,ThisSub)
ProcessSensHeatRecRate = CSec * (ExchCond(ExNum)%SecOutTemp - ExchCond(ExNum)%SecInTemp)
ProcessTotHeatRecRate = ExchCond(ExNum)%SecOutMassFlow * (ExchCond(ExNum)%SecOutEnth - ExchCond(ExNum)%SecInEnth)
ProcessLatHeatRecRate = ProcessTotHeatRecRate - ProcessSensHeatRecRate
! Set report variables based on sign of recovery rate
IF (ProcessSensHeatRecRate .GT. 0.0d0) THEN
ExchCond(ExNum)%SensHeatingRate = ProcessSensHeatRecRate
ExchCond(ExNum)%SensCoolingRate = 0.0d0
ELSE
ExchCond(ExNum)%SensHeatingRate = 0.0d0
ExchCond(ExNum)%SensCoolingRate = ABS(ProcessSensHeatRecRate)
END IF
IF (ProcessLatHeatRecRate .GT. 0.0d0) THEN
ExchCond(ExNum)%LatHeatingRate = ProcessLatHeatRecRate
ExchCond(ExNum)%LatCoolingRate = 0.0d0
ELSE
ExchCond(ExNum)%LatHeatingRate = 0.0d0
ExchCond(ExNum)%LatCoolingRate = ABS(ProcessLatHeatRecRate)
END IF
IF (ProcessTotHeatRecRate .GT. 0.0d0) THEN
ExchCond(ExNum)%TotHeatingRate = ProcessTotHeatRecRate
ExchCond(ExNum)%TotCoolingRate = 0.0d0
ELSE
ExchCond(ExNum)%TotHeatingRate = 0.0d0
ExchCond(ExNum)%TotCoolingRate = ABS(ProcessTotHeatRecRate)
END IF
RETURN
END SUBROUTINE CalcDesiccantBalancedHeatExch