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.
SUBROUTINE InitDaylightingDevices
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN May 2003
! MODIFIED PGE, Aug 2003: Added daylighting shelves.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes all daylighting device: TDD pipes and daylighting shelves.
! This is only called once at the beginning of the simulation under the BeginSimFlag.
! METHODOLOGY EMPLOYED:
! Daylighting and thermal variables are calculated. BeamTrans/COSAngle table is calculated.
! REFERENCES: na
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
USE DataHeatBalance, ONLY : IntGainTypeOf_DaylightingDeviceTubular
USE DataInterfaces
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS: na
! DERIVED TYPE DEFINITIONS:
TYPE TDDPipeStoredData
REAL(r64) :: AspectRatio = 0.0d0 ! Aspect ratio, length / diameter
REAL(r64) :: Reflectance = 0.0d0 ! Reflectance of surface
REAL(r64), DIMENSION(NumOfAngles) :: TransBeam = 0.0d0 ! Table of beam transmittance vs. cosine angle
END TYPE TDDPipeStoredData
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PipeNum ! TDD pipe object number
INTEGER :: StoredNum ! Stored TDD pipe object number
INTEGER :: AngleNum
INTEGER :: TZoneNum
INTEGER :: Loop
REAL(r64) :: Theta ! Angle of entry in degrees, 0 is parallel to pipe axis
REAL(r64) :: dTheta ! Angle increment
REAL(r64) :: Reflectance ! Visible or solar reflectance of surface
REAL(r64) :: SumTZoneLengths
LOGICAL :: Found
TYPE (TDDPipeStoredData), ALLOCATABLE, DIMENSION(:) :: TDDPipeStored
INTEGER :: ShelfNum ! Daylighting shelf object number
INTEGER :: ShelfSurf ! Daylighting shelf surface number
INTEGER :: WinSurf ! Window surface number
INTEGER :: NumStored = 0 ! Counter for number of pipes stored as they are calculated
LOGICAL :: ShelfReported=.false.
! FLOW:
! Initialize tubular daylighting devices (TDDs)
CALL GetTDDInput
IF (NumOfTDDPipes > 0) THEN
CALL DisplayString('Initializing Tubular Daylighting Devices')
! Setup COSAngle list for all TDDs
COSAngle(1) = 0.0d0
COSAngle(NumOfAngles) = 1.0d0
dTheta = 90.0d0 * DegToRadians / (NumOfAngles - 1.0d0)
Theta = 90.0d0 * DegToRadians
DO AngleNum = 2, NumOfAngles - 1
Theta = Theta - dTheta
COSAngle(AngleNum) = COS(Theta)
END DO ! AngleNum
ALLOCATE(TDDPipeStored(NumOfTDDPipes * 2))
DO PipeNum = 1, NumOfTDDPipes
! Initialize optical properties
TDDPipe(PipeNum)%AspectRatio = TDDPipe(PipeNum)%TotLength/TDDPipe(PipeNum)%Diameter
TDDPipe(PipeNum)%ReflectVis = 1.0d0 - Construct(TDDPipe(PipeNum)%Construction)%InsideAbsorpVis
TDDPipe(PipeNum)%ReflectSol = 1.0d0 - Construct(TDDPipe(PipeNum)%Construction)%InsideAbsorpSolar
! Calculate the beam transmittance table for visible and solar spectrum
! First time thru use the visible reflectance
Reflectance = TDDPipe(PipeNum)%ReflectVis
DO Loop = 1, 2
! For computational efficiency, search stored pipes to see if an identical pipe has already been calculated
Found = .FALSE.
DO StoredNum = 1, NumStored
IF (TDDPipeStored(StoredNum)%AspectRatio .NE. TDDPipe(PipeNum)%AspectRatio) CYCLE
IF (TDDPipeStored(StoredNum)%Reflectance .EQ. Reflectance) THEN
Found = .TRUE. ! StoredNum points to the matching TDDPipeStored
EXIT
END IF
END DO ! StoredNum
IF (.NOT. Found) THEN ! Not yet calculated
! Add a new pipe to TDDPipeStored
NumStored = NumStored + 1
TDDPipeStored(NumStored)%AspectRatio = TDDPipe(PipeNum)%AspectRatio
TDDPipeStored(NumStored)%Reflectance = Reflectance
! Set beam transmittances for 0 and 90 degrees
TDDPipeStored(NumStored)%TransBeam(1) = 0.0d0
TDDPipeStored(NumStored)%TransBeam(NumOfAngles) = 1.0d0
! Calculate intermediate beam transmittances between 0 and 90 degrees
Theta = 90.0d0 * DegToRadians
DO AngleNum = 2, NumOfAngles - 1
Theta = Theta - dTheta
TDDPipeStored(NumStored)%TransBeam(AngleNum) = CalcPipeTransBeam(Reflectance, TDDPipe(PipeNum)%AspectRatio, Theta)
END DO ! AngleNum
StoredNum = NumStored
END IF
! Assign stored values to TDDPipe
IF (Loop .EQ. 1) THEN ! Visible
TDDPipe(PipeNum)%PipeTransVisBeam = TDDPipeStored(StoredNum)%TransBeam
ELSE ! Solar
TDDPipe(PipeNum)%PipeTransSolBeam = TDDPipeStored(StoredNum)%TransBeam
END IF
! Second time thru use the solar reflectance
Reflectance = TDDPipe(PipeNum)%ReflectSol
END DO ! Loop
! Calculate the solar isotropic diffuse and horizon transmittances. These values are constant for a given TDD.
TDDPipe(PipeNum)%TransSolIso = CalcTDDTransSolIso(PipeNum)
TDDPipe(PipeNum)%TransSolHorizon = CalcTDDTransSolHorizon(PipeNum)
! Initialize thermal properties
SumTZoneLengths= 0.0d0
DO TZoneNum = 1, TDDPipe(PipeNum)%NumOfTZones
SumTZoneLengths = SumTZoneLengths + TDDPipe(PipeNum)%TZoneLength(TZoneNum)
CALL SetupZoneInternalGain(TDDPipe(PipeNum)%TZone(TZoneNum), &
'DaylightingDevice:Tubular', &
TDDPipe(PipeNum)%Name, &
IntGainTypeOf_DaylightingDeviceTubular, &
ConvectionGainRate = TDDPipe(PipeNum)%TZoneHeatGain(TZoneNum) )
END DO ! TZoneNum
TDDPipe(PipeNum)%ExtLength = TDDPipe(PipeNum)%TotLength - SumTZoneLengths
! Setup report variables: CurrentModuleObject='DaylightingDevice:Tubular'
CALL SetupOutputVariable('Tubular Daylighting Device Transmitted Solar Radiation Rate [W]', &
TDDPipe(PipeNum)%TransmittedSolar,'Zone','Average', TDDPipe(PipeNum)%Name)
CALL SetupOutputVariable('Tubular Daylighting Device Pipe Absorbed Solar Radiation Rate [W]', &
TDDPipe(PipeNum)%PipeAbsorbedSolar,'Zone','Average', TDDPipe(PipeNum)%Name)
CALL SetupOutputVariable('Tubular Daylighting Device Heat Gain Rate [W]', &
TDDPipe(PipeNum)%HeatGain,'Zone','Average', TDDPipe(PipeNum)%Name)
CALL SetupOutputVariable('Tubular Daylighting Device Heat Loss Rate [W]', &
TDDPipe(PipeNum)%HeatLoss,'Zone','Average', TDDPipe(PipeNum)%Name)
CALL SetupOutputVariable('Tubular Daylighting Device Beam Solar Transmittance []', &
TDDPipe(PipeNum)%TransSolBeam,'Zone','Average', TDDPipe(PipeNum)%Name)
CALL SetupOutputVariable('Tubular Daylighting Device Beam Visible Transmittance []', &
TDDPipe(PipeNum)%TransVisBeam,'Zone','Average', TDDPipe(PipeNum)%Name)
CALL SetupOutputVariable('Tubular Daylighting Device Diffuse Solar Transmittance []', &
TDDPipe(PipeNum)%TransSolDiff,'Zone','Average',TDDPipe(PipeNum)%Name)
CALL SetupOutputVariable('Tubular Daylighting Device Diffuse Visible Transmittance []', &
TDDPipe(PipeNum)%TransVisDiff,'Zone','Average',TDDPipe(PipeNum)%Name)
END DO ! PipeNum
DEALLOCATE(TDDPipeStored)
END IF
! Initialize daylighting shelves
CALL GetShelfInput
IF(NumOfShelf > 0) CALL DisplayString('Initializing Light Shelf Daylighting Devices')
DO ShelfNum = 1, NumOfShelf
WinSurf = Shelf(ShelfNum)%Window
ShelfSurf = Shelf(ShelfNum)%InSurf
IF (ShelfSurf > 0) THEN
! Double surface area so that both sides of the shelf are treated as internal mass
Surface(ShelfSurf)%Area = 2.0d0* Surface(ShelfSurf)%Area
END IF
ShelfSurf = Shelf(ShelfNum)%OutSurf
IF (ShelfSurf > 0) THEN
Shelf(ShelfNum)%OutReflectVis = 1.0d0 - Construct(Shelf(ShelfNum)%Construction)%OutsideAbsorpVis
Shelf(ShelfNum)%OutReflectSol = 1.0d0 - Construct(Shelf(ShelfNum)%Construction)%OutsideAbsorpSolar
IF (Shelf(ShelfNum)%ViewFactor < 0) CALL CalcViewFactorToShelf(ShelfNum)
IF (Shelf(ShelfNum)%ViewFactor + Surface(WinSurf)%ViewFactorSky + Surface(WinSurf)%ViewFactorGround > 1.0d0) THEN
CALL ShowWarningError('DaylightingDevice:Shelf = '//TRIM(Shelf(ShelfNum)%Name)// &
': Window view factors to sky ['//trim(RoundSigDigits(Surface(WinSurf)%ViewFactorSky,2))//'],')
CALL ShowContinueError('ground ['//trim(RoundSigDigits(Surface(WinSurf)%ViewFactorGround,2))// &
'], and outside shelf ['//trim(RoundSigDigits(Shelf(ShelfNum)%ViewFactor,2))//'] add up to > 1.0.')
ENDIF
! Report calculated view factor so that user knows what to make the view factor to ground
IF (.not. ShelfReported) THEN
Write(OutputFileInits,'(A)') &
'! <Shelf Details>,Name,View Factor to Outside Shelf,Window Name,Window View Factor to Sky,Window View Factor to Ground'
ShelfReported=.true.
ENDIF
Write(OutputFileInits,'(A)') trim(Shelf(ShelfNum)%Name)//','//trim(RoundSigDigits(Shelf(ShelfNum)%ViewFactor,2))//','// &
trim(Surface(WinSurf)%Name)//','//trim(RoundSigDigits(Surface(WinSurf)%ViewFactorSky,2))//','// &
trim(RoundSigDigits(Surface(WinSurf)%ViewFactorGround,2))
! CALL SetupOutputVariable('View Factor To Outside Shelf []', &
! Shelf(ShelfNum)%ViewFactor,'Zone','Average',Shelf(ShelfNum)%Name)
END IF
END DO
! Warning that if Calculate Solar Reflection From Exterior Surfaces = Yes in Building input, then
! solar reflection calculated from obstructions will not be used in daylighting shelf or tubular device
! calculation
IF(CalcSolRefl .AND. (NumOfTDDPipes > 0 .OR. NumOfShelf > 0)) THEN
CALL ShowWarningError('InitDaylightingDevices: Solar Distribution Model includes Solar Reflection calculations;')
CALL ShowContinueError('the resulting reflected solar values will not be used in the')
CALL ShowContinueError('DaylightingDevice:Shelf or DaylightingDevice:Tubular calculations.')
END IF
RETURN
END SUBROUTINE InitDaylightingDevices