| 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