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) | :: | SurfNum | |||
real(kind=r64), | intent(in) | :: | HMovInsul | |||
integer, | intent(in) | :: | Roughness | |||
real(kind=r64), | intent(in) | :: | AbsExt | |||
real(kind=r64), | intent(in) | :: | TempExt | |||
real(kind=r64), | intent(out) | :: | HExt | |||
real(kind=r64), | intent(out) | :: | HSky | |||
real(kind=r64), | intent(out) | :: | HGround | |||
real(kind=r64), | intent(out) | :: | HAir |
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 InitExteriorConvectionCoeff(SurfNum,HMovInsul,Roughness,AbsExt,TempExt,HExt,HSky,HGround,HAir)
! SUBROUTINE INFORMATION:
! AUTHOR George Walton
! DATE WRITTEN January 1990
! MODIFIED na
! RE-ENGINEERED Mar98 (RKS); Sep03 (LKL): Add additional flavors of Ext Convection Coeff.
! Dec03 (PGE): Re-eng'd ASHRAEDetailed to match BLAST and TARP.
! Aug04 (PGE): Corrected error for calculating local wind speeds for different terrains.
! Aug 2010 B. Griffith. for outside air convection, added new adaptive convection algorithm etc.
! PURPOSE OF THIS SUBROUTINE:
! This subroutine determines the outside convection coefficient for
! a particular surface.
! METHODOLOGY EMPLOYED:
! Based on the properties of a particular surface, determine what the
! outside convection coefficients are for outside air, the sky, and
! the ground. Convection coefficients for the sky and ground are
! actually linearized radiation coefficients. The ground surface is
! assumed to be the same temperature as the outside air.
! REFERENCES:
! (I)BLAST legacy routine OCNVCO
! TARP Reference Manual, "Surface Outside Heat Balances", pp 71ff
! USE STATEMENTS:
USE DataEnvironment, ONLY: SkyTempKelvin, WindDir
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: SurfNum ! Surface number (in Surface derived type)
INTEGER, INTENT(IN) :: Roughness ! Roughness index (1-6), see DataHeatBalance parameters
REAL(r64), INTENT(IN) :: HMovInsul ! Equivalent convection coefficient of movable insulation
REAL(r64), INTENT(IN) :: AbsExt ! Exterior thermal absorptance
REAL(r64), INTENT(IN) :: TempExt ! Exterior surface temperature (C)
! REAL(r64), INTENT(IN) :: WindSpeedExt ! Exterior wind speed (m/s) **No longer used
REAL(r64), INTENT(OUT) :: HExt ! Convection coefficient to exterior air
REAL(r64), INTENT(OUT) :: HSky ! "Convection" coefficient to sky temperature
REAL(r64), INTENT(OUT) :: HGround ! "Convection" coefficient to ground temperature
REAL(r64), INTENT(OUT) :: HAir ! Radiation to Air Component
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: MoWiTTTurbulentConstant = 0.84d0 ! Turbulent natural convection constant
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: TAir ! Absolute dry bulb temperature of outdoor air (K)
! REAL(r64) :: TSky ! Absolute temperature of the sky (K)
REAL(r64) :: TSurf ! Absolute temperature of the exterior surface (K)
REAL(r64) :: SurfWindSpeed ! Local wind speed at height of the heat transfer surface (m/s)
REAL(r64) :: ConstantA ! = a, Constant, W/(m2K(m/s)^b)
REAL(r64) :: ConstantB ! = b, Constant, W/(m2K^(4/3))
REAL(r64) :: Hn ! Natural part of exterior convection
REAL(r64) :: Hf ! Forced part of exterior convection
REAL(r64) :: HcGlass
REAL(r64) :: rcalcPerimeter ! approximation for Perimeter
INTEGER :: BaseSurf
! real(r64) :: flag
! FLOW:
IF (GetUserSuppliedConvectionCoeffs) THEN
CALL GetUserConvectionCoefficients
GetUserSuppliedConvectionCoeffs = .FALSE.
ENDIF
TAir = Surface(SurfNum)%OutDryBulbTemp + KelvinConv
TSurf = TempExt + KelvinConv
BaseSurf = Surface(SurfNum)%BaseSurf ! If this is a base surface, BaseSurf = SurfNum
IF (.NOT. Surface(SurfNum)%ExtWind) THEN
SurfWindSpeed = 0.0d0 ! No wind exposure
ELSE IF (Surface(SurfNum)%Class == SurfaceClass_Window .AND. SurfaceWindow(SurfNum)%ShadingFlag == ExtShadeOn) THEN
SurfWindSpeed = 0.0d0 ! Assume zero wind speed at outside glass surface of window with exterior shade
ELSE
SurfWindSpeed = Surface(SurfNum)%WindSpeed
ENDIF
! Check if exterior is to be set by user
SELECT CASE(Surface(SurfNum)%ExtConvCoeff)
CASE(:-1) ! Set by user using one of the standard algorithms...
SELECT CASE(ABS(Surface(SurfNum)%ExtConvCoeff))
CASE(ASHRAESimple)
HExt = CalcASHRAESimpExtConvectCoeff(Roughness, SurfWindSpeed) ! includes radiation to sky, ground, and air
CASE(ASHRAETARP, BLASTHcOutside, TarpHcOutside)
! Convection is split into forced and natural components. The total
! convective heat transfer coefficient is the sum of these components.
!
! Coefficients for subsurfaces are handled in a special way. The values for perimeter and gross area
! are actually referencing the base surface because a subsurface does not initiate a completely new
! thermal boundary layer (although it may add some additional complexity that cannot be accounted for
! here). The values for height (Z) and roughness do, however, come from the subsurface.
!
! BLAST algorithm has been replaced by this one since it was identical except for the standard wind
! speed measurement height which was only different because of unit conversions: 10 m vs. 30 ft (= 9.14 m).
!
! ASHRAE/BLAST REFERENCES:
! ?
!
! TARP REFERENCES:
! Walton, G. N. 1983. Thermal Analysis Research Program Reference Manual.
! National Bureau of Standards. NBSSIR 83-2655.
! due to outlying calculations when perimeter is very small compared to area, use Perimeter
! approximation calculation
IF (Surface(BaseSurf)%GrossArea /= 0.0d0 .and. Surface(BaseSurf)%Height /= 0.0d0) THEN
rCalcPerimeter = 2.0d0 * (Surface(BaseSurf)%GrossArea / Surface(BaseSurf)%Height + Surface(BaseSurf)%Height)
Hf = CalcHfExteriorSparrow(SurfWindSpeed, Surface(BaseSurf)%GrossArea, rCalcPerimeter, &
Surface(SurfNum)%CosTilt, Surface(SurfNum)%Azimuth, Roughness, WindDir)
ELSE
Hf = 0.0d0
ENDIF
IF (HMovInsul > 0.0d0) TSurf = (HMovInsul * TSurf + Hf * TAir) / (HMovInsul + Hf)
Hn = CalcHnASHRAETARPExterior(TSurf,TAir,Surface(SurfNum)%CosTilt)
HExt = Hn + Hf
CASE(MoWiTTHcOutside)
! The MoWiTT model is based on measurements taken at the Mobile Window
! Thermal Test (MoWiTT) facility. Appropriate for very smooth surfaces.
!
! REFERENCES:
! Yazdanian, M. and J.H. Klems. 1994. Measurement of the exterior convective
! film coefficient for windows in low-rise buildings.
! ASHRAE Transactions 100(1): 1087.
IF (Windward(Surface(SurfNum)%CosTilt,Surface(SurfNum)%Azimuth, WindDir)) THEN
ConstantA = 3.26d0
ConstantB = 0.89d0
ELSE ! leeward
ConstantA = 3.55d0
ConstantB = 0.617d0
END IF
! NOTE: Movable insulation is not taken into account here
HExt = SQRT((MoWiTTTurbulentConstant * (ABS(TAir-TSurf))** OneThird) ** 2 &
+(ConstantA * SurfWindSpeed ** ConstantB) ** 2)
CASE(DOE2HcOutside)
! The DOE-2 convection model is a combination of the MoWiTT and the BLAST
! convection models. However, it calculates the coefficient for very smooth
! surfaces (glass) first and then modified for other surfaces.
!
! REFERENCES:
! Lawrence Berkeley Laboratory. 1994. DOE2.1E-053 source code.
IF (Windward(Surface(SurfNum)%CosTilt,Surface(SurfNum)%Azimuth, WindDir)) THEN
ConstantA = 3.26d0
ConstantB = 0.89d0
ELSE ! leeward
ConstantA = 3.55d0
ConstantB = 0.617d0
END IF
Hn = CalcHnASHRAETARPExterior(TSurf,TAir,Surface(SurfNum)%CosTilt)
HcGlass = SQRT(Hn**2 + (ConstantA * SurfWindSpeed ** ConstantB)**2)
Hf = RoughnessMultiplier(Roughness) * (HcGlass - Hn)
IF (HMovInsul > 0.0d0) THEN
TSurf = (HMovInsul * TSurf + Hf * TAir) / (HMovInsul + Hf)
Hn = CalcHnASHRAETARPExterior(TSurf,TAir,Surface(SurfNum)%CosTilt)
! Better if there was iteration for movable insulation?
END IF
HExt = Hn + Hf
CASE (AdaptiveConvectionAlgorithm)
CALL ManageOutsideAdaptiveConvectionAlgo(SurfNum, HExt)
CASE DEFAULT
CALL ShowFatalError('InitExtConvection Coefficients: invalid parameter -- outside convection type, Surface='// &
TRIM(Surface(SurfNum)%Name))
END SELECT ! choice of algorithm type
IF (Surface(SurfNum)%EMSOverrideExtConvCoef) HExt = Surface(SurfNum)%EMSValueForExtConvCoef
IF (TSurf == SkyTempKelvin .OR. ABS(Surface(SurfNum)%ExtConvCoeff) == ASHRAESimple) THEN
HSky = 0.0d0
ELSE
! Compute sky radiation coefficient
HSky = StefanBoltzmann*AbsExt*Surface(SurfNum)%ViewFactorSkyIR &
*AirSkyRadSplit(SurfNum)*((TSurf**4)-(SkyTempKelvin**4))/(TSurf-SkyTempKelvin)
END IF
IF (TSurf == TAir .OR. ABS(Surface(SurfNum)%ExtConvCoeff) == ASHRAESimple) THEN
HGround = 0.0d0
HAir = 0.0d0
ELSE
! Compute ground radiation coefficient
HGround = StefanBoltzmann*AbsExt*Surface(SurfNum)%ViewFactorGroundIR &
*((TSurf**4)-(TAir**4))/(TSurf-TAir)
! Compute air radiation coefficient
HAir = StefanBoltzmann*AbsExt*Surface(SurfNum)%ViewFactorSkyIR &
*(1.d0-AirSkyRadSplit(SurfNum))*((TSurf**4)-(TAir**4))/(TSurf-TAir)
END IF
CASE(0) ! Not set by user -- uses Zone setting
SELECT CASE(Zone(Surface(SurfNum)%Zone)%OutsideConvectionAlgo) ! Algorithm type
CASE(ASHRAESimple)
HExt = CalcASHRAESimpExtConvectCoeff(Roughness, SurfWindSpeed) ! includes radiation to sky, ground, and air
CASE(ASHRAETARP, BLASTHcOutside, TarpHcOutside)
! Convection is split into forced and natural components. The total
! convective heat transfer coefficient is the sum of these components.
!
! Coefficients for subsurfaces are handled in a special way. The values for perimeter and gross area
! are actually referencing the base surface because a subsurface does not initiate a completely new
! thermal boundary layer (although it may add some additional complexity that cannot be accounted for
! here). The values for height (Z) and roughness do, however, come from the subsurface.
!
! BLAST algorithm has been replaced by this one since it was identical except for the standard wind
! speed measurement height which was only different because of unit conversions: 10 m vs. 30 ft (= 9.14 m).
!
! ASHRAE/BLAST REFERENCES:
! ?
!
! TARP REFERENCES:
! Walton, G. N. 1983. Thermal Analysis Research Program Reference Manual.
! National Bureau of Standards. NBSSIR 83-2655.
! due to outlying calculations when perimeter is very small compared to area, use Perimeter
! approximation calculation
IF (Surface(BaseSurf)%GrossArea /= 0.0d0 .and. Surface(BaseSurf)%Height /= 0.0d0) THEN
rCalcPerimeter = 2.0d0 * (Surface(BaseSurf)%GrossArea / Surface(BaseSurf)%Height + Surface(BaseSurf)%Height)
Hf = CalcHfExteriorSparrow(SurfWindSpeed, Surface(BaseSurf)%GrossArea, rCalcPerimeter, &
Surface(SurfNum)%CosTilt, Surface(SurfNum)%Azimuth, Roughness, WindDir)
ELSE
Hf = 0.0d0
ENDIF
IF (HMovInsul > 0.0d0) TSurf = (HMovInsul * TSurf + Hf * TAir) / (HMovInsul + Hf)
Hn = CalcHnASHRAETARPExterior(TSurf,TAir,Surface(SurfNum)%CosTilt)
HExt = Hn + Hf
CASE(MoWiTTHcOutside)
! The MoWiTT model is based on measurements taken at the Mobile Window
! Thermal Test (MoWiTT) facility. Appropriate for very smooth surfaces.
!
! REFERENCES:
! Yazdanian, M. and J.H. Klems. 1994. Measurement of the exterior convective
! film coefficient for windows in low-rise buildings.
! ASHRAE Transactions 100(1): 1087.
IF (Windward(Surface(SurfNum)%CosTilt,Surface(SurfNum)%Azimuth, WindDir)) THEN
ConstantA = 3.26d0
ConstantB = 0.89d0
ELSE ! leeward
ConstantA = 3.55d0
ConstantB = 0.617d0
END IF
! NOTE: Movable insulation is not taken into account here
HExt = SQRT((MoWiTTTurbulentConstant * (ABS(TAir-TSurf))** OneThird) ** 2 &
+(ConstantA * SurfWindSpeed ** ConstantB) ** 2)
CASE(DOE2HcOutside)
! The DOE-2 convection model is a combination of the MoWiTT and the BLAST
! convection models. However, it calculates the coefficient for very smooth
! surfaces (glass) first and then modified for other surfaces.
!
! REFERENCES:
! Lawrence Berkeley Laboratory. 1994. DOE2.1E-053 source code.
IF (Windward(Surface(SurfNum)%CosTilt,Surface(SurfNum)%Azimuth, WindDir)) THEN
ConstantA = 3.26d0
ConstantB = 0.89d0
ELSE ! leeward
ConstantA = 3.55d0
ConstantB = 0.617d0
END IF
Hn = CalcHnASHRAETARPExterior(TSurf,TAir,Surface(SurfNum)%CosTilt)
HcGlass = SQRT(Hn**2 + (ConstantA * SurfWindSpeed ** ConstantB)**2)
Hf = RoughnessMultiplier(Roughness) * (HcGlass - Hn)
IF (HMovInsul > 0.0d0) THEN
TSurf = (HMovInsul * TSurf + Hf * TAir) / (HMovInsul + Hf)
Hn = CalcHnASHRAETARPExterior(TSurf,TAir,Surface(SurfNum)%CosTilt)
! Better if there was iteration for movable insulation?
END IF
HExt = Hn + Hf
CASE (AdaptiveConvectionAlgorithm)
CALL ManageOutsideAdaptiveConvectionAlgo(SurfNum, HExt)
CASE DEFAULT
CALL ShowFatalError('InitExtConvection Coefficients: invalid parameter -- outside convection type, Surface='// &
TRIM(Surface(SurfNum)%Name))
END SELECT ! choice of algorithm type
IF (Surface(SurfNum)%EMSOverrideExtConvCoef) HExt = Surface(SurfNum)%EMSValueForExtConvCoef
IF (TSurf == SkyTempKelvin .OR. Zone(Surface(SurfNum)%Zone)%OutsideConvectionAlgo == ASHRAESimple) THEN
HSky = 0.0d0
ELSE
! Compute sky radiation coefficient
HSky = StefanBoltzmann*AbsExt*Surface(SurfNum)%ViewFactorSkyIR &
*AirSkyRadSplit(SurfNum)*((TSurf**4)-(SkyTempKelvin**4))/(TSurf-SkyTempKelvin)
END IF
IF (TSurf == TAir .OR. Zone(Surface(SurfNum)%Zone)%OutsideConvectionAlgo == ASHRAESimple) THEN
HGround = 0.0d0
HAir = 0.0d0
ELSE
! Compute ground radiation coefficient
HGround = StefanBoltzmann*AbsExt*Surface(SurfNum)%ViewFactorGroundIR &
*((TSurf**4)-(TAir**4))/(TSurf-TAir)
! Compute air radiation coefficient
HAir = StefanBoltzmann*AbsExt*Surface(SurfNum)%ViewFactorSkyIR &
*(1.d0-AirSkyRadSplit(SurfNum))*((TSurf**4)-(TAir**4))/(TSurf-TAir)
END IF
CASE DEFAULT ! Exterior convection scheme for this surface has been set by user
HExt = SetExtConvectionCoeff(SurfNum)
IF (Surface(SurfNum)%EMSOverrideExtConvCoef) HExt = Surface(SurfNum)%EMSValueForExtConvCoef
IF (TSurf == SkyTempKelvin .OR. Zone(Surface(SurfNum)%Zone)%OutsideConvectionAlgo == ASHRAESimple) THEN
HSky = 0.0d0
ELSE
! Compute sky radiation coefficient
HSky = StefanBoltzmann*AbsExt*Surface(SurfNum)%ViewFactorSkyIR &
*AirSkyRadSplit(SurfNum)*((TSurf**4)-(SkyTempKelvin**4))/(TSurf-SkyTempKelvin)
END IF
IF (TSurf == TAir .OR. Zone(Surface(SurfNum)%Zone)%OutsideConvectionAlgo == ASHRAESimple) THEN
HGround = 0.0d0
HAir = 0.0d0
ELSE
! Compute ground radiation coefficient
HGround = StefanBoltzmann*AbsExt*Surface(SurfNum)%ViewFactorGroundIR &
*((TSurf**4)-(TAir**4))/(TSurf-TAir)
! Compute air radiation coefficient
HAir = StefanBoltzmann*AbsExt*Surface(SurfNum)%ViewFactorSkyIR &
*(1.d0-AirSkyRadSplit(SurfNum))*((TSurf**4)-(TAir**4))/(TSurf-TAir)
END IF
END SELECT
RETURN
END SUBROUTINE InitExteriorConvectionCoeff