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) | :: | CoilNum | |||
integer, | intent(in) | :: | FanOpMode | |||
real(kind=r64), | intent(in) | :: | PartLoadRatio | |||
integer, | intent(in) | :: | CalcMode |
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 CalcSimpleHeatingCoil(CoilNum, FanOpMode, PartLoadRatio, CalcMode)
! SUBROUTINE INFORMATION:
! AUTHOR Rich Liesen
! DATE WRITTEN
! MODIFIED Aug. 2007 - R. Raustad, added fan operating mode and part-load ratio to
! calculate the outlet conditions when fan and coil cycle.
! Air and water outlet temperature are full output with average
! air and water mass flow rate when fan and coil cycle.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulates a simple NTU effectiveness model heating coil
! METHODOLOGY EMPLOYED:
! (1) outlet conditions are calculated from the effectiveness and the inlet conditions.
! (2) Effectiveness is calculated from the NTU formula for a cross flow heat exchanger
! with both streams unmixed.
! Note: UA is input by user and is fixed.
! REFERENCES:
! See for instance ASHRAE HVAC 2 Toolkit, page 4-4, formula (4-7)
! USE STATEMENTS:
USE DataBranchAirLoopPlant, ONLY : MassFlowTolerance
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CoilNum ! index to heating coil
INTEGER, INTENT(IN) :: FanOpMode ! fan operating mode
REAL(r64), INTENT(IN) :: PartLoadRatio ! part-load ratio of heating coil
INTEGER, INTENT(IN) :: CalcMode ! 1 = design calc; 2 = simulation calculation
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) WaterMassFlowRate
REAL(r64) AirMassFlow ! [kg/sec]
REAL(r64) TempAirIn ! [C]
REAL(r64) TempAirOut ! [C]
REAL(r64) Win
REAL(r64) TempWaterIn
REAL(r64) TempWaterOut
REAL(r64) UA
REAL(r64) CapacitanceAir
REAL(r64) CapacitanceWater
REAL(r64) CapacitanceMin
REAL(r64) CapacitanceMax
REAL(r64) HeatingCoilLoad
REAL(r64) NTU, ETA, A, CapRatio, E1, E2, Effec
REAL(r64) Cp
Integer Control
UA = WaterCoil(CoilNum)%UACoilVariable
TempAirIn = WaterCoil(CoilNum)%InletAirTemp
Win = WaterCoil(CoilNum)%InletAirHumRat
Control = WaterCoil(CoilNum)%Control
TempWaterIn = WaterCoil(CoilNum)%InletWaterTemp
! adjust mass flow rates for cycling fan cycling coil operation
IF(FanOpMode .EQ. CycFanCycCoil)THEN
IF(PartLoadRatio .GT. 0.0d0)THEN
AirMassFlow = WaterCoil(CoilNum)%InletAirMassFlowRate/PartLoadRatio
WaterMassFlowRate = MIN(WaterCoil(CoilNum)%InletWaterMassFlowRate/PartLoadRatio, &
WaterCoil(CoilNum)%MaxWaterMassFlowRate)
ELSE
AirMassFlow = 0.0d0
WaterMassFlowRate = 0.0d0
END IF
ELSE
AirMassFlow = WaterCoil(CoilNum)%InletAirMassFlowRate
WaterMassFlowRate = WaterCoil(CoilNum)%InletWaterMassFlowRate
END IF
IF (WaterMassFlowRate .GT. MassFlowTolerance) THEN ! If the coil is operating
CapacitanceAir=PsyCpAirFnWTdb(Win,0.5d0*(TempAirIn+TempWaterIn))*AirMassFlow
Cp = GetSpecificHeatGlycol(PlantLoop(WaterCoil(CoilNum)%WaterLoopNum)%FluidName, &
TempWaterIn, &
PlantLoop(WaterCoil(CoilNum)%WaterLoopNum)%FluidIndex, &
'SizeWaterCoil')
CapacitanceWater=Cp*WaterMassFlowRate
CapacitanceMin=MIN(CapacitanceAir,CapacitanceWater)
CapacitanceMax=MAX(CapacitanceAir,CapacitanceWater)
Else
CapacitanceAir=0.0d0
CapacitanceWater=0.0d0
End If
! If the coil is operating there should be some heating capacitance
! across the coil, so do the simulation. If not set outlet to inlet and no load.
! Also the coil has to be scheduled to be available
IF(((CapacitanceAir .gt. 0.0d0).and.(CapacitanceWater .gt. 0.0d0)) .and. &
(GetCurrentScheduleValue(WaterCoil(CoilNum)%SchedPtr) .gt. 0.0d0 .or. MySizeFlag(CoilNum) .or. &
MyUAAndFlowCalcFlag(CoilNum) .or. CalcMode == DesignCalc) ) Then
IF (UA <= 0.0d0) THEN
CALL ShowFatalError('UA is zero for COIL:Heating:Water '//TRIM(WaterCoil(CoilNum)%Name))
END IF
NTU=UA/CapacitanceMin
ETA=NTU**0.22d0
CapRatio=CapacitanceMin/CapacitanceMax
A=CapRatio*NTU/ETA
IF(A .GT. 20.0d0) Then
A=ETA*1.0d0/CapRatio
Else
E1=EXP(-A)
A=ETA*(1.d0-E1)/CapRatio
End If
IF(A.GT.20.d0) Then
Effec=1.0d0
Else
E2=EXP(-A)
Effec=1.d0-E2
End IF
TempAirOut=TempAirIn+Effec*CapacitanceMin*(TempWaterIn-TempAirIn)/CapacitanceAir
TempWaterOut=TempWaterIn-CapacitanceAir*(TempAirOut-TempAirIn)/CapacitanceWater
HeatingCoilLoad=CapacitanceWater*(TempWaterIn-TempWaterOut)
!The HeatingCoilLoad is the change in the enthalpy of the water
WaterCoil(CoilNum)%OutletWaterEnthalpy = WaterCoil(CoilNum)%InletWaterEnthalpy- &
HeatingCoilLoad/WaterCoil(CoilNum)%InletWaterMassFlowRate
WaterCoil(CoilNum)%OutletWaterMassFlowRate = WaterCoil(CoilNum)%InletWaterMassFlowRate
ELSE ! If not running Conditions do not change across coil from inlet to outlet
TempAirOut=TempAirIn
TempWaterOut =TempWaterIn
HeatingCoilLoad=0.0d0
WaterCoil(CoilNum)%OutletWaterEnthalpy = WaterCoil(CoilNum)%InletWaterEnthalpy
WaterCoil(CoilNum)%OutletWaterMassFlowRate = 0.0d0
ENDIF
IF(FanOpMode .EQ. CycFanCycCoil)THEN
HeatingCoilLoad = HeatingCoilLoad*PartLoadRatio
END IF
! Set the outlet conditions
WaterCoil(CoilNum)%TotWaterHeatingCoilRate = HeatingCoilLoad
WaterCoil(CoilNum)%OutletAirTemp = TempAirOut
WaterCoil(CoilNum)%OutletWaterTemp = TempWaterOut
! This WaterCoil does not change the moisture or Mass Flow across the component
WaterCoil(CoilNum)%OutletAirHumRat = WaterCoil(CoilNum)%InletAirHumRat
WaterCoil(CoilNum)%OutletAirMassFlowRate = WaterCoil(CoilNum)%InletAirMassFlowRate
!Set the outlet enthalpys for air and water
WaterCoil(CoilNum)%OutletAirEnthalpy = PsyHFnTdbW(WaterCoil(CoilNum)%OutletAirTemp, &
WaterCoil(CoilNum)%OutletAirHumRat)
RETURN
END Subroutine CalcSimpleHeatingCoil