Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ISurf | |||
integer, | intent(in) | :: | IState | |||
type(BSDFWindowGeomDescr), | intent(inout) | :: | Window | |||
type(BSDFGeomDescr), | intent(inout) | :: | Geom | |||
type(BSDFStateDescr), | intent(inout) | :: | State | |||
integer, | intent(in) | :: | Hour | |||
integer, | intent(in) | :: | TS |
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 CalculateWindowBeamProperties(ISurf, IState, Window, Geom, State, Hour, TS)
! SUBROUTINE INFORMATION:
! AUTHOR Joe Klems
! DATE WRITTEN August 2011
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates those optical properties of all the Complex Fenestrations that
! depend on the beam direction (hence, on hour and time step)
! METHODOLOGY EMPLOYED:
! Locate the bidirectional property matrices in the BSDFInput structure
! and use them to calculate the desired average properties.
! REFERENCES:
! na
! USE STATEMENTS:
USE vectors
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! INTEGER, INTENT(IN) :: IWind !Window number (in WindowList)
INTEGER, INTENT(IN) :: ISurf !Window surface number
INTEGER, INTENT(IN) :: IState !Window state number
TYPE (BSDFWindowGeomDescr),INTENT(INOUT) :: Window !Window Geometry
TYPE (BSDFGeomDescr), INTENT(INOUT) :: Geom !State Geometry
TYPE (BSDFStateDescr), INTENT(INOUT) :: State !State Description
INTEGER, INTENT(IN) :: Hour !Hour number
INTEGER, INTENT(IN) :: TS !Timestep number
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IConst !State construction number
INTEGER :: I !general purpose index--Back surface
INTEGER :: J !general purpose index--ray
INTEGER :: JRay !ray index number
REAL(r64) :: Theta
REAL(r64) :: Phi
INTEGER :: JSurf !gen purpose surface no
INTEGER :: BaseSurf !base surface no
INTEGER :: K !general purpose index
INTEGER :: M !general purpose index--ray
INTEGER :: L !general purpose index--layer
INTEGER :: KBkSurf !general purpose index--back surface
REAL(r64) :: Sum1 !general purpose sum
REAL(r64) :: Sum2 !general purpose sum
REAL(r64) :: Sum3 !general purpose sum
INTEGER :: IBm !index of beam ray in incoming basis
INTEGER :: BkIncRay !index of sun dir in back incidence basis
LOGICAL :: RegWindFnd !flag for regular exterior back surf window
INTEGER, DIMENSION(:), ALLOCATABLE :: RegWinIndex !bk surf nos of reg windows
INTEGER :: NRegWin =0 !no reg windows found as back surfaces
INTEGER :: KRegWin =0 !index of reg window as back surface
TYPE (vector) :: SunDir !current sun direction
REAL(r64) :: Refl !temporary reflectance
REAL(r64),DIMENSION(:), ALLOCATABLE :: Absorb !temporary layer absorptance
IConst = SurfaceWindow(ISurf)%ComplexFen%State(IState)%Konst
! Begin calculation
! Calculate the Transmittance from a given beam direction to a given zone surface
IBm = Geom%SolBmIndex( Hour, TS )
IF(IBm <= 0.0d0 ) THEN !Beam cannot be incident on window for this Hour, TS
State%WinToSurfBmTrans( 1 : Window%NBkSurf , Hour , TS ) = 0.0d0
State%WinDirHemiTrans( Hour, TS ) = 0.0d0
State%WinDirSpecTrans( Hour, TS ) = 0.0d0
State%WinBmFtAbs( 1 : State%NLayers , Hour , TS ) = 0.0d0
ELSE
DO I = 1 , Window%NBkSurf !Back surface loop
Sum1 = 0.0d0
DO J = 1 , Geom%NSurfInt ( I ) !Ray loop
Sum1 = Sum1 + Geom%Trn%Lamda(Geom%SurfInt( I , J )) * &
Construct(IConst)%BSDFInput%SolFrtTrans ( Geom%SurfInt( I , J ) , IBm )
END DO !Ray loop
State%WinToSurfBmTrans( I , Hour , TS ) = Sum1
END DO !Back surface loop
!
!Calculate the directional-hemispherical transmittance
Sum1 = 0.0d0
DO J = 1 , Geom%Trn%NBasis
Sum1 = Sum1 + Geom%Trn%Lamda(J) * Construct(IConst)%BSDFInput%SolFrtTrans ( J , IBm )
END DO
State%WinDirHemiTrans( Hour, TS ) = Sum1
!Calculate the directional specular transmittance
!Note: again using assumption that Inc and Trn basis have same structure
State%WinDirSpecTrans( Hour, TS ) = Geom%Trn%Lamda(IBm)*Construct(IConst)%BSDFInput%SolFrtTrans ( IBm , IBm )
!Calculate the layer front absorptance for beam radiation
FORALL ( L = 1 : State%NLayers )
State%WinBmFtAbs( L , Hour , TS ) = Construct(IConst)%BSDFInput%Layer(L)%FrtAbs( 1 , IBm)
END FORALL
ENDIF
!Calculate, for a given beam direction, the transmittance into the zone
! for ground-reflected radiation (transmitted radiation assumed uniformly diffuse)
Sum1 = 0.0d0
Sum2 = 0.0d0
DO J = 1 , Geom%NGnd !Incident ray loop
JRay = Geom%GndIndex( J )
IF ( Geom%SolBmGndWt( J , Hour, TS) > 0.0d0 ) THEN
Sum2 = Sum2 + Geom%SolBmGndWt( J ,Hour, TS) * Geom%Inc%Lamda( JRay)
DO M = 1 , Geom%Trn%NBasis !Outgoing ray loop
Sum1 = Sum1 + Geom%SolBmGndWt( J ,Hour, TS) * &
Geom%Inc%Lamda( JRay) * Geom%Trn%Lamda(M) * &
Construct(IConst)%BSDFInput%SolFrtTrans ( M , JRay )
END DO !Outgoing ray loop
ENDIF
END DO !Indcident ray loop
IF (Sum2 > 0.0d0 ) THEN
State%WinBmGndTrans( Hour , TS ) = Sum1/Sum2
ELSE
State%WinBmGndTrans( Hour , TS ) = 0.0d0 !No unshaded ground => no transmittance
ENDIF
!Calculate, for a given beam direction, the layer front absorptance
! for ground-reflected radiation
DO L = 1 , State%NLayers !layer loop
Sum1 = 0.0d0
Sum2 = 0.0d0
DO J = 1 , Geom%NGnd !Incident ray loop
JRay = Geom%GndIndex( J )
IF ( Geom%SolBmGndWt( J , Hour, TS) > 0.0d0 ) THEN
Sum2 = Sum2 + Geom%SolBmGndWt( J ,Hour, TS) * &
Geom%Inc%Lamda( JRay)
Sum1 = Sum1 + Geom%SolBmGndWt( J ,Hour, TS) * &
Geom%Inc%Lamda( JRay) * Construct(IConst)%BSDFInput%Layer(L)%FrtAbs ( 1 , JRay )
END IF
END DO !Incident ray loop
IF (Sum2 > 0.0d0 ) THEN
State%WinBmGndAbs( L , Hour , TS ) = Sum1/Sum2
ELSE
State%WinBmGndAbs( L , Hour , TS ) = 0.0d0 !No unshaded ground => no absorptance
ENDIF
END DO !layer loop
!Check the back surfaces for exterior windows
RegWindFnd = .FALSE.
NRegWin = 0.0d0
ALLOCATE(RegWinIndex( Window%NBkSurf) )
DO KBkSurf = 1 , Window%NBkSurf
BaseSurf = Surface(ISurf)%BaseSurf !ShadowComb is organized by base surface
JSurf = ShadowComb(BaseSurf)%BackSurf(KBkSurf)
IF (SurfaceWindow(JSurf)%WindowModelType == WindowBSDFModel ) CYCLE
IF (.NOT. (Surface(JSurf)%Class == SurfaceClass_Window .OR. Surface(JSurf)%Class == &
SurfaceClass_GlassDoor ) ) CYCLE
IF (.NOT. (Surface(JSurf)%HeatTransSurf .AND. Surface(JSurf)%ExtBoundCond == ExternalEnvironment &
.AND. Surface(JSurf)%ExtSolar ) ) CYCLE
! Back surface is an exterior window or door
RegWindFnd = .TRUE.
NRegWin = NRegWin + 1
RegWinIndex(NRegWin) = KBkSurf
END DO
IF (RegWindFnd) THEN
ALLOCATE(Absorb(State%NLayers) )
SunDir = SUNCOSTS(1:3,Hour,TS)
BkIncRay = FindInBasis ( SunDir, Back_Incident,ISurf,IState,&
ComplexWind(ISurf)%Geom(IState)%Trn, Theta, Phi)
IF ( BkIncRay > 0 ) THEN
!Here calculate the back incidence properties for the solar ray
!this does not say whether or not the ray can pass through the
!back surface window and hit this one!
Sum1 = 0.0d0
DO J = 1 , Geom%Trn%NBasis
Sum1 = Sum1 + Geom%Trn%Lamda(J) * &
Construct(IConst)%BSDFInput%SolBkRefl( J, BkIncRay )
END DO
Refl = Sum1
DO L = 1 , State%NLayers
Absorb(L) =Construct(IConst)%BSDFInput%Layer(L)%BkAbs(1 , BkIncRay )
END DO
ELSE
!solar ray can't be incident on back, so set properties equal to zero
Refl = 0.0d0
DO L = 1 , State%NLayers
Absorb(L) =0.0d0
END DO
ENDIF
DO KRegWin = 1, NRegWin
KBkSurf = RegWinIndex( KRegWin )
State%BkSurf(KBkSurf)%WinDHBkRefl( Hour, TS )= Refl
DO L = 1 , State%NLayers
State%BkSurf(KBkSurf)%WinDirBkAbs (L , Hour, TS ) = Absorb(L)
END DO
ENDDO
ENDIF
IF (ALLOCATED(Absorb) ) DEALLOCATE (Absorb)
DEALLOCATE(RegWinIndex)
!
!
RETURN
END SUBROUTINE CalculateWindowBeamProperties