Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | IWIN | |||
integer, | intent(in) | :: | WinEl | |||
integer, | intent(in) | :: | NBasis | |||
integer, | intent(in) | :: | IHR | |||
integer, | intent(in) | :: | iRefPoint | |||
real(kind=r64), | intent(out), | dimension(NBasis, 4) | :: | ElementLuminanceSky | ||
real(kind=r64), | intent(out), | dimension(NBasis) | :: | ElementLuminanceSun | ||
real(kind=r64), | intent(out), | dimension(NBasis) | :: | ElementLuminanceSunDisk | ||
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 ComplexFenestrationLuminances(IWIN, WinEl, NBasis, IHR, iRefPoint, ElementLuminanceSky, ElementLuminanceSun, &
ElementLuminanceSunDisk, CalledFrom, MapNum)
! SUBROUTINE INFORMATION:
! AUTHOR Simon Vidanovic
! DATE WRITTEN June 2013
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
!
! METHODOLOGY EMPLOYED: na
! REFERENCES:
!
! USE STATEMENTS:
implicit none ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
integer, intent(in) :: IWIN
integer, intent(in) :: WinEl
integer, intent(in) :: NBasis
integer, intent(in) :: IHR
integer, intent(in) :: iRefPoint
real(r64), dimension(NBasis, 4), intent(out) :: ElementLuminanceSky ! sky related luminance at window element (exterior side)
real(r64), dimension(NBasis), intent(out) :: ElementLuminanceSun ! sun related luminance at window element (exterior side),
! exluding beam
real(r64), dimension(NBasis), intent(out) :: ElementLuminanceSunDisk ! sun related luminance at window element (exterior side),
! due to sun beam
integer, intent(in) :: CalledFrom
integer, intent(in), optional :: MapNum
integer :: iIncElem
integer :: iSky
integer :: SolBmIndex
real(r64) :: LambdaInc
real(r64) :: Altitude
real(r64) :: Azimuth
! real(r64) :: CurCplxFenState
integer :: CurCplxFenState
real(r64) :: SunObstrMultiplier ! sun obstruction multiplier used to determine if sun hit the ground point
real(r64) :: ObstrTrans ! product of all surface transmittances intersecting incoming beam
real(r64) :: COSIncSun ! cosine of the Sun incidence angle
real(r64) :: BeamObstrMultiplier ! beam obstruction multiplier in case incoming beam is from the ground
integer :: ObsSurfNum ! Obstruction surface number
integer :: iHitObs ! = 1 if obstruction is hit, = 0 otherwise
real(r64) :: ObsHitPt(3) ! Coordinates of hit point on an obstruction (m)
real(r64) :: GroundHitPt(3) ! Coordinates of point that ray from window center hits the ground (m)
integer :: NRefl ! number of exterior obstructions
integer :: iReflElem ! incoming direction blocking surfaces element counter
integer :: iReflElemIndex ! reflection element index
integer :: NGnd ! number of ground elements
integer :: iGndElem ! ground elements counter
integer :: iGndElemIndex ! ground element index
CurCplxFenState = SurfaceWindow(IWin)%ComplexFen%CurrentState
! Calculate luminance from sky and sun excluding exterior obstruction transmittances and obstruction multipliers
SolBmIndex = ComplexWind(IWin)%Geom(CurCplxFenState)%SolBmIndex(IHR, timestep)
do iIncElem = 1, NBasis
LambdaInc = ComplexWind(IWin)%Geom(CurCplxFenState)%Inc%Lamda(iIncElem)
!COSB = ComplexWind(IWin)%Geom(CurCplxFenState)%CosInc(iIncElem)
!DA = ComplexWind(IWin)%Geom(CurCplxFenState)%DAInc(iIncElem)
Altitude = ComplexWind(IWin)%Geom(CurCplxFenState)%pInc(iIncElem)%Altitude
Azimuth = ComplexWind(IWin)%Geom(CurCplxFenState)%pInc(iIncElem)%Azimuth
if (Altitude > 0.0d0) then
! Ray from sky element
do iSky = 1, 4
ElementLuminanceSky(iIncElem, iSky) = DayltgSkyLuminance(iSky, Azimuth, Altitude) * LambdaInc
end do
else if (Altitude < 0.0d0) then
! Ray from ground element
! BeamObstrMultiplier = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%GndObstrMultiplier(WinEl, iIncElem)
do iSky = 1, 4
ElementLuminanceSky(iIncElem, iSky) = GILSK(iSky,IHR) * GndReflectanceForDayltg / PI * LambdaInc
end do
ElementLuminanceSun(iIncElem) = GILSU(IHR) * GndReflectanceForDayltg / PI * LambdaInc
else
! Ray from the element which is half sky and half ground
do iSky = 1, 4
! in this case half of the pach is coming from the sky and half from the ground
ElementLuminanceSky(iIncElem, iSky) = 0.5 * DayltgSkyLuminance(iSky, Azimuth, Altitude) * LambdaInc
ElementLuminanceSky(iIncElem, iSky) = ElementLuminanceSky(iIncElem, iSky) + &
0.5 * GILSK(iSky,IHR) * GndReflectanceForDayltg / PI * LambdaInc
end do
ElementLuminanceSun(iIncElem) = 0.5 * GILSU(IHR) * GndReflectanceForDayltg / PI * LambdaInc
end if
! Sun beam calculations
if ((SolBmIndex == iIncElem).and.(SunLitFracHR(IWin,IHR) > 0.0d0)) then
ElementLuminanceSunDisk(iIncElem) = 1.0d0
end if
end do
! add exterior obstructions transmittances to calculated luminances
if (CalledFrom == CalledForRefPoint) then
NRefl = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%NReflSurf(WinEl)
else
NRefl = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%NReflSurf(WinEl)
end if
do iReflElem = 1, NRefl
if (CalledFrom == CalledForRefPoint) then
ObstrTrans = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%TransOutSurf(WinEl, iReflElem)
iReflElemIndex = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%RefSurfIndex(WinEl, iReflElem)
else
ObstrTrans = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%TransOutSurf(WinEl, iReflElem)
iReflElemIndex = &
ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%RefSurfIndex(WinEl, iReflElem)
end if
do iSky = 1, 4
ElementLuminanceSky(iReflElemIndex, iSky) = ElementLuminanceSky(iReflElemIndex, iSky) * ObstrTrans
end do
ElementLuminanceSun(iReflElemIndex) = ElementLuminanceSun(iReflElemIndex) * ObstrTrans
ElementLuminanceSunDisk(iReflElemIndex) = ElementLuminanceSunDisk(iReflElemIndex) * ObstrTrans
end do
! add exterior ground element obstruction multipliers to calculated luminances. For sun reflection, calculate if
! sun reaches the ground for that point
if (CalledFrom == CalledForRefPoint) then
NGnd = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%NGnd(WinEl)
else
NGnd = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%NGnd(WinEl)
end if
do iGndElem = 1, NGnd
! case for sky elements. Integration is done over upper ground hemisphere to determine how many obstructions
! were hit in the process
if (CalledFrom == CalledForRefPoint) then
BeamObstrMultiplier = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%GndObstrMultiplier(WinEl, iGndElem)
iGndElemIndex = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%GndIndex(WinEl, iGndElem)
else
BeamObstrMultiplier = &
ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%GndObstrMultiplier(WinEl, iGndElem)
iGndElemIndex = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%GndIndex(WinEl, iGndElem)
end if
do iSky = 1, 4
ElementLuminanceSky(iGndElemIndex, iSky) = ElementLuminanceSky(iGndElemIndex, iSky) * BeamObstrMultiplier
end do
! direct sun disk reflect off the ground
SunObstrMultiplier = 1.0d0
if (CalcSolRefl) then
! Sun reaches ground point if vector from this point to the sun is unobstructed
iHitObs = 0
do ObsSurfNum = 1, TotSurfaces
if (.NOT.Surface(ObsSurfNum)%ShadowSurfPossibleObstruction) cycle
if (CalledFrom == CalledForRefPoint) then
GroundHitPt(1) = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%GndPt(WinEl, iGndElem)%x
GroundHitPt(2) = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%GndPt(WinEl, iGndElem)%y
GroundHitPt(3) = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%RefPoint(iRefPoint)%GndPt(WinEl, iGndElem)%z
else
GroundHitPt(1) = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%GndPt(WinEl, iGndElem)%x
GroundHitPt(2) = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%GndPt(WinEl, iGndElem)%y
GroundHitPt(3) = ComplexWind(IWin)%DaylghtGeom(CurCplxFenState)%IlluminanceMap(MapNum, iRefPoint)%GndPt(WinEl, iGndElem)%z
end if
call DayltgPierceSurface(ObsSurfNum,GroundHitPt,SunCosHr(1:3,IHr),iHitObs,ObsHitPt)
if (iHitObs > 0) exit
end do
if (iHitObs > 0) SunObstrMultiplier = 0.0d0
end if
ElementLuminanceSun(iGndElemIndex) = ElementLuminanceSun(iGndElemIndex) * SunObstrMultiplier
end do
RETURN
END SUBROUTINE ComplexFenestrationLuminances