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 InitSurfaceHeatBalance ! Surface Heat Balance Initialization Manager
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN January 1998
! MODIFIED Nov. 1999, FCW,
! Move ComputeIntThermalAbsorpFactors
! so called every timestep
! Jan 2004, RJH
! Added calls to alternative daylighting analysis using DElight
! All modifications demarked with RJH (Rob Hitchcock)
! RJH, Jul 2004: add error handling for DElight calls
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for surface initializations within the
! heat balance.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger record keeping events.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataDaylighting, ONLY: ZoneDaylight, NoDaylighting, DetailedDaylighting, DElightDaylighting, &
mapResultsToReport, TotIllumMaps
USE DataDaylightingDevices, ONLY: NumOfTDDPipes
USE SolarShading
USE ConvectionCoefficients, ONLY : InitInteriorConvectionCoeffs
USE InternalHeatGains, ONLY : ManageInternalHeatGains
USE DataRoomAirModel, ONLY : IsZoneDV,IsZoneCV,IsZoneUI
USE HeatBalanceIntRadExchange, ONLY : CalcInteriorRadExchange
USE HeatBalFiniteDiffManager, ONLY : InitHeatBalFiniteDiff
USE DataSystemVariables, ONLY: GoodIOStatValue
USE DataGlobals , ONLY: AnyEnergyManagementSystemInModel
! RJH DElight Modification Begin
USE DElightManagerF
! RJH DElight Modification End
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64),PARAMETER :: Eps = 1.d-10 ! Small number
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ConstrNum ! Construction index
INTEGER :: NZ ! DO loop counter for zones
REAL(r64) :: QIC ! Intermediate calculation variable
REAL(r64) :: QOC ! Intermediate calculation variable
INTEGER :: SurfNum ! DO loop counter for surfaces
INTEGER :: Term ! DO loop counter for conduction equation terms
REAL(r64) :: TSC ! Intermediate calculation variable
INTEGER :: ZoneNum ! Counter for zone loop initialization
! RJH DElight Modification Begin
REAL(r64) :: dPowerReducFac ! Return value Electric Lighting Power Reduction Factor for current Zone and Timestep
REAL(r64) :: dHISKFFC ! double value for argument passing
REAL(r64) :: dHISUNFFC ! double value for argument passing
REAL(r64) :: dSOLCOS1 ! double value for argument passing
REAL(r64) :: dSOLCOS2 ! double value for argument passing
REAL(r64) :: dSOLCOS3 ! double value for argument passing
REAL(r64) :: dLatitude ! double value for argument passing
REAL(r64) :: dCloudFraction ! double value for argument passing
INTEGER :: iErrorFlag ! Error Flag for warning/errors returned from DElight
INTEGER, EXTERNAL :: GetNewUnitNumber ! External function to "get" a unit number
INTEGER :: iDElightErrorFile ! Unit number for reading DElight Error File (eplusout.delightdfdmp)
INTEGER :: iReadStatus ! Error File Read Status
CHARACTER(len=210) cErrorLine ! Each DElight Error line can be up to 210 characters long
CHARACTER(len=200) cErrorMsg ! Each DElight Error Message can be up to 200 characters long
LOGICAL :: bEndofErrFile ! End of Error File flag
INTEGER :: iDElightRefPt ! Reference Point number for reading DElight Dump File (eplusout.delighteldmp)
REAL(r64) :: dRefPtIllum ! tmp var for reading RefPt illuminance
! RJH DElight Modification End
logical, save :: firsttime=.true.
INTEGER :: MapNum
INTEGER :: iwriteStatus
LOGICAL :: errFlag
LOGICAL :: elOpened
! LOGICAL :: ShadowingSurf
! FLOW:
if (firsttime) CALL DisplayString('Initializing Outdoor environment for Surfaces')
! Initialize zone outdoor environmental variables
! Bulk Initialization for Temperatures & WindSpeed
! using the zone, modify the zone Dry/Wet BulbTemps
CALL SetOutBulbTempAt(NumOfZones, Zone(1:NumOfZones)%Centroid%Z, &
Zone(1:NumOfZones)%OutDryBulbTemp, Zone(1:NumOfZones)%OutWetBulbTemp, 'Zone')
CALL SetWindSpeedAt(NumOfZones, Zone(1:NumOfZones)%Centroid%Z, Zone(1:NumOfZones)%WindSpeed, 'Zone')
! DO ZoneNum = 1, NumOfZones
! Zone(ZoneNum)%WindSpeed = WindSpeedAt(Zone(ZoneNum)%Centroid%Z)
! END DO
! Initialize surface outdoor environmental variables
! Bulk Initialization for Temperatures & WindSpeed
! using the surface centroids, modify the surface Dry/Wet BulbTemps
CALL SetOutBulbTempAt(TotSurfaces, Surface(1:TotSurfaces)%Centroid%Z, &
Surface(1:TotSurfaces)%OutDryBulbTemp, Surface(1:TotSurfaces)%OutWetBulbTemp, 'Surface')
CALL SetWindSpeedAt(TotSurfaces, Surface(1:TotSurfaces)%Centroid%Z, Surface(1:TotSurfaces)%WindSpeed, 'Surface')
! DO SurfNum = 1, TotSurfaces
! IF (Surface(SurfNum)%ExtWind) Surface(SurfNum)%WindSpeed = WindSpeedAt(Surface(SurfNum)%Centroid%Z)
! END DO
IF (AnyEnergyManagementSystemInModel) THEN
DO SurfNum = 1, TotSurfaces
IF (Surface(SurfNum)%OutDryBulbTempEMSOverrideOn) THEN
Surface(SurfNum)%OutDryBulbTemp = Surface(SurfNum)%OutDryBulbTempEMSOverrideValue
ENDIF
IF (Surface(SurfNum)%OutWetBulbTempEMSOverrideOn) THEN
Surface(SurfNum)%OutWetBulbTemp = Surface(SurfNum)%OutWetBulbTempEMSOverrideValue
ENDIF
IF (Surface(SurfNum)%WindSpeedEMSOverrideOn) THEN
Surface(SurfNum)%WindSpeed = Surface(SurfNum)%WindSpeedEMSOverrideValue
ENDIF
ENDDO
ENDIF
! Do the Begin Simulation initializations
IF (BeginSimFlag) THEN
CALL AllocateSurfaceHeatBalArrays ! Allocate the Module Arrays before any inits take place
InterZoneWindow=ANY(Zone%HasInterZoneWindow)
ALLOCATE (IsZoneDV(NumOfZones))
IsZoneDV=.false.
ALLOCATE (IsZoneCV(NumOfZones))
IsZoneCV=.false.
ALLOCATE (IsZoneUI(NumOfZones))
IsZoneUI=.false.
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag) THEN
if (firsttime) CALL DisplayString('Initializing Temperature and Flux Histories')
CALL InitThermalAndFluxHistories ! Set initial temperature and flux histories
ENDIF
! There are no daily initializations done in this portion of the surface heat balance
! There are no hourly initializations done in this portion of the surface heat balance
IF (AnyEnergyManagementSystemInModel) THEN
CALL InitEMSControlledConstructions
CALL InitEMSControlledSurfaceProperties
ENDIF
! Need to be called each timestep in order to check if surface points to new construction (EMS) and if does then
! complex fenestration needs to be initialized for additional states
CALL TimestepInitComplexFenestration
! Calculate exterior-surface multipliers that account for anisotropy of
! sky radiance
IF (SunIsUp .AND. DifSolarRad > 0.0d0) THEN
CALL AnisoSkyViewFactors
ELSE
AnisoSkyMult = 0.0d0
ENDIF
! Set shading flag for exterior windows (except flags related to daylighting) and
! window construction (unshaded or shaded) to be used in heat balance calculation
if (firsttime) CALL DisplayString('Initializing Window Shading')
CALL WindowShadingManager
! Calculate factors that are used to determine how much long-wave radiation from internal
! gains is absorbed by interior surfaces
if (firsttime) CALL DisplayString('Computing Interior Absorption Factors')
CALL ComputeIntThermalAbsorpFactors
! Calculate factors for diffuse solar absorbed by room surfaces and interior shades
if (firsttime) CALL DisplayString('Computing Interior Diffuse Solar Absorption Factors')
CALL ComputeIntSWAbsorpFactors
! Calculate factors for exchange of diffuse solar between zones through interzone windows
if (firsttime) CALL DisplayString('Computing Interior Diffuse Solar Exchange through Interzone Windows')
CALL ComputeDifSolExcZonesWIZWindows(NumOfZones)
! For daylit zones, calculate interior daylight illuminance at reference points and
! simulate lighting control system to get overhead electric lighting reduction
! factor due to daylighting.
DO SurfNum = 1,TotSurfaces
IF(Surface(SurfNum)%Class == SurfaceClass_Window .AND. Surface(SurfNum)%ExtSolar) THEN
SurfaceWindow(SurfNum)%IllumFromWinAtRefPt1Rep = 0.0d0
SurfaceWindow(SurfNum)%IllumFromWinAtRefPt2Rep = 0.0d0
SurfaceWindow(SurfNum)%LumWinFromRefPt1Rep = 0.0d0
SurfaceWindow(SurfNum)%LumWinFromRefPt2Rep = 0.0d0
END IF
END DO
DO NZ=1,NumOfZones
! RJH DElight Modification Begin - Change Daylighting test to continue for Detailed AND DElight
IF (ZoneDaylight(NZ)%DaylightType == NoDaylighting) CYCLE
! RJH DElight Modification End - Change Daylighting test to continue for Detailed AND DElight
ZoneDaylight(NZ)%DaylIllumAtRefPt = 0.0d0
ZoneDaylight(NZ)%GlareIndexAtRefPt = 0.0d0
ZoneDaylight(NZ)%ZonePowerReductionFactor = 1.0d0
ZoneDaylight(NZ)%InterReflIllFrIntWins = 0.0d0 ! inter-reflected illuminance from interior windows
IF (ZoneDaylight(NZ)%TotalDaylRefPoints /= 0) THEN
ZoneDaylight(NZ)%TimeExceedingGlareIndexSPAtRefPt = 0.0d0
ZoneDaylight(NZ)%TimeExceedingDaylightIlluminanceSPAtRefPt = 0.0d0
ENDIF
IF(SunIsUp .AND. ZoneDaylight(NZ)%TotalDaylRefPoints /= 0) THEN
if (firsttime) CALL DisplayString('Computing Interior Daylighting Illumination')
CALL DayltgInteriorIllum(NZ)
IF (.not. DoingSizing) CALL DayltgInteriorMapIllum(NZ)
END IF
IF (SunIsUp .AND. NumOfTDDPipes > 0 .and. NZ == 1) THEN
if (firsttime) CALL DisplayString('Computing Interior Daylighting Illumination for TDD pipes')
CALL DayltgInteriorTDDIllum
END IF
! RJH DElight Modification Begin - Call to DElight electric lighting control subroutine
! Check if the sun is up and the current Thermal Zone hosts a Daylighting:DElight object
IF(SunIsUp .AND. ZoneDaylight(NZ)%TotalDElightRefPts /= 0) THEN
! Call DElight interior illuminance and electric lighting control subroutine
dPowerReducFac = 1.0d0
dHISKFFC = HISKF*LUX2FC
dHISUNFFC = HISUNF*LUX2FC
dSOLCOS1 = SOLCOS(1)
dSOLCOS2 = SOLCOS(2)
dSOLCOS3 = SOLCOS(3)
dLatitude = Latitude
dCloudFraction = CloudFraction
! Init Error Flag to 0 (no Warnings or Errors)
iErrorFlag = 0
CALL DElightElecLtgCtrl(LEN_TRIM(Zone(NZ)%Name), TRIM(Zone(NZ)%Name), dLatitude, &
dHISKFFC, dHISUNFFC, dCloudFraction, &
dSOLCOS1, dSOLCOS2, dSOLCOS3, &
dPowerReducFac, iErrorFlag)
! Check Error Flag for Warnings or Errors returning from DElight
! RJH 2008-03-07: If no warnings/errors then read refpt illuminances for standard output reporting
IF (iErrorFlag .NE. 0) THEN
! Open DElight Electric Lighting Error File for reading
iDElightErrorFile=GetNewUnitNumber()
! RJH 2008-03-07: open file with READWRITE
Open (unit=iDElightErrorFile, file='eplusout.delighteldmp', action='READWRITE', IOSTAT=iwriteStatus)
IF (iwriteStatus == 0) THEN
elOpened=.true.
ELSE
elOpened=.false.
ENDIF
! IF (iwriteStatus /= 0) THEN
! CALL ShowFatalError('InitSurfaceHeatBalance: Could not open file "eplusout.delighteldmp" for output (readwrite).')
! ENDIF
! Open (unit=iDElightErrorFile, file='eplusout.delighteldmp', action='READ')
! Sequentially read lines in DElight Electric Lighting Error File
! and process them using standard EPlus warning/error handling calls
bEndofErrFile=.false.
ireadStatus=0
DO WHILE (.not. bEndofErrFile .and. iwriteStatus==0 .and. ireadStatus==0)
READ(iDElightErrorFile,'(A)',IOSTAT=iReadStatus) cErrorLine
IF (iReadStatus < GoodIOStatValue) THEN
bEndofErrFile=.true.
CYCLE
ENDIF
! Is the current line a Warning message?
IF (cErrorLine(1:9) == 'WARNING: ') THEN
cErrorMsg = cErrorLine(10:210)
cErrorMsg = TRIM(cErrorMsg)
CALL ShowWarningError(cErrorMsg)
ENDIF
! Is the current line an Error message?
IF (cErrorLine(1:7) == 'ERROR: ') THEN
cErrorMsg = cErrorLine(8:210)
cErrorMsg = TRIM(cErrorMsg)
CALL ShowSevereError(cErrorMsg)
iErrorFlag = 1
ENDIF
ENDDO
! Close DElight Error File and delete
IF (elOpened) Close (unit=iDElightErrorFile, status='DELETE')
! If any DElight Error occurred then ShowFatalError to terminate
IF (iErrorFlag .GT. 0) THEN
CALL ShowFatalError("End of DElight Error Messages")
ENDIF
ELSE ! RJH 2008-03-07: No errors
! extract reference point illuminance values from DElight Electric Lighting dump file for reporting
! Open DElight Electric Lighting Dump File for reading
iDElightErrorFile=GetNewUnitNumber()
Open (unit=iDElightErrorFile, file='eplusout.delighteldmp', action='READWRITE', IOSTAT=iwriteStatus)
! IF (iwriteStatus /= 0) THEN
! CALL ShowFatalError('InitSurfaceHeatBalance: Could not open file "eplusout.delighteldmp" for output (readwrite).')
! ENDIF
IF (iwriteStatus == 0) THEN
elOpened=.true.
ELSE
elOpened=.false.
ENDIF
! Sequentially read lines in DElight Electric Lighting Dump File
! and extract refpt illuminances for standard EPlus output handling
bEndofErrFile=.false.
iDElightRefPt = 0
ireadStatus=0
DO WHILE (.not. bEndofErrFile .and. iwriteStatus==0 .and. ireadStatus==0)
READ(iDElightErrorFile, * ,IOSTAT=iReadStatus) dRefPtIllum
IF (iReadStatus < GoodIOStatValue) THEN
bEndofErrFile=.true.
CYCLE
ENDIF
! Increment refpt counter
iDElightRefPt = iDElightRefPt + 1
! Assure refpt index does not exceed number of refpts in this zone
IF (iDElightRefPt <= ZoneDaylight(NZ)%TotalDElightRefPts) THEN
ZoneDaylight(NZ)%DaylIllumAtRefPt(iDElightRefPt) = dRefPtIllum
ENDIF
ENDDO
! Close DElight Electric Lighting Dump File and delete
IF (elOpened) Close (unit=iDElightErrorFile, status='DELETE')
ENDIF
! Store the calculated total zone Power Reduction Factor due to DElight daylighting
! in the ZoneDaylight structure for later use
ZoneDaylight(NZ)%ZonePowerReductionFactor = dPowerReducFac
END IF
! RJH DElight Modification End - Call to DElight electric lighting control subroutine
END DO
errFlag=.false.
DO SurfNum = 1, TotSurfaces
IF(Surface(SurfNum)%Class /= SurfaceClass_Window) CYCLE
SurfaceWindow(SurfNum)%FracTimeShadingDeviceOn = 0.0d0
IF(SurfaceWindow(SurfNum)%ShadingFlag > 0) THEN
SurfaceWindow(SurfNum)%FracTimeShadingDeviceOn = 1.0d0
ELSE
SurfaceWindow(SurfNum)%FracTimeShadingDeviceOn = 0.0d0
END IF
END DO
CALL CalcInteriorRadExchange(TH(:,1,2),0,NetLWRadToSurf,calledfrom='Main')
IF(AirflowWindows) CALL WindowGapAirflowControl
! The order of these initializations is important currently. Over time we hope to
! take the appropriate parts of these inits to the other heat balance managers
if (firsttime) CALL DisplayString('Initializing Solar Heat Gains')
CALL InitSolarHeatGains
IF(SunIsUp .AND. (BeamSolarRad+GndSolarRad+DifSolarRad > 0.0d0)) THEN
DO NZ = 1,NumOfZones
IF(ZoneDaylight(NZ)%TotalDaylRefPoints > 0) THEN
IF(Zone(NZ)%HasInterZoneWindow) THEN
CALL DayltgInterReflIllFrIntWins(NZ)
CALL DayltgGlareWithIntWins(ZoneDaylight(NZ)%GlareIndexAtRefPt,NZ)
END IF
CALL DayltgElecLightingControl(NZ)
END IF
END DO
ELSEIF (mapResultsToReport .and. TimeStep == NumOfTimeStepInHour) THEN
DO MapNum = 1, TotIllumMaps
CALL ReportIllumMap(MapNum)
END DO
mapResultsToReport=.false.
END IF
if (firsttime) CALL DisplayString('Initializing Internal Heat Gains')
CALL ManageInternalHeatGains(InitOnly=.false.)
if (firsttime) CALL DisplayString('Initializing Interior Solar Distribution')
CALL InitIntSolarDistribution
if (firsttime) CALL DisplayString('Initializing Interior Convection Coefficients')
CALL InitInteriorConvectionCoeffs(TempSurfInTmp)
IF (BeginSimFlag) THEN ! Now's the time to report surfaces, if desired
! if (firsttime) CALL DisplayString('Reporting Surfaces')
! CALL ReportSurfaces
if (firsttime) CALL DisplayString('Gathering Information for Predefined Reporting')
CALL GatherForPredefinedReport
ENDIF
! Initialize the temperature history terms for conduction through the surfaces
IF (ANY(HeatTransferAlgosUsed == UseCondFD) ) THEN
CALL InitHeatBalFiniteDiff
ENDIF
CTFConstOutPart = 0.0d0
CTFConstInPart = 0.0d0
CTFTsrcConstPart = 0.0d0
DO SurfNum = 1, TotSurfaces ! Loop through all surfaces...
IF (.NOT. Surface(SurfNum)%HeatTransSurf) CYCLE ! Skip non-heat transfer surfaces
IF (Surface(SurfNum)%HeatTransferAlgorithm /= HeatTransferModel_CTF .AND. &
Surface(SurfNum)%HeatTransferAlgorithm /= HeatTransferModel_EMPD) CYCLE
IF(Surface(SurfNum)%Class == SurfaceClass_Window) CYCLE
! Outside surface temp of "normal" windows not needed in Window5 calculation approach
! Window layer temperatures are calculated in CalcHeatBalanceInsideSurf
ConstrNum = Surface(SurfNum)%Construction
IF (Construct(ConstrNum)%NumCTFTerms > 1) THEN ! COMPUTE CONSTANT PORTION OF CONDUCTIVE FLUXES.
QIC = 0.0D0
QOC = 0.0D0
TSC = 0.0D0
DO Term = 1, Construct(ConstrNum)%NumCTFTerms
! Sign convention for the various terms in the following two equations
! is based on the form of the Conduction Transfer Function equation
! given by:
! Qin,now = (Sum of)(Y Tout) - (Sum of)(Z Tin) + (Sum of)(F Qin,old)
! Qout,now = (Sum of)(X Tout) - (Sum of)(Y Tin) + (Sum of)(F Qout,old)
! In both equations, flux is positive from outside to inside.
QIC = QIC + Construct(ConstrNum)%CTFCross(Term) *TH(SurfNum,Term+1,1) &
- Construct(ConstrNum)%CTFInside(Term)*TH(SurfNum,Term+1,2) &
+ Construct(ConstrNum)%CTFFlux(Term) *QH(SurfNum,Term+1,2)
QOC = QOC + Construct(ConstrNum)%CTFOutside(Term)*TH(SurfNum,Term+1,1) &
- Construct(ConstrNum)%CTFCross(Term) *TH(SurfNum,Term+1,2) &
+ Construct(ConstrNum)%CTFFlux(Term) *QH(SurfNum,Term+1,1)
IF (Construct(ConstrNum)%SourceSinkPresent) THEN
QIC = QIC + Construct(ConstrNum)%CTFSourceIn(Term) *QsrcHist(SurfNum,Term+1)
QOC = QOC + Construct(ConstrNum)%CTFSourceOut(Term)*QsrcHist(SurfNum,Term+1)
TSC = TSC + Construct(ConstrNum)%CTFTSourceOut(Term)*TH(SurfNum,Term+1,1) &
+ Construct(ConstrNum)%CTFTSourceIn(Term) *TH(SurfNum,Term+1,2) &
+ Construct(ConstrNum)%CTFTSourceQ(Term) *QsrcHist(SurfNum,Term+1) &
+ Construct(ConstrNum)%CTFFlux(Term) *TsrcHist(SurfNum,Term+1)
END IF
END DO
CTFConstOutPart(SurfNum) = QOC
CTFConstInPart(SurfNum) = QIC
CTFTsrcConstPart(SurfNum) = TSC
ELSE ! Number of CTF Terms = 1-->Resistance only constructions have no history terms.
CTFConstOutPart(SurfNum) = 0.0d0
CTFConstInPart(SurfNum) = 0.0d0
CTFTsrcConstPart(SurfNum) = 0.0d0
END IF
END DO ! ...end of surfaces DO loop for initializing temperature history terms for the surface heat balances
! Zero out all of the radiant system heat balance coefficient arrays
RadSysTiHBConstCoef = 0.0d0
RadSysTiHBToutCoef = 0.0d0
RadSysTiHBQsrcCoef = 0.0d0
RadSysToHBConstCoef = 0.0d0
RadSysToHBTinCoef = 0.0d0
RadSysToHBQsrcCoef = 0.0d0
QRadSysSource = 0.0D0
QPVSysSource = 0.0d0
QHTRadSysSurf = 0.0D0
QHWBaseboardSurf = 0.0D0
QSteamBaseboardSurf = 0.0D0
QElecBaseboardSurf = 0.0D0
IF (ZoneSizingCalc) CALL GatherComponentLoadsSurfAbsFact
if (firsttime) CALL DisplayString('Completed Initializing Surface Heat Balance')
firsttime=.false.
RETURN
END SUBROUTINE InitSurfaceHeatBalance