fw if (ra > 2.0e6): error that outside range of Rayleigh number?
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | SurfNum | |||
real(kind=r64), | intent(in) | :: | tso | |||
real(kind=r64), | intent(in) | :: | tsi | |||
integer, | intent(in) | :: | IGap | |||
real(kind=r64), | intent(in) | :: | gr | |||
real(kind=r64), | intent(in) | :: | pr | |||
real(kind=r64), | intent(out) | :: | gnu |
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 NusseltNumber (SurfNum,tso,tsi,IGap,gr,pr,gnu)
! SUBROUTINE INFORMATION:
! AUTHOR Adapted by Fred Winkelmann from Window5 subroutine nusselt
! DATE WRITTEN September 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Finds the Nusselt number for gas-filled gaps between isothermal solid layers.
! The gap may be filled with a single gas or a gas mixture.
! METHODOLOGY EMPLOYED:
! Based on methodology in Chapter 5 of the July 18, 2001 draft of ISO 15099,
! "Thermal Performance of Windows, Doors and Shading Devices--Detailed Calculations."
! The equation numbers below correspond to those in the standard.
! REFERENCES:
! Window5 source code; ISO 15099
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: tso ! Temperature of gap surface closest to outside (K)
REAL(r64), INTENT(IN) :: tsi ! Temperature of gap surface closest to zone (K)
INTEGER, INTENT(IN) :: SurfNum ! Surface number
INTEGER, INTENT(IN) :: IGap ! Gap number
REAL(r64), INTENT(IN) :: pr ! Gap gas Prandtl number
REAL(r64), INTENT(IN) :: gr ! Gap gas Grashof number
REAL(r64), INTENT(OUT) :: gnu ! Gap gas Nusselt number
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: asp ! Aspect ratio: window height to gap width
REAL(r64) :: ra ! Rayleigh number
REAL(r64) :: gnu901,gnu902,gnu90,gnu601 ! Nusselt number temporary variables for
REAL(r64) :: gnu602,gnu60,gnu601a,gnua,gnub ! different tilt and Ra ranges
REAL(r64) :: cra,a,b,g,ang ! Temporary variables
IF(SurfNum > 0) THEN
asp = Surface(SurfNum)%Height/gap(IGap)
ELSE ! SurfNum = 0 when NusseltNumber is called from CalcNominalWindowCond, which applies to a
! particular construction. So window height is not known and we assume 5 ft (1.524 m)
asp = 1.524d0/gap(IGap)
END IF
tiltr = tilt * DegToRadians
ra = gr*pr
!!fw if (ra > 2.0e6): error that outside range of Rayleigh number?
if(ra <= 1.0d4) gnu901 = 1.d0 + 1.7596678d-10 * ra**2.2984755d0 ! eq. 51
if(ra > 1.0d4 .and. ra <= 5.0d4) gnu901 = 0.028154d0 * ra**0.4134d0 ! eq. 50
if(ra > 5.0d4) gnu901 = 0.0673838d0 * ra**(1.0d0/3.0d0) ! eq. 49
gnu902 = 0.242d0 * (ra/asp)**.272d0 ! eq. 52
gnu90 = MAX(gnu901,gnu902)
if(tso > tsi)then ! window heated from above
gnu = 1.0d0 + (gnu90-1.0d0)*sin(tiltr) ! eq. 53
else ! window heated from below
if (tilt >= 60.0d0) then
if (ra >= .001d0) then
g = 0.5d0 * (1.0d0+(ra/3160.d0)**20.6d0)**(-0.1d0) ! eq. 47
else
g = 0.5d0
endif
gnu601a = 1.0d0 + (0.0936d0*(ra**0.314d0)/(1.0d0+g))**7 ! eq. 45
gnu601 = gnu601a**0.142857d0
! For any aspect ratio
gnu602 = (0.104d0+0.175d0/asp) * ra**0.283d0 ! eq. 46
gnu60 = MAX(gnu601,gnu602)
! linear interpolation for layers inclined at angles between 60 and 90 deg
gnu = ((90.0d0-tilt)*gnu60 + (tilt-60.0d0)*gnu90)/30.0d0
endif
if (tilt < 60.0d0) then ! eq. 42
cra = ra*cos(tiltr)
a = 1.0d0 - 1708.0d0/cra
b = (cra/5830.0d0)**0.33333d0-1.0d0
gnua = (abs(a)+a)/2.0d0
gnub = (abs(b)+b)/2.0d0
ang = 1708.0d0 * (sin(1.8d0*tiltr))**1.6d0
gnu = 1.0d0 + 1.44d0*gnua*(1.0d0-ang/cra) + gnub
endif
endif
RETURN
END SUBROUTINE NusseltNumber