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) | :: | HumNum | |||
real(kind=r64), | intent(in) | :: | WaterAddNeeded |
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 CalcElecSteamHumidifier(HumNum,WaterAddNeeded)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN September 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculate the electricity consumption and the outlet conditions for an electric steam
! humidifier, given the inlet conditions and the steam addition rate.
! METHODOLOGY EMPLOYED:
! Uses energy and mass balance as well as pschrometric relations.
! REFERENCES:
! ASHRAE HVAC 2 Toolkit, page 4-112
! 1997 ASHRAE Handbook Fundamentals, page 6.18
! USE STATEMENTS:
Use Psychrometrics, ONLY:PsyWFnTdbRhPb,PsyTdbFnHW,PsyHFnTdbW,RhoH2O
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: HumNum ! number of the current humidifier being simulated
REAL(r64), INTENT(IN) :: WaterAddNeeded ! moisture addition rate set by controller [kg/s]
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AirMassFlowRate ! air mass flow rate [kg/s]
REAL(r64) :: HumRatSatOut ! humidity ratio at saturation at the outlet temperature [kg H2O / kg dry air]
REAL(r64) :: HumRatSatIn ! humidity ratio at saturation at the inlet temperature [kg H2O / kg dry air]
REAL(r64) :: WaterAddRate ! moisture addition rate by humidifier [kg/s]
REAL(r64) :: WaterAddNeededMax ! moisture addition rate set by controller, limited by humidifier capacity
REAL(r64) :: AirOutEnthalpy ! outlet air enthalpy [J/kg]
REAL(r64) :: AirOutHumRat ! outlet air humidity ratio [kg H2O / kg dry air]
REAL(r64) :: AirOutTemp ! outlet air temperature [C]
REAL(r64) :: WaterInEnthalpy ! enthalpy of the inlet steam [J/kg]
REAL(r64) :: HumRatSatApp ! the approximate humidity ratio where the line drawn between inlet and desired outlet conditions
! crosses the saturation line.
REAL(r64) :: WaterDens ! density of liquid water [kg/m3]
AirMassFlowRate = Humidifier(HumNum)%AirInMassFlowRate
HumRatSatIn = PsyWFnTdbRhPb(Humidifier(HumNum)%AirInTemp,1.0d0,OutBaroPress, 'CalcElecSteamHumidifier')
HumRatSatOut = 0.0d0
HumRatSatApp = 0.0d0
WaterInEnthalpy = 2676125.d0 ! At 100 C
WaterDens = RhoH2O(InitConvTemp)
WaterAddNeededMax = MIN(WaterAddNeeded,Humidifier(HumNum)%NomCap)
IF (WaterAddNeededMax.GT.0.0d0) THEN
! ma*W1 + mw = ma*W2
! ma*h1 + mw*hw = ma*h2
! where ma is air mass flow rate; h1,W1 are the inlet enthalpy and humidity ratio; h2 and W2 are
! the outlet enthalpy and humidity ratio; mw is the steam mass flow rate; hw is the steam enthalpy.
! Setting mw equal to the desired water addition rate, use the above 2 equations to calculate the
! outlet conditions
AirOutEnthalpy=(AirMassFlowRate*Humidifier(HumNum)%AirInEnthalpy + WaterAddNeededMax*WaterInEnthalpy)/AirMassFlowRate
AirOutHumRat = (AirMassFlowRate*Humidifier(HumNum)%AirInHumRat + WaterAddNeededMax) / AirMassFlowRate
AirOutTemp = PsyTdbFnHW(AirOutEnthalpy,AirOutHumrat, 'CalcElecSteamHumidifier')
HumRatSatOut = PsyWFnTdbRhPb(AirOutTemp,1.0d0,OutBaroPress, 'CalcElecSteamHumidifier')
IF (AirOutHumRat .LE. HumRatSatOut) THEN
! If the outlet condition is below the saturation curve, the desired moisture addition rate can be met.
WaterAddRate = WaterAddNeededMax
ELSE
! The desired moisture addition rate results in an outlet state above the saturation curve. We need to
! find the point where the line drawn between state 1 (inlet) and state 2 (our desired outlet) crosses
! the saturation curve. This will be the new outlet condition. Rather than iterate to obtain this point,
! we find it approximately by solving for the point where 2 lines cross: the first drawn from
! state 1 to state 2, the second from T1, W1s to T2, W2s; where T1 is the inlet temperature, W1s is
! the humidity ratio at saturation at temperature T1; and T2 is the desired outlet temperature, W2s
! is the humidity ratio at saturation at temperature T2. The 2 lines are given by the equations:
! W = W1 + ((W2-W1)/(T2-T1))*(T-T1)
! W = W1s + ((W2s-W1s)/(T2-T1))*(T-T1)
! Solving for the point where the line cross (T3,W3):
! W3 = W1 + ((W2-W1)*(W1s-W1))/(W2-W2s + W1s-W1)
! T3 = T1 + (W3-W1)*((T2-T1)/(W2-W1)) ! "T1 +" added by Shirey 8/12/04 That's correct! [WFB 9/29/2004]
HumRatSatApp = Humidifier(HumNum)%AirInHumRat + (AirOutHumRat - Humidifier(HumNum)%AirInHumRat) &
* (HumRatSatIn - Humidifier(HumNum)%AirInHumRat) &
/ (AirOutHumRat - HumRatSatOut + HumRatSatIn - Humidifier(HumNum)%AirInHumRat)
AirOutTemp = Humidifier(HumNum)%AirInTemp + &
(HumRatSatApp - Humidifier(HumNum)%AirInHumRat)*((AirOutTemp - Humidifier(HumNum)%AirInTemp) &
/ (AirOutHumRat - Humidifier(HumNum)%AirInHumRat))
! This point isn't quite on the saturation curve since we made a linear approximation of the curve,
! but the temperature should be very close to the correct outlet temperature. We will use this temperature
! as the outlet temperature and move to the saturation curve for the outlet humidity and enthalpy
AirOutHumRat = PsyWFnTdbRhPb(AirOutTemp,1.0d0,OutBaroPress, 'CalcElecSteamHumidifier')
AirOutEnthalpy = PsyHFnTdbW(AirOutTemp,AirOutHumRat, 'CalcElecSteamHumidifier')
WaterAddRate = AirMassFlowRate * (AirOutHumRat - Humidifier(HumNum)%AirInHumRat)
END IF
ELSE
WaterAddRate = 0.0d0
AirOutEnthalpy = Humidifier(HumNum)%AirInEnthalpy
AirOutTemp = Humidifier(HumNum)%AirInTemp
AirOutHumRat = Humidifier(HumNum)%AirInHumRat
END IF
Humidifier(HumNum)%WaterAdd = WaterAddRate
Humidifier(HumNum)%AirOutTemp = AirOutTemp
Humidifier(HumNum)%AirOutHumRat = AirOutHumRat
Humidifier(HumNum)%AirOutEnthalpy = AirOutEnthalpy
Humidifier(HumNum)%AirOutMassFlowRate = AirMassFlowRate
IF (WaterAddRate.GT.0.0d0) THEN
Humidifier(HumNum)%ElecUseRate = (WaterAddRate/Humidifier(HumNum)%NomCap)*Humidifier(HumNum)%NomPower &
+ Humidifier(HumNum)%FanPower + Humidifier(HumNum)%StandbyPower
ELSE IF (GetCurrentScheduleValue(Humidifier(HumNum)%SchedPtr) .GT. 0.0d0) THEN
Humidifier(HumNum)%ElecUseRate = Humidifier(HumNum)%StandbyPower
ELSE
Humidifier(HumNum)%ElecUseRate = 0.0d0
END IF
Humidifier(HumNum)%WaterConsRate = Humidifier(HumNum)%WaterAdd / WaterDens
RETURN
END SUBROUTINE CalcElecSteamHumidifier