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.
adjust regen heating coil capacity based on desiccant cycling ratio (PLR)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | DesicDehumNum | |||
real(kind=r64), | intent(in) | :: | HumRatNeeded | |||
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 CalcGenericDesiccantDehumidifier(DesicDehumNum,HumRatNeeded,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Mangesh Basarkar, FSEC
! DATE WRITTEN May 2007
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculate the electricity consumption, regen heat requirements and the outlet
! conditions for a desiccant dehumidifier, given the inlet conditions,
! DX coil part-load ratio, and/or the needed process leaving humidity ratio.
! METHODOLOGY EMPLOYED:
! Given the entering conditions, the full-load outlet conditions are calculated.
! Adjust for part-load if required.
! Calculate the required regen energy and call the regen coil and the regen fan.
! REFERENCES:
! Kosar, D. 2006. Dehumidification Enhancements, ASHRAE Journal, Vol. 48, No. 2, February 2006.
! Kosar, D. et al. 2006. Dehumidification Enhancement of Direct Expansion Systems Through Component
! Augmentation of the Cooling Coil. 15th Symposium on Improving Building Systems in Hot and Humid
! Climates, July 24-26, 2006.
! USE STATEMENTS:
USE Psychrometrics, ONLY: PsyHFnTdbW, PsyRhoAirFnPbTdbW
!unused USE DataEnvironment, ONLY: StdBaroPress
USE HeatRecovery, ONLY: SimHeatRecovery
USE DXCoils, ONLY: DXCoilPartLoadRatio, DXCoilFanOpMode
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: DesicDehumNum ! number of the current dehumidifier being simulated
REAL(r64), INTENT (IN) :: HumRatNeeded ! process air leaving humidity ratio set by controller [kg water/kg air]
LOGICAL, INTENT (IN) :: FirstHVACIteration ! TRUE if 1st HVAC simulation of system timestep
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: MinVolFlowPerRatedTotQ = 0.00002684d0 ! m3/s per W = 200 cfm/ton,
! min vol flow per rated evaporator capacity
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: DDPartLoadRatio ! fraction of dehumidification capacity required to meet setpoint
REAL(r64) :: QRegen = 0.0d0 ! required coil load passed to sim heating coil routine (W)
REAL(r64) :: MassFlowRateNew ! new required mass flow rate calculated to keep regen setpoint temperature (kg/s)
REAL(r64) :: CondenserWasteHeat ! Condenser waste heat (W)
REAL(r64) :: CpAir ! Specific heat of air (J/kg-K)
REAL(r64) :: NewRegenInTemp ! new temp calculated from condenser waste heat (C)
REAL(r64) :: ExhaustFanMassFlowRate ! exhaust fan mass flow rate (kg/s)
REAL(r64) :: ExhaustFanPLR ! exhaust fan run time fraction calculated from new mass flow rate for regen side
REAL(r64) :: ExhaustFanPowerMod ! used to calculate exhaust fan power from flow fraction
REAL(r64) :: VolFlowPerRatedTotQ ! flow rate per rated total cooling capacity of the companion coil (m3/s/W)
REAL(r64) :: FanDeltaT ! used to account for fan heat when calculating regeneration heater energy (C)
REAL(r64) :: OnOffFanPLF ! save air loop fan part load fracton while calculating exhaust fan power
REAL(r64) :: RegenSetPointTemp ! regeneration temperature setpoint (C)
INTEGER :: RegenCoilIndex ! index to regeneration heating coil, 0 when not used
INTEGER :: CompanionCoilIndexNum ! index for companion DX cooling coil, 0 when DX coil is not used
CHARACTER(len=MaxNameLength) :: MinVol ! character string used for error messages
CHARACTER(len=MaxNameLength) :: VolFlowChar ! character string used for error messages
LOGICAL, SAVE :: MyOneTimeFlag = .TRUE. ! one time flag
REAL(r64), SAVE :: RhoAirStdInit ! standard air density (kg/m3)
LOGICAL :: UnitOn ! unit on flag
! LOGICAL :: SimFlag ! used to turn off additional simulation if DX Coil is off
REAL(r64) :: QRegen_OASysFanAdjust ! temporary variable used to adjust regen heater load during iteration
UnitOn = .FALSE.
DDPartLoadRatio = 0.0d0
RegenCoilIndex = DesicDehum(DesicDehumNum)%RegenCoilIndex
FanDeltaT = 0.0d0
RegenSetPointTemp = DesicDehum(DesicDehumNum)%RegenSetPointTemp
ExhaustFanMassFlowRate = 0.0d0
! Save OnOffFanPartLoadFraction while performing exhaust fan calculations
OnOffFanPLF = OnOffFanPartLoadFraction
OnOffFanPartLoadFraction = 1.0d0
IF(DesicDehum(DesicDehumNum)%CoilUpstreamOfProcessSide == Yes)THEN
! Cooling coil directly upstream of desiccant dehumidifier, dehumidifier runs in tandem with DX coil
CompanionCoilIndexNum = DesicDehum(DesicDehumNum)%DXCoilIndex
ELSE
! desiccant dehumidifier determines its own PLR
CompanionCoilIndexNum = 0
END IF
IF(MyOneTimeFlag)THEN
RhoAirStdInit = StdRhoAir
MyOneTimeFlag = .FALSE.
END IF
IF (HumRatNeeded .LT. Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat)THEN
UnitOn = .TRUE.
ENDIF
IF(DesicDehum(DesicDehumNum)%CoilUpstreamOfProcessSide == Yes) THEN
IF (DXCoilPartLoadRatio(DesicDehum(DesicDehumNum)%DXCoilIndex) .EQ. 0.0d0)THEN
UnitOn = .FALSE.
ENDIF
ENDIF
IF (UnitOn) THEN
IF (DesicDehum(DesicDehumNum)%RegenInletIsOutsideAirNode) THEN
IF (DesicDehum(DesicDehumNum)%HXTypeNum == BalancedHX) THEN
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate = &
Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%MassFlowRate
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRateMaxAvail = &
Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%MassFlowRate
END IF
END IF
! Get conditions from DX Coil condenser if present (DXCoilIndex verified > 0 in GetInput)
IF(DesicDehum(DesicDehumNum)%Preheat == Yes)THEN
! condenser waste heat is proportional to DX coil PLR
CondenserWasteHeat = HeatReclaimDXCoil(DesicDehum(DesicDehumNum)%DXCoilIndex)%AvailCapacity
HeatReclaimDXCoil(DesicDehum(DesicDehumNum)%DXCoilIndex)%AvailCapacity = 0.0d0
CpAir = PsyCpAirFnWTdb(Node(DesicDehum(DesicDehumNum)%CondenserInletNode)%HumRat, &
Node(DesicDehum(DesicDehumNum)%CondenserInletNode)%Temp)
IF (DesicDehum(DesicDehumNum)%RegenFanPlacement == BlowThru)THEN
CALL SimulateFanComponents(DesicDehum(DesicDehumNum)%RegenFanName,FirstHVACIteration, &
DesicDehum(DesicDehumNum)%RegenFanIndex)
FanDeltaT = Node(DesicDehum(DesicDehumNum)%RegenFanOutNode)%Temp - &
Node(DesicDehum(DesicDehumNum)%RegenFanInNode)%Temp
! Adjust setpoint to account for fan heat
RegenSetPointTemp = RegenSetPointTemp - FanDeltaT
ENDIF
! CompanionCoilIndexNum .GT. 0 means the same thing as DesicDehum(DesicDehumNum)%CoilUpstreamOfProcessSide == Yes
IF(CompanionCoilIndexNum .GT. 0)THEN
DDPartLoadRatio = DXCoilPartLoadRatio(DesicDehum(DesicDehumNum)%DXCoilIndex)
END IF
! calculate actual condenser outlet node (regen inlet node) temperature
IF(CompanionCoilIndexNum .GT. 0) THEN
IF(DXCoilFanOpMode(DesicDehum(DesicDehumNum)%DXCoilIndex) == ContFanCycCoil) THEN
NewRegenInTemp = Node(DesicDehum(DesicDehumNum)%CondenserInletNode)%Temp + &
CondenserWasteHeat/(CpAir*(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate)* DDPartLoadRatio)
CondenserWasteHeat = CondenserWasteHeat / DDPartLoadRatio
ELSE
NewRegenInTemp = Node(DesicDehum(DesicDehumNum)%CondenserInletNode)%Temp + &
CondenserWasteHeat/(CpAir*(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate))
END IF
ELSE
NewRegenInTemp = Node(DesicDehum(DesicDehumNum)%CondenserInletNode)%Temp + &
CondenserWasteHeat/(CpAir*(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate))
END IF
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%Temp = NewRegenInTemp
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%Enthalpy = PsyHFnTdbW(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%Temp, &
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%HumRat)
MassFlowRateNew = 0.0d0
IF (DesicDehum(DesicDehumNum)%ExhaustFanMaxVolFlowRate .GT. 0)THEN
! calculate mass flow rate required to maintain regen inlet setpoint temp
IF(NewRegenInTemp .GT. RegenSetPointTemp)THEN
IF(RegenSetPointTemp - Node(DesicDehum(DesicDehumNum)%CondenserInletNode)%Temp .NE. 0.0d0)THEN
MassFlowRateNew = MAX(0.0d0, CondenserWasteHeat / &
(CpAir*(RegenSetPointTemp - Node(DesicDehum(DesicDehumNum)%CondenserInletNode)%Temp)))
ELSE
MassFlowRateNew = Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate
ENDIF
ENDIF
! calculate exhaust fan mass flow rate and new regen inlet temperature (may not be at setpoint)
IF (MassFlowRateNew > Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate)THEN
ExhaustFanMassFlowRate = MassFlowRateNew - Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate
ExhaustFanMassFlowRate = MAX(0.0d0,MIN(ExhaustFanMassFlowRate,DesicDehum(DesicDehumNum)%ExhaustFanMaxMassFlowRate))
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%Temp = Node(DesicDehum(DesicDehumNum)%CondenserInletNode)%Temp &
+ CondenserWasteHeat/(CpAir*(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate+ExhaustFanMassFlowRate))
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%HumRat = Node(DesicDehum(DesicDehumNum)%CondenserInletNode)%HumRat
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%Enthalpy = &
PsyHFnTdbW(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%Temp, &
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%HumRat)
END IF
ENDIF
IF(RegenCoilIndex .GT. 0)THEN
IF(NewRegenInTemp .LT. RegenSetPointTemp)THEN
CpAir = PsyCpAirFnWTdb(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%HumRat, &
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%Temp)
END IF
QRegen = MAX(0.0d0, (CpAir * Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate * &
(RegenSetPointTemp-Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%Temp)))
IF(QRegen .EQ. 0.0d0) QRegen = -1.0d0
END IF
! CompanionCoilIndexNum .EQ. 0 means the same thing as DesicDehum(DesicDehumNum)%CoilUpstreamOfProcessSide == No
IF(CompanionCoilIndexNum .EQ. 0)THEN
IF(RegenCoilIndex .GT. 0)THEN
QRegen_OASysFanAdjust = QRegen
IF (DesicDehum(DesicDehumNum)%RegenFanPlacement == BlowThru)THEN
IF(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate .GT. 0.0d0)THEN
! For VAV systems, fan may restrict air flow during iteration. Adjust QRegen proportional to Mdot reduction through fan
QRegen_OASysFanAdjust = QRegen_OASysFanAdjust * Node(DesicDehum(DesicDehumNum)%RegenFanOutNode)%MassFlowRate / &
Node(DesicDehum(DesicDehumNum)%RegenFanInNode)%MassFlowRate
END IF
END IF
CALL CalcNonDXHeatingCoils(DesicDehumNum,FirstHVACIteration,QRegen_OASysFanAdjust)
END IF
CALL SimHeatRecovery(DesicDehum(DesicDehumNum)%HXName,FirstHVACIteration,DesicDehum(DesicDehumNum)%CompIndex, &
ContFanCycCoil, HXPartLoadRatio=1.0d0, HXUnitEnable=.TRUE., CompanionCoilIndex=CompanionCoilIndexNum, &
RegenInletIsOANode=DesicDehum(DesicDehumNum)%RegenInletIsOutsideAirNode)
! calculate desiccant part-load ratio
IF(Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat .NE. Node(DesicDehum(DesicDehumNum)%ProcAirOutNode)%HumRat) THEN
DDPartLoadRatio = (Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat - HumRatNeeded) / &
(Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat - Node(DesicDehum(DesicDehumNum)%ProcAirOutNode)%HumRat)
DDPartLoadRatio = MAX(0.0d0, MIN(1.0d0, DDPartLoadRatio))
ELSE
DDPartLoadRatio = 1.0d0
END IF
END IF
IF(ExhaustFanMassFlowRate .GT. 0.0d0)THEN
! calculate exhaust fan mass flow rate due to desiccant system operation
ExhaustFanMassFlowRate = ExhaustFanMassFlowRate * DDPartLoadRatio
! calculate exhaust fan PLR due to desiccant system operation
ExhaustFanPLR = ExhaustFanMassFlowRate/DesicDehum(DesicDehumNum)%ExhaustFanMaxMassFlowRate
! find exhaust fan power multiplier using exhaust fan part-load ratio
IF(DesicDehum(DesicDehumNum)%ExhaustFanCurveIndex .GT. 0) THEN
ExhaustFanPowerMod = MIN(1.0d0,MAX(0.0d0,CurveValue(DesicDehum(DesicDehumNum)%ExhaustFanCurveIndex,ExhaustFanPLR)))
ELSE
ExhaustFanPowerMod = 1.0d0
END IF
! calculate exhaust fan power due to desiccant operation
DesicDehum(DesicDehumNum)%ExhaustFanPower = DesicDehum(DesicDehumNum)%ExhaustFanMaxPower * ExhaustFanPowerMod
END IF
ELSE ! ELSE for IF(DesicDehum(DesicDehumNum)%Preheat == Yes)THEN
IF(Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat .GT. HumRatNeeded)THEN
! Get Full load output of desiccant wheel
IF (DesicDehum(DesicDehumNum)%RegenFanPlacement == BlowThru)THEN
CALL SimulateFanComponents(DesicDehum(DesicDehumNum)%RegenFanName,FirstHVACIteration, &
DesicDehum(DesicDehumNum)%RegenFanIndex)
FanDeltaT = Node(DesicDehum(DesicDehumNum)%RegenFanOutNode)%Temp - &
Node(DesicDehum(DesicDehumNum)%RegenFanInNode)%Temp
RegenSetPointTemp = RegenSetPointTemp - FanDeltaT
ENDIF
IF(RegenCoilIndex .GT. 0)THEN
CpAir = PsyCpAirFnWTdb(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%HumRat, &
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%Temp)
QRegen = MAX(0.0d0, (CpAir * Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate * &
(RegenSetPointTemp-Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%Temp)))
QRegen_OASysFanAdjust = QRegen
IF (DesicDehum(DesicDehumNum)%RegenFanPlacement == BlowThru)THEN
IF(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate .GT. 0.0d0)THEN
! For VAV systems, fan may restrict air flow during iteration. Adjust QRegen proportional to Mdot reduction through fan
QRegen_OASysFanAdjust = QRegen_OASysFanAdjust * Node(DesicDehum(DesicDehumNum)%RegenFanOutNode)%MassFlowRate / &
Node(DesicDehum(DesicDehumNum)%RegenFanInNode)%MassFlowRate
END IF
END IF
IF(QRegen_OASysFanAdjust .EQ. 0.0d0) QRegen_OASysFanAdjust = -1.0d0
CALL CalcNonDXHeatingCoils(DesicDehumNum,FirstHVACIteration,QRegen_OASysFanAdjust)
END IF
! CompanionCoilIndexNum .EQ. 0 means the same thing as DesicDehum(DesicDehumNum)%CoilUpstreamOfProcessSide == No
IF(CompanionCoilIndexNum .EQ. 0)THEN
CALL SimHeatRecovery(DesicDehum(DesicDehumNum)%HXName,FirstHVACIteration,DesicDehum(DesicDehumNum)%CompIndex, &
ContFanCycCoil, HXPartLoadRatio=1.0d0, HXUnitEnable=.TRUE., CompanionCoilIndex=CompanionCoilIndexNum, &
RegenInletIsOANode=DesicDehum(DesicDehumNum)%RegenInletIsOutsideAirNode)
! calculate desiccant part-load ratio
IF(Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat .NE. Node(DesicDehum(DesicDehumNum)%ProcAirOutNode)%HumRat) THEN
DDPartLoadRatio = (Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat - HumRatNeeded) / &
(Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat - Node(DesicDehum(DesicDehumNum)%ProcAirOutNode)%HumRat)
DDPartLoadRatio = MAX(0.0d0, MIN(1.0d0, DDPartLoadRatio))
ELSE
DDPartLoadRatio = 1.0d0
END IF
ELSE
DDPartLoadRatio = DXCoilPartLoadRatio(DesicDehum(DesicDehumNum)%DXCoilIndex)
END IF
ELSE ! ELSE for IF(Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat .GT. HumRatNeeded)THEN
DDPartLoadRatio = 0.0d0
END IF ! END IF for IF(Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat .GT. HumRatNeeded)THEN
ENDIF ! END IF for IF(DesicDehum(DesicDehumNum)%Preheat == Yes)THEN
DesicDehum(DesicDehumNum)%PartLoad = DDPartLoadRatio
QRegen_OASysFanAdjust = QRegen
! set average regeneration air mass flow rate based on desiccant cycling ratio (DDPartLoadRatio)
IF (DesicDehum(DesicDehumNum)%RegenInletIsOutsideAirNode) THEN
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate = &
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate * DDPartLoadRatio
! **RR moved to here, only adjust regen heater load if mass flow rate is changed
! adjust regen heating coil capacity based on desiccant cycling ratio (PLR)
QRegen_OASysFanAdjust = QRegen_OASysFanAdjust * DDPartLoadRatio
END IF
! Call regen fan, balanced desiccant HX and heating coil
IF (DesicDehum(DesicDehumNum)%RegenFanPlacement == BlowThru)THEN
CALL SimulateFanComponents(DesicDehum(DesicDehumNum)%RegenFanName,FirstHVACIteration, &
DesicDehum(DesicDehumNum)%RegenFanIndex)
ENDIF
IF(RegenCoilIndex .GT. 0)THEN
!! adjust regen heating coil capacity based on desiccant cycling ratio (PLR)
! QRegen_OASysFanAdjust = QRegen * DDPartLoadRatio
IF (DesicDehum(DesicDehumNum)%RegenFanPlacement == BlowThru)THEN
IF(Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate .GT. 0.0d0)THEN
! For VAV systems, fan may restrict air flow during iteration. Adjust QRegen proportional to Mdot reduction through fan
QRegen_OASysFanAdjust = QRegen_OASysFanAdjust * Node(DesicDehum(DesicDehumNum)%RegenFanOutNode)%MassFlowRate / &
Node(DesicDehum(DesicDehumNum)%RegenFanInNode)%MassFlowRate
END IF
END IF
IF(QRegen_OASysFanAdjust .EQ. 0.0d0) QRegen_OASysFanAdjust = -1.0d0
CALL CalcNonDXHeatingCoils(DesicDehumNum,FirstHVACIteration,QRegen_OASysFanAdjust)
END IF
CALL SimHeatRecovery(DesicDehum(DesicDehumNum)%HXName,FirstHVACIteration,DesicDehum(DesicDehumNum)%CompIndex, &
ContFanCycCoil, HXPartLoadRatio=DDPartLoadRatio, HXUnitEnable=.TRUE., CompanionCoilIndex=CompanionCoilIndexNum, &
RegenInletIsOANode=DesicDehum(DesicDehumNum)%RegenInletIsOutsideAirNode)
IF (DesicDehum(DesicDehumNum)%RegenFanPlacement == DrawThru)THEN
CALL SimulateFanComponents(DesicDehum(DesicDehumNum)%RegenFanName,FirstHVACIteration, &
DesicDehum(DesicDehumNum)%RegenFanIndex)
ENDIF
! Calculate water removal
DesicDehum(DesicDehumNum)%WaterRemoveRate = Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%MassFlowRate* &
(Node(DesicDehum(DesicDehumNum)%ProcAirInNode)%HumRat - &
Node(DesicDehum(DesicDehumNum)%ProcAirOutNode)%HumRat)
! If preheat is Yes, exhaust fan is condenser fan, if CoilUpstreamOfProcessSide is No, DD runs an its own PLR
IF(DesicDehum(DesicDehumNum)%Preheat == Yes .AND. DesicDehum(DesicDehumNum)%CoilUpstreamOfProcessSide == No)THEN
! should actually use DX coil RTF instead of PLR since fan power is being calculated
DesicDehum(DesicDehumNum)%ExhaustFanPower = DesicDehum(DesicDehumNum)%ExhaustFanPower + &
MAX(0.0d0,(DesicDehum(DesicDehumNum)%ExhaustFanMaxPower * &
(DXCoilPartLoadRatio(DesicDehum(DesicDehumNum)%DXCoilIndex)-DDPartLoadRatio)))
END IF
ELSE ! unit must be off
DesicDehum(DesicDehumNum)%PartLoad = 0.0d0
IF(DesicDehum(DesicDehumNum)%RegenInletIsOutsideAirNode) THEN
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate = 0.0d0
Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRateMaxAvail = 0.0d0
END IF
IF (DesicDehum(DesicDehumNum)%RegenFanPlacement == BlowThru)THEN
CALL SimulateFanComponents(DesicDehum(DesicDehumNum)%RegenFanName,FirstHVACIteration, &
DesicDehum(DesicDehumNum)%RegenFanIndex)
ENDIF
IF(RegenCoilIndex .GT. 0)THEN
CALL CalcNonDXHeatingCoils(DesicDehumNum,FirstHVACIteration,-1.0d0)
END IF
CALL SimHeatRecovery(DesicDehum(DesicDehumNum)%HXName,FirstHVACIteration,DesicDehum(DesicDehumNum)%CompIndex, &
ContFanCycCoil,HXPartLoadRatio=0.0d0,HXUnitEnable=.FALSE.,CompanionCoilIndex=CompanionCoilIndexNum, &
RegenInletIsOANode=DesicDehum(DesicDehumNum)%RegenInletIsOutsideAirNode)
IF (DesicDehum(DesicDehumNum)%RegenFanPlacement == DrawThru)THEN
CALL SimulateFanComponents(DesicDehum(DesicDehumNum)%RegenFanName,FirstHVACIteration, &
DesicDehum(DesicDehumNum)%RegenFanIndex)
ENDIF
! Turn on exhaust fan if DX Coil is operating
IF(DesicDehum(DesicDehumNum)%ExhaustFanMaxVolFlowRate .GT. 0)THEN
IF(DesicDehum(DesicDehumNum)%DXCoilIndex .GT. 0)THEN
DDPartLoadRatio = DXCoilPartLoadRatio(DesicDehum(DesicDehumNum)%DXCoilIndex)
DesicDehum(DesicDehumNum)%ExhaustFanPower = DesicDehum(DesicDehumNum)%ExhaustFanMaxPower * DDPartLoadRatio
ExhaustFanMassFlowRate = DesicDehum(DesicDehumNum)%ExhaustFanMaxMassFlowRate * DDPartLoadRatio
END IF
END IF
ENDIF ! UnitOn/Off
! check condenser minimum flow per rated total capacity
IF(DDPartLoadRatio .GT. 0.0d0 .AND. DesicDehum(DesicDehumNum)%ExhaustFanMaxVolFlowRate .GT. 0.0d0) THEN
VolFlowperRatedTotQ = (Node(DesicDehum(DesicDehumNum)%RegenAirInNode)%MassFlowRate+ExhaustFanMassFlowRate)/ &
MAX(0.00001d0,(DesicDehum(DesicDehumNum)%CompanionCoilCapacity*DDPartLoadRatio*RhoAirStdInit))
IF(.NOT. WarmupFlag .AND. (VolFlowperRatedTotQ .LT. MinVolFlowPerRatedTotQ)) THEN
WRITE(VolFlowChar,*) VolFlowperRatedTotQ
DesicDehum(DesicDehumNum)%ErrCount=DesicDehum(DesicDehumNum)%ErrCount+1
IF (DesicDehum(DesicDehumNum)%ErrCount < 2) THEN
CALL ShowWarningError(TRIM(DesicDehum(DesicDehumNum)%DehumType)//' "'//TRIM(DesicDehum(DesicDehumNum)%Name)//&
'" - Air volume flow rate per watt of total condenser waste heat is below the minimum recommended at ' &
//TRIM(VolFlowChar)//' m3/s/W.')
CALL ShowContinueErrorTimeStamp(' ')
WRITE(MinVol,*) MinVolFlowPerRatedTotQ
CALL ShowContinueError('Expected minimum for VolumeFlowperRatedTotalCondenserWasteHeat = ['//TRIM(MinVol)//']')
CALL ShowContinueError('Possible causes include inconsistent air flow rates in system components ')
CALL ShowContinueError('on the regeneration side of the desiccant dehumidifier.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(DesicDehum(DesicDehumNum)%DehumType)//' "' &
//TRIM(DesicDehum(DesicDehumNum)%Name)// &
'" - Air volume flow rate per watt of rated total cooling capacity is out ' //&
'of range error continues...',DesicDehum(DesicDehumNum)%ErrIndex1,VolFlowperRatedTotQ,VolFlowperRatedTotQ)
END IF
END IF ! flow per rated total capacity check ends
END IF
! Reset OnOffFanPartLoadFraction for process side fan calculations
OnOffFanPartLoadFraction = OnOffFanPLF
RETURN
END SUBROUTINE CalcGenericDesiccantDehumidifier