Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(out), | DIMENSION(3) | :: | SunDirectionCosines |
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 DetermineSunUpDown(SunDirectionCosines)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN 1999
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine determines if the sun is up or down for the current
! hour/timestep.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Sun routines from IBLAST, authored by Walton.
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(OUT), DIMENSION(3) :: SunDirectionCosines
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) H ! Hour angle (before noon = +)
REAL(r64) SinAltitude,SolarAltitude,SolarAzimuth,SolarZenith
REAL(r64) CosAzimuth,CosZenith
! REAL(r64) HAngle
! COMPUTE THE HOUR ANGLE
IF (NumOfTimeStepInHour /= 1) THEN
HrAngle = (15.d0*(12.d0-(CurrentTime+TodayVariables%EquationOfTime))+(TimeZoneMeridian-Longitude))
ELSE
HrAngle = (15.d0*(12.d0-((CurrentTime+TS1TimeOffset)+TodayVariables%EquationOfTime))+(TimeZoneMeridian-Longitude))
ENDIF
H=HrAngle*DegToRadians
! Compute the Cosine of the Solar Zenith (Altitude) Angle.
CosZenith=SinLatitude*TodayVariables%SinSolarDeclinAngle+CosLatitude*TodayVariables%CosSolarDeclinAngle*COS(H)
SolarZenith=ACOS(CosZenith)
SinAltitude=CosLatitude*TodayVariables%CosSolarDeclinAngle*COS(H)+SinLatitude*TodayVariables%SinSolarDeclinAngle
SolarAltitude=ASIN(SinAltitude)
CosAzimuth=-(SinLatitude*CosZenith-TodayVariables%SinSolarDeclinAngle)/(CosLatitude*SIN(SolarZenith))
! Following because above can yield invalid cos value. (e.g. at south pole)
CosAzimuth=MAX(CosAzimuth,-1.0d0)
CosAzimuth=MIN(1.0d0,CosAzimuth)
SolarAzimuth=ACOS(CosAzimuth)
SolarAltitudeAngle=SolarAltitude/DegToRadians
SolarAzimuthAngle=SolarAzimuth/DegToRadians
IF (HrAngle < 0.0d0) THEN
SolarAzimuthAngle=360.d0-SolarAzimuthAngle
ENDIF
SunDirectionCosines(3) = CosZenith
IF (CosZenith < SunIsUpValue) THEN
SunIsUp=.false.
SunDirectionCosines(2)=0.0d0
SunDirectionCosines(1)=0.0d0
ELSE
SunIsUp=.true.
SunDirectionCosines(2) = TodayVariables%SinSolarDeclinAngle*CosLatitude &
- TodayVariables%CosSolarDeclinAngle*SinLatitude*COS(H)
SunDirectionCosines(1) = TodayVariables%CosSolarDeclinAngle*SIN(H)
ENDIF
RETURN
END SUBROUTINE DetermineSunUpDown