Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(CFSTY), | intent(inout) | :: | FS | |||
real(kind=r64), | intent(out) | :: | SHGCSummer | |||
real(kind=r64), | intent(out) | :: | TransNormal |
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 CalcEQLWindowSHGCAndTransNormal(FS, SHGCSummer, TransNormal)
! SUBROUTINE INFORMATION:
! AUTHOR Bereket Nigusse
! DATE WRITTEN May 2013
! MODIFIED na
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates SHGC and Normal Transmittance of equivalent layer
! fenestration.
! METHODOLOGY EMPLOYED:
! Uses routine developed for ASHRAE RP-1311 (ASHWAT Model)
!
! Summer Window Rating Conditoions
! tin = 297.15d0 ! indoor air condition (75.2F, 24.0C)
! tout = 305.15d0 ! Outside air temperature (89.6F, 32C)
! hcout = 15.d0 ! Outside convective film conductance at 2.8 m/s (6.2 mph) wind speed
! BeamSolarInc = 783.0d0 ! Direct normal incident solar radiation, W/m2
!
! REFERENCES:
! na
!
! USE STATEMENTS:
! na
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
TYPE (CFSTY), INTENT( INOUT) :: FS ! fenestration system
REAL(r64), INTENT(OUT) :: TransNormal ! transmittance at normal incidence
REAL(r64), INTENT(OUT) :: SHGCSummer ! solar heat gain coefficient
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: TOL = 0.01d0
REAL(r64), PARAMETER :: TIN = 297.15d0
REAL(r64), PARAMETER :: TOUT= 305.15d0
REAL(r64), PARAMETER :: BeamSolarInc = 783.0d0
CHARACTER(len=*), PARAMETER :: RoutineName='CalcEQLWindowSHGCAndTransNormal: '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: HCOUT
REAL(r64) :: TRMOUT
REAL(r64) :: TRMIN
REAL(r64) :: HCIN
TYPE(CFSSWP) :: SWP_ON(CFSMAXNL)
REAL(r64) :: QOCF(CFSMAXNL)
REAL(r64) :: JB(0:CFSMAXNL)
REAL(r64) :: JF(1:CFSMAXNL+1)
REAL(r64) :: T(CFSMAXNL)
REAL(r64) :: Q(0:CFSMAXNL)
REAL(r64) :: H(0:CFSMAXNL+1)
REAL(r64) :: Abs1(CFSMAXNL+1, 2)
REAL(r64) :: QRSW
REAL(r64) :: QRLW
REAL(r64) :: QCONV
REAL(r64) :: QOCFRoom
REAL(r64) :: QROOM
REAL(r64) :: UCG
REAL(r64) :: SHGC
REAL(r64) :: SHGCCheck
REAL(r64) :: IncA
REAL(r64) :: VProfA
REAL(r64) :: HProfA
INTEGER :: NL
INTEGER :: I
INTEGER :: iL
INTEGER :: iLC1
LOGICAL :: DoShadeControlR
LOGICAL :: CFSSHGC
! Flow
CFSSHGC = .TRUE.
NL = FS%NL
IncA = 0.0d0
VProfA = 0.0d0
HProfA = 0.0d0
ABS1 = 0.0d0
HCIN = 3.0d0 ! Initial guess
HCOUT = 15.0d0
IF ( FS%L(1)%LTYPE == ltyROLLB .OR. & ! Exterior Roller Blind Present
FS%L(1)%LTYPE == ltyDRAPE .OR. & ! Exterior Drape Fabric
FS%L(1)%LTYPE == ltyINSCRN.OR. & ! Exterior Insect Screen Present
FS%L(1)%LTYPE == ltyVBHOR .OR. FS%L(1)%LTYPE == ltyVBVER ) THEN ! Exterior Venetian Blind Present
! Reduced convection coefficient due to external attachment
HCOUT = 12.25d0
ENDIF
! Temperatures
TRMOUT = TOUT
TRMIN = TIN
! Convert direct-normal solar properties for beam incidence to current incident angle
DO I = 1, NL
CALL ASHWAT_OffNormalProperties( FS%L(I), IncA, VProfA, HProfA, SWP_ON( I))
END DO
CALL ASHWAT_Solar( FS%NL, SWP_ON, SWP_ROOMBLK, 1.0d0, 0.0d0, 0.0d0, Abs1( :, 1), Abs1( :, 2))
TransNormal = Abs1(NL+1,1)
! Calculate SHGC using net radiation method (ASHWAT Model)
CFSSHGC = ASHWAT_Thermal( FS, TIN, TOUT, HCIN, HCOUT, TRMOUT, TRMIN, BeamSolarInc, &
BeamSolarInc*Abs1(1:NL+1,1), TOL, QOCF, QOCFRoom, &
T, Q, JF, JB, H, UCG, SHGC, .TRUE.)
IF (.NOT. CFSSHGC) THEN
CALL ShowWarningMessage(RoutineName//'Solar heat gain coefficient calculation failed for '//FS%Name)
CALL ShowContinueError('...Calculated SHGC = '//TRIM(TrimSigDigits(SHGC,4)))
CALL ShowContinueError('...Calculated U-Value = '//TRIM(TrimSigDigits(UCG,4)))
CALL ShowContinueError('...Check consistency of inputs.')
RETURN
ENDIF
SHGCSummer = SHGC
RETURN
END SUBROUTINE CalcEQLWindowSHGCAndTransNormal