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.
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 CalcEarthTube
! SUBROUTINE INFORMATION:
! AUTHOR Kwang Ho Lee
! DATE WRITTEN November 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine simulates the components making up the EarthTube unit.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE ScheduleManager, ONLY: GetCurrentScheduleValue, GetScheduleIndex
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Loop, NZ
REAL(r64) :: Process1 ! Variable Used in the Middle of the Calculation
REAL(r64) :: GroundTempz1z2t ! Average Ground Temperature between Depth z1 and z2 at time t
REAL(r64) :: AirThermCond ! Thermal Conductivity of Air (W/mC)
REAL(r64) :: AirKinemVisco ! Kinematic Viscosity of Air (m2/s)
REAL(r64) :: AirThermDiffus ! Thermal Diffusivity of Air (m2/s)
REAL(r64) :: Re ! Reynolds Number for Flow Inside Pipe
REAL(r64) :: Pr ! Prandtl Number for Flow Inside Pipe
REAL(r64) :: Nu ! Nusselt Number for Flow Inside Pipe
REAL(r64) :: fa ! Friction Factor of Pipe
REAL(r64) :: PipeHeatTransCoef ! Convective Heat Transfer Coefficient at Inner Pipe Surface
REAL(r64) :: Rc ! Thermal Resistance due to Convection between Air and Pipe Inner Surface
REAL(r64) :: Rp ! Thermal Resistance due to Conduction between Pipe Inner and Outer Surface
REAL(r64) :: Rs ! Thermal Resistance due to Conduction between Pipe Outer Surface and Soil
REAL(r64) :: Rt ! Total Thermal Resistance between Pipe Air and Soil
REAL(r64) :: OverallHeatTransCoef ! Overall Heat Transfer Coefficient of Earth Tube
REAL(r64) :: AverPipeAirVel ! Average Pipe Air Velocity (m/s)
REAL(r64) :: AirMassFlowRate ! Actual Mass Flow Rate of Air inside Pipe
REAL(r64) :: AirSpecHeat ! Specific Heat of Air
REAL(r64) :: AirDensity ! Density of Air
REAL(r64) :: InsideEnthalpy
REAL(r64) :: OutletAirEnthalpy
REAL(r64) :: InsideDewPointTemp
REAL(r64) :: InsideHumRat
REAL(r64), ALLOCATABLE, DIMENSION(:), SAVE :: EVF ! DESIGN EARTHTUBE FLOW RATE (M**3/SEC)
! Allocate the EVF array
IF (.NOT. ALLOCATED(EVF)) ALLOCATE(EVF(NumOfZones))
EVF = 0.0d0
MCPTE = 0.0d0
MCPE = 0.0d0
EAMFL = 0.0d0
DO Loop=1, TotEarthTube
NZ = EarthTubeSys(Loop)%ZonePtr
EarthTubeSys(Loop)%FanPower = 0.0d0
! Skip this if the zone is below the minimum temperature limit
IF (MAT(NZ) < EarthTubeSys(Loop)%MinTemperature) CYCLE
! Skip this if the zone is above the maximum temperature limit
IF (MAT(NZ) > EarthTubeSys(Loop)%MaxTemperature) CYCLE
! Skip if below the temperature difference limit
IF (ABS(MAT(NZ)-OutDryBulbTemp) < EarthTubeSys(Loop)%DelTemperature) CYCLE
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress,OutDryBulbTemp,OutHumRat)
AirSpecHeat = PsyCpAirFnWTdb(OutHumRat,OutDryBulbTemp)
EVF(NZ) = EarthTubeSys(Loop)%DesignLevel*GetCurrentScheduleValue(EarthTubeSys(Loop)%SchedPtr)
MCPE(NZ) = EVF(NZ)*AirDensity*AirSpecHeat*( EarthTubeSys(Loop)%ConstantTermCoef &
+ ABS(OutDryBulbTemp-MAT(NZ))*EarthTubeSys(Loop)%TemperatureTermCoef &
+ WindSpeed*(EarthTubeSys(Loop)%VelocityTermCoef + WindSpeed*EarthTubeSys(Loop)%VelocitySQTermCoef) )
EAMFL(NZ) = MCPE(NZ)/AirSpecHeat
IF (EarthTubeSys(Loop)%FanEfficiency > 0.0d0) THEN
EarthTubeSys(Loop)%FanPower = EAMFL(NZ)*EarthTubeSys(Loop)%FanPressure/(EarthTubeSys(Loop)%FanEfficiency*AirDensity)
END IF
AverPipeAirVel=EVF(NZ)/PI/(EarthTubeSys(Loop)%r1**2)
AirMassFlowRate=EVF(NZ)*AirDensity
! Calculation of Average Ground Temperature between Depth z1 and z2 at time t
GroundTempz1z2t=EarthTubeSys(Loop)%AverSoilSurTemp-EarthTubeSys(Loop)%ApmlSoilSurTemp* &
exp(-EarthTubeSys(Loop)%z*SQRT(pi/365.0d0/EarthTubeSys(Loop)%SoilThermDiff))* &
cos(2.0d0*pi/365.0d0*(DayOfYear-EarthTubeSys(Loop)%SoilSurPhaseConst-EarthTubeSys(Loop)%z/2.0d0* &
SQRT(365.0d0/pi/EarthTubeSys(Loop)%SoilThermDiff)))
EarthTubeSys(Loop)%GroundTempz1z2t = GroundTempz1z2t
! Calculation of Convective Heat Transfer Coefficient at Inner Pipe Surface
AirThermCond=0.02442d0+0.6992d0*OutDryBulbTemp/10000.d0
AirKinemVisco=(0.1335d0+0.000925d0*OutDryBulbTemp)/10000.d0
AirThermDiffus=(0.0014d0*OutDryBulbTemp+0.1872d0)/10000.d0
Re=2.d0*EarthTubeSys(Loop)%r1*AverPipeAirVel/AirKinemVisco
Pr=AirKinemVisco/AirThermDiffus
IF (Re<=2300.d0) THEN
Nu=3.66d0
ELSE IF (Re<=4000.d0) THEN
fa=(1.58d0*LOG(Re)-3.28d0)**(-2.d0)
Process1=(fa/2.d0)*(Re-1000.d0)*Pr/(1.d0+12.7d0*((fa/2.d0)**0.5d0)*(Pr**(2.d0/3.d0)-1.d0))
Nu=(Process1-3.66d0)/(1700.d0)*Re+(4000.d0*3.66d0-2300.d0*Process1)/1700.d0
ELSE
fa=(1.58d0*LOG(Re)-3.28d0)**(-2.d0)
Nu=(fa/2.d0)*(Re-1000.d0)*Pr/(1.d0+12.7d0*((fa/2.d0)**0.5d0)*(Pr**(2.d0/3.d0)-1.d0))
END IF
PipeHeatTransCoef=Nu*AirThermCond/2.d0/EarthTubeSys(Loop)%r1
! Claculation of Thermal Resistance and Overall Heat Transger Coefficient
Rc=1.d0/2.d0/PI/EarthTubeSys(Loop)%r1/PipeHeatTransCoef
Rp=LOG((EarthTubeSys(Loop)%r1+EarthTubeSys(Loop)%r2)/EarthTubeSys(Loop)%r1)/2.d0/PI/ &
EarthTubeSys(Loop)%PipeThermCond
Rs=LOG((EarthTubeSys(Loop)%r1+EarthTubeSys(Loop)%r2+EarthTubeSys(Loop)%r3)/ &
(EarthTubeSys(Loop)%r1+EarthTubeSys(Loop)%r2))/2.d0/PI/EarthTubeSys(Loop)%SoilThermCond
Rt=Rc+Rp+Rs
OverallHeatTransCoef=1.d0/Rt
IF (AirMassFlowRate*AirSpecHeat == 0.0d0) THEN
EarthTubeSys(Loop)%InsideAirTemp=GroundTempz1z2t
ELSE
!Calculation of Pipe Outlet Air Temperature
IF (OutDryBulbTemp>GroundTempz1z2t) THEN
Process1=(LOG(ABS(OutDryBulbTemp-GroundTempz1z2t))*AirMassFlowRate*AirSpecHeat-OverallHeatTransCoef* &
EarthTubeSys(Loop)%PipeLength)/(AirMassFlowRate*AirSpecHeat)
EarthTubeSys(Loop)%InsideAirTemp=EXP(Process1)+GroundTempz1z2t
ELSE IF (OutDryBulbTemp==GroundTempz1z2t) THEN
EarthTubeSys(Loop)%InsideAirTemp=GroundTempz1z2t
ELSE
Process1=(LOG(ABS(OutDryBulbTemp-GroundTempz1z2t))*AirMassFlowRate*AirSpecHeat-OverallHeatTransCoef* &
EarthTubeSys(Loop)%PipeLength)/(AirMassFlowRate*AirSpecHeat)
EarthTubeSys(Loop)%InsideAirTemp=GroundTempz1z2t-EXP(Process1)
END IF
END IF
InsideDewPointTemp = PsyTdpFnWPb(OutHumRat, OutBaroPress)
IF (EarthTubeSys(Loop)%InsideAirTemp>=InsideDewPointTemp) THEN
InsideEnthalpy = PsyHFnTdbW(EarthTubeSys(Loop)%InsideAirTemp,OutHumRat)
! Intake fans will add some heat to the air, raising the temperature for an intake fan...
IF (EarthTubeSys(Loop)%FanType == IntakeEarthTube) THEN
IF (EAMFL(NZ) == 0.0d0) Then
OutletAirEnthalpy = InsideEnthalpy
ELSE
OutletAirEnthalpy = InsideEnthalpy + EarthTubeSys(Loop)%FanPower/EAMFL(NZ)
END IF
EarthTubeSys(Loop)%AirTemp = PsyTdbFnHW(OutletAirEnthalpy,OutHumRat)
ELSE
EarthTubeSys(Loop)%AirTemp = EarthTubeSys(Loop)%InsideAirTemp
END IF
MCPTE(NZ) = MCPE(NZ)*EarthTubeSys(Loop)%AirTemp
ELSE
InsideHumRat = PsyWFnTdpPb (EarthTubeSys(Loop)%InsideAirTemp, OutBaroPress)
InsideEnthalpy = PsyHFnTdbW(EarthTubeSys(Loop)%InsideAirTemp,InsideHumRat)
! Intake fans will add some heat to the air, raising the temperature for an intake fan...
IF (EarthTubeSys(Loop)%FanType == IntakeEarthTube) THEN
IF (EAMFL(NZ) == 0.0d0) Then
OutletAirEnthalpy = InsideEnthalpy
ELSE
OutletAirEnthalpy = InsideEnthalpy + EarthTubeSys(Loop)%FanPower/EAMFL(NZ)
END IF
EarthTubeSys(Loop)%AirTemp = PsyTdbFnHW(OutletAirEnthalpy,InsideHumRat)
ELSE
EarthTubeSys(Loop)%AirTemp = EarthTubeSys(Loop)%InsideAirTemp
END IF
MCPTE(NZ) = MCPE(NZ)*EarthTubeSys(Loop)%AirTemp
END IF
END DO
RETURN
END SUBROUTINE CalcEarthTube