SUBROUTINE CalculateCoil(CoilID,QZnReq)
! SUBROUTINE INFORMATION:
! AUTHOR Therese Stovall, ORNL
! DATE WRITTEN January 2011
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulates the refrigerated warehouse coil object.
! Note QZnReq < 0 corresponds to cooling needed
! METHODOLOGY EMPLOYED:
! Called from Calculate Air Chiller Set.
! Air chillers are used to model the type of equipment typically used in
! refrigerated warehouses. For that reason, there is a major difference
! between the air chiller model and those for refrigerated cases or walk-ins.
! For cases and walk-ins, a portion of the model is directed toward
! calculating the amount of refrigeration needed to maintain the refrigerated
! volume at the desired temperature due to heat exchange with the surrounding
! zone, and that zone is conditioned to a nearly constant temperature.
! In a refrigerated warehouse, the refrigeration load is caused by heat exchange
! with a variable external environment. For that reason, the loads for these
! zones are calculated by the usual EnergyPlus zone heat balance.
! The amount of refrigeration needed to maintain the specified temperature
! setpoints is then passed to the air chiller model, in a similar fashion
! to the load passed to a window air conditioner model. The air chillers
! are therefore solved using the system time step, not the zone time step
! used for cases and walk-ins.
!
! The air chiller performance is based on three types of manufacturers ratings,
! Unit Load Factor, Total Capacity Map, or a set of European standards.
! Correction factors for material and refrigerant are applied to all of these ratings.
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE DataLoopNode
USE Psychrometrics, ONLY: PsyRhoAirFnPbTdbW,RhoH2O,PsyWFnTdbTwbPb,PsyTwbFnTdbWPb,CPHW,&
PsyHFnTdbW,PsyTsatFnHPb, PsyWFnTdpPb,PsyHFnTdbRhPb, PsyRhFnTdbWPb, &
PsyTdpFnWPb, PsyWFnTdbH, PsyCpAirFnWTdb
USE General, ONLY: CreateSysTimeIntervalString
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CoilID !
REAL(r64), INTENT(IN) :: QZnReq ! sensible load required
! SUBROUTINE PARAMETER DEFINITIONS:
!unused REAL(r64), PARAMETER ::ErrorTol = 0.001d0 !Iterative solution tolerance
CHARACTER(len=MaxNameLength),Parameter :: TrackMessage = 'from RefrigeratedCase:CalculateCoil'
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!INTEGER :: Iter =0 ! counter for loop to solve for total coil capacity as a function of inlet air conditions
INTEGER :: FanSpeedControlType =0 ! from input
INTEGER :: ShrCorrectionCurvePtr =0 ! Points to curve entered by user to specify total/sensible capacity as a function of SHR
INTEGER :: SHRCorrectionType =0 ! SHR60, QUADRATICSHR, EUROPEAN, or TABULARRH_DT1_TRoom
INTEGER :: ZoneNodeNum =0 ! Zone node number
REAL(r64) :: AirVolRatio =0.0d0 ! used when operating at part load
REAL(r64) :: AirVolumeFlowMax =0.0d0 ! Coil air flow limited by drip down schedule (m3/s)
REAL(r64) :: AirVolumeFlowRated =0.0d0 ! Coil rated air flow (m3/s)
REAL(r64) :: AvailDefrostEnergy =0.0d0 ! available to melt ice with temp term control (J)
REAL(r64) :: CapFac =0.0d0 ! used to reduce fan power when don't need full coil capacity
REAL(r64) :: CoilCapTotal =0.0d0 ! Sensible plus latent load (W)
REAL(r64) :: CoilCapTotEstimate =0.0d0 ! Part of loop to solve for total coil capacity as a function of inlet air conditions (W)
REAL(r64) :: CoilInletCp =0.0d0 ! Coil air inlet specific heat (J/kg-deltaC)
REAL(r64) :: CoilInletDensity =0.0d0 ! Coil air inlet density (kg/m3)
REAL(r64) :: CoilInletDryAirCp =0.0d0 ! Dry air specific heat at coil inlet temperature (J/kg-C)
REAL(r64) :: CoilInletDryAirDensity =0.0d0 ! Dry Air density at coil inlet temperature (kg/m3)
REAL(r64) :: CoilInletHumRatio =0.0d0 ! Coil air inlet humidity ratio (kg water/kg air)
REAL(r64) :: CoilInletTemp =0.0d0 ! Inlet temperature of air to coil, not mixed zone temperature unless "middle" location selected (C)
REAL(r64) :: CoilInletEnthalpy =0.0d0 ! Coil inlet air enthalpy (J/kg)
REAL(r64) :: CoilInletRHFrac =0.0d0 ! Coil inlet air relative humidity expressed as a fraction (0 to 1)
REAL(r64) :: CoilSchedule =0.0d0 ! Current value of Coil operating (availability) schedule
REAL(r64) :: CoolingLoadNet =0.0d0 ! Cooling capacity of the coil minus fan, heater, and defrost loads (W)
REAL(r64) :: DefrostCap =0.0d0 ! Design defrost capacity of Coil (W)
REAL(r64) :: DefrostEnergy =0.0d0 ! (J)
REAL(r64) :: DefEnergyFraction =0.0d0 ! dimensionless
REAL(r64) :: DefrostLoad =0.0d0 ! Part of the defrost that is a heat load on the zone (W)
REAL(r64) :: DefrostSchedule =0.0d0 ! Coil defrost schedule, between 0 and 1
REAL(r64) :: DefrostDripDownSchedule =0.0d0 ! Coil drip-down schedule (allows coil to drain after defrost)
REAL(r64) :: DefrostEnergyNeeded =0.0d0 ! Energy needed to melt all ice, used with temperature termination (J)
REAL(r64) :: DefrostRateNeeded =0.0d0 ! Defrost load that actually goes to melting ice (W)
REAL(r64) :: DryAirMassFlowMax =0.0d0 ! Rated volume flow rate times dry air density adjusted for schedules (kg/s)
REAL(r64) :: DryAirMassFlowRated =0.0d0 ! Rated volume flow rate times dry air density
!REAL(r64) :: Error =0.0d0 ! Used in iterative solution for sensible heat ratio
REAL(r64) :: ExitHumRatio =0.0d0 ! kg water/kg air
REAL(r64) :: ExitTemperature =0.0d0 ! Air temperature leaving the coil (C)
REAL(r64) :: ExitTemperatureEstimate =0.0d0 ! Estimated Air temperature leaving the coil (C)
REAL(r64) :: ExitEnthalpy =0.0d0 ! Air enthalpy leaving the coil (J/kg)
REAL(r64) :: ExitEnthalpyEstimate =0.0d0 ! Estimated Air enthalpy leaving the coil (J/kg)
REAL(r64) :: FanMinAirFlowRatio =0.0d0 ! From input
REAL(r64) :: FanPowerActual =0.0d0 ! (W)
REAL(r64) :: FanPowerRated =0.0d0 ! (W)
REAL(r64) :: FanPowerMax =0.0d0 ! Total fan energy rate, limited by dripdown period (W)
REAL(r64) :: FanPowerRatio =0.0d0 ! Used for variable speed fans, dimensionless
REAL(r64) :: FrostChangekg =0.0d0 ! Amount of frost added or melted (kg)
REAL(r64) :: HeaterSchedule =0.0d0 ! zero to one
REAL(r64) :: HeaterLoad =0.0d0 ! Total heater (except defrost) energy rate (W)
REAL(r64) :: IceSensHeatNeeded =0.0d0 ! Energy to raise frost temperature to 0C, used w/ temp termination (J)
REAL(r64) :: LatLoadServed =0.0d0 ! Energy rate used to remove water from zone air (W)
REAL(r64) :: MaxTemperatureDif =0.0d0 ! Used to limit capacity during initial pulldown (deltaC)
REAL(r64) :: SensibleCapacityMax =0.0d0 ! Sensible capacity adjusted for any time in dripdown state (W)
!REAL(r64) :: SensibleLoad =0.0d0 ! Sensible load provided by coil (W)
REAL(r64) :: SensLoadRequested =0.0d0 ! Sensible load requested by zone balance (W)
REAL(r64) :: SensLoadFromZone =0.0d0 ! Net sensible load removed from zone after accounting for heaters, fans, defrost [W]
REAL(r64) :: SensLoadRequestedGross =0.0d0 ! Gross sensible load removed by coil
REAL(r64) :: SensLoadGross =0.0d0 ! Sensible load met by coil (W)
REAL(r64) :: SHR =0.0d0 ! Sensible heat ratio, sensible load/total load
REAL(r64) :: SHRCorrection =0.0d0 ! Actual total/sensible load, NOT = Inverse SHR (unless coil efficiency = 1.0),
! but function of SHR, which is why iteration needed
REAL(r64) :: ShrCorrection60 =0.0d0 ! Total capacity as a fraction of sensible capacity at a SHR of 0.6, entered by user
REAL(r64) :: Slope =0.0d0 ! Part of linear SHR60 correction factor, dimensionless
REAL(r64) :: StartIceTemp =0.0d0 ! Frost temperature at start of time step [C]
REAL(r64) :: StartFrostkg =0.0d0 ! frost load at start of time step (kg of ice)
REAL(r64) :: TemperatureDif =0.0d0 ! difference between inlet air and evaporating temperature (deltaC)
REAL(r64) :: TEvap =0.0d0 ! Evaporating temperature in the coil (C)
REAL(r64) :: UnitLoadFactorSens =0.0d0 ! Rated capacity divided by rated DT1 (T air in - Tevap) (W/delta C)
REAL(r64) :: WaterRemovRate =0.0d0 ! Walk in cooler removes water at this rate in this zone (kg/s)
REAL(r64) :: Yint =0.0d0 !Part of linear SHR60 correction factor, dimensionless
REAL(r64) :: ZoneDryAirDensity =0.0d0 ! Dry air density at mixed zone conditions
REAL(r64) :: ZoneMixedAirCp =0.0d0 ! J/kg-deltaC
REAL(r64) :: ZoneMixedAirDensity =0.0d0 ! kg/m3
REAL(r64) :: ZoneMixedAirDrybulb =0.0d0 ! (C)
REAL(r64) :: ZoneMixedAirRHfrac =0.0d0 ! relative humidity of mixed air in the zone expressed as a fraction from 0 to 1
REAL(r64) :: ZoneMixedAirEnthalpy =0.0d0 ! J/kg
REAL(r64) :: ZoneMixedAirHumRatio =0.0d0 ! kg water/kg air in the zone mixed air
! GET SCHEDULES
CoilSchedule = GetCurrentScheduleValue(WarehouseCoil(CoilID)%SchedPtr)
IF ( CoilSchedule <= 0.d0) RETURN
DefrostSchedule = GetCurrentScheduleValue(WarehouseCoil(CoilID)%DefrostSchedPtr)
DefrostDripDownSchedule = GetCurrentScheduleValue(WarehouseCoil(CoilID)%DefrostDripDownSchedPtr)
!next statement In case user doesn't understand concept of drip down schedule
DefrostDripDownSchedule = MAX(DefrostDripDownSchedule,DefrostSchedule)
!next value optional, so set to default before checking for schedule
HeaterSchedule = 1.0d0
IF (WarehouseCoil(CoilID)%HeaterSchedPtr > 0) HeaterSchedule = &
GetCurrentScheduleValue(WarehouseCoil(CoilID)%HeaterSchedPtr)
AirVolRatio = 0.d0
AirVolumeFlowMax = 0.d0
CapFac = 0.d0
CoilCapTotal = 0.d0
CoilCapTotEstimate = 0.d0
CoolingLoadNet = 0.d0
DefrostLoad = 0.d0
DryAirMassFlowMax = 0.d0
ExitEnthalpyEstimate = 0.d0
ExitEnthalpy = 0.d0
ExitTemperature = 0.d0
ExitHumRatio = 0.d0
FanPowerActual = 0.d0
HeaterLoad = 0.d0
LatLoadServed = 0.d0
FanPowerRatio = 0.d0
FrostChangekg = 0.d0
SensLoadFromZone = 0.d0
SensLoadGross = 0.d0
SensibleCapacityMax = 0.d0
SHR = 0.d0
WaterRemovRate = 0.d0
!Set local subroutine variables for convenience
ZoneNodeNum = WarehouseCoil(CoilID)%ZoneNodeNum
AirVolumeFlowRated = WarehouseCoil(CoilID)%RatedAirVolumeFlow
FanPowerRated = WarehouseCoil(CoilID)%RatedFanPower
HeaterLoad = WarehouseCoil(CoilID)%HeaterPower * HeaterSchedule
UnitLoadFactorSens = WarehouseCoil(CoilID)%UnitLoadFactorSens
DefrostCap = WarehouseCoil(CoilID)%DefrostCapacity
TEvap = WarehouseCoil(CoilID)%TEvapDesign
SHRCorrectionType = WarehouseCoil(CoilID)%SHRCorrectionType
SHRCorrection60 = WarehouseCoil(CoilID)%SHRCorrection60
SHRCorrectionCurvePtr = WarehouseCoil(CoilID)%SHRCorrectionCurvePtr
FanMinAirFlowRatio = WarehouseCoil(CoilID)%FanMinAirFlowRatio
FanSpeedControlType = WarehouseCoil(CoilID)%FanType
MaxTemperatureDif = WarehouseCoil(CoilID)%MaxTemperatureDif
IF (DefrostDripDownSchedule == 1.0d0) THEN
AirVolumeFlowMax = 0.d0
DryAirMassFlowMax = 0.d0
ELSE ! DefrostDripDownSchedule < 1.0d0, cooling will occur at least part of the time step
SensLoadRequested = - QZnReq !here let cooling demand be positive within subroutine
IF(SensLoadRequested <= 0.d0)THEN !No load so assume control keeps off, except that scheduled defrost still occurs
AirVolumeFlowMax = 0.d0
DryAirMassFlowMax = 0.d0
ELSE
SensLoadRequestedGross = SensLoadRequested + HeaterLoad + FanPowerRated
ZoneMixedAirDryBulb = Node(ZoneNodeNum)%Temp
ZoneMixedAirHumRatio = Node(ZoneNodeNum)%Humrat
ZoneMixedAirRHFrac = PsyRhFnTdbWPb(ZoneMixedAirDryBulb,ZoneMixedAirHumRatio,OutBaroPress,TrackMessage)
ZoneMixedAirEnthalpy = PsyHFnTdbRhPb(ZoneMixedAirDryBulb,ZoneMixedAirRHFrac,OutBaroPress,TrackMessage)
ZoneMixedAirDensity = PsyRhoAirFnPbTdbW(OutBaroPress,ZoneMixedAirDryBulb,ZoneMixedAirHumRatio,TrackMessage)
ZoneDryAirDensity = PsyRhoAirFnPbTdbW(OutBaroPress,ZoneMixedAirDryBulb,0.d0,TrackMessage)
ZoneMixedAirCp = PsyCpAirFnWTdb(ZoneMixedAirHumRatio,ZoneMixedAirDryBulb,TrackMessage)
DryAirMassFlowRated = AirVolumeFlowRated * ZoneDryAirDensity
!calc t inlet to coil assuming at middle/mixed point in room bbb -
! later need to do for hottest/coolest in room where Tin /= Tzonemixed
!calc RH inlet to coil assuming at middle/mixed point in room
!calc coilcap, sens and latent, available as f(inlet T,RH)
SELECT CASE(WarehouseCoil(CoilID)%VerticalLocation)
CASE(Middle)
CoilInletTemp = ZoneMixedAirDryBulb
CoilInletEnthalpy = ZoneMixedAirEnthalpy
CoilInletRHFrac = ZoneMixedAirRHFrac
CoilInletDensity = ZoneMixedAirDensity
CoilInletCp = ZoneMixedAirCp
CoilInletHumRatio = ZoneMixedAirHumRatio
CoilInletDryAirDensity = ZoneDryAirDensity
CoilInletDryAirCp = PsyCpAirFnWTdb(0.0d0,CoilInletTemp,TrackMessage)
CASE(Floor)
CASE(Ceiling)
END SELECT
AirVolumeFlowMax = AirVolumeFlowRated * (1.d0-DefrostDripDownSchedule) * CoilSchedule
DryAirMassFlowMax = DryAirMassFlowRated *(1.d0-DefrostDripDownSchedule) * CoilSchedule
END IF !Sens load requested is non-zero
END IF ! DefrostDripDownSchedule == 1.0d0
IF(AirVolumeFlowMax > 0.d0) THEN
TemperatureDif = MIN(MaxTemperatureDif,(CoilInletTemp-TEvap))
IF (WarehouseCoil(CoilID)%RatingType == RatedCapacityTotal) THEN
! RatingType = CapacityTotalSpecificConditions, will be doing a table lookup
! based upon RHInlet, DT1, CoilInletTemperature - see excel files from B. Nelson, CoilCom
! In the table, X1== inlet air dry bulb temperature
! X2== Difference between inlet T and evap T
! X3== RH expressed as decimal
CoilCapTotEstimate = CurveValue(SHRCorrectionCurvePtr,CoilInletTemp,TemperatureDif,&
CoilInletRHFrac) * WarehouseCoil(CoilID)%RatedCapTotal * &
(1.d0-DefrostDripDownSchedule) * CoilSchedule
ELSE !work with unit load factor (sensible only), function of DT1 (Tair in drybulb-Tevap)
SensibleCapacityMax = WarehouseCoil(CoilID)%UnitLoadFactorSens*TemperatureDif * &
(1.d0-DefrostDripDownSchedule) * CoilSchedule
IF (SensibleCapacityMax > 0.d0) THEN
ExitTemperatureEstimate = CoilInletTemp - &
(SensibleCapacityMax/(DryAirMassFlowMax * CoilInletDryAirCp))
IF(ExitTemperatureEstimate <= TEvap) THEN
CALL ShowWarningError(TrackMessage//'Refrigeration:AirCoil: '//TRIM( WarehouseCoil(CoilID)%Name))
CALL ShowContinueError(' The estimated air outlet temperature is less than the evaporating temperature.')
END IF
ExitEnthalpyEstimate = PsyHFnTdbRhPb(ExitTemperatureEstimate,1.0d0,OutBaroPress,TrackMessage)
IF(ExitEnthalpyEstimate <= CoilInletEnthalpy) THEN
CoilCapTotEstimate = (CoilInletEnthalpy - ExitEnthalpyEstimate) * AirVolumeFlowMax * CoilInletDensity
ELSE
! Assume no water is extracted from flow
ExitEnthalpyEstimate = PsyHFnTdbW(ExitTemperatureEstimate,CoilInletHumRatio,TrackMessage)
CoilCapTotEstimate = (CoilInletEnthalpy - ExitEnthalpyEstimate) * AirVolumeFlowMax * CoilInletDensity
END IF
IF (SensibleCapacityMax > CoilCapTotEstimate)SensibleCapacityMax = CoilCapTotEstimate
IF(ABS(CoilCapTotEstimate) > 0.d0) THEN
SHR = SensibleCapacityMax/(CoilCapTotEstimate)
ELSE
! will occur whenever defrost or dripdown
SHR = 0.d0
END IF
SELECT CASE (SHRCorrectionType)
CASE( SHR60)
!line from y = SHRCorrection60 value to 1. as x(SHR) goes from .6 to 1, from B. Nelson, ASHRAE August 2010
Slope = (SHRCorrection60 - 1.D0)/(.6D0-1.D0)
yint = SHRCorrection60-(Slope*.6D0)
SHRCorrection =Slope*SHR + yint
CASE(QuadraticSHR)
SHRCorrection = CurveValue(SHRCorrectionCurvePtr,SHR)
CASE(European)
!With European ratings, either start with rated total sensible capacity or rated total capacity
! If rated total capacity is used, 'get input'
! translated it to rated total sensible capacity using
! PARAMETER ::EuropeanWetCoilFactor = (/1.35D0, 1.15D0, 1.05D0, 1.01D0, 1.0D0/)
! That sensible capacity rating was then turned to a rated UnitLoadFactor using
! the rated temperature difference. That sensible rating was also corrected
! for refrigerant and fin material in 'get input' and is given as UnitLoadFactor
! The total (sens + latent) capacity is equal to that * DT1 * WetCoilFactor(TcoilIn)
! Sensible capacity max already has DT1, just need WetCoilFactor(TcoilIn)
!PARAMETER ::EuropeanWetCoilFactor = (/1.35D0, 1.15D0, 1.05D0, 1.01D0, 1.0D0/)
!PARAMETER ::EuropeanAirInletTemp = (/10.0D0, 0.0D0, -18.0D0, -25.0D0, -34.0D0/)
!PARAMETER ::EuropeanEvapTemp = (/ 0.0D0, -8.0D0, -25.0D0, -31.0D0, -40.0D0/)
!PARAMETER ::EuropeanDT1 = (/10.0D0, 8.0D0, 7.0D0, 7.0D0, 6.0D0/)
IF (CoilInletTemp <= -25.d0) THEN
SHRCorrection = 1.0d0
ELSE IF(CoilInletTemp > -25.d0 .and. CoilInletTemp <=0.0d0) THEN
SHRCorrection = (EuropeanWetCoilFactor(2)-EuropeanWetCoilFactor(4))/ &
(EuropeanAirInletTemp(2) - EuropeanAirInletTemp(4)) * &
(EuropeanAirInletTemp(2) - CoilInletTemp) + &
EuropeanWetCoilFactor(4)
ELSE IF(CoilInletTemp > 0.d0 .and. CoilInletTemp <=5.0d0) THEN
SHRCorrection = (EuropeanWetCoilFactor(1)-EuropeanWetCoilFactor(2))/ &
(EuropeanAirInletTemp(1) - EuropeanAirInletTemp(2)) * &
(EuropeanAirInletTemp(1) - CoilInletTemp) + &
EuropeanWetCoilFactor(2)
ELSE IF(CoilInletTemp > 5.d0) THEN
SHRCorrection = EuropeanWetCoilFactor(1)
END IF ! calc correction as a function of coil inlet temperature
END SELECT
CoilCapTotEstimate = SHRCorrection * SensibleCapacityMax
ELSE ! NOT (SensibleCapacityMax > 0.d0)
CoilCapTotEstimate = 0.d0
END IF ! (SensibleCapacityMax > 0.d0)
END IF ! Rating type : CapacityTotalSpecificConditions or Sensible Unit Load Factor
IF (CoilCapTotEstimate > 0.0d0) THEN
ExitEnthalpy = CoilInletEnthalpy - (CoilCapTotEstimate/(AirVolumeFlowMax*CoilInletDensity))
ExitTemperature = PsyTsatFnHPb(ExitEnthalpy,OutBaroPress,TrackMessage) !RH =1.0 at Tsat
ExitHumRatio = PsyWFnTdbH(ExitTemperature,ExitEnthalpy,TrackMessage)
IF (ExitHumRatio > CoilInletHumRatio) ExitHumRatio = CoilInletHumRatio
WaterRemovRate = DryAirMassFlowMax *(CoilInletHumRatio - ExitHumRatio)
LatLoadServed = WaterRemovRate * IcetoVaporEnthalpy
SensLoadGross = CoilCapTotEstimate - LatLoadServed
FanPowerActual = FanPowerRated
IF(SensLoadGross < 0.d0) THEN
! Could rarely happen during initial cooldown of a warm environment
SensLoadGross = 0.d0
LatLoadServed = CoilCapTotEstimate
WaterRemovRate = LatLoadServed / IcetoVaporEnthalpy
END IF !SensLoadGross < 0
ELSE ! NOT (SensibleCapacityMax > 0.d0)
WaterRemovRate = 0.d0
LatLoadServed = 0.d0
SensLoadGross = 0.d0
FanPowerActual = 0.d0
END IF !(CoilCapTotEstimate > 0.d0)
FanPowerMax = FanPowerRated*(1.0d0 - DefrostDripDownSchedule)
IF(SensLoadGross > SensLoadRequestedGross) THEN !part load operation
!don't need full chiller power, reduce fan speed to reduce air flow
! move fan to part power if need to
CapFac = SensLoadRequestedGross/SensLoadGross
AirVolRatio=MAX(FanMinAirFlowRatio,CapFac**EvaporatorAirVolExponent)
!Fans limited by minimum air flow ratio
SELECT CASE (FanSpeedControlType)
CASE(FanVariableSpeed) !fan power law, adjusted for reality, applies
FanPowerRatio=AirVolRatio**2.5d0
FanPowerActual=FanPowerRatio*FanPowerMax
CASE(FanConstantSpeed)
FanPowerActual=AirVolRatio*EXP(1.d0-AirVolRatio)*FanPowerMax
CASE(FanConstantSpeedLinear) !e.g., on-off control
FanPowerActual=AirVolRatio*FanPowerMax
CASE(FanTwoSpeed)
!low speed setting of 1/2 fan speed can give up to 60% of capacity.
!1/2 speed corresonds to ~1/8 power consumption (FanHalfSpeedRatio = 1/(2**2.5) = 0.1768)
!dampers are used to control flow within those two ranges as in FanConstantSpeed
IF(CapFac < CapFac60Percent) THEN
FanPowerActual=((AirVolRatio+0.4d0)*(FanHalfSpeedRatio))*EXP(1.d0-AirVolRatio)*FanPowerMax
ELSE
FanPowerActual=AirVolRatio*EXP(1.d0-AirVolRatio)*FanPowerMax
ENDIF !capfac60percent
END SELECT ! fan speed control type
!reduce latent capacity according to value called for for sensible - recalc latent.
! recalc coilcaptotal
WaterRemovRate = WaterRemovRate*AirVolRatio
LatLoadServed = WaterRemovRate * IcetoVaporEnthalpy
SensLoadGross = SensLoadRequestedGross
ELSE ! at full load
FanPowerActual = FanPowerMax
END IF ! part load and sensload served > 0.
CoilCapTotal = SensLoadGross + LatLoadServed
IF(CoilCapTotal > 0.d0) THEN
SHR = SensLoadGross / CoilCapTotal
ELSE
SHR = 0.d0
END IF !(CoilCapTotal > 0.)
!now handle ice on coil and defrost because defrost energy not into melting ice goes into sensible load
! FROST: keep track of frost build up on evaporator coil
! avoid accumulation during warm-up to avoid reverse dd test problem
IF(.NOT. WarmUpFlag) THEN
FrostChangekg = (WaterRemovRate * TimeStepSys * SecInHour)
WarehouseCoil(CoilID)%KgFrost = WarehouseCoil(CoilID)%KgFrost + FrostChangekg
END IF
ELSE ! NOT (AirVolumeFlowMax > 0.d0)
CoilCapTotEstimate = 0.d0
WaterRemovRate = 0.d0
LatLoadServed = 0.d0
FrostChangekg = 0.d0
SensLoadGross = 0.d0
FanPowerActual = 0.d0
END IF !(AirVolumeFlowMax > 0.d0)
!DEFROST CALCULATIONS ***** need to reduce sensible heat to zone from
! defrost by amount used to melt ice. Last two elements
! in starting IF are there to mimic temperature override
! on the coils that stops defrost if the coils get above
! a certain temperature (such as when there's no load and no ice)
IF((DefrostSchedule > 0.0d0).AND. &
(WarehouseCoil(CoilID)%DefrostType /= DefrostNone) .AND. &
(WarehouseCoil(CoilID)%DefrostType /= DefrostOffCycle))THEN
DefrostLoad = DefrostCap * DefrostSchedule !W
DefrostEnergy = DefrostLoad * TimeStepSys * SecInHour !Joules
StartFrostKg = WarehouseCoil(CoilID)%KgFrost
IF (WarehouseCoil(CoilID)%DefrostControlType == DefrostContTempTerm) THEN
! Need to turn defrost system off early if controlled by temperature and all ice melted
! For temperature termination, need to recognize not all defrost heat goes to melt ice
! Some goes to misc losses (for fluid defrost, some coil areas bare earlier than
! others and xfer heat to environment)
! Assume full ice melting satisfies temperature control.
! (defaults for DefEnergyFraction are :=0.7 for elec, =0.3 for fluids)
DefEnergyFraction = WarehouseCoil(CoilID)%DefEnergyFraction
AvailDefrostEnergy = DefEnergyFraction * DefrostEnergy !Joules avail to melt ice
IceSensHeatNeeded = 0.d0
IF(StartFrostKg > 0.0d0) THEN
IF(WarehouseCoil(CoilID)%IceTemp < 0.d0) THEN
StartIceTemp = WarehouseCoil(CoilID)%IceTemp
IceSensHeatNeeded = StartFrostKg * SpecificHeatIce * (0.0d0 - StartIceTemp)!Joules
IF (AvailDefrostEnergy >= IceSensHeatNeeded) THEN
WarehouseCoil(CoilID)%IceTemp = 0.d0
AvailDefrostEnergy = AvailDefrostEnergy - IceSensHeatNeeded !Joules
ELSE !DefrostEnergy < IceSensHeatNeeded
WarehouseCoil(CoilID)%IceTemp = &
StartIceTemp + AvailDefrostEnergy/(SpecificHeatIce * StartFrostKg)
AvailDefrostEnergy = 0.d0
END IF ! AvailDefrostEnergy >= IceSensHeatNeeded
END IF ! IceTemp < 0, need to raise temperature of ice
!Reduce defrost heat load on walkin by amount of ice melted during time step
FrostChangekg = MIN(AvailDefrostEnergy/IceMeltEnthalpy,StartFrostKg)
IF(FrostChangekg < StartFrostKg) THEN
DefrostLoad = DefrostLoad - FrostChangekg*IceMeltEnthalpy/TimeStepSys/SecInHour
IF(.NOT. WarmUpFlag)WarehouseCoil(CoilID)%KgFrost = StartFrostKg - FrostChangekg
!DefrostSchedule not changed because ice not all melted, temp term not triggered
ELSE ! all frost melted during time step, so need to terminate defrost
! see Aug 8 2010 page 3 notes
WarehouseCoil(CoilID)%KgFrost = 0.d0
DefrostEnergyNeeded = (IceSensHeatNeeded + (FrostChangekg*IceMeltEnthalpy))/ &
DefEnergyFraction !Joules - energy needed including E unavail to melt ice
DefrostSchedule = MIN(DefrostSchedule,(DefrostEnergyNeeded/(DefrostCap*TimeStepSys*SecInHour)))
! reduce heat load on warehouse by energy put into ice melting
DefrostRateNeeded = (IceSensHeatNeeded + (FrostChangekg*IceMeltEnthalpy))/(TimeStepSys*SecInHour)
DefrostLoad = MAX(0.d0,(DefrostSchedule*DefrostCap - DefrostRateNeeded))
WarehouseCoil(CoilID)%IceTemp = WarehouseCoil(CoilID)%TEvapDesign
END IF ! frost melted during time step less than amount of ice at start
ELSE
! no frost present so terminate defrost and reset ice temperature for start of next defrost
! However, dripdown schedule still prevents/limits cooling capacity during time step
DefrostLoad = 0.d0
DefrostSchedule = 0.d0
WarehouseCoil(CoilID)%IceTemp = WarehouseCoil(CoilID)%TEvapDesign
END IF ! have frost present
ELSE
!Not temperature control type, controlled only by schedule
!Reduce defrost heat load on the zone by amount of ice melted during time step
!But DefrostSchedule not changed
FrostChangekg = MAX(0.d0,MIN((DefrostEnergy/IceMeltEnthalpy),StartFrostKg))
DefrostLoad = DefrostLoad - FrostChangekg*IceMeltEnthalpy/TimeStepSys/SecInHour
IF(.NOT. WarmUpFlag)WarehouseCoil(CoilID)%KgFrost = StartFrostKg - FrostChangekg
END IF !Temperature termination vs. time-clock control type
ELSE !DefrostSchedule <= 0 or have None or OffCycle
DefrostLoad = 0.0d0
END IF !Defrost calculations
SensLoadFromZone = SensLoadGross - HeaterLoad - DefrostLoad - FanPowerActual
CoolingLoadNet = SensLoadFromZone + LatLoadServed
! ReportWarehouseCoil(CoilID)
WarehouseCoil(CoilID)%ThermalDefrostPower = DefrostLoad
IF(WarehouseCoil(CoilID)%DefrostType == DefrostElec) THEN
WarehouseCoil(CoilID)%ElecDefrostConsumption = DefrostCap*DefrostSchedule*TimeStepSys*SecInHour
WarehouseCoil(CoilID)%ElecDefrostPower = DefrostCap*DefrostSchedule
ELSE
WarehouseCoil(CoilID)%ElecDefrostConsumption = 0.d0
WarehouseCoil(CoilID)%ElecDefrostPower = 0.d0
END IF
! If hot brine or hot gas is used for defrost, need to reduce condenser load by heat reclaimed for defrost
IF(WarehouseCoil(CoilID)%DefrostType == DefrostFluid)WarehouseCoil(CoilID)%HotDefrostCondCredit=DefrostCap*DefrostSchedule
! LatentLoadServed is positive for latent heat removed from zone
! SensLoadFromZone positive for heat REMOVED from zone, switch when do credit to zone
WarehouseCoil(CoilID)%SensCreditRate = SensLoadFromZone
WarehouseCoil(CoilID)%SensCreditEnergy = SensLoadFromZone * TimeStepSys * SecInHour
WarehouseCoil(CoilID)%LatCreditRate = LatLoadServed
WarehouseCoil(CoilID)%LatCreditEnergy = LatLoadServed * TimeStepSys * SecInHour
WarehouseCoil(CoilID)%LatKgPerS_ToZone = WaterRemovRate
WarehouseCoil(CoilID)%TotalCoolingLoad = CoilCapTotal
WarehouseCoil(CoilID)%TotalCoolingEnergy = CoilCapTotal * TimeStepSys * SecInHour
WarehouseCoil(CoilID)%SensCoolingEnergyRate = SensLoadGross
WarehouseCoil(CoilID)%SensCoolingEnergy = SensLoadGross * TimeStepSys * SecInHour
WarehouseCoil(CoilID)%SensHeatRatio = SHR
WarehouseCoil(CoilID)%ElecFanPower = FanPowerActual
WarehouseCoil(CoilID)%ElecFanConsumption = FanPowerActual * TimeStepSys * SecInHour
WarehouseCoil(CoilID)%ElecHeaterPower = HeaterLoad
WarehouseCoil(CoilID)%ElecHeaterConsumption = HeaterLoad * TimeStepSys * SecInHour
WarehouseCoil(CoilID)%TotalElecPower = FanPowerActual + HeaterLoad + WarehouseCoil(CoilID)%ElecDefrostPower
WarehouseCoil(CoilID)%TotalElecConsumption = WarehouseCoil(CoilID)%TotalElecPower * TimeStepSys * SecInHour
IF(WarehouseCoil(CoilID)%SensCreditRate >= 0.d0) THEN
WarehouseCoil(CoilID)%ReportSensCoolCreditRate = WarehouseCoil(CoilID)%SensCreditRate
WarehouseCoil(CoilID)%ReportHeatingCreditRate = 0.d0
ELSE
WarehouseCoil(CoilID)%ReportSensCoolCreditRate = 0.d0
WarehouseCoil(CoilID)%ReportHeatingCreditRate = - WarehouseCoil(CoilID)%SensCreditRate
END IF
WarehouseCoil(CoilID)%ReportSensCoolCreditEnergy = WarehouseCoil(CoilID)%ReportSensCoolCreditRate * &
TimeStepSys * SecInHour
WarehouseCoil(CoilID)%ReportHeatingCreditEnergy = WarehouseCoil(CoilID)%ReportHeatingCreditRate * &
TimeStepSys * SecInHour
WarehouseCoil(CoilID)%ReportTotalCoolCreditRate = WarehouseCoil(CoilID)%ReportSensCoolCreditRate + &
WarehouseCoil(CoilID)%LatCreditRate
WarehouseCoil(CoilID)%ReportTotalCoolCreditEnergy = WarehouseCoil(CoilID)%ReportSensCoolCreditEnergy + &
WarehouseCoil(CoilID)%LatCreditEnergy
!**************************************************************************************************
! Cap Kg Frost to avoid floating overflow errors
! 1-time warning is issued. It should be rare but could happen with unrealistic inputs.
IF( WarehouseCoil(CoilID)%KgFrost > MyLargeNumber) THEN
WarehouseCoil(CoilID)%KgFrost=MyLargeNumber
IF(ShowCoilFrostWarning(CoilID)) THEN
CALL ShowWarningError('Refrigeration:AirCoil: '//TRIM( WarehouseCoil(CoilID)%Name))
CALL ShowContinueError(' This refrigerated air coil has insufficient defrost capacity '// &
'to remove the excess frost accumulation.')
CALL ShowContinueError(' Check the defrost schedule or defrost capacity. ')
CALL ShowContinueErrorTimeStamp('... Occurrence info ')
ShowCoilFrostWarning( CoilID) = .FALSE.
END IF
END IF
RETURN
END SUBROUTINE CalculateCoil