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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in), | DIMENSION(:) | :: | SurfaceTemp | ||
integer, | intent(in) | :: | SurfIterations | |||
real(kind=r64), | intent(inout), | DIMENSION(:) | :: | NetLWRadToSurf | ||
integer, | intent(in), | optional | :: | ZoneToResimulate | ||
character(len=*), | optional | :: | calledfrom |
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 CalcInteriorRadExchange(SurfaceTemp,SurfIterations,NetLWRadToSurf,ZoneToResimulate,calledfrom)
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN September 2000
! MODIFIED 6/18/01, FCW: calculate IR on windows
! Jan 2002, FCW: add blinds with movable slats
! Sep 2011 LKL/BG - resimulate only zones needing it for Radiant systems
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Determines the interior radiant exchange between surfaces using
! Hottel's ScriptF method for the grey interchange between surfaces
! in an enclosure.
! METHODOLOGY EMPLOYED:
! See reference
! REFERENCES:
! Hottel, H. C. and A. F. Sarofim, Radiative Transfer, Ch 3, McGraw Hill, 1967.
! USE STATEMENTS:
USE General, ONLY: InterpSlatAng ! Function for slat angle interpolation
USE DataTimings
USE WindowEquivalentLayer, ONLY: EQLWindowInsideEffectiveEmiss
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENTS:
REAL(r64), DIMENSION(:), INTENT(IN) :: SurfaceTemp ! Current surface temperatures
INTEGER, INTENT(IN) :: SurfIterations ! Number of iterations in calling subroutine
REAL(r64), DIMENSION(:), INTENT(INOUT) :: NetLWRadToSurf ! Net long wavelength radiant exchange from other surfaces
INTEGER, INTENT(IN), OPTIONAL :: ZoneToResimulate ! if passed in, then only calculate for this zone
character(len=*), optional :: calledfrom
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: StefanBoltzmannConst = 5.6697d-8 ! Stefan-Boltzmann constant in W/(m2*K4)
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: FirstTime = .TRUE. ! Logical flag for one-time initializations
INTEGER :: RecSurfNum ! Counter within DO loop (refers to main surface derived type index) RECEIVING SURFACE
INTEGER :: RecZoneSurfNum ! DO loop counter for receiving surface within a zone (local derived type arrays)
INTEGER :: SendSurfNum ! Counter within DO loop (refers to main surface derived type index) SENDING SURFACE
INTEGER :: SendZoneSurfNum ! DO loop counter for sending surfaces within a zone (local derived type arrays)
INTEGER :: ZoneNum ! DO loop counter for zones
INTEGER :: ConstrNumRec ! Receiving surface construction number
INTEGER :: ConstrNumSend ! Sending surface construction number
REAL(r64) :: RecSurfTemp ! Receiving surface temperature (C)
REAL(r64) :: SendSurfTemp ! Sending surface temperature (C)
REAL(r64) :: RecSurfEmiss ! Inside surface emissivity
INTEGER :: ZoneSurfNum ! Runs from 1 to number of surfaces in zone
INTEGER :: SurfNum ! Surface number
INTEGER :: ConstrNum ! Construction number
LOGICAL :: IntShadeOrBlindStatusChanged ! True if status of interior shade or blind on at least
! one window in a zone has changed from previous time step
INTEGER :: ShadeFlag ! Window shading status current time step
INTEGER :: ShadeFlagPrev ! Window shading status previous time step
CHARACTER(len=158) :: tdstring
!variables added as part of strategy to reduce calculation time - Glazer 2011-04-22
REAL(r64) :: SendSurfTempInKTo4th ! Sending surface temperature in K to 4th power
REAL(r64) :: RecSurfTempInKTo4th ! Receiving surface temperature in K to 4th power
REAL(r64),DIMENSION(:),ALLOCATABLE, SAVE :: SendSurfaceTempInKto4thPrecalc
! FLOW:
#ifdef EP_Detailed_Timings
CALL epStartTime('CalcInteriorRadExchange=')
#endif
IF (FirstTime) THEN
CALL InitInteriorRadExchange
#ifdef EP_HBIRE_SEQ
ALLOCATE(SendSurfaceTempInKto4thPrecalc(MaxNumOfZoneSurfaces))
#else
ALLOCATE(SendSurfaceTempInKto4thPrecalc(TotSurfaces))
#endif
FirstTime = .FALSE.
if (DeveloperFlag) then
write(tdstring,*)' OMP turned off, HBIRE loop executed in serial'
call DisplayString(trim(tdstring))
endif
END IF
if (kickoffsimulation .or. kickoffsizing) return
#ifdef EP_Count_Calls
if (.not. present(zonetoresimulate)) then
NumIntRadExchange_Calls=NumIntRadExchange_Calls+1
else
NumIntRadExchangeZ_Calls=NumIntRadExchangeZ_Calls+1
endif
if (calledfrom == 'Main') then
NumIntRadExchangeMain_Calls=NumIntRadExchangeMain_Calls+1
elseif (calledfrom == 'Outside') then
NumIntRadExchangeOSurf_Calls=NumIntRadExchangeOSurf_Calls+1
elseif (calledfrom == 'Inside') then
NumIntRadExchangeISurf_Calls=NumIntRadExchangeISurf_Calls+1
endif
#endif
ConstrNumRec=0
IF (.NOT. PRESENT(ZoneToResimulate)) THEN
NetLWRadToSurf = 0.0d0
SurfaceWindow%IRfromParentZone = 0.0d0
ENDIF
DO ZoneNum = 1, NumOfZones
IF (PRESENT(ZoneToResimulate)) THEN
IF (ZoneNum /= ZoneToResimulate ) THEN
CYCLE
ELSE
NetLWRadToSurf(Zone(ZoneNum)%SurfaceFirst:Zone(ZoneNum)%SurfaceLast) = 0.d0
SurfaceWindow(Zone(ZoneNum)%SurfaceFirst:Zone(ZoneNum)%SurfaceLast)%IRfromParentZone = 0.d0
ENDIF
ENDIF
! Calculate ScriptF if first time step in environment and surface heat-balance iterations not yet started;
! recalculate ScriptF if status of window interior shades or blinds has changed from
! previous time step. This recalculation is required since ScriptF depends on the inside
! emissivity of the inside surfaces, which, for windows, is (1) the emissivity of the
! inside face of the inside glass layer if there is no interior shade/blind, or (2) the effective
! emissivity of the shade/blind if the shade/blind is in place. (The "effective emissivity"
! in this case is (1) the shade/blind emissivity if the shade/blind IR transmittance is zero,
! or (2) a weighted average of the shade/blind emissivity and inside glass emissivity if the
! shade/blind IR transmittance is not zero (which is sometimes the case for a "shade" and
! usually the case for a blind). It assumed for switchable glazing that the inside surface
! emissivity does not change if the glazing is switched on or off.
! Determine if status of interior shade/blind on one or more windows in the zone has changed
! from previous time step.
IF(SurfIterations == 0) THEN
IntShadeOrBlindStatusChanged = .FALSE.
IF(.NOT.BeginEnvrnFlag) THEN ! Check for change in shade/blind status
DO SurfNum = Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
IF(IntShadeOrBlindStatusChanged) EXIT ! Need only check of one window's status has changed
ConstrNum = Surface(SurfNum)%Construction
IF(.NOT.Construct(ConstrNum)%TypeIsWindow) CYCLE
ShadeFlag = SurfaceWindow(SurfNum)%ShadingFlag
ShadeFlagPrev = SurfaceWindow(SurfNum)%ExtIntShadePrevTS
IF((ShadeFlagPrev /= IntShadeOn .AND. ShadeFlag == IntShadeOn).OR. &
(ShadeFlagPrev /= IntBlindOn .AND. ShadeFlag == IntBlindOn).OR. &
(ShadeFlagPrev == IntShadeOn .AND. ShadeFlag /= IntShadeOn).OR. &
(ShadeFlagPrev == IntBlindOn .AND. ShadeFlag /= IntBlindOn)) &
IntShadeOrBlindStatusChanged = .TRUE.
END DO
END IF
IF(IntShadeOrBlindStatusChanged.OR.BeginEnvrnFlag) THEN ! Calc inside surface emissivities for this time step
DO ZoneSurfNum = 1,ZoneInfo(ZoneNum)%NumOfSurfaces
SurfNum = ZoneInfo(ZoneNum)%SurfacePtr(ZoneSurfNum)
ConstrNum = Surface(SurfNum)%Construction
ZoneInfo(ZoneNum)%Emissivity(ZoneSurfNum) = Construct(ConstrNum)%InsideAbsorpThermal
IF(Construct(ConstrNum)%TypeIsWindow.AND. &
(SurfaceWindow(SurfNum)%ShadingFlag==IntShadeOn.OR.SurfaceWindow(SurfNum)%ShadingFlag==IntBlindOn)) THEN
ZoneInfo(ZoneNum)%Emissivity(ZoneSurfNum) = &
InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS,SurfaceWindow(SurfNum)%MovableSlats, &
SurfaceWindow(SurfNum)%EffShBlindEmiss) + &
InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS,SurfaceWindow(SurfNum)%MovableSlats, &
SurfaceWindow(SurfNum)%EffGlassEmiss)
END IF
END DO
CALL CalcScriptF(ZoneInfo(ZoneNum)%NumOfSurfaces, &
ZoneInfo(ZoneNum)%Area, &
ZoneInfo(ZoneNum)%F, &
ZoneInfo(ZoneNum)%Emissivity, &
ZoneInfo(ZoneNum)%ScriptF)
! precalc - multiply by StefanBoltzmannConstant
ZoneInfo(ZoneNum)%ScriptF=ZoneInfo(ZoneNum)%ScriptF*StefanBoltzmannConst
END IF
END IF ! End of check if SurfIterations = 0
! precalculate the fourth power of surface temperature as part of strategy to reduce calculation time - Glazer 2011-04-22
DO SendZoneSurfNum = 1, ZoneInfo(ZoneNum)%NumOfSurfaces
SendSurfNum = ZoneInfo(ZoneNum)%SurfacePtr(SendZoneSurfNum)
ConstrNumSend = Surface(SendSurfNum)%Construction
SendSurfTemp = SurfaceTemp(SendSurfNum)
IF(Construct(ConstrNumSend)%TypeIsWindow .AND. &
SurfaceWindow(SendSurfNum)%OriginalClass .NE. SurfaceClass_TDD_Diffuser .AND. &
.NOT. Construct(ConstrNumSend)%WindowTypeEQL) THEN
IF(SurfIterations == 0 .AND. SurfaceWindow(SendSurfNum)%ShadingFlag <= 0) THEN
SendSurfTemp = SurfaceWindow(SendSurfNum)%ThetaFace(2*Construct(ConstrNumSend)%TotGlassLayers)-KelvinConv
ELSE IF(SurfaceWindow(SendSurfNum)%ShadingFlag == IntShadeOn .OR. &
SurfaceWindow(SendSurfNum)%ShadingFlag == IntBlindOn) THEN
SendSurfTemp = SurfaceWindow(SendSurfNum)%EffInsSurfTemp
END IF
ELSEIF (Construct(ConstrNumSend)%WindowTypeEQL) THEN
SendSurfTemp = SurfaceWindow(SendSurfNum)%EffInsSurfTemp
END IF
#ifdef EP_HBIRE_SEQ
SendSurfaceTempInKto4thPrecalc(SendZoneSurfNum) = (SendSurfTemp+KelvinConv)**4
#else
SendSurfaceTempInKto4thPrecalc(SendSurfNum) = (SendSurfTemp+KelvinConv)**4
#endif
END DO
! these are the money do loops.
DO RecZoneSurfNum = 1, ZoneInfo(ZoneNum)%NumOfSurfaces
RecSurfNum = ZoneInfo(ZoneNum)%SurfacePtr(RecZoneSurfNum)
ConstrNumRec = Surface(RecSurfNum)%Construction
RecSurfTemp = SurfaceTemp(RecSurfNum)
RecSurfEmiss = Construct(ConstrNumRec)%InsideAbsorpThermal
IF (Construct(ConstrNumRec)%TypeIsWindow .AND. &
SurfaceWindow(RecSurfNum)%OriginalClass .NE. SurfaceClass_TDD_Diffuser .AND. &
.NOT. Construct(ConstrNumRec)%WindowTypeEQL ) THEN
IF(SurfIterations == 0 .AND. SurfaceWindow(RecSurfNum)%ShadingFlag <= 0) THEN
! If the window is bare this TS and it is the first time through we use the previous TS glass
! temperature whether or not the window was shaded in the previous TS. If the window was shaded
! the previous time step this temperature is a better starting value than the shade temperature.
RecSurfTemp = SurfaceWindow(RecSurfNum)%ThetaFace(2*Construct(ConstrNumRec)%TotGlassLayers)-KelvinConv
! For windows with an interior shade or blind an effective inside surface temp
! and emiss is used here that is a weighted combination of shade/blind and glass temp and emiss.
ELSEIF (SurfaceWindow(RecSurfNum)%ShadingFlag==IntShadeOn .OR. &
SurfaceWindow(RecSurfNum)%ShadingFlag==IntBlindOn) THEN
RecSurfTemp = SurfaceWindow(RecSurfNum)%EffInsSurfTemp
RecSurfEmiss = &
InterpSlatAng(SurfaceWindow(RecSurfNum)%SlatAngThisTS,SurfaceWindow(RecSurfNum)%MovableSlats, &
SurfaceWindow(RecSurfNum)%EffShBlindEmiss) + &
InterpSlatAng(SurfaceWindow(RecSurfNum)%SlatAngThisTS,SurfaceWindow(RecSurfNum)%MovableSlats, &
SurfaceWindow(RecSurfNum)%EffGlassEmiss)
END IF
ELSEIF( Construct(ConstrNumRec)%WindowTypeEQL) THEN
RecSurfEmiss = EQLWindowInsideEffectiveEmiss(ConstrNumRec)
RecSurfTemp = SurfaceWindow(RecSurfNum)%EffInsSurfTemp
END IF
! precalculate the fourth power of surface temperature as part of strategy to reduce calculation time - Glazer 2011-04-22
RecSurfTempInKTo4th = (RecSurfTemp+KelvinConv)**4
! IF (ABS(RecSurfTempInKTo4th) > 1.d100) THEN
! SendZoneSurfNum=1
! ENDIF
! Calculate net long-wave radiation for opaque surfaces and incident
! long-wave radiation for windows.
DO SendZoneSurfNum = 1, ZoneInfo(ZoneNum)%NumOfSurfaces
SendSurfNum = ZoneInfo(ZoneNum)%SurfacePtr(SendZoneSurfNum)
!#ifdef EP_HBIRE_SEQ
! SendSurfTempInKTo4th = SendSurfaceTempInKto4thPrecalc(SendZoneSurfNum)
!#else
! SendSurfTempInKTo4th = SendSurfaceTempInKto4thPrecalc(SendSurfNum)
!#endif
IF (RecZoneSurfNum /= SendZoneSurfNum) THEN
#ifdef EP_HBIRE_SEQ
NetLWRadToSurf(RecSurfNum) = NetLWRadToSurf(RecSurfNum) &
+(ZoneInfo(ZoneNum)%ScriptF(RecZoneSurfNum,SendZoneSurfNum) &
*(SendSurfaceTempInKto4thPrecalc(SendZoneSurfNum) - RecSurfTempInKTo4th))
#else
NetLWRadToSurf(RecSurfNum) = NetLWRadToSurf(RecSurfNum) &
+(ZoneInfo(ZoneNum)%ScriptF(RecZoneSurfNum,SendZoneSurfNum) &
*(SendSurfaceTempInKto4thPrecalc(SendSurfNum) - RecSurfTempInKTo4th))
#endif
ENDIF
IF(Construct(ConstrNumRec)%TypeIsWindow) THEN ! Window
! Calculate interior LW incident on window rather than net LW for use in window layer
! heat balance calculation.
#ifdef EP_HBIRE_SEQ
SurfaceWindow(RecSurfNum)%IRfromParentZone = SurfaceWindow(RecSurfNum)%IRfromParentZone + &
(ZoneInfo(ZoneNum)%ScriptF(RecZoneSurfNum,SendZoneSurfNum) &
* SendSurfaceTempInKto4thPrecalc(SendZoneSurfNum)) / RecSurfEmiss
#else
SurfaceWindow(RecSurfNum)%IRfromParentZone = SurfaceWindow(RecSurfNum)%IRfromParentZone + &
(ZoneInfo(ZoneNum)%ScriptF(RecZoneSurfNum,SendZoneSurfNum) &
* SendSurfaceTempInKto4thPrecalc(SendSurfNum)) / RecSurfEmiss
#endif
! Per BG -- this should never happened. (CR6346,CR6550 caused this to be put in. Now removed. LKL 1/2013)
! IF (SurfaceWindow(RecSurfNum)%IRfromParentZone < 0.0) THEN
! CALL ShowRecurringWarningErrorAtEnd('CalcInteriorRadExchange: Window_IRFromParentZone negative, Window="'// &
! TRIM(Surface(RecSurfNum)%Name)//'"', &
! SurfaceWindow(RecSurfNum)%IRErrCount)
! CALL ShowRecurringContinueErrorAtEnd('..occurs in Zone="'//TRIM(Surface(RecSurfNum)%ZoneName)// &
! '", reset to 0.0 for remaining calculations.',SurfaceWindow(RecSurfNum)%IRErrCountC)
! SurfaceWindow(RecSurfNum)%IRfromParentZone=0.0
! ENDIF
ENDIF
END DO
END DO
END DO
#ifdef EP_Detailed_Timings
CALL epStopTime('CalcInteriorRadExchange=')
#endif
RETURN
END SUBROUTINE CalcInteriorRadExchange