Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | CoilNum | |||
real(kind=r64), | intent(in) | :: | AirTempIn | |||
real(kind=r64), | intent(in) | :: | EnthAirInlet | |||
real(kind=r64), | intent(in) | :: | EnthAirOutlet | |||
real(kind=r64), | intent(in) | :: | UACoilExternal | |||
real(kind=r64) | :: | OutletAirTemp | ||||
real(kind=r64) | :: | OutletAirHumRat | ||||
real(kind=r64) | :: | SenWaterCoilLoad |
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 WetCoilOutletCondition(CoilNum,AirTempIn,EnthAirInlet,EnthAirOutlet,UACoilExternal, &
OutletAirTemp,OutletAirHumRat,SenWaterCoilLoad)
! FUNCTION INFORMATION:
! AUTHOR Rahul Chillar
! DATE WRITTEN Mar 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! Calculate the leaving air temperature,the leaving air humidity ratio and the
! sensible cooling capacity of wet cooling coil.
! METHODOLOGY EMPLOYED:
! Assumes condensate at uniform temperature.
! REFERENCES:
! Elmahdy, A.H. and Mitalas, G.P. 1977."A Simple Model for Cooling and
! Dehumidifying Coils for Use In Calculating Energy Requirements for Buildings,"
! ASHRAE Transactions,Vol.83 Part 2, pp. 103-117.
! USE STATEMENTS:
! Enforce explicit typing of all variables in this routine
Implicit None
! FUNCTION ARGUMENT DEFINITIONS:
Integer, intent(in) :: CoilNum !
REAL(r64), intent(in) :: AirTempIn ! Entering air dry bulb temperature(C)
REAL(r64), intent(in) :: EnthAirInlet ! Entering air enthalpy(J/kg)
REAL(r64), intent(in) :: EnthAirOutlet ! Leaving air enthalpy(J/kg)
REAL(r64), intent(in) :: UACoilExternal ! Heat transfer coefficient for external surface (W/C)
REAL(r64) :: OutletAirTemp ! Leaving air dry bulb temperature(C)
REAL(r64) :: OutletAirHumRat ! Leaving air humidity ratio
REAL(r64) :: SenWaterCoilLoad ! Sensible heat transfer rate(W)
! FUNCTION PARAMETER DEFINITIONS:
REAL(r64), Parameter:: SmallNo=1.d-9 ! SmallNo value used in place of zero
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! FUNCTION LOCAL VARIABLE DECLARATIONS:
REAL(r64) CapacitanceAir ! Air capacity rate(W/C)
REAL(r64) NTU ! Number of heat transfer units
REAL(r64) effectiveness ! Heat exchanger effectiveness
REAL(r64) EnthAirCondensateTemp ! Saturated air enthalpy at temperature of condensate(J/kg)
REAL(r64) TempCondensation ! Temperature of condensate(C)
REAL(r64) TempAirDewPoint ! Temperature air dew point
! Determine the temperature effectiveness, assuming the temperature
! of the condensate is constant (MinimumCapacityStream/MaximumCapacityStream = 0) and the specific heat
! of moist air is constant
CapacitanceAir = WaterCoil(CoilNum)%InletAirMassFlowRate* &
PsyCpAirFnWTdb(WaterCoil(CoilNum)%InletAirHumRat,AirTempIn)
! Calculating NTU from UA and Capacitance.
!del NTU = UACoilExternal/MAX(CapacitanceAir,SmallNo)
!del effectiveness = 1 - EXP(-MAX(0.0d0,NTU))
! Calculating NTU from UA and Capacitance.
IF (UACoilExternal > 0.0d0) THEN
IF (CapacitanceAir > 0.0d0) THEN
NTU = UACoilExternal/CapacitanceAir
ELSE
NTU = 0.0d0
END IF
effectiveness = 1.0d0 - EXP(-NTU)
ELSE
effectiveness = 0.0d0
END IF
! Calculate coil surface enthalpy and temperature at the exit
! of the wet part of the coil using the effectiveness relation
effectiveness = MAX(effectiveness,SmallNo)
EnthAirCondensateTemp = EnthAirInlet-(EnthAirInlet-EnthAirOutlet)/effectiveness
! Calculate condensate temperature as the saturation temperature
! at given saturation enthalpy
TempCondensation= PsyTsatFnHPb(EnthAirCondensateTemp,OutBaroPress)
TempAirDewPoint=PsyTdpFnWPb(WaterCoil(CoilNum)%InletAirHumRat,OutBaroPress)
If((TempAirDewPoint-TempCondensation).GT.0.1d0)Then
! Calculate Outlet Air Temperature using effectivness
OutletAirTemp = AirTempIn-(AirTempIn-TempCondensation)*effectiveness
! Calculate Outlet air humidity ratio from PsyWFnTdbH routine
OutletAirHumRat = PsyWFnTdbH(OutletAirTemp,EnthAirOutlet)
Else
OutletAirHumRat=WaterCoil(CoilNum)%InletAirHumRat
OutletAirTemp=PsyTdbFnHW(EnthAirOutlet,OutletAirHumRat)
EndIf
! Calculate Sensible Coil Load
SenWaterCoilLoad = CapacitanceAir*(AirTempIn-OutletAirTemp)
RETURN
END SUBROUTINE WetCoilOutletCondition