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.
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 PerformSolarCalculations
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN July 1999
! MODIFIED Sept 2003, FCW: add calls to CalcBeamSolDiffuseReflFactors and
! CalcBeamSolSpecularReflFactors
! Jan 2004, FCW: call CalcDayltgCoefficients if storm window status on
! any window has changed
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine determines if new solar/shading calculations need
! to be performed and calls the proper routines to do the job.
! METHODOLOGY EMPLOYED:
! Users are allowed to enter a value for number of days in each period that
! will be used for calculating solar. (Later, this could be more complicated as
! in allowing a number of days in a month or something). Using this value or the
! default (20 days) if nothing is entered by the user, the routine will use the
! number of days left to determine if a new set of calculations should be done.
! The calculations use the average of "equation of time" and "solar declination"
! to perform the calculations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DaylightingManager, ONLY: CalcDayltgCoefficients, TotWindowsWithDayl
USE DataSystemVariables, ONLY: DetailedSolarTimestepIntegration
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) SumDec
REAL(r64) SumET
REAL(r64) AvgEqOfTime
REAL(r64) AvgSinSolarDeclin
REAL(r64) AvgCosSolarDeclin
INTEGER PerDayOfYear
INTEGER Count
REAL(r64) SinDec
REAL(r64) EqTime
!not used INTEGER SurfNum
! Calculate sky diffuse shading
IF(BeginSimFlag) THEN
CalcSkyDifShading = .TRUE.
CALL SkyDifSolarShading ! Calculate factors for shading of sky diffuse solar
CalcSkyDifShading = .FALSE.
END IF
IF (BeginEnvrnFlag) THEN
ShadowingDaysLeft = 0
ENDIF
IF (ShadowingDaysLeft <= 0 .OR. DetailedSolarTimestepIntegration) THEN
IF (.NOT. DetailedSolarTimestepIntegration) THEN
! Perform calculations.
ShadowingDaysLeft=ShadowingCalcFrequency
IF (DayOfSim + ShadowingDaysLeft > NumOfDayInEnvrn) THEN
ShadowingDaysLeft=NumOfDayInEnvrn-DayOfSim+1
ENDIF
! Calculate average Equation of Time, Declination Angle for this period
IF (.not. WarmUpFlag) THEN
CALL DisplayString('Updating Shadowing Calculations, Start Date='//CurMnDy)
DisplayPerfSimulationFlag=.true.
ENDIF
PerDayOfYear=DayOfYear
SumDec=0.0d0
SumET=0.0d0
DO Count=1,ShadowingDaysLeft
CALL Sun3(PerDayOfYear,SinDec,EqTime)
SumDec=SumDec+SinDec
SumET=SumET+EqTime
PerDayOfYear=PerDayOfYear+1
ENDDO
! Compute Period Values
AvgSinSolarDeclin=SumDec/REAL(ShadowingDaysLeft,r64)
AvgCosSolarDeclin=SQRT(1.0d0-AvgSinSolarDeclin**2)
AvgEqOfTime=SumET/REAL(ShadowingDaysLeft,r64)
ELSE
CALL Sun3(DayOfYear,AvgSinSolarDeclin,AvgEqOfTime)
AvgCosSolarDeclin=SQRT(1.0d0-AvgSinSolarDeclin**2)
ENDIF
CALL CalcPerSolarBeam(AvgEqOfTime,AvgSinSolarDeclin,AvgCosSolarDeclin)
! Calculate factors for solar reflection
IF(CalcSolRefl) THEN
CALL CalcBeamSolDiffuseReflFactors
CALL CalcBeamSolSpecularReflFactors
IF(BeginSimFlag) CALL CalcSkySolDiffuseReflFactors
END IF
! Calculate daylighting coefficients
CALL CalcDayltgCoefficients
ENDIF
IF (.not. WarmUpFlag) THEN
ShadowingDaysLeft=ShadowingDaysLeft-1
ENDIF
! Recalculate daylighting coefficients if storm window has been added
! or removed from one or more windows at beginning of day
IF(TotWindowsWithDayl > 0 .AND. .not.BeginSimFlag .AND. &
.not.BeginEnvrnFlag .AND. .not.WarmupFlag .AND. TotStormWin > 0 .AND. StormWinChangeThisDay) THEN
CALL CalcDayltgCoefficients
END IF
RETURN
END SUBROUTINE PerformSolarCalculations