Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in) | :: | b | |||
real(kind=r64), | intent(in) | :: | L | |||
real(kind=r64), | intent(in) | :: | Ts | |||
real(kind=r64), | intent(in) | :: | Tamb | |||
real(kind=r64), | intent(in) | :: | hc_in | |||
integer, | intent(in) | :: | scheme |
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.
REAL(r64) FUNCTION SLtoAMB(b, L, Ts, Tamb, hc_in, scheme)
!
! AUTHOR ASHRAE 1311-RP
! DATE WRITTEN unknown
! MODIFIED na
! RE-ENGINEERED na
!
! PURPOSE OF THIS FUNCTION:
! Returns shade to room air heat transfer coefficient
!
!
! METHODOLOGY EMPLOYED:
!
! fill gas is always air, orientation is always vertical
! hsamb should be h-flatplate at b=0 and 2*h-flatplate at b=large. Note
! that hsamb is the same at slat angle = 0, 90, -90 degrees but increase
! by 20% at slat angle =45 degrees to mimic air pumping between slats
! therefore, specify slat angle=0 or 90 or -90 is shade is other than
! a venetian blind
!
!
! REFERENCES:
! na
!
!
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: b ! distance from shade to glass (m) where air flow takes place
REAL(r64), INTENT(IN) :: L ! window height, m (usually taken as 1 m)
REAL(r64), INTENT(IN) :: Ts ! shade temperature, K
REAL(r64), INTENT(IN) :: Tamb ! room air temperature, K
REAL(r64), INTENT(IN) :: hc_in ! indoor (room) convective transfer coeff, W/m2K)
INTEGER, INTENT(IN) :: scheme ! flag to select model, scheme=2 has problems
! scheme=3 recommended
!
! FUNCTION PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! FUNCTION LOCAL VARIABLE DECLARATIONS:
! a
REAL(r64) :: Tavg
REAL(r64) :: P
REAL(r64) :: rho
REAL(r64) :: beta
REAL(r64) :: dvisc
REAL(r64) :: Cp
REAL(r64) :: k
REAL(r64) :: Rabsa
REAL(r64) :: hfp
! Flow
SLtoAmb = 2.d0 * hc_in ! DEFAULT - convection from both sides
! of shading layer - large spacing, b
IF (scheme .eq. 1) then
! properties of AIR
Tavg=(Ts+Tamb)/2.d0
rho=PAtmSeaLevel/(287.097d0*Tavg) ! density (kg/m3) <- temperature in (K)
beta=1.d0/Tavg ! thermal expansion coef(/K)
dvisc = (18.05d0 + ((Tavg-290.d0)/10.d0) * (18.53d0-18.05d0)) * 1.0d-6
! dynamic viscosity (kg/m.sec) or (N.sec/m2)
Cp= 1044.66d0-0.31597d0*Tavg+0.000707908*Tavg**2-0.00000027034d0*Tavg**3
! specific heat at constant pressure (J/kg.K)
k= 0.02538d0+((Tavg-290.d0)/10.d0)*(0.02614d0-0.02538d0) ! conductivity (W/m.K)
Rabsa= ( 9.81d0*beta*(b**3)*ABS(Ts-Tamb)*(rho**2)*Cp )/(dvisc*k)
IF (Rabsa .LE. 1.d0) then
Rabsa=1.0d0
ENDIF
hfp= HIC_ASHRAE(L, Ts, Tamb) ! h - flat plate, influence by
! window height and temperature
! difference. Note: hfp goes to
! zero as delta-T goes to zero
! now adjust for distance from window glass
SLtoAmb=hfp*(1.d0 + EXP(-6000.d0/Rabsa))
! SLtoAmb goes to 2*hfp at large b and hfp at small b and small (20%)
! penalty is applied if slat angle is not zero or +/- 90 degrees
! Note: influence of distance is lost if delta-T goes to zero
! Note: as delta-T -> zero, Rabga->0, SLtoAmb -> hfp, not 2hfp,
! for any spacing, even large b. This is a problem
ELSE IF (scheme .eq. 2) then
! properties of AIR
Tavg=(Ts+Tamb)/2.d0
rho=PAtmSeaLevel/(287.097d0*Tavg) ! density (kg/m3) <- temperature in (K)
beta=1.d0/Tavg ! thermal expansion coef(/K)
dvisc = (18.05d0 + ((Tavg - 290.d0)/10.d0) * (18.53d0 - 18.05d0)) * 1.0d-6
! dynamic viscosity (kg/m.sec) or (N.sec/m2)
Cp= 1044.66d0 - 0.31597d0*Tavg+0.000707908d0*Tavg**2 -0.00000027034d0*Tavg**3
! specific heat at constant pressure (J/kg.K)
k= 0.02538d0+((Tavg-290.d0)/10.d0)*(0.02614d0 - 0.02538d0) ! conductivity (W/m.K)
Rabsa= ( 9.81d0*beta*(b**3)*ABS(Ts-Tamb)*(rho**2)*Cp )/(dvisc*k)
IF (Rabsa .LE. 1.d0) then
Rabsa=1.0d0
ENDIF
hfp= hc_in ! h - flat plate - from calling routine
!Note: using this approach, L no longer has influence on hfp
! now adjust for distance from window glass
SLtoAmb=hfp*(1.d0 + EXP(-6000.d0/Rabsa))
! Note: as delta-T -> zero, Rabga->0, SLtoAmb -> hfp, not 2hfp,
! for any spacing, even large b. This is a problem
ELSE IF (scheme .eq. 3) then
hfp= hc_in ! h - flat plate - from calling routine
! now adjust for distance from window glass
SLtoAmb=hfp*(2.d0 - exp(-4.6d0 * b /0.1d0))
!Note: using this approach, L and temperatures no longer have
! influence on result
! SLtoAmb = 2*hc_in when glass/shade spacing, b, is large
! SLtoAmb = hc_in when glass/shade spacing, b, is zero
! The exponential decay is 99% complete at b=4 inches = 0.1 m
! ln(0.01) = -4.6
! This coefficient could be fine tuned in future versions, perhaps
! as a function of boundary layer thickness for specific values
! of glass and shade temperatures
END IF ! end of scheme .eq. 3
RETURN
END FUNCTION SLtoAMB