Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer | :: | FluidCoolerNum | ||||
real(kind=r64) | :: | WaterMassFlowRate | ||||
real(kind=r64) | :: | AirFlowRate | ||||
real(kind=r64) | :: | UAdesign | ||||
real(kind=r64) | :: | OutletWaterTemp |
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 SimSimpleFluidCooler(FluidCoolerNum,WaterMassFlowRate,AirFlowRate,UAdesign,OutletWaterTemp)
! SUBROUTINE INFORMATION:
! AUTHOR Chandan Sharma
! DATE WRITTEN August 2008
! MODIFIED April 2010, Chandan Sharma, FSEC
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! See purpose for Single Speed or Two Speed Fluid Cooler model
! METHODOLOGY EMPLOYED:
! See methodology for Single Speed or Two Speed Fluid Cooler model
! REFERENCES:
! na
! USE STATEMENTS:
! USE FluidProperties, ONLY : GetSpecificHeatGlycol
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: FluidCoolerNum
REAL(r64) :: WaterMassFlowRate
REAL(r64) :: AirFlowRate
REAL(r64) :: UAdesign
REAL(r64) :: OutletWaterTemp
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: MdotCpWater ! Water mass flow rate times the heat capacity [W/K]
REAL(r64) :: InletAirTemp ! Dry-bulb temperature of air entering the fluid cooler [C]
REAL(r64) :: CpWater ! Heat capacity of water [J/kg/K]
REAL(r64) :: CpAir ! Heat capacity of air [J/kg/K]
REAL(r64) :: AirDensity ! Density of air [kg/m3]
REAL(r64) :: AirMassFlowRate ! Mass flow rate of air [kg/s]
REAL(r64) :: effectiveness ! Effectiveness of the heat exchanger [-]
REAL(r64) :: OutletAirTemp ! Drybulb temp of exiting moist air [C]
REAL(r64) :: AirCapacity ! MdotCp of air through the fluid cooler
REAL(r64) :: CapacityRatioMin ! Minimum capacity of airside and waterside
REAL(r64) :: CapacityRatioMax ! Maximum capacity of airside and waterside
REAL(r64) :: CapacityRatio ! Ratio of minimum to maximum capacity
REAL(r64) :: NumTransferUnits ! Number of transfer Units [NTU]
REAL(r64) :: Qactual ! Actual heat transfer rate between fluid cooler water and air [W]
REAL(r64) :: ETA ! initialize some local variables
REAL(r64) :: A ! initialize some local variables
REAL(r64) :: InletWaterTemp ! Water inlet temperature
WaterInletNode = SimpleFluidCooler(FluidCoolerNum)%WaterInletNodeNum
WaterOutletNode = SimpleFluidCooler(FluidCoolerNum)%WaterOutletNodeNum
Qactual = 0.0d0
! set local fluid cooler inlet and outlet temperature variables
InletWaterTemp = SimpleFluidCoolerInlet(FluidCoolerNum)%WaterTemp
OutletWaterTemp = InletWaterTemp
InletAirTemp = SimpleFluidCoolerInlet(FluidCoolerNum)%AirTemp
IF(UAdesign.EQ.0.0d0)RETURN
! set water and air properties
AirDensity = PsyRhoAirFnPbTdbW(SimpleFluidCoolerInlet(FluidCoolerNum)%AirPress,InletAirTemp, &
SimpleFluidCoolerInlet(FluidCoolerNum)%AirHumRat)
AirMassFlowRate = AirFlowRate * AirDensity
CpAir = PsyCpAirFnWTdb(SimpleFluidCoolerInlet(FluidCoolerNum)%AirHumRat,InletAirTemp)
CpWater = GetSpecificHeatGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
InletWaterTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex, &
'SimSimpleFluidCooler')
! Calcluate mass flow rates
MdotCpWater = WaterMassFlowRate * CpWater
AirCapacity = AirMassFlowRate * CpAir
! calculate the minimum to maximum capacity ratios of airside and waterside
CapacityRatioMin = MIN(AirCapacity,MdotCpWater)
CapacityRatioMax = MAX(AirCapacity,MdotCpWater)
CapacityRatio = CapacityRatioMin/CapacityRatioMax
! Calculate number of transfer units (NTU)
NumTransferUnits = UAdesign/CapacityRatioMin
ETA=NumTransferUnits**0.22d0
A=CapacityRatio*NumTransferUnits/ETA
effectiveness = 1.d0 - Exp((Exp(-A) - 1.d0) / (CapacityRatio / ETA))
! calculate water to air heat transfer
Qactual = effectiveness * CapacityRatioMin * (InletWaterTemp-InletAirTemp)
! calculate new exiting dry bulb temperature of airstream
OutletAirTemp = InletAirTemp + Qactual/AirCapacity
IF(Qactual .GE. 0.0d0)THEN
OutletWaterTemp = InletWaterTemp - Qactual/ MdotCpWater
ELSE
OutletWaterTemp = InletWaterTemp
END IF
RETURN
END SUBROUTINE SimSimpleFluidCooler