Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | iWin | |||
integer, | intent(in) | :: | ZoneNum | |||
integer, | intent(in) | :: | iHour | |||
integer, | intent(in) | :: | LoopWin | |||
integer, | intent(in) | :: | iRefPoint | |||
integer, | intent(in) | :: | NumEl | |||
real(kind=r64), | intent(in) | :: | AZVIEW | |||
integer, | intent(in) | :: | CalledFrom | |||
integer, | intent(in), | optional | :: | MapNum | ||
real(kind=r64), | intent(in), | optional | dimension(:,:) | :: | MapWindowSolidAngAtRefPtWtd |
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 DayltgDirectSunDiskComplexFenestration(iWin, ZoneNum, iHour, loopwin, iRefPoint, NumEl, AZVIEW, CalledFrom, MapNum, &
MapWindowSolidAngAtRefPtWtd)
! SUBROUTINE INFORMATION:
! AUTHOR Simon Vidanovic
! DATE WRITTEN June 2013
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculate illuminance from sun disk for complex fenestration systems
! METHODOLOGY EMPLOYED: na
! REFERENCES:
!
! USE STATEMENTS:
implicit none ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
integer, intent(in) :: iWin ! Window index
integer, intent(in) :: ZoneNum ! Zone number
integer, intent(in) :: iHour ! Hour of day
integer, intent(in) :: LoopWin
integer, intent(in) :: CalledFrom ! indicate which type of routine called this routine
integer, intent(in) :: NumEl ! Total number of window elements
real(r64), intent(in) :: AZVIEW ! Azimuth of view vector in absolute coord system for
! glare calculation (radians)
integer, intent(in) :: iRefPoint
integer, intent(in), optional :: MapNum
real(r64), dimension(:,:), intent(in), optional :: MapWindowSolidAngAtRefPtWtd
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
integer :: CurCplxFenState
integer :: iConst
integer :: SolBmIndex
integer :: NTrnBasis
integer :: iTrnElem
real(r64) :: WindowSolidAngleDaylightPoint
real(r64) :: XR
real(r64) :: YR
real(r64) :: PosFac
real(r64) :: dirTrans
real(r64) :: LambdaTrn
real(r64) :: WinLumSunDisk ! window luminance from sun disk
real(r64) :: ELumSunDisk ! window illuminance from sun disk
real(r64) :: TransBeam ! transmittance of the beam for given direction
real(r64), dimension(3) :: V ! temporary vector
real(r64), dimension(3) :: RWin ! Window center
real(r64) :: RayZ ! z component of unit vector for outgoing direction
logical :: refPointIntersect
CurCplxFenState = SurfaceWindow(iWin)%ComplexFen%CurrentState
iConst = SurfaceWindow(iWin)%ComplexFen%State(CurCplxFenState)%Konst
SolBmIndex = ComplexWind(iWin)%Geom(CurCplxFenState)%SolBmIndex(iHour, timestep)
select case (CalledFrom)
case (CalledForRefPoint)
WindowSolidAngleDaylightPoint = SurfaceWindow(IWin)%SolidAngAtRefPtWtd(iRefPoint)
case (CalledForMapPoint)
WindowSolidAngleDaylightPoint = MapWindowSolidAngAtRefPtWtd(LoopWin, iRefPoint)
end select
if (WindowSolidAngleDaylightPoint < 1e-6) return
WinLumSunDisk = 0.0d0
ELumSunDisk = 0.0d0
NTrnBasis = ComplexWind(IWin)%Geom(CurCplxFenState)%Trn%NBasis
do iTrnElem = 1, NTrnBasis
! if ray from any part of the window can reach reference point
if (CalledFrom == CalledForRefPoint) then
refPointIntersect = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%RefPointIntersection(iTrnElem)
else
refPointIntersect = &
ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%RefPointIntersection(iTrnElem)
end if
if (refPointIntersect) then
if (CalledFrom == CalledForRefPoint) then
PosFac = ComplexWind(iWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%RefPtIntPosFac(iTrnElem)
else
PosFac = ComplexWind(iWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%RefPtIntPosFac(iTrnElem)
end if
RayZ = -ComplexWind(IWin)%Geom(CurCplxFenState)%sTrn(iTrnElem)%z
! Need to recalculate position factor for dominant direction in case of specular bsdf. Otherwise this will produce
! very inaccurate results because of position factor of the sun and bsdf pach can vary by lot
if (iTrnElem == SolBmIndex) then
XR = TAN(ABS(PIOVR2 - AZVIEW - THSUN) + 0.001d0)
YR = TAN(PHSUN + 0.001d0)
PosFac = DayltgGlarePositionFactor(XR,YR)
RayZ = SPHSUN
end if
if (PosFac /= 0.0d0) then
if (SolBmIndex > 0) then
dirTrans = Construct(iConst)%BSDFInput%VisFrtTrans(SolBmIndex, iTrnElem)
else
dirTrans = 0.0d0
end if
LambdaTrn = ComplexWind(iWin)%Geom(CurCplxFenState)%Trn%Lamda(iTrnElem)
V(1) = ComplexWind(IWin)%Geom(CurCplxFenState)%sTrn(iTrnElem)%x
V(2) = ComplexWind(IWin)%Geom(CurCplxFenState)%sTrn(iTrnElem)%y
V(3) = ComplexWind(IWin)%Geom(CurCplxFenState)%sTrn(iTrnElem)%z
V = -V
RWin(1) = Surface(iWin)%Centroid%x
RWin(2) = Surface(iWin)%Centroid%y
RWin(3) = Surface(iWin)%Centroid%z
call DayltgHitObstruction(iHour, iWin, RWin, V, TransBeam)
WinLumSunDisk = WinLumSunDisk + (14700.0d0 * SQRT(0.000068d0 * PosFac) * real(NumEl, r64) / &
WindowSolidAngleDaylightPoint**0.8d0) * dirTrans * LambdaTrn * TransBeam
ELumSunDisk = ELumSunDisk + RayZ * dirTrans * LambdaTrn * TransBeam
end if
end if
end do
AVWLSUdisk(1,iHour) = WinLumSunDisk
EDirSUDisk(1,iHour) = ELumSunDisk
END SUBROUTINE DayltgDirectSunDiskComplexFenestration