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.
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 InitBSDFWindows
! SUBROUTINE INFORMATION:
! AUTHOR Joe Klems
! DATE WRITTEN August 2011
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Set up the overall optical geometry for a BSDF window
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE vectors
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
TYPE TempBasisIdx
INTEGER :: Basis !Basis no in basis table
INTEGER :: State !State in which basis first occurs
END TYPE TempBasisIdx
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: BasisFound = .FALSE. !Flag for sorting Basis List
LOGICAL :: Once =.TRUE. !Flag for insuring things happen once
INTEGER :: IBasis =0 !Index for identifying basis in BasisList
INTEGER :: ISurf =0 !Index for sorting thru Surface array
INTEGER :: IConst =0 !Index for accessing Construct array
INTEGER :: IState =0 !Index identifying the window state for a particular window
INTEGER :: IWind =0 !Index identifying a window in the WindowList
INTEGER :: I =0 !general purpose index
INTEGER :: J =0 !general purpose index
INTEGER :: JSurf =0 !back surface number
INTEGER :: BaseSurf !base surface number (used in finding back surface)
INTEGER :: K =0 !general purpose index
INTEGER :: KBkSurf =0 !back surface index
INTEGER :: KBasis =0 !secondary reference to a basis index
INTEGER :: NThetas =0 !Current number of theta values
INTEGER :: NumBasis =0 !Number of unique bases (No. in BasisList)
INTEGER :: NumElem =0 !Number of elements in current basis
INTEGER :: NBkSurf =0 !Local variable for the number of back surfaces
INTEGER :: NumStates !Local variable for the number of states
INTEGER :: ElemNo =0 !Current basis element number
INTEGER :: ThConst =0 !Construct array index of thermal construction of state
REAL(r64) :: Theta =0.0d0 !Current theta value
REAL(r64) :: Phi =0.0d0 !Current phi value
REAL(r64) :: DPhi =0.0d0 !Increment for phi value (Window6 type input)
REAL(r64) :: Lamda =0.0d0 !Current 'Lamda' value (element weight)
INTEGER :: MatrixNo =0 !Index of Basis matrix
REAL(r64) :: NextTheta =0.0d0 !Next theta in the W6 basis after current
REAL(r64) :: LastTheta =0.0d0 !Previous theta in the W6 basis before current
REAL(r64) :: LowerTheta =0.0d0 !Lower theta boundary of the element
REAL(r64) :: UpperTheta =0.0d0 !Upper theta boundary of the element
REAL(r64) :: Azimuth !Azimuth of window surface (radians)
REAL(r64) :: Tilt !Tilt of window surface (radians)
REAL(r64), DIMENSION(:), ALLOCATABLE :: Thetas !temp array holding theta values
INTEGER, DIMENSION(:), ALLOCATABLE :: NPhis !temp array holding number of phis for a given theta
TYPE (BasisStruct), DIMENSION(:), ALLOCATABLE :: TempList !Temporary Basis List
REAL(r64),DIMENSION(3) :: V !vector array
REAL(r64) :: VLen !Length of vector array
TYPE (TempBasisIdx), DIMENSION(:), ALLOCATABLE :: IHold !Temporary array
INTEGER :: NHold !No. values in the Temporary array
IF (TotComplexFenStates <= 0) RETURN !Nothing to do if no complex fenestration states
!
!Construct Basis List
!
ALLOCATE(TempList(TotComplexFenStates))
!Note: Construction of the basis list contains the assumption of identical incoming and outgoing bases in
! that the complex fenestration state definition contains only one basis description, hence
! assumes square property matrices. If this assumption were relaxed through change of the
! definition or additional definition of a state type with non-square matrices, then the loop
! below should be modified to enter both of the bases into the basis list.
BsLoop: DO IConst = FirstBSDF, FirstBSDF+TotComplexFenStates-1
MatrixNo = Construct(IConst)%BSDFInput%BasisMatIndex
IF (NumBasis ==0) THEN
NumBasis = 1
CALL ConstructBasis (IConst, TempList(1))
ELSE
BLsLp: DO IBasis=1, NumBasis
IF (MatrixNo == TempList(IBasis)%BasisMatIndex) CYCLE BsLoop
END DO BLsLp
NumBasis=NumBasis + 1
CALL ConstructBasis (IConst, TempList(NumBasis) )
ENDIF
END DO BsLoop
ALLOCATE(BasisList(NumBasis))
BasisList=TempList(1:NumBasis)
DEALLOCATE(TempList)
!
! Proceed to set up geometry for complex fenestration states
!
ALLOCATE(ComplexWind(TotSurfaces)) !Set up companion array to SurfaceWindow to hold window
! geometry for each state. This is an allocatable array of
! geometries for the window states but only the complex
! fenestration surfaces will have the arrays allocated
!
! Search Thru Surfaces for Complex Fenestration State references
! This will define the first complex fenestration state for that window, others will follow if there are
! control specifications
!
ALLOCATE(WindowList(TotSurfaces)) !Temporary allocation
ALLOCATE(WindowStateList(TotSurfaces, TotComplexFenStates)) !Temporary allocation
SfLoop: DO ISurf = 1,TotSurfaces
IConst=Surface(ISurf)%Construction
IF (IConst == 0) CYCLE ! This is true for overhangs (Shading:Zone:Detailed)
IF (.NOT.(Construct(IConst)%TypeIsWindow.AND.(Construct(IConst)%WindowTypeBSDF))) CYCLE !Only BSDF windows
!Simon Check: Thermal construction removed
!ThConst = Construct(IConst)%BSDFInput%ThermalConstruction
SurfaceWindow(ISurf)%WindowModelType = WindowBSDFModel
NumComplexWind = NumComplexWind + 1
NumStates = 1
WindowList(NumComplexWind)%NumStates = 1 !Having found the construction reference in
! the Surface array defines the first state for this window
WindowList(NumComplexWind)%SurfNo = ISurf
!WindowList(NumComplexWind)%Azimuth=DegToRadians*Surface(ISurf)%Azimuth
!WindowList(NumComplexWind)%Tilt=DegToRadians*Surface(ISurf)%Tilt
WindowStateList(NumComplexWind, NumStates)%InitInc = Calculate_Geometry
WindowStateList(NumComplexWind, NumStates)%InitTrn = Calculate_Geometry
WindowStateList(NumComplexWind, NumStates)%CopyIncState = 0
WindowStateList(NumComplexWind, NumStates)%CopyTrnState = 0
WindowStateList(NumComplexWind, NumStates)%Konst =IConst
!Simon Check: ThermalConstruction assigned to current construction
!WindowStateList(NumComplexWind, NumStates)%ThermConst = ThConst
DO I = 1 , NumBasis !Find basis in Basis List
IF(Construct(IConst)%BSDFInput%BasisMatIndex == BasisList(I)%BasisMatIndex) THEN
WindowStateList(NumComplexWind, NumStates)%IncBasisIndx = I !Note: square property matrices
WindowStateList(NumComplexWind, NumStates)%TrnBasisIndx = I ! assumption
ENDIF
END DO
IF(WindowStateList(NumComplexWind, NumStates)%IncBasisIndx <= 0) THEN
CALL ShowFatalError('Complex Window Init: Window Basis not in BasisList.')
ENDIF
END DO SfLoop
!
! Should now have a WindowList with NumComplexWind entries containing all the complex fenestrations
! with a first state defined for each.
!
! * * *
!
! Here a search should be made for control specifications, which will give additional states for
! controlled complex fenestrations. These should be added to the WindowStateList, and
! WindowList( )%NumStates incremented for each window for which states are added.
! Added states should have WindowStateList ( , )%InitInc set to Calculate_Geometry
!
! * * *
! At this point, we have a complete WindowList and WindowStateList, with NumComplexWind
! defined, and NumStates for each complex window defined
!
! Now sort through the window list to see that geometry will only be done once for each
! window, basis combination
!
! Note: code below assumes identical incoming and outgoing bases; following code will
! need revision if this assumption relaxed
!
DO IWind = 1,NumComplexWind !Search window list for repeated bases
IF (WindowList(IWind)%NumStates > 1) THEN
ALLOCATE (IHold(WindowList(IWind)%NumStates))
NHold=1
IHold(1)%State = 1
IHold(1)%Basis = WindowStateList(IWind, 1)%IncBasisIndx
! If the Mth new basis found is basis B in the basis list, and it
! first occurs in the WindowStateList in state N, then IHold(M)%Basis=B
! and IHold(M)%State=N
DO K = 1, NumBasis
IF(K > NHold ) EXIT
KBasis = IHold(K)%Basis
J = IHold(K)%State
Once = .TRUE.
DO I = J+1 , WindowList(IWind)%NumStates !See if subsequent states have the same basis
IF(( WindowStateList(NumComplexWind, I)%InitInc == Calculate_Geometry) .AND. &
& (WindowStateList(NumComplexWind, I)%IncBasisIndx == KBasis )) THEN
!Note: square property matrices (same inc & trn bases) assumption
!If same incident and outgoing basis assumption removed, following code will need to
! be extended to treat the two bases separately
WindowStateList(NumComplexWind, I )%InitInc = Copy_Geometry
WindowStateList(NumComplexWind, I )%InitTrn = Copy_Geometry
WindowStateList(NumComplexWind, I )%CopyIncState = J
WindowStateList(NumComplexWind, I )%CopyTrnState = J
ELSE IF (Once) THEN
Once = .FALSE. !First occurrence of a different basis
NHold = NHold +1
IHold(NHold)%State = I
IHold(NHold)%Basis = WindowStateList(IWind, I )%IncBasisIndx
WindowStateList(NumComplexWind, I )%InitTrn = Calculate_Geometry
WindowStateList(NumComplexWind, I )%CopyIncState = 0
WindowStateList(NumComplexWind, I )%CopyTrnState = 0
ENDIF
END DO
END DO
DEALLOCATE( IHold )
ENDIF
END DO
!
! Now go through window list and window state list and calculate or copy the
! geometry information for each window, state
DO IWind = 1 , NumComplexWind
ISurf = WindowList( IWind )%SurfNo
NumStates = WindowList( IWind )%NumStates
!ALLOCATE (SurfaceWindow( ISurf )%ComplexFen) !activate the BSDF window description
! for this surface
SurfaceWindow(ISurf)%ComplexFen%NumStates = NumStates
ALLOCATE (SurfaceWindow( ISurf )%ComplexFen%State(NumStates)) !Allocate space for the states
ComplexWind( ISurf )%NumStates = NumStates
ALLOCATE (ComplexWind (ISurf )%Geom( NumStates )) !Allocate space for the geometries
!Azimuth = WindowList ( IWind )%Azimuth
!Tilt = WindowList ( IWind )%Tilt
! Get the number of back surfaces for this window
BaseSurf = Surface(ISurf)%BaseSurf !ShadowComb is organized by base surface
NBkSurf = ShadowComb(BaseSurf)%NumBackSurf
ComplexWind (ISurf )%NBkSurf = NBkSurf
! Define the back surface directions
ALLOCATE( ComplexWind (ISurf )%sWinSurf(NBkSurf))
ALLOCATE( ComplexWind (ISurf )%sdotN(NBkSurf))
!Define the unit vectors pointing from the window center to the back surface centers
DO KBkSurf = 1 , NBkSurf
BaseSurf = Surface(ISurf)%BaseSurf !ShadowComb is organized by base surface
JSurf = ShadowComb(BaseSurf)%BackSurf(KBkSurf) !these are all proper back surfaces
V = Surface(JSurf)%Centroid - Surface(ISurf)%Centroid
VLen = SQRT( DOT_PRODUCT( V , V ) )
!Define the unit vector from the window center to the back
ComplexWind (ISurf )%sWinSurf( KBkSurf ) = V / VLen
!surface center
!Define the back surface cosine(incident angle)
ComplexWind (ISurf )%sdotN( KBkSurf ) = DOT_PRODUCT ( V , Surface(JSurf)%OutNormVec )/VLen
ENDDO
DO IState = 1, NumStates
!The following assumes identical incoming and outgoing bases. The logic will need to be
! redesigned if this assumption is relaxed
IConst = WindowStateList ( IWind , IState )%Konst
!ThConst = WindowStateList ( IWind , IState )%ThermConst
SurfaceWindow(ISurf)%ComplexFen%State(IState)%Konst = IConst
!SurfaceWindow(ISurf)%ComplexFen%State(IState)%ThermConst = ThConst
IF ( WindowStateList( IWind , IState )%InitInc == Calculate_Geometry ) THEN
ComplexWind (ISurf)%Geom(IState)%Inc = BasisList(WindowStateList(IWind , IState)&
& %IncBasisIndx) !Put in the basis structure from the BasisList
ComplexWind (ISurf)%Geom(IState)%Trn = BasisList(WindowStateList(IWind , IState)&
& %TrnBasisIndx)
CALL SetupComplexWindowStateGeometry (ISurf, IState,IConst, &
& ComplexWind(ISurf),ComplexWind( ISurf )%Geom(IState),&
& SurfaceWindow( ISurf )%ComplexFen%State(IState))
!Note--setting up the state geometry will include constructing outgoing basis/surface
! maps and those incoming maps that will not depend on shading.
ELSE
SurfaceWindow (ISurf )%ComplexFen%State(IState)=SurfaceWindow( ISurf )%ComplexFen &
& %State(WindowStateList( IWind , IState )%CopyIncState) !Note this overwrites Konst
SurfaceWindow (ISurf )%ComplexFen%State(IState)%Konst = IConst ! so it has to be put back
!SurfaceWindow (ISurf )%ComplexFen%State(IState)%ThermConst = ThConst !same for ThermConst
ComplexWind(ISurf)%Geom(IState) = ComplexWind(ISurf) &
& %Geom(WindowStateList( IWind , IState )%CopyIncState)
ENDIF
END DO !State loop
END DO !Complex Window loop
!
! Allocate all beam-dependent complex fenestration quantities
DO IWind = 1 , NumComplexWind
ISurf = WindowList( IWind )%SurfNo
NumStates = WindowList( IWind )%NumStates
DO IState = 1, NumStates
CALL AllocateCFSStateHourlyData(ISurf, IState)
END DO !State loop
END DO !Complex Window loop
RETURN
END SUBROUTINE InitBSDFWindows