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 | :: | 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 CalcDirectEvapCooler(EvapCoolNum)
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN October 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine needs a description.
! METHODOLOGY EMPLOYED:
! Needs description, as appropriate.
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY : RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer :: EvapCoolNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!REAL(r64) Variables
REAL(r64) :: PadDepth ! EvapCooler Pad Depth in Meters as input by the User
REAL(r64) :: SatEff ! Saturation Efficiency of the CelDek Pad
REAL(r64) :: AirVel ! The Calculated Air Velocity through the Pad
REAL(r64) :: TEDB ! Entering Dry Bulb Temperature
REAL(r64) :: TEWB ! Entering Wet Bulb Temperature
REAL(r64) :: RhoWater
! 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
PadDepth = EvapCond(EvapCoolNum)%PadDepth
!******************************************************************************
! THIS SUBROUTINE WILL CACULATE THE TEMPERATURE OF THE LEAVING AIR DRY BULB
! FOR A DIRECT EVAPORATIVE AIR COOLER SUPPLIED WITH CFMAIR,DIRPAD,TEWB,TEDB,
! AND PB (ATM. PRESS.) FOR AIR DENSITY CALCULATIONS.
!******************************************************************************
AirVel=EvapCond(EvapCoolNum)%VolFlowRate/EvapCond(EvapCoolNum)%PadArea
!******************************************************************************
! SAT EFF IS FOR DIFFERENT THICKNESS CELDEK PAD (CURVE FIT FROM DATA)
!******************************************************************************
SatEff=0.792714d0+0.958569d0*PadDepth - 0.25193d0*AirVel &
- 1.03215d0*PadDepth**2 + 2.62659d-2*AirVel**2 + 0.914869d0*PadDepth*AirVel &
- 1.48241d0*AirVel*PadDepth**2 - 1.89919d-2*AirVel**3*PadDepth &
+ 1.13137d0*PadDepth**3*AirVel + 3.27622d-2*AirVel**3*PadDepth**2 &
- 0.145384d0*PadDepth**3*AirVel**2
IF(SatEff.GE.1.0d0) SatEff=1.0d0
IF(SatEff < 0.0d0) THEN ! we have a serious problem. Pad Area and/or depth not suitable for system air flow rates
Call ShowSevereError('EVAPCOOLER:DIRECT:CELDEKPAD: '//trim(EvapCond(EvapCoolNum)%EvapCoolerName)//' has a problem')
Call ShowContinueError('Check size of Pad Area and/or Pad Depth in input')
Call ShowContinueError('Cooler Effectiveness calculated as: '//trim(RoundSigDigits(SatEff,2)) )
Call ShowContinueError('Air velocity (m/s) through pads calculated as: '//trim(RoundSigDigits(AirVel,2)) )
CALL showFatalError('Program Terminates due to previous error condition')
ENDIF
EvapCond(EvapCoolNum)%SatEff = SatEff
!***************************************************************************
! TEMP LEAVING DRY BULB IS CALCULATED FROM SATURATION EFFICIENCY AS THE
! DRY BULB TEMP APPROACHES THE WET BULB TEMP. WET BULB TEMP IS CONSTANT
! ACROSS A DIRECT EVAPORATION COOLER.
TEWB = EvapCond(EvapCoolNum)%InletWetBulbTemp
TEDB = EvapCond(EvapCoolNum)%InletTemp
EvapCond(EvapCoolNum)%OutletTemp = TEDB-((TEDB-TEWB)*SatEff)
EvapCond(EvapCoolNum)%OuletWetBulbTemp = EvapCond(EvapCoolNum)%InletWetBulbTemp
EvapCond(EvapCoolNum)%OutletHumRat = PsyWFnTdbTwbPb(EvapCond(EvapCoolNum)%OutletTemp,TEWB,OutBaroPress)
EvapCond(EvapCoolNum)%OutletEnthalpy = PsyHFnTdbW(EvapCond(EvapCoolNum)%OutletTemp, &
EvapCond(EvapCoolNum)%OutletHumRat)
!***************************************************************************
! 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)%RecircPumpPower
!******************
! WATER CONSUMPTION IN m3 OF WATER FOR DIRECT
! H2O [m3/sec] = Delta W[KgH2O/Kg air]*Mass Flow Air[Kg air]
! /RhoWater [kg H2O/m3 H2O]
!******************
RhoWater = RhoH2O(EvapCond(EvapCoolNum)%OutletTemp)
EvapCond(EvapCoolNum)%EvapWaterConsumpRate = &
(EvapCond(EvapCoolNum)%OutletHumRat - EvapCond(EvapCoolNum)%InletHumRat) * &
EvapCond(EvapCoolNum)%InletMassFlowRate/Rhowater
! 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)%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 CalcDirectEvapCooler