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.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Allocation for each complex fenestration state reference points !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ZoneNum | |||
integer, | intent(in) | :: | IWin | |||
integer, | intent(in) | :: | NWX | |||
integer, | intent(in) | :: | NWY | |||
real(kind=r64), | intent(in), | dimension(3) | :: | VIEWVC | ||
real(kind=r64), | intent(in), | dimension(3) | :: | RefPoint | ||
integer, | intent(in) | :: | NRefPts | |||
integer, | intent(in) | :: | iRefPoint | |||
integer, | intent(in) | :: | CalledFrom | |||
integer, | intent(in), | optional | :: | MapNum |
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 InitializeCFSDaylighting(ZoneNum, IWin, NWX, NWY, VIEWVC, RefPoint, NRefPts, iRefPoint, CalledFrom, MapNum)
! SUBROUTINE INFORMATION:
! AUTHOR Simon Vidanovic
! DATE WRITTEN April 2013
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! For incoming BSDF window direction calucates wheter bin is coming from sky, ground or reflected surface.
! Routine also calculates intersection points with ground and exterior reflection surfaces.
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
use vectors
use WindowComplexManager, only: PierceSurfaceVector, DaylghtAltAndAzimuth
implicit none ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
integer, intent(in) :: ZoneNum ! Current zone number
integer, intent(in) :: IWin ! Complex fenestration number
integer, intent(in) :: NWX ! Number of horizontal divisions
integer, intent(in) :: NWY ! Number of vertical divisions
real(r64), dimension(3), intent(in) :: VIEWVC ! view vector component in absolute coord sys
real(r64), dimension(3), intent(in) :: RefPoint ! reference point coordinates
integer, intent(in) :: NRefPts ! Number of reference points
integer, intent(in) :: iRefPoint ! Reference points counter
integer, intent(in) :: CalledFrom
integer, intent(in), optional :: MapNum
integer :: NumOfWinEl ! Number of window elements
integer :: CurFenState ! Current fenestration state
real(r64) :: DWX ! Window element width
real(r64) :: DWY ! Window element height
real(r64) :: WinElArea ! Window element area
real(r64) :: CosB ! Cosine of angle between ray and window outward normal
! window coordinates and vectors
real(r64) :: W1(3)
real(r64) :: W2(3)
real(r64) :: W3(3)
real(r64) :: W21(3)
real(r64) :: W23(3)
! window elements counters
! integer :: IX ! horizontal elements
! integer :: IY ! vertical elements
integer :: NReflSurf
! type(vector) :: HitPt ! surface hit point
! real(r64), dimension(3) :: RWin ! window element center point (same as centroid)
real(r64), dimension(3) :: WNorm ! unit vector from window (point towards outside)
integer :: NSky
integer :: NGnd
integer :: NReflected
integer :: IRay
integer :: iTrnRay
integer :: JSurf
integer :: iHit
integer :: TotHits
integer :: MaxTotHits ! maximal number of exterior surface hits for current window state
integer :: I, J
!real(r64) :: DotProd !Temporary variable for manipulating dot product .dot.
!real(r64) :: LeastHitDsq ! dist^2 from window element center to hit point
!real(r64) :: HitDsq
!real(r64), dimension(3) :: V !vector array
!real(r64), dimension(3) :: GroundHitPt ! Coordinates of point that ray hits ground (m)
real(r64) :: TransRSurf
integer :: curWinEl ! Counter for current window element
integer :: NBasis ! number of incident basis directions for current state
integer :: NTrnBasis ! number of outgoing basis directions for current state
! reference point variables
! real(r64), dimension(3) :: RefPoint ! reference point
real(r64), dimension(3) :: Ray ! vector along ray from window to reference point
real(r64), dimension(3) :: RayNorm ! unit vector along ray from window to reference point
real(r64) :: Dist ! distance between reference point and center of window element
real(r64) :: BestMatch ! temporary variable for storing best match when calculating reference point outgoing beam number
real(r64) :: temp
integer :: iPierc ! intersection flag = 1 (Yes); =0 (No)
real(r64), dimension(3) :: InterPoint ! Intersection point
! Position factor variables
real(r64) :: RR ! Distance from ref point to intersection of view vector
! and plane normal to view vector and window element (m)
real(r64) :: ASQ ! Square of distance from above intersection to window element (m2)
real(r64) :: YD ! Vertical displacement of window element wrt ref point
real(r64) :: XR ! Horizontal displacement ratio
real(r64) :: YR ! Vertical displacement ratio
real(r64) :: AZVIEW ! Azimuth of view vector
type(BSDFDaylghtPosition) :: elPos ! altitude and azimuth of intersection element
type(vector) :: Vec ! temporary vector variable
NumOfWinEl = NWX * NWY
DWX = Surface(IWin)%Width / NWX
DWY = Surface(IWin)%Height / NWY
AZVIEW = (ZoneDaylight(ZoneNum)%ViewAzimuthForGlare + Zone(ZoneNum)%RelNorth + BuildingAzimuth + BuildingRotationAppendixG) &
* DegToRadians
! Perform necessary calculations for window coordinates and vectors. This will be used to calculate centroids for
! each window element
W1 = 0.0d0
W2 = 0.0d0
W3 = 0.0d0
if (Surface(IWin)%Sides == 4) then
W3 = Surface(IWin)%Vertex(2)
W2 = Surface(IWin)%Vertex(3)
W1 = Surface(IWin)%Vertex(4)
else if (Surface(IWin)%Sides == 3) then
W3 = Surface(IWin)%Vertex(2)
W2 = Surface(IWin)%Vertex(3)
W1 = Surface(IWin)%Vertex(1)
end if
W21 = W1 - W2
W23 = W3 - W2
W21 = W21/Surface(IWin)%Height
W23 = W23/Surface(IWin)%Width
WNorm = Surface(IWin)%lcsz
WinElArea = DWX * DWY
if (Surface(IWin)%Sides == 3) then
WinElArea = WinElArea * SQRT(1.0d0 - DOT_PRODUCT(W21,W23)**2)
end if
if (CalledFrom == CalledForMapPoint) then
if (.not. allocated(ComplexWind(IWin)%IlluminanceMap)) then
allocate (ComplexWind(IWin)%IlluminanceMap(TotIllumMaps, NRefPts))
end if
call AllocateForCFSRefPointsGeometry(ComplexWind(IWin)%IlluminanceMap(MapNum, iRefPoint), NumOfWinEl)
else if (CalledFrom == CalledForRefPoint) then
if (.not. allocated(ComplexWind(IWin)%RefPoint)) then
allocate (ComplexWind(IWin)%RefPoint(NRefPts))
end if
call AllocateForCFSRefPointsGeometry(ComplexWind(IWin)%RefPoint(iRefPoint), NumOfWinEl)
end if
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! Allocation for each complex fenestration state reference points
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if (.not. allocated(ComplexWind(IWin)%DaylghtGeom)) then
allocate (ComplexWind(IWin)%DaylghtGeom(ComplexWind(IWin)%NumStates))
end if
! Calculation needs to be performed for each state
do CurFenState = 1, ComplexWind(IWin)%NumStates
NBasis = ComplexWind(IWin)%Geom(CurFenState)%Inc%NBasis
NTrnBasis = ComplexWind(IWin)%Geom(CurFenState)%Trn%NBasis
if (CalledFrom == CalledForMapPoint) then
if (TotIllumMaps > 0) then
! illuminance map for each state
if (.not. allocated(ComplexWind(IWin)%DaylghtGeom(CurFenState)%IlluminanceMap)) then
allocate (ComplexWind(IWin)%DaylghtGeom(CurFenState)%IlluminanceMap(TotIllumMaps, NRefPts))
end if
call AllocateForCFSRefPointsState(ComplexWind(IWin)%DaylghtGeom(CurFenState)%IlluminanceMap(MapNum, iRefPoint), &
NumOfWinEl, NBasis, NTrnBasis)
call InitializeCFSStateData(ComplexWind(IWin)%DaylghtGeom(CurFenState)%IlluminanceMap(MapNum, iRefPoint), &
ComplexWind(IWin)%IlluminanceMap(MapNum, iRefPoint), ZoneNum, iWin, RefPoint, curFenState, NBasis, NTrnBasis, AZVIEW, &
NWX, NWY, W2, W21, W23, DWX, DWY, WNorm, WinElArea, CalledFrom, MapNum)
end if
else if (CalledFrom == CalledForRefPoint) then
if (.not. allocated(ComplexWind(IWin)%DaylghtGeom(CurFenState)%RefPoint)) then
allocate (ComplexWind(IWin)%DaylghtGeom(CurFenState)%RefPoint(NRefPts))
end if
call AllocateForCFSRefPointsState(ComplexWind(IWin)%DaylghtGeom(CurFenState)%RefPoint(iRefPoint), NumOfWinEl, &
NBasis, NTrnBasis)
call InitializeCFSStateData(ComplexWind(IWin)%DaylghtGeom(CurFenState)%RefPoint(iRefPoint), &
ComplexWind(IWin)%RefPoint(iRefPoint), ZoneNum, iWin, RefPoint, curFenState, NBasis, NTrnBasis, AZVIEW, &
NWX, NWY, W2, W21, W23, DWX, DWY, WNorm, WinElArea, CalledFrom, MapNum)
end if
end do
END SUBROUTINE InitializeCFSDaylighting