Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in), | DIMENSION(3) | :: | GroundHitPt | ||
integer, | intent(in) | :: | AltSteps | |||
integer, | intent(in) | :: | AzimSteps |
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.
REAL(r64) FUNCTION CalcObstrMultiplier(GroundHitPt, AltSteps, AzimSteps)
! SUBROUTINE INFORMATION:
! AUTHOR Simon Vidanovic
! DATE WRITTEN April 2013, refactor from legacy code by Fred Winklemann
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! collect code to do obstruction multiplier from ground point
! METHODOLOGY EMPLOYED:
! Send rays upward from hit point and see which ones are unobstructed and so go to sky.
! Divide hemisphere centered at ground hit point into elements of altitude Phi and
! azimuth Theta and create upward-going ground ray unit vector at each Phi,Theta pair.
! Phi = 0 at the horizon; Phi = Pi/2 at the zenith.
! REFERENCES:
! <>
! USE STATEMENTS:
IMPLICIT NONE
REAL(r64), DIMENSION(3), INTENT(IN) :: GroundHitPt ! Coordinates of point that ray hits ground (m)
INTEGER, INTENT(IN) :: AltSteps ! Number of steps in altitude angle for solar reflection calc
INTEGER, INTENT(IN) :: AzimSteps ! Number of steps in azimuth angle of solar reflection calc
REAL(r64), DIMENSION(3) :: URay ! Unit vector in (Phi,Theta) direction
REAL(r64) :: DPhi ! Phi increment (radians)
REAL(r64) :: DTheta ! Theta increment (radians)
REAL(r64) :: SkyGndUnObs ! Unobstructed sky irradiance at a ground point
REAL(r64) :: SkyGndObs ! Obstructed sky irradiance at a ground point
INTEGER :: IPhi ! Phi index
REAL(r64) :: Phi ! Altitude angle of ray from a ground point (radians)
REAL(r64) :: SPhi ! Sin of Phi
REAL(r64) :: CPhi ! cos of Phi
INTEGER :: ITheta !Theta index
REAL(r64) :: Theta ! Azimuth angle of ray from a ground point (radians)
REAL(r64) :: CosIncAngURay ! Cosine of incidence angle of URay on ground plane
REAL(r64) :: dOmegaGnd ! Solid angle element of ray from ground point (steradians)
REAL(r64) :: IncAngSolidAngFac ! CosIncAngURay*dOmegaGnd/Pi
INTEGER :: IHitObs ! 1 if obstruction is hit; 0 otherwise
INTEGER :: ObsSurfNum ! Surface number of obstruction
REAL(r64), DIMENSION(3) :: ObsHitPt ! Coordinates of hit point on an obstruction (m)
DPhi = PiOvr2 / (AltSteps/2.d0)
DTheta = Pi / AzimSteps
SkyGndObs = 0.0d0
SkyGndUnObs = 0.0d0
! Altitude loop
DO IPhi = 1,(AltSteps/2)
Phi = (IPhi - 0.5d0) * DPhi
SPhi = SIN(Phi)
CPhi = COS(Phi)
! Third component of ground ray unit vector in (Theta,Phi) direction
URay(3) = SPhi
dOmegaGnd = CPhi * DTheta * DPhi
! Cosine of angle of incidence of ground ray on ground plane
CosIncAngURay = SPhi
IncAngSolidAngFac = CosIncAngURay*dOmegaGnd/Pi
! Azimuth loop
DO ITheta = 1,2*AzimSteps
Theta = (ITheta - 0.5d0) * DTheta
URay(1) = CPhi * COS(Theta)
URay(2) = CPhi * SIN(Theta)
SkyGndUnObs = SkyGndUnObs + IncAngSolidAngFac
! Does this ground ray hit an obstruction?
IHitObs = 0
DO ObsSurfNum = 1, TotSurfaces
IF(.NOT.Surface(ObsSurfNum)%ShadowSurfPossibleObstruction) CYCLE
CALL DayltgPierceSurface(ObsSurfNum,GroundHitPt,URay,IHitObs,ObsHitPt)
IF(IHitObs > 0) EXIT
END DO
IF(IHitObs > 0) CYCLE ! Obstruction hit
! Sky is hit
SkyGndObs = SkyGndObs + IncAngSolidAngFac
END DO ! End of azimuth loop
END DO ! End of altitude loop
! in case ground point is surrounded by obstructions (SkyGndUnObs == 0), then multiplier will be equal to zero
! This should not happen anyway because in that case ray would not be able to reach ground point
CalcObstrMultiplier = 0.0d0
IF (SkyGndUnObs /= 0.0d0) THEN
CalcObstrMultiplier = SkyGndObs / SkyGndUnObs
END IF
RETURN
END FUNCTION CalcObstrMultiplier