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) | :: | ZoneDehumNum | |||
real(kind=r64), | intent(in) | :: | QZnDehumidReq | |||
real(kind=r64), | intent(out) | :: | SensibleOutput | |||
real(kind=r64), | intent(out) | :: | LatentOutput |
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 CalcZoneDehumidifier(ZoneDehumNum,QZnDehumidReq,SensibleOutput,LatentOutput)
! SUBROUTINE INFORMATION:
! AUTHOR Don Shirey, FSEC
! DATE WRITTEN July/Aug 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculate the delivered capacity, electric energy consumption and water/condensate
! removal rates for the zone dehumidifier.
! METHODOLOGY EMPLOYED:
! Cycle the dehumidifier as needed to meet the remaining zone dehumidification load.
! Send excess sensible heat to zone energy balance (via SensibleOutput) for next HVAC time step,
! so set the dehumidifier outlet air temp = inlet air temp to avoid double counting excess sensible.
! REFERENCES:
! na
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE Psychrometrics, ONLY: RhoH2O, PsyRhFnTdbWPb, PsyHfgAirFnWTdb, PsyCpAirFnWTdb, PsyHFnTdbW
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: ZoneDehumNum ! Index number of the current zone dehumidifier being simulated
REAL(r64), INTENT (IN) :: QZnDehumidReq ! Dehumidification load to be met (kg/s), negative value means dehumidification load
REAL(r64), INTENT (OUT) :: SensibleOutput ! Sensible (heating) output (W), sent to load predictor for next simulation time step
REAL(r64), INTENT (OUT) :: LatentOutput ! Latent (dehumidification) output provided (kg/s)
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: WaterRemovalRateFactor ! Adjustment to Rate Water Removal as a function of inlet air T and RH
REAL(r64) :: WaterRemovalVolRate ! Actual water removal rate at current inlet air conditions (L/day)
REAL(r64) :: WaterRemovalMassRate ! Actual water removal rate at current inlet air conditions (kg/s)
REAL(r64) :: EnergyFactorAdjFactor ! Adjustment to Rate Energy Factor as a function of inlet air T and RH
REAL(r64) :: EnergyFactor ! Actual Energy Factor as a function of inlet air T and RH
REAL(r64) :: InletAirTemp ! Dry-bulb temperature of air entering the dehumidifier (C)
REAL(r64) :: InletAirHumRat ! Humidity ratio of the air entering the dehumidifier (kg/kg)
REAL(r64) :: InletAirRH ! Relative humidity of air entering the dehumidifier (%)
REAL(r64) :: OutletAirTemp ! Dry-bulb temperature of air leaving the dehumidifier (C)
REAL(r64) :: OutletAirHumRat ! Humidity ratio of air leaving the dehumidifier (kg/kg)
REAL(r64) :: PLR ! Part-load ratio = (dehumid load to be met)/(dehumid capacity of the dehumidifier)
REAL(r64) :: PLF ! Part-load fraction (-), RuntimeFraction = PLR/PLF
REAL(r64) :: RunTimeFraction ! Dehumidifier runtime fraction (-)
REAL(r64) :: ElectricPowerOnCycle ! Electric power when dehumidifier is operating (W)
REAL(r64) :: ElectricPowerAvg ! Average electric power for this dehumidifier (W)
REAL(r64) :: hfg ! Enthalpy of evaporation of inlet air (J/kg)
REAL(r64) :: AirMassFlowRate ! Air mass flow rate through this dehumidifier (kg/s)
REAL(r64) :: Cp ! Heat capacity of inlet air (J/kg-C)
INTEGER :: AirInletNodeNum = 0 ! Node number for the inlet air to the dehumidifier
INTEGER :: AirOutletNodeNum = 0 ! Node number for the outlet air from the dehumidifier
SensibleOutput = 0.0d0
LatentOutput = 0.0d0
WaterRemovalRateFactor = 0.0d0
AirMassFlowRate = 0.0d0
PLR = 0.0d0
PLF = 0.0d0
EnergyFactorAdjFactor = 0.0d0
RunTimeFraction = 0.0d0
ElectricPowerAvg = 0.0d0
ElectricPowerOnCycle = 0.0d0
AirInletNodeNum = ZoneDehumid(ZoneDehumNum)%AirInletNodeNum
AirOutletNodeNum = ZoneDehumid(ZoneDehumNum)%AirOutletNodeNum
InletAirTemp = Node(AirInletNodeNum)%Temp
InletAirHumRat = Node(AirInletNodeNum)%Humrat
InletAirRH = 100.0d0 * PsyRhFnTdbWPb(InletAirTemp,InletAirHumRat,OutBaroPress,'CalcZoneDehumidifier') ! RH in percent (%)
IF (QZnDehumidReq .LT. 0.0d0 .AND. GetCurrentScheduleValue(ZoneDehumid(ZoneDehumNum)%SchedPtr) .GT. 0.0d0 .AND. &
InletAirTemp .GE. ZoneDehumid(ZoneDehumNum)%MinInletAirTemp .AND. &
InletAirTemp .LE. ZoneDehumid(ZoneDehumNum)%MaxInletAirTemp) THEN
! A dehumidification load is being requested and dehumidifier is available (schedule value > 0)
! and the inlet air temperature is within the min/max values specified by user input
WaterRemovalRateFactor = CurveValue(ZoneDehumid(ZoneDehumNum)%WaterRemovalCurveIndex,InletAirTemp,InletAirRH)
! Warn user if curve output goes negative
IF (WaterRemovalRateFactor .LE. 0.0d0) THEN
IF (ZoneDehumid(ZoneDehumNum)%WaterRemovalCurveErrorCount .LT. 1) THEN
ZoneDehumid(ZoneDehumNum)%WaterRemovalCurveErrorCount = ZoneDehumid(ZoneDehumNum)%WaterRemovalCurveErrorCount + 1
CALL ShowWarningError(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'//TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":')
CALL ShowContinueError(' Water Removal Rate Curve output is <= 0.0 (' &
//TRIM(TrimSigDigits(WaterRemovalRateFactor,5))//').')
CALL ShowContinueError(' Negative value occurs using an inlet air dry-bulb temperature of ' &
//TRIM(TrimSigDigits(InletAirTemp,2))// &
' and an inlet air relative humidity of '//TRIM(TrimSigDigits(InletAirRH,1))//'.')
CALL ShowContinueErrorTimeStamp(' Dehumidifier turned off for this time step but simulation continues.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'// &
TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":'//&
' Water Removal Rate Curve output is <= 0.0 warning continues...' &
, ZoneDehumid(ZoneDehumNum)%WaterRemovalCurveErrorIndex, WaterRemovalRateFactor, WaterRemovalRateFactor)
END IF
WaterRemovalRateFactor = 0.0d0
END IF
WaterRemovalVolRate = WaterRemovalRateFactor * ZoneDehumid(ZoneDehumNum)%RatedWaterRemoval
WaterRemovalMassRate = WaterRemovalVolRate / (24.0d0 * SecInHour * 1000.0d0) * & !(L/d)/(24 hr/day *3600 sec/hr * 1000 L/m3)
RhoH2O(MAX((InletAirTemp-11.0d0),1.0d0),'CalcZoneDehumidifier') ! Density of water, minimum temp = 1.0C
IF (WaterRemovalMassRate .GT. 0.0d0) THEN
PLR = MAX(0.0d0, MIN(1.0d0, -QZnDehumidReq / WaterRemovalMassRate))
ELSE
PLR = 0.0d0
RunTimeFraction = 0.0d0
END IF
EnergyFactorAdjFactor = CurveValue(ZoneDehumid(ZoneDehumNum)%EnergyFactorCurveIndex,InletAirTemp,InletAirRH)
! Warn user if curve output goes negative
IF (EnergyFactorAdjFactor .LE. 0.0d0) THEN
IF (ZoneDehumid(ZoneDehumNum)%EnergyFactorCurveErrorCount .LT. 1) THEN
ZoneDehumid(ZoneDehumNum)%EnergyFactorCurveErrorCount = ZoneDehumid(ZoneDehumNum)%EnergyFactorCurveErrorCount + 1
CALL ShowWarningError(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'//TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":')
CALL ShowContinueError(' Energy Factor Curve output is <= 0.0 (' &
//TRIM(TrimSigDigits(EnergyFactorAdjFactor,5))//').')
CALL ShowContinueError(' Negative value occurs using an inlet air dry-bulb temperature of ' &
//TRIM(TrimSigDigits(InletAirTemp,2))// &
' and an inlet air relative humidity of '//TRIM(TrimSigDigits(InletAirRH,1))//'.')
CALL ShowContinueErrorTimeStamp(' Dehumidifier turned off for this time step but simulation continues.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'// &
TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":'//&
' Energy Factor Curve output is <= 0.0 warning continues...' &
, ZoneDehumid(ZoneDehumNum)%EnergyFactorCurveErrorIndex, EnergyFactorAdjFactor, EnergyFactorAdjFactor)
END IF
ElectricPowerAvg = 0.0d0
PLR = 0.0d0
RunTimeFraction = 0.0d0
ELSE
! EnergyFactorAdjFactor is not negative, so proceed with calculations
EnergyFactor = EnergyFactorAdjFactor * ZoneDehumid(ZoneDehumNum)%RatedEnergyFactor
IF (ZoneDehumid(ZoneDehumNum)%PartLoadCurveIndex .GT. 0) THEN
PLF = CurveValue(ZoneDehumid(ZoneDehumNum)%PartLoadCurveIndex,PLR) ! Calculate part load fraction
ELSE
PLF = 1.0d0
END IF
IF (PLF < 0.7d0) THEN
IF (ZoneDehumid(ZoneDehumNum)%LowPLFErrorCount .LT. 1) THEN
ZoneDehumid(ZoneDehumNum)%LowPLFErrorCount = ZoneDehumid(ZoneDehumNum)%LowPLFErrorCount + 1
CALL ShowWarningError(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'//TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":')
CALL ShowContinueError(' The Part Load Fraction Correlation Curve output is (' &
//TRIM(TrimSigDigits(PLF,2))//') at a part-load ratio ='//TRIM(TrimSigDigits(PLR,3)))
CALL ShowContinueErrorTimeStamp(' PLF curve values must be >= 0.7. '//&
' PLF has been reset to 0.7 and simulation is continuing.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'// &
TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":'//&
' Part Load Fraction Correlation Curve output < 0.7 warning continues...' &
, ZoneDehumid(ZoneDehumNum)%LowPLFErrorIndex, PLF, PLF)
END IF
PLF = 0.7d0
END IF
IF (PLF > 1.0d0) THEN
IF (ZoneDehumid(ZoneDehumNum)%HighPLFErrorCount .LT. 1) THEN
ZoneDehumid(ZoneDehumNum)%HighPLFErrorCount = ZoneDehumid(ZoneDehumNum)%HighPLFErrorCount + 1
CALL ShowWarningError(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'//TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":')
CALL ShowContinueError(' The Part Load Fraction Correlation Curve output is (' &
//TRIM(TrimSigDigits(PLF,2))//') at a part-load ratio ='//TRIM(TrimSigDigits(PLR,3)))
CALL ShowContinueErrorTimeStamp(' PLF curve values must be < 1.0. '//&
' PLF has been reset to 1.0 and simulation is continuing.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'// &
TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":'//&
' Part Load Fraction Correlation Curve output > 1.0 warning continues...' &
, ZoneDehumid(ZoneDehumNum)%HighPLFErrorIndex, PLF, PLF)
END IF
PLF = 1.0d0
END IF
IF (PLF .GT. 0.0d0 .AND. PLF .GE. PLR) THEN
RunTimeFraction = PLR/PLF ! Calculate dehumidifier runtime fraction
ELSE
IF (ZoneDehumid(ZoneDehumNum)%PLFPLRErrorCount .LT. 1) THEN
ZoneDehumid(ZoneDehumNum)%PLFPLRErrorCount = ZoneDehumid(ZoneDehumNum)%PLFPLRErrorCount + 1
CALL ShowWarningError(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'//TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":')
CALL ShowContinueError('The part load fraction was less than the part load ratio calculated'// &
' for this time step [PLR='//TRIM(TrimSigDigits(PLR,4))//', PLF='//TRIM(TrimSigDigits(PLF,4))//'].')
CALL ShowContinueError('Runtime fraction reset to 1 and the simulation will continue.')
CALL ShowContinueErrorTimeStamp(' ')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'// &
TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":'//&
' Part load fraction less than part load ratio warning continues...' &
, ZoneDehumid(ZoneDehumNum)%PLFPLRErrorIndex)
END IF
RunTimeFraction = 1.0d0
END IF
IF (RunTimeFraction > 1.0d0 .AND. ABS(RunTimeFraction-1.0d0) > 0.001d0) THEN
IF (ZoneDehumid(ZoneDehumNum)%HighRTFErrorCount .LT. 1) THEN
ZoneDehumid(ZoneDehumNum)%HighRTFErrorCount = ZoneDehumid(ZoneDehumNum)%HighRTFErrorCount + 1
CALL ShowWarningError(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'//TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":')
CALL ShowContinueError('The runtime fraction for this zone dehumidifier'// &
' exceeded 1.0 ['//TRIM(TrimSigDigits(RunTimeFraction,4))//'].')
CALL ShowContinueError('Runtime fraction reset to 1 and the simulation will continue.')
CALL ShowContinueErrorTimeStamp(' ')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(ZoneDehumid(ZoneDehumNum)%UnitType)//' "'// &
TRIM(ZoneDehumid(ZoneDehumNum)%Name)//'":'//&
' Runtime fraction for zone dehumidifier exceeded 1.0 warning continues...' &
, ZoneDehumid(ZoneDehumNum)%HighRTFErrorIndex, RunTimeFraction, RunTimeFraction)
END IF
RunTimeFraction = 1.0d0
END IF
! ElectricPowerOnCycle = Water removal volumetric rate (L/day) / (Energy Factor(L/kWh) * 24 hrs/day ) * 1000 Wh/kWh
ElectricPowerOnCycle = WaterRemovalVolRate / (EnergyFactor*24.0d0) * 1000.0d0 ! Watts
! ElectricPowerAvg = ElectricPowerOnCycle * RTF + (1-RTF)*OffCycleParsiticLoad
ElectricPowerAvg = ElectricPowerOnCycle * RunTimeFraction + & ! average Watts
(1.0d0 - RunTimeFraction)*ZoneDehumid(ZoneDehumNum)%OffCycleParasiticLoad
END IF
LatentOutput = WaterRemovalMassRate * PLR ! Average moisture removal rate, kg/s, for this timestep
hfg = PsyHfgAirFnWTdb(InletAirHumRat,InletAirTemp)
SensibleOutput = (LatentOutput * hfg) + ElectricPowerAvg ! Average sensible output, Watts
! Send SensibleOutput to zone air heat balance via SysDepZoneLoads in ZoneEquipmentManager
Node(AirInletNodeNum)%MassFlowRate = ZoneDehumid(ZoneDehumNum)%RatedAirMassFlow * PLR
AirMassFlowRate = Node(AirInletNodeNum)%MassFlowRate ! Average air mass flow for this timestep
Cp = PsyCpAirFnWTdb(InletAirHumRat,InletAirTemp) ! Heat capacity of air
IF (AirMassFlowRate .GT. 0.0d0 .AND. Cp .GT. 0.0d0) THEN
OutletAirTemp = InletAirTemp + (ElectricPowerOnCycle + (WaterRemovalMassRate*hfg)) / &
(ZoneDehumid(ZoneDehumNum)%RatedAirMassFlow * Cp)
OutletAirHumRat = InletAirHumRat - LatentOutput / AirMassFlowRate
ELSE
OutletAirTemp = InletAirTemp
OutletAirHumRat = InletAirHumRat
END IF
ELSE
! No load or not available or inlet air temps beyond min/max limits, then set outlet conditions
! equal to inlet conditions and PLR = RTF = 0.0
OutletAirTemp = InletAirTemp
OutletAirHumRat = InletAirHumRat
PLR = 0.0d0
RunTimeFraction = 0.0d0
Node(AirInletNodeNum)%MassFlowRate = 0.0d0
! If available but didn't operate, then set electric power = off cycle parasitic load.
! Else, electric power = 0.0
IF (GetCurrentScheduleValue(ZoneDehumid(ZoneDehumNum)%SchedPtr) .GT. 0.0d0) THEN
ElectricPowerAvg = ZoneDehumid(ZoneDehumNum)%OffCycleParasiticLoad ! off cycle parasitic is on entire timestep
ELSE
ElectricPowerAvg = 0.0d0
END IF
END IF
ZoneDehumid(ZoneDehumNum)%OutletAirTemp = OutletAirTemp ! Update report variable here. Node outlet Temp set equal
! to Node inlet Temp in Update subroutine
ZoneDehumid(ZoneDehumNum)%OutletAirHumRat = OutletAirHumRat ! Store in structure, updated outlet node in Update subroutine
! Use inlet air temperature in outlet air enthalpy calculation... since the sensible heat output
! from the dehumidifier is being sent directly to the zone air heat balance for next hvac simulation time step
ZoneDehumid(ZoneDehumNum)%OutletAirEnthalpy = PsyHFnTdbW(InletAirTemp,OutletAirHumRat,'CalcZoneDehumidifier')
ZoneDehumid(ZoneDehumNum)%SensHeatingRate = SensibleOutput ! Report variable update, W, avg sens output when unit is 'on'
ZoneDehumid(ZoneDehumNum)%WaterRemovalRate = LatentOutput ! Report variable update, kg/s
LatentOutput = - LatentOutput ! change sign... negative is dehumidification in zone air balance
ZoneDehumid(ZoneDehumNum)%OffCycleParasiticElecPower=(1.0d0 - RunTimeFraction)*ZoneDehumid(ZoneDehumNum)%OffCycleParasiticLoad
ZoneDehumid(ZoneDehumNum)%ElecPower = ElectricPowerAvg
ZoneDehumid(ZoneDehumNum)%DehumidPLR = PLR
ZoneDehumid(ZoneDehumNum)%DehumidRTF = RunTimeFraction
RETURN
END SUBROUTINE CalcZoneDehumidifier