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) | :: | ColleNum |
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 CalcHeatTransCoeffAndCoverTemp(ColleNum)
! SUBROUTINE INFORMATION:
! AUTHOR Bereket A Nigusse, FSEC/UCF
! DATE WRITTEN February 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates the various heat transfer coefficients, and collector cover temperatures.
! METHODOLOGY EMPLOYED:
!
! REFERENCES:
! Duffie, J. A., and Beckman, W. A. Solar Engineering of Thermal Processes, Second Edition.
! Wiley-Interscience: New York (1991).
!
USE DataGlobals, ONLY: StefanBoltzmann, KelvinConv
USE DataEnvironment, ONLY: SkyTemp, SkyTempKelvin, GroundTemp, GroundTempKelvin
USE DataHeatBalance, ONLY: QRadSWOutIncident
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ColleNum ! Collector object number
! FUNCTION PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: gravity = 9.806d0 ! gravitational constant [m/s^2]
REAL(r64), PARAMETER :: SmallNumber = 1.00d-20 ! small number to avoid div by zero
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! CHARACTER(len=MaxNameLength):: String ! Dummy string for converting numbers to strings
INTEGER :: ParamNum ! collector parameters object number
INTEGER :: CoverNum ! counter for number of covers
INTEGER :: NumCovers ! number of covers
INTEGER :: SurfNum ! surface number
INTEGER :: Num ! covers counter
REAL(r64) :: tempnom ! intermediate variable
REAL(r64) :: tempdenom ! intermediate variable
REAL(r64) :: AirGapDepth ! characteristic length [m]
REAL(r64) :: TempAbsPlate ! absorber plate average temperature [C]
REAL(r64) :: TempInnerCover ! inner cover average temperature [C]
REAL(r64) :: TempOuterCover ! outer cover average temperature [C]
REAL(r64) :: TempOutdoorAir ! outdoor air temperature [C]
REAL(r64) :: EmissOfAbsPlate ! emissivity of absorber plate
REAL(r64) :: EmissOfInnerCover ! emissivity of inner cover
REAL(r64) :: EmissOfOuterCover ! emissivity of outer cover
REAL(r64) :: UTopLoss ! over all top heat loss coefficient [W/m2C]
REAL(r64) :: hRadCoefC2Sky ! radiation coeff from collector to the sky [W/m2C]
REAL(r64) :: hRadCoefC2Gnd ! radiation coeff from collector to the ground [W/m2C]
REAL(r64) :: hRadConvOut ! combined convection-radiation coefficient [W/m2C]
REAL(r64) :: hConvCoefA2C ! convection coeff. between abs plate and cover [W/m2C]
REAL(r64) :: hConvCoefC2C ! convection coeff. between covers [W/m2C]
REAL(r64) :: hConvCoefC2O ! convection coeff. between outer cover and the ambient [W/m2C]
REAL(r64) :: hRadCoefA2C ! radiation coeff. between abs plate and cover [W/m2C]
REAL(r64) :: hRadCoefC2C ! radiation coeff. between covers [W/m2C]
REAL(r64) :: hRadCoefC2O ! radiation coeff. between outer covers and the ambient [W/m2C]
! flow
UTopLoss = 0.d0
ParamNum = Collector(ColleNum)%Parameters
NumCovers = Parameters(ParamNum)%NumOfCovers
SurfNum = Collector(ColleNum)%Surface
TempAbsPlate = Collector(ColleNum)%SavedTempOfAbsPlate
TempInnerCover = Collector(ColleNum)%SavedTempOfInnerCover
TempOuterCover = Collector(ColleNum)%SavedTempOfOuterCover
TempOutdoorAir = Surface(SurfNum)%OutDryBulbTemp
EmissOfAbsPlate = Parameters(ParamNum)%EmissOfAbsPlate
EmissOfOuterCover = Parameters(ParamNum)%EmissOfCover(1)
EmissOfInnerCover = Parameters(ParamNum)%EmissOfCover(2)
AirGapDepth = Parameters(ParamNum)%CoverSpacing
Select Case (NumCovers)
Case (1)
! calc linearized radiation coefficient
tempnom = StefanBoltzmann*((TempAbsPlate+KelvinConv)+(TempOuterCover+KelvinConv)) &
* ((TempAbsPlate+KelvinConv)**2+(TempOuterCover+KelvinConv)**2)
tempdenom = 1.d0/EmissOfAbsPlate+1.d0/EmissOfOuterCover-1.d0
hRadCoefA2C = tempnom/tempdenom
hRadCoefC2C = 0.0d0
hConvCoefC2C= 0.0d0
! Calc convection heat transfer coefficient:
hConvCoefA2C = CalcConvCoeffBetweenPlates(TempAbsPlate,TempOuterCover,AirGapDepth, &
Collector(ColleNum)%CosTilt,Collector(ColleNum)%SinTilt)
Case (2)
DO CoverNum = 1, NumCovers
IF (CoverNum == 1) THEN
! calc linearized radiation coefficient
tempnom = StefanBoltzmann*((TempAbsPlate+KelvinConv)+(TempInnerCover+KelvinConv)) &
* ((TempAbsPlate+KelvinConv)**2+(TempInnerCover+KelvinConv)**2)
tempdenom = 1.d0/EmissOfAbsPlate+1.d0/EmissOfInnerCover-1.d0
hRadCoefA2C = tempnom / tempdenom
! Calc convection heat transfer coefficient:
hConvCoefA2C = CalcConvCoeffBetweenPlates(TempAbsPlate,TempOuterCover,AirGapDepth, &
Collector(ColleNum)%CosTilt,Collector(ColleNum)%SinTilt)
ELSE
! calculate the linearized radiation coeff.
tempnom = StefanBoltzmann*((TempInnerCover+KelvinConv)+(TempOuterCover+KelvinConv)) &
* ((TempInnerCover+KelvinConv)**2+(TempOuterCover+KelvinConv)**2)
tempdenom = 1.d0/EmissOfInnerCover+1.d0/EmissOfOuterCover-1.d0
hRadCoefC2C = tempnom / tempdenom
! Calc convection heat transfer coefficient:
hConvCoefC2C = CalcConvCoeffBetweenPlates(TempInnerCover,TempOuterCover,AirGapDepth, &
Collector(ColleNum)%CosTilt,Collector(ColleNum)%SinTilt)
ENDIF
END DO
END SELECT
! Calc collector outside surface convection heat transfer coefficient:
hConvCoefC2O = 2.8d0+3.0d0*Surface(SurfNum)%WindSpeed
! Calc linearized radiation coefficient between outer cover and the surrounding:
tempnom = Surface(SurfNum)%ViewFactorSky*EmissOfOuterCover*StefanBoltzmann &
* ((TempOuterCover+KelvinConv)+SkyTempKelvin) * ((TempOuterCover+KelvinConv)**2 + SkyTempKelvin**2)
tempdenom = (TempOuterCover-TempOutdoorAir)/(TempOuterCover-SkyTemp)
IF (tempdenom < 0.0d0) THEN
! use approximate linearized radiation coefficient
hRadCoefC2Sky = tempnom
ELSEIF (tempdenom == 0.0d0) THEN
! if temperature difference is zero, no radiation exchange
hRadCoefC2Sky = 0.0d0
ELSE
hRadCoefC2Sky = tempnom / tempdenom
ENDIF
tempnom = Surface(SurfNum)%ViewFactorGround*EmissOfOuterCover*StefanBoltzmann &
* ((TempOuterCover+KelvinConv)+GroundTempKelvin) * ((TempOuterCover+KelvinConv)**2+GroundTempKelvin**2)
tempdenom = (TempOuterCover-TempOutdoorAir)/(TempOuterCover-GroundTemp)
IF (tempdenom < 0.0d0) THEN
! use approximate linearized radiation coefficient
hRadCoefC2Gnd = tempnom
ELSEIF (tempdenom == 0.0d0) THEN
! if temperature difference is zero, no radiation exchange
hRadCoefC2Gnd = 0.0d0
ELSE
hRadCoefC2Gnd = tempnom / tempdenom
ENDIF
! combine the radiation coefficients
hRadCoefC2O = hRadCoefC2Sky+hRadCoefC2Gnd
! calculate the overall top heat loss coefficient:
IF (NumCovers == 1 ) THEN
UTopLoss = 1.d0/(1.d0/(hRadCoefA2C+hConvCoefA2C)+1.d0/(hRadCoefC2O + hConvCoefC2O))
ELSE
UTopLoss = 1.d0/(1.d0/(hRadCoefA2C+hConvCoefA2C)+1.d0/(hRadCoefC2C + hConvCoefC2C) &
+ 1.d0/(hRadCoefC2O+hConvCoefC2O))
ENDIF
Collector(ColleNum)%UTopLoss = UTopLoss
! calculate the side loss coefficient. Adds the insulation resistance and the combined
! convection-radiation coefficients in series.
hRadConvOut = 5.7d0 + 3.8d0 * Surface(SurfNum)%WindSpeed
Collector(ColleNum)%UsLoss = 1.d0/(1.d0/(Parameters(ParamNum)%ULossSide*Collector(ColleNum)%AreaRatio) &
+ 1.d0/(hRadConvOut*Collector(ColleNum)%AreaRatio))
! the bottom loss coefficient calculation depends on the boundary condition
IF ( Collector(ColleNum)%OSCM_ON ) THEN ! OtherSideConditionsModel
Collector(ColleNum)%UbLoss = Parameters(ParamNum)%ULossBottom
ELSE ! AmbientAir
Collector(ColleNum)%UbLoss = 1.d0/(1.0d0/Parameters(ParamNum)%ULossBottom+1.d0/hRadConvOut)
ENDIF
! Calculate current timestep covers temperature
Select Case (NumCovers)
Case (1)
tempnom = Collector(ColleNum)%CoverAbs(1)*QRadSWOutIncident(SurfNum) &
+ TempOutdoorAir*(hConvCoefC2O+hRadCoefC2O) + TempAbsPlate*(hConvCoefA2C+hRadCoefA2C)
tempdenom = (hConvCoefC2O+hRadCoefC2O)+(hConvCoefA2C+hRadCoefA2C)
TempOuterCover = tempnom / tempdenom
Case (2)
DO Num = 1, NumCovers
IF (Num == 1) THEN
tempnom = Collector(ColleNum)%CoverAbs(Num)*QRadSWOutIncident(SurfNum) &
+ TempOutdoorAir*(hConvCoefC2O+hRadCoefC2O) &
+ TempInnerCover*(hConvCoefC2C+hRadCoefC2C)
tempdenom = (hConvCoefC2O+hRadCoefC2O)+(hConvCoefC2C+hRadCoefC2C)
TempOuterCover = tempnom / tempdenom
ELSEIF (Num == 2) THEN
tempnom = Collector(ColleNum)%CoverAbs(Num)*QRadSWOutIncident(SurfNum) &
+ TempAbsPlate*(hConvCoefA2C+hRadCoefA2C) &
+ TempOuterCover*(hConvCoefC2C+hRadCoefC2C)
tempdenom = (hConvCoefC2C+hRadCoefC2C+hConvCoefA2C+hRadCoefA2C)
TempInnerCover = tempnom / tempdenom
ENDIF
END DO
End Select
Collector(ColleNum)%TempOfInnerCover = TempInnerCover
Collector(ColleNum)%TempOfOuterCover = TempOuterCover
RETURN
END SUBROUTINE CalcHeatTransCoeffAndCoverTemp