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 | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | CalcMode | |||
integer, | intent(in) | :: | FanOpMode | |||
real(kind=r64), | intent(in) | :: | PartLoadRatio |
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 CoolingCoil(CoilNum, FirstHVACIteration, CalcMode,FanOpMode,PartLoadRatio)
! FUNCTION INFORMATION:
! AUTHOR Rahul Chillar
! DATE WRITTEN Mar 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! The subroutine has the coil logic. Three types of Cooling Coils exist:
! They are 1.CoilDry , 2.CoilWet, 3. CoilPartDryPartWet. The logic for
! the three individual cases is in this subroutine.
! METHODOLOGY EMPLOYED:
! Simulates a Coil Model from Design conditions and subsequently uses
! configuration values (example: UA)calculated from those design conditions
! to calculate new performance of coil from operating inputs.The values are
! calculated in the Subroutine InitWaterCoil
! REFERENCES:
! ASHRAE Secondary HVAC Toolkit TRNSYS. 1990. A Transient System
! Simulation Program: Reference Manual. Solar Energy Laboratory, Univ. Wisconsin-
! Madison, pp. 4.6.8-1 - 4.6.8-12.
! Threlkeld, J.L. 1970. Thermal Environmental Engineering, 2nd Edition,
! Englewood Cliffs: Prentice-Hall,Inc. pp. 254-270.
! USE STATEMENTS:
USE General, ONLY: SafeDivide
! Enforce explicit typing of all variables in this routine
IMPLICIT NONE
! FUNCTION ARGUMENT DEFINITIONS:
Integer, intent(in) :: CoilNum
Logical, intent(in) :: FirstHVACIteration
Integer, intent(in) :: CalcMode
INTEGER, INTENT(IN) :: FanOpMode ! fan operating mode
REAL(r64), INTENT(IN) :: PartLoadRatio ! part-load ratio of heating coil
! FUNCTION PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! FUNCTION LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AirInletCoilSurfTemp ! Coil surface temperature at air entrance(C)
REAL(r64) :: AirDewPointTemp ! Temperature dew point at operating condition
REAL(r64) :: OutletAirTemp ! Outlet air temperature at operating condition
REAL(r64) :: OutletAirHumRat ! Outlet air humidity ratio at operating condition
REAL(r64) :: OutletWaterTemp ! Outlet water temperature at operating condtitons
REAL(r64) :: TotWaterCoilLoad ! Total heat transfer rate(W)
REAL(r64) :: SenWaterCoilLoad ! Sensible heat transfer rate
REAL(r64) :: SurfAreaWetFraction ! Fraction of surface area wet
REAL(r64) :: AirMassFlowRate ! Air mass flow rate for the calculation
AirInletCoilSurfTemp=0.0d0 ! Coil surface temperature at air entrance(C)
AirDewPointTemp=0.0d0 ! Temperature dew point at operating condition
OutletAirTemp=0.0d0 ! Outlet air temperature at operating condition
OutletAirHumRat=0.0d0 ! Outlet air humidity ratio at operating condition
OutletWaterTemp=0.0d0 ! Outlet water temperature at operating condtitons
TotWaterCoilLoad=0.0d0 ! Total heat transfer rate(W)
SenWaterCoilLoad=0.0d0 ! Sensible heat transfer rate
SurfAreaWetFraction=0.0d0 ! Fraction of surface area wet
IF (FanOpMode == CycFanCycCoil .and. PartLoadRatio > 0.0d0) THEN !FB Start
AirMassFlowRate = WaterCoil(CoilNum)%InletAirMassFlowRate / PartLoadRatio
ELSE
AirMassFlowRate = WaterCoil(CoilNum)%InletAirMassFlowRate
END IF
! If Coil is Scheduled ON then do the simulation
IF(((GetCurrentScheduleValue(WaterCoil(CoilNum)%SchedPtr) .gt. 0.0d0) &
.AND. (WaterCoil(CoilNum)%InletWaterMassFlowRate .GT. 0.0d0) &
.AND. (AirMassFlowRate .GE. MinAirMassFlow) &
.AND. (WaterCoil(CoilNum)%DesAirVolFlowRate .gt. 0.0d0) &
.AND. (WaterCoil(CoilNum)%MaxWaterMassFlowRate .gt. 0.0d0)) .OR. (CalcMode == DesignCalc))THEN
!Calculate Temperature Dew Point at operating conditions.
AirDewPointTemp= PsyTdpFnWPb(WaterCoil(CoilNum)%InletAirHumRat,OutBaroPress)
Select Case(WaterCoil(CoilNum)%CoolingCoilAnalysisMode)
Case(DetailedAnalysis)
!Coil is completely dry if AirDewPointTemp is less than InletWaterTemp,hence Call CoilCompletelyDry
IF (AirDewPointTemp .LE. WaterCoil(CoilNum)%InletWaterTemp) THEN
!Calculate the leaving conditions and performance of dry coil
CALL CoilCompletelyDry (CoilNum,WaterCoil(CoilNum)%InletWaterTemp,WaterCoil(CoilNum)%InletAirTemp,&
WaterCoil(CoilNum)%UACoilTotal, OutletWaterTemp, &
OutletAirTemp,OutletAirHumRat,TotWaterCoilLoad, FanOpMode,PartLoadRatio )
SenWaterCoilLoad = TotWaterCoilLoad
SurfAreaWetFraction = 0.0d0
ELSE
!Else If AirDewPointTemp is greater than InletWaterTemp then assume the
!external surface of coil is completely wet,hence Call CoilCompletelyWet
!Calculate the leaving conditions and performance of wet coil
CALL CoilCompletelyWet (CoilNum,WaterCoil(CoilNum)%InletWaterTemp, &
WaterCoil(CoilNum)%InletAirTemp,WaterCoil(CoilNum)%InletAirHumRat, &
WaterCoil(CoilNum)%UACoilInternal,WaterCoil(CoilNum)%UACoilExternal, &
OutletWaterTemp,OutletAirTemp,OutletAirHumRat,TotWaterCoilLoad, &
SenWaterCoilLoad,SurfAreaWetFraction,AirInletCoilSurfTemp, FanOpMode, PartLoadRatio)
!If AirDewPointTemp is less than temp of coil surface at entry of air
IF (AirDewPointTemp .LT. AirInletCoilSurfTemp) THEN
!Then coil is partially wet and dry hence call CoilPartWetPartDry
!Calculate the leaving conditions and performance of dry coil
CALL CoilPartWetPartDry (CoilNum,FirstHVACIteration,WaterCoil(CoilNum)%InletWaterTemp, &
WaterCoil(CoilNum)%InletAirTemp, &
AirDewPointTemp,OutletWaterTemp,OutletAirTemp,OutletAirHumRat, &
TotWaterCoilLoad,SenWaterCoilLoad,SurfAreaWetFraction,FanOpMode,PartLoadRatio)
ENDIF !End if for part wet part dry coil
ENDIF !End if for dry coil
Case(SimpleAnalysis)
!Coil is completely dry if AirDewPointTemp is less than InletWaterTemp,hence Call CoilCompletelyDry
IF (AirDewPointTemp .LE. WaterCoil(CoilNum)%InletWaterTemp) THEN
!Calculate the leaving conditions and performance of dry coil
CALL CoilCompletelyDry (CoilNum,WaterCoil(CoilNum)%InletWaterTemp,WaterCoil(CoilNum)%InletAirTemp,&
WaterCoil(CoilNum)%UACoilTotal, OutletWaterTemp, &
OutletAirTemp,OutletAirHumRat,TotWaterCoilLoad, FanOpMode, PartLoadRatio )
SenWaterCoilLoad = TotWaterCoilLoad
SurfAreaWetFraction = 0.0d0
ELSE
!Else If AirDewPointTemp is greater than InletWaterTemp then assume the
!external surface of coil is completely wet,hence Call CoilCompletelyWet
!Calculate the leaving conditions and performance of wet coil
CALL CoilCompletelyWet (CoilNum,WaterCoil(CoilNum)%InletWaterTemp, &
WaterCoil(CoilNum)%InletAirTemp,WaterCoil(CoilNum)%InletAirHumRat, &
WaterCoil(CoilNum)%UACoilInternal,WaterCoil(CoilNum)%UACoilExternal, &
OutletWaterTemp,OutletAirTemp,OutletAirHumRat,TotWaterCoilLoad, &
SenWaterCoilLoad,SurfAreaWetFraction,AirInletCoilSurfTemp, FanOpMode, PartLoadRatio)
ENDIF !End if for dry coil
End Select
! Report outlet variables at nodes
WaterCoil(CoilNum)%OutletAirTemp = OutletAirTemp
WaterCoil(CoilNum)%OutletAirHumRat=OutletAirHumRat
WaterCoil(CoilNum)%OutletWaterTemp=OutletWaterTemp
!Report output results if the coil was operating
IF(FanOpMode .EQ. CycFanCycCoil)THEN
TotWaterCoilLoad = TotWaterCoilLoad*PartLoadRatio
SenWaterCoilLoad = SenWaterCoilLoad*PartLoadRatio
END IF
WaterCoil(CoilNum)%TotWaterCoolingCoilRate=TotWaterCoilLoad
WaterCoil(CoilNum)%SenWaterCoolingCoilRate=SenWaterCoilLoad
WaterCoil(CoilNum)%SurfAreaWetFraction=SurfAreaWetFraction
! WaterCoil(CoilNum)%OutletWaterEnthalpy = WaterCoil(CoilNum)%InletWaterEnthalpy+ &
! WaterCoil(CoilNum)%TotWaterCoolingCoilRate/WaterCoil(CoilNum)%InletWaterMassFlowRate
WaterCoil(CoilNum)%OutletWaterEnthalpy = WaterCoil(CoilNum)%InletWaterEnthalpy+ &
SafeDivide(WaterCoil(CoilNum)%TotWaterCoolingCoilRate,WaterCoil(CoilNum)%InletWaterMassFlowRate)
ELSE
!If both mass flow rates are zero, set outputs to inputs and return
WaterCoil(CoilNum)%OutletWaterTemp = WaterCoil(CoilNum)%InletWaterTemp
WaterCoil(CoilNum)%OutletAirTemp = WaterCoil(CoilNum)%InletAirTemp
WaterCoil(CoilNum)%OutletAirHumRat = WaterCoil(CoilNum)%InletAirHumRat
WaterCoil(CoilNum)%OutletWaterEnthalpy = WaterCoil(CoilNum)%InletWaterEnthalpy
WaterCoil(CoilNum)%TotWaterCoolingCoilEnergy=0.0d0
WaterCoil(CoilNum)%SenWaterCoolingCoilEnergy=0.0d0
WaterCoil(CoilNum)%SurfAreaWetFraction=0.0d0
ENDIF !End of the Flow or No flow If block
WaterCoil(CoilNum)%OutletWaterMassFlowRate = WaterCoil(CoilNum)%InletWaterMassFlowRate
WaterCoil(CoilNum)%OutletAirMassFlowRate = WaterCoil(CoilNum)%InletAirMassFlowRate
WaterCoil(CoilNum)%OutletAirEnthalpy = PsyHFnTdbW(WaterCoil(CoilNum)%OutletAirTemp,WaterCoil(CoilNum)%OutletAirHumRat)
RETURN
End Subroutine CoolingCoil