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) | :: | EvapCoolNum |
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 CalcIndirectResearchSpecialEvapCooler(EvapCoolNum)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN July 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Subroutine models a "special" cooler that allows high effectiveness and controls
! METHODOLOGY EMPLOYED:
! Needs description, as appropriate.
! REFERENCES:
! copied CalcWetIndirectEvapCooler as template for new cooler
! USE STATEMENTS:
Use DataEnvironment, ONLY: OutDryBulbTemp, OutWetBulbTemp, OutHumRat, OutBaroPress
USE DataWater , ONLY: WaterStorage
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: EvapCoolNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!REAL(r64) Variables
REAL(r64) :: SecondaryInletWetBulbTemp ! entering wet bulb for secondary/purge side
REAL(r64) :: SecondaryInletDewpointTemp ! entering dewpoint for secondary/purge side
REAL(r64) :: StageEff ! Stage Efficiency of the Heat Exchanger
REAL(r64) :: TEDB ! Entering Dry Bulb Temperature
REAL(r64) :: TEWB ! Entering Wet Bulb Temperature
REAL(r64) :: QHX ! Q Across Sec HX in Watts or J/sec
REAL(r64) :: RhoWater
REAL(r64) :: RhoAir ! Density of the primary side air
REAL(r64) :: CFMAir
Integer :: TertNode ! inlet node for relief (from bulding) to mix for purge
REAL(r64) :: BoundTemp ! temperature limit for outlet
REAL(r64) :: PartLoad
REAL(r64) :: TotalVolFlow
REAL(r64) :: TertMdot
REAL(r64) :: TertHumRate
REAL(r64) :: TertTemp
REAL(r64) :: TertRho
REAL(r64) :: TertVdot
REAL(r64) :: SecVdot
REAL(r64) :: SecRho
REAL(r64) :: SecMdot
REAL(r64) :: PurgeMdot
REAL(r64) :: PurgeHumRat
REAL(r64) :: PurgeEnthalpy
REAL(r64) :: PurgeTemp
REAL(r64) :: BlowDownVdot =0.0d0
REAL(r64) :: DriftVdot =0.0d0
REAL(r64) :: EvapVdot =0.0d0
! If the Evaporative Cooler is operating there should be some mass flow rate
! Also the evap cooler has to be scheduled to be available
IF((EvapCond(EvapCoolNum)%InletMassFlowRate .GT. 0.0d0) .and. &
(GetCurrentScheduleValue(EvapCond(EvapCoolNum)%SchedPtr) .gt. 0.0d0)) THEN
!******************************************************************************
! THIS SUBROUTINE WILL CACULATE THE TEMPERATURE OF THE LEAVING AIR DRY BULB
! FOR A WET COIL EVAPORATIVE COOLER
!******************************************************************************
! INDIRECT STAGE EFFICIENCY FOR WET COIL INDIRECT EVAP COOLERS
CFMAir = EvapCond(EvapCoolNum)%VolFlowRate !Volume Flow Rate Primary Side
! CFMSec = EvapCond(EvapCoolNum)%IndirectVolFlowRate !Volume Flolw Rate Secondary Side
StageEff = EvapCond(EvapCoolNum)%WetCoilMaxEfficiency
! This is model is for special indirect cooler with efficiency greater than 1.0
IF(StageEff.GE.1.5d0) StageEff=1.5d0
EvapCond(EvapCoolNum)%StageEff = StageEff
!***********************************************
! Unit is allowed to mix relief air that would otherwise be exhausted outdoors for ventilation
! If tertiary node is set >0 then it assumed that this node is the exhaust out of the building
! and the remainder will be made up with outside air from the secondary node
!*********************************************
TertNode = EvapCond(EvapCoolNum)%TertiaryInletNode
If (tertNode .EQ. 0) then
SecondaryInletWetBulbTemp = PsyTwbFnTdbWPb(EvapCond(EvapCoolNum)%SecInletTemp, &
EvapCond(EvapCoolNum)%SecInletHumRat,OutBaroPress)
SecondaryInletDewpointTemp = PsyTdpFnTdbTwbPb(EvapCond(EvapCoolNum)%SecInletTemp, SecondaryInletWetBulbTemp, OutBaroPress)
Else
TotalVolFlow = EvapCond(EvapCoolNum)%IndirectVolFlowRate
TertMdot = node(TertNode)%MassFlowRate
TertHumRate = node(TertNode)%HumRat
TertTemp = node(TertNode)%Temp
! is Node pressure available or better? using outdoor pressure for now
TertRho = PsyRhoAirFnPbTdbW(OutBaroPress, TertTemp , TertHumRate)
TertVdot = TertMdot/TertRho
SecVdot = TotalVolFlow - TertVdot
IF (SecVdot .LT. 0.0d0) then ! all tertiary/releif air e.g. econonizer wide open
SecVdot = 0.0d0
SecondaryInletWetBulbTemp = PsyTwbFnTdbWPb(TertTemp, TertHumRate , OutBaroPress)
SecondaryInletDewpointTemp = PsyTdpFnTdbTwbPb(TertTemp, SecondaryInletWetBulbTemp, OutBaroPress)
Else
! First determine mass flow of OA, in secondary
SecRho = PsyRhoAirFnPbTdbW(OutBaroPress, EvapCond(EvapCoolNum)%SecInletTemp,EvapCond(EvapCoolNum)%SecInletHumRat)
SecMdot = SecRho * SecVdot
! Mass balance on moisture to get outlet air humidity ratio
! this mixing takes place before wet media.
PurgeMdot = SecMdot + TertMdot
PurgeHumRat = (SecMdot * EvapCond(EvapCoolNum)%SecInletHumRat + TertMdot * TertHumRate) / PurgeMdot
! Energy balance to get outlet air enthalpy
PurgeEnthalpy = (SecMdot * PsyHFnTdbW(EvapCond(EvapCoolNum)%SecInletTemp,EvapCond(EvapCoolNum)%SecInletHumRat) &
+ TertMdot * PsyHFnTdbW(TertTemp, TertHumRate)) / PurgeMdot
! Use Enthalpy and humidity ratio to get outlet temperature from psych chart
PurgeTemp = PsyTdbFnHW(PurgeEnthalpy, PurgeHumRat)
SecondaryInletWetBulbTemp = PsyTwbFnTdbWPb(PurgeTemp, PurgeHumRat, OutBaroPress)
SecondaryInletDewpointTemp = PsyTdpFnTdbTwbPb(PurgeTemp,SecondaryInletWetBulbTemp, OutBaroPress)
Endif
endif
!***************************************************************************
! TEMP LEAVING DRY BULB IS CALCULATED FROM A SIMPLE WET BULB APPROACH
! MODEL GIVEN THE INDIRECT STAGE EFFICIENCY.
! DRY BULB TEMP APPROACHES THE WET BULB TEMP ACROSS THE INDIRECT STAGE.
!***************************************************************************
TEWB = EvapCond(EvapCoolNum)%InletWetBulbTemp
TEDB = EvapCond(EvapCoolNum)%InletTemp
PartLoad = EvapCond(EvapCoolNum)%PartLoadFract
IF (PartLoad .EQ. 1.0D0) THEN
! Tout = Tin - ( 0.7 (Tin - Tpurge,wb,in)
EvapCond(EvapCoolNum)%OutletTemp = TEDB - StageEff*(TEDB - SecondaryInletWetBulbTemp )
! now bound with secondary dewpoint.
! unless the resulting Tout<=Tpurge,dp,in ; in which case Tout = Tin - 0.9(Tin-Tpurge,dp,in)
BoundTemp = TEDB - EvapCond(EvapCoolNum)%DPBoundFactor *(TEDB - SecondaryInletDewpointTemp )
IF (EvapCond(EvapCoolNum)%OutletTemp .LT. BoundTemp) THEN
EvapCond(EvapCoolNum)%OutletTemp = BoundTemp
EvapCond(EvapCoolNum)%DewPointBoundFlag = 1
ENDIF
ELSEIF ((partLoad .LT. 1.0D0) .AND. (partLoad .GT. 0.0D0)) THEN
! assume perfect control Use PLF for energy consumption
IF (EvapCond(EvapCoolNum)%DesiredOutletTemp .LT. TEDB ) THEN
EvapCond(EvapCoolNum)%OutletTemp = EvapCond(EvapCoolNum)%DesiredOutletTemp
ENDIF
ELSE
!part load set to zero so no cooling
EvapCond(EvapCoolNum)%OutletTemp = EvapCond(EvapCoolNum)%InletTemp
ENDIF
!***************************************************************************
! CALCULATE THE WET BULB TEMP in the primary system air using PSYCH ROUTINES
! There is a constant humidity ratio across the primary side but a reduction in the dry bulb temp
EvapCond(EvapCoolNum)%OuletWetBulbTemp = PsyTwbFnTdbWPb(EvapCond(EvapCoolNum)%OutletTemp, &
EvapCond(EvapCoolNum)%InletHumRat,OutBaroPress)
!***************************************************************************
! CALCULATE other outlet propertiesusing PSYCH ROUTINES
EvapCond(EvapCoolNum)%OutletHumRat = EvapCond(EvapCoolNum)%InletHumRat
EvapCond(EvapCoolNum)%OutletEnthalpy = PsyHFnTdbW(EvapCond(EvapCoolNum)%OutletTemp, &
EvapCond(EvapCoolNum)%OutletHumRat)
!***************************************************************************
! POWER OF THE SECONDARY AIR FAN with part load factor applied (assumes const efficiency)
IF (EvapCond(EvapCoolNum)%IndirectFanEff > 0.0D0) THEN
EvapCond(EvapCoolNum)%EvapCoolerPower=EvapCond(EvapCoolNum)%EvapCoolerPower + &
EvapCond(EvapCoolNum)%IndirectFanDeltaPress* &
EvapCond(EvapCoolNum)%IndirectVolFlowRate/ &
EvapCond(EvapCoolNum)%IndirectFanEff* PartLoad
ENDIF
! ENERGY CONSUMED BY THE RECIRCULATING PUMP
! ENERGY CONSUMED BY THE RECIRCULATING PUMP
!Add the pump energy to the total Evap Cooler energy comsumption
EvapCond(EvapCoolNum)%EvapCoolerPower = EvapCond(EvapCoolNum)%EvapCoolerPower + &
EvapCond(EvapCoolNum)%IndirectRecircPumpPower* PartLoad
!******************
! WATER CONSUMPTION IN LITERS OF WATER FOR Wet InDIRECT
! H2O [m3/sec] = (QHx [J/s])/(2,500,000 [J/kg H2O] * RhoWater [kg H2O/m3 H2O])
!******************
!***** FIRST calculate the heat exchange on the primary air side**********
RhoAir = PsyRhoAirFnPbTdbW(OutBaroPress,EvapCond(EvapCoolNum)%InletTemp,EvapCond(EvapCoolNum)%InletHumRat)
QHX = CFMAir*RhoAir*(EvapCond(EvapCoolNum)%InletEnthalpy - EvapCond(EvapCoolNum)%OutletEnthalpy)
RhoWater = RhoH2O(OutDryBulbTemp)
EvapVdot= (QHx)/(2500000.0d0 * RhoWater)
DriftVdot = EvapVdot * EvapCond(EvapCoolNum)%DriftFraction
IF (EvapCond(EvapCoolNum)%BlowDownRatio > 0.0D0) THEN
BlowDownVdot = EvapVdot / (EvapCond(EvapCoolNum)%BlowDownRatio - 1) - DriftVdot
IF ( BlowDownVdot < 0.0d0 ) BlowDownVdot = 0.0d0
ELSE
BlowDownVdot = 0.0D0
ENDIF
EvapCond(EvapCoolNum)%EvapWaterConsumpRate = EvapVdot + DriftVdot + BlowDownVdot
! A numerical check to keep from having very tiny negative water consumption values being reported
IF(EvapCond(EvapCoolNum)%EvapWaterConsumpRate < 0.0d0) EvapCond(EvapCoolNum)%EvapWaterConsumpRate = 0.0d0
ELSE
! The evap cooler is not running and does not change conditions from inlet to outlet
EvapCond(EvapCoolNum)%OutletTemp = EvapCond(EvapCoolNum)%InletTemp
EvapCond(EvapCoolNum)%OuletWetBulbTemp = EvapCond(EvapCoolNum)%InletWetBulbTemp
EvapCond(EvapCoolNum)%OutletHumRat = EvapCond(EvapCoolNum)%InletHumRat
EvapCond(EvapCoolNum)%OutletEnthalpy = EvapCond(EvapCoolNum)%InletEnthalpy
EvapCond(EvapCoolNum)%EvapCoolerEnergy = 0.0D0
EvapCond(EvapCoolNum)%EvapCoolerPower = 0.0D0
EvapCond(EvapCoolNum)%EvapWaterConsumpRate = 0.0D0
End IF
! all of the mass flowrates are not changed across the evap cooler
EvapCond(EvapCoolNum)%OutletMassFlowRate = EvapCond(EvapCoolNum)%InletMassFlowRate
EvapCond(EvapCoolNum)%OutletMassFlowRateMaxAvail = EvapCond(EvapCoolNum)%InletMassFlowRateMaxAvail
EvapCond(EvapCoolNum)%OutletMassFlowRateMinAvail = EvapCond(EvapCoolNum)%InletMassFlowRateMinAvail
! the pressure is not changed across the evap cooler
EvapCond(EvapCoolNum)%OutletPressure = EvapCond(EvapCoolNum)%InletPressure
RETURN
END SUBROUTINE CalcIndirectResearchSpecialEvapCooler