Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(CFSTY), | intent(in) | :: | FS | |||
real(kind=r64), | intent(out) | :: | UNFRC |
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 CalcEQLWindowUvalue(FS, UNFRC)
! SUBROUTINE INFORMATION:
! AUTHOR JOHN L. WRIGHT/Chip Barnaby
! DATE WRITTEN Last Modified February 2008
!
! MODIFIED Bereket Nigusse, May 2013
! Replaced inside convection calculation
! with ISO Std 15099
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates U-value of equivalent layer window at standard
! fenestration winter rating conditions
! METHODOLOGY EMPLOYED:
! uses routine developed for ASHRAE RP-1311 (ASHWAT Model)
!
! NFRC rated *HEATING* U-factor or Winter Rating Condition
! tin = 294.15d0 ! Inside air temperature (69.8F, 21.0C)
! tout = 255.15d0 ! Outside air temperature (-0.4F, -18C)
! hcout = 26.d0 ! Outside convective film conductance at 5.5 m/s (12.3 mph)
! ! wind speed (the value used in Window 5)
! BeamSolarInc = 0.0
!
! REFERENCES:
! na
!
! USE STATEMENTS:
! na
!
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
TYPE (CFSTY), INTENT(IN) :: FS ! CFS to be calculated
REAL(r64), INTENT(OUT) :: UNFRC ! NFRC U-factor, W/m2-K
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: Height = 1.0d0 ! window height, m
REAL(r64), PARAMETER :: TOUT =-18.0d0 ! outdoor air temperature, C
REAL(r64), PARAMETER :: TIN = 21.0d0 ! indoor air temperature, C
CHARACTER(len=*), PARAMETER :: RoutineName='CalcEQLWindowUvalue: '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS
REAL(r64) :: U ! U-factor, W/m2-K
REAL(r64) :: UOld ! U-factor during pevious iteration step, W/m2-K
REAL(r64) :: HXO ! outdoor combined conv+rad surf coeff, W/m2-K
REAL(r64) :: HXI ! indoor combined conf+rad surf coeff, W/m2-K
REAL(r64) :: HRO ! outdoor side radiation surf coeff, W/m2-K
REAL(r64) :: HCO ! outdoor side convection surf coeff, W/m2-K
REAL(r64) :: HRI ! indoor side radiation surf coeff, W/m2-K
REAL(r64) :: HCI ! indoor side convection surf coeff, W/m2-K
REAL(r64) :: TGO
REAL(r64) :: TGI
REAL(r64) :: TGIK
REAL(r64) :: TIK
REAL(r64) :: DT ! temperature difference, K
REAL(r64) :: EO ! outside face effective emissivity, (-)
REAL(r64) :: EI ! inside face effective emissivity, (-)
INTEGER :: I ! index
LOGICAL :: CFSURated ! false if U-Value calculation failed
! Flow
CFSURated = .FALSE.
! Intial guess value for combined conductance
HXO = 29.0d0 ! 1/FenROut
HXI = 7.0d0 ! 1/FenRIn
HCO = 26.0d0 !
HCI = 3.0d0 ! Initial guess
DT = TIN - TOUT ! note DT == 0 detected in CFSUFactor()
EO = FS%L(1)%LWP_EL%EPSLF ! emissivities outside
EI = FS%L(FS%NL)%LWP_EL%EPSLB ! emissivities inside
U = 5.0d0 / FS%NL ! initial guess
! Iterate: find surface temperature, update coeffs, converge to U
DO I = 1, 10
TGO = TOUT + U * DT / HXO ! update glazing surface temps
TGI = TIN - U * DT / HXI
HRO = StefanBoltzmann*EO*((TGO + KelvinConv)**2 + (TOUT + KelvinConv)**2) &
* ((TGO + KelvinConv)+(TOUT + KelvinConv))
HRI = StefanBoltzmann*EI*((TGI + KelvinConv)**2 + (TIN + KelvinConv)**2) &
* ((TGI + KelvinConv)+(TIN + KelvinConv))
!HCI = HIC_ASHRAE( Height, TGI, TI) ! BAN June 2103 Raplaced with ISO Std 15099
TGIK = TGI + KelvinConv
TIK = TIN + KelvinConv
HCI = HCInWindowStandardRatings(Height, TGIK, TIK)
IF (HCI < 0.001d0) EXIT
HXI = HCI + HRI
HXO = HCO + HRO
UOld = U
IF (.NOT. CFSUFactor( FS, TOUT, HCO, TIN, HCI, U)) EXIT
IF (I > 1 .AND. FEQX( U, UOld, 0.001d0)) THEN
CFSURated = .TRUE.
EXIT
END IF
END DO
IF (.NOT. CFSURated) THEN
CALL ShowWarningMessage(RoutineName//'Fenestration U-Value calculation failed for '//TRIM(FS%Name))
CALL ShowContinueError('...Calculated U-value = '//TRIM(TrimSigDigits(U,4)))
CALL ShowContinueError('...Check consistency of inputs')
END IF
UNFRC = U
RETURN
END SUBROUTINE CalcEQLWindowUvalue