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 ComputeDelayedComponents
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN September 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! For load component report, convert the sequence of radiant gains
! for people and equipment and other internal loads into convective
! gains based on the decay curves.
! METHODOLOGY EMPLOYED:
! For each step of sequence from each design day, compute the
! contributations from previous timesteps multiplied by the decay
! curve. Rather than store every internal load's radiant contribution
! to each surface, the TMULT and ITABSF sequences were also stored
! which allocates the total radiant to each surface in the zone. The
! formula used is:
! QRadThermInAbs(SurfNum) = QL(NZ) * TMULT(NZ) * ITABSF(SurfNum)
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSurfaces, ONLY: Surface, TotSurfaces,SurfaceClass_Window
USE DataEnvironment, ONLY: TotDesDays, TotRunDesPersDays
USE DataGlobals, ONLY: NumOfTimeStepInHour
USE DataSizing, ONLY: CalcFinalZoneSizing,NumTimeStepsInAvg
USE DataZoneEquipment, ONLY: ZoneEquipConfig
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:
INTEGER :: iZone
INTEGER :: jSurf
INTEGER :: kTimeStep
INTEGER :: lDesHtCl
INTEGER :: mStepBack
INTEGER :: desSelected
LOGICAL :: isCooling
REAL(r64) :: QRadThermInAbsMult
REAL(r64) :: peopleConvFromSurf
REAL(r64) :: peopleConvIntoZone
REAL(r64),DIMENSION(:),ALLOCATABLE :: peopleRadIntoSurf
REAL(r64) :: equipConvFromSurf
REAL(r64) :: equipConvIntoZone
REAL(r64),DIMENSION(:),ALLOCATABLE :: equipRadIntoSurf
REAL(r64) :: hvacLossConvFromSurf
REAL(r64) :: hvacLossConvIntoZone
REAL(r64),DIMENSION(:),ALLOCATABLE :: hvacLossRadIntoSurf
REAL(r64) :: powerGenConvFromSurf
REAL(r64) :: powerGenConvIntoZone
REAL(r64),DIMENSION(:),ALLOCATABLE :: powerGenRadIntoSurf
REAL(r64) :: lightLWConvFromSurf
REAL(r64) :: lightLWConvIntoZone
REAL(r64),DIMENSION(:),ALLOCATABLE :: lightLWRadIntoSurf
REAL(r64) :: lightSWConvFromSurf
REAL(r64) :: lightSWConvIntoZone
REAL(r64) :: feneSolarConvFromSurf
REAL(r64) :: feneSolarConvIntoZone
REAL(r64) :: adjFeneSurfNetRadSeq
ALLOCATE(peopleRadIntoSurf(NumOfTimeStepInHour*24))
ALLOCATE(equipRadIntoSurf(NumOfTimeStepInHour*24))
ALLOCATE(hvacLossRadIntoSurf(NumOfTimeStepInHour*24))
ALLOCATE(powerGenRadIntoSurf(NumOfTimeStepInHour*24))
ALLOCATE(lightLWRadIntoSurf(NumOfTimeStepInHour*24))
! deallocate after writing? LKL
IF (ALLOCATED(CalcFinalZoneSizing)) THEN
DO lDesHtCl = 1,2 !iterates between heating and cooling design day
isCooling = lDesHtCl .EQ. 2 !flag for when cooling design day otherwise heating design day
DO iZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(iZone)%IsControlled) CYCLE
IF (isCooling) THEN
desSelected = CalcFinalZoneSizing(iZone)%CoolDDNum
ELSE
desSelected = CalcFinalZoneSizing(iZone)%HeatDDNum
END IF
IF (desSelected .EQ. 0) CYCLE
DO kTimeStep = 1, NumOfTimeStepInHour*24
peopleConvIntoZone = 0.0d0
equipConvIntoZone = 0.0d0
hvacLossConvIntoZone = 0.0d0
powerGenConvIntoZone = 0.0d0
lightLWConvIntoZone = 0.0d0
lightSWConvIntoZone = 0.0d0
feneSolarConvIntoZone = 0.0d0
adjFeneSurfNetRadSeq = 0.0d0
DO jSurf = 1,TotSurfaces
IF (.NOT. Surface(jSurf)%HeatTransSurf) CYCLE ! Skip non-heat transfer surfaces
IF (Surface(jSurf)%Zone .EQ. iZone) THEN
!determine for each timestep the amount of radiant heat for each end use absorbed in each surface
QRadThermInAbsMult = TMULTseq(iZone,kTimeStep,desSelected) * ITABSFseq(jSurf,kTimeStep,desSelected) &
* Surface(jSurf)%area
peopleRadIntoSurf(kTimeStep) = peopleRadSeq(iZone,kTimeStep,DesSelected) * QRadThermInAbsMult
equipRadIntoSurf(kTimeStep) = equipRadSeq(iZone,kTimeStep,DesSelected) * QRadThermInAbsMult
hvacLossRadIntoSurf(kTimeStep) = hvacLossRadSeq(iZone,kTimeStep,DesSelected) * QRadThermInAbsMult
powerGenRadIntoSurf(kTimeStep) = powerGenRadSeq(iZone,kTimeStep,DesSelected) * QRadThermInAbsMult
lightLWRadIntoSurf(kTimeStep) = lightLWRadSeq(iZone,kTimeStep,DesSelected) * QRadThermInAbsMult
!for each time step, step back through time and apply decay curve
peopleConvFromSurf = 0.0d0
equipConvFromSurf = 0.0d0
hvacLossConvFromSurf = 0.0d0
powerGenConvFromSurf = 0.0d0
lightLWConvFromSurf = 0.0d0
lightSWConvFromSurf = 0.0d0
feneSolarConvFromSurf = 0.0d0
DO mStepBack = 1,kTimeStep
IF (isCooling) THEN
peopleConvFromSurf = peopleConvFromSurf + peopleRadIntoSurf(kTimeStep - mStepBack + 1) &
* decayCurveCool(jSurf,mStepBack)
equipConvFromSurf = equipConvFromSurf + equipRadIntoSurf(kTimeStep - mStepBack + 1) &
* decayCurveCool(jSurf,mStepBack)
hvacLossConvFromSurf = hvacLossConvFromSurf + hvacLossRadIntoSurf(kTimeStep - mStepBack + 1) &
* decayCurveCool(jSurf,mStepBack)
powerGenConvFromSurf = powerGenConvFromSurf + powerGenRadIntoSurf(kTimeStep - mStepBack + 1) &
* decayCurveCool(jSurf,mStepBack)
lightLWConvFromSurf = lightLWConvFromSurf + lightLWRadIntoSurf(kTimeStep - mStepBack + 1) &
* decayCurveCool(jSurf,mStepBack)
! short wave is already accumulated by surface
lightSWConvFromSurf = lightSWConvFromSurf + lightSWRadSeq(jSurf,kTimeStep - mStepBack + 1,DesSelected) &
* decayCurveCool(jSurf,mStepBack)
feneSolarConvFromSurf = feneSolarConvFromSurf + feneSolarRadSeq(jSurf,kTimeStep - mStepBack + 1,DesSelected) &
* decayCurveCool(jSurf,mStepBack)
ELSE
peopleConvFromSurf = peopleConvFromSurf + peopleRadIntoSurf(kTimeStep - mStepBack + 1) &
* decayCurveHeat(jSurf,mStepBack)
equipConvFromSurf = equipConvFromSurf + equipRadIntoSurf(kTimeStep - mStepBack + 1) &
* decayCurveHeat(jSurf,mStepBack)
hvacLossConvFromSurf = hvacLossConvFromSurf + hvacLossRadIntoSurf(kTimeStep - mStepBack + 1) &
* decayCurveHeat(jSurf,mStepBack)
powerGenConvFromSurf = powerGenConvFromSurf + powerGenRadIntoSurf(kTimeStep - mStepBack + 1) &
* decayCurveHeat(jSurf,mStepBack)
lightLWConvFromSurf = lightLWConvFromSurf + lightLWRadIntoSurf(kTimeStep - mStepBack + 1) &
* decayCurveHeat(jSurf,mStepBack)
! short wave is already accumulated by surface
lightSWConvFromSurf = lightSWConvFromSurf + lightSWRadSeq(jSurf, kTimeStep - mStepBack + 1,DesSelected) &
* decayCurveHeat(jSurf,mStepBack)
feneSolarConvFromSurf = feneSolarConvFromSurf + feneSolarRadSeq(jSurf,kTimeStep - mStepBack + 1,DesSelected) &
* decayCurveHeat(jSurf,mStepBack)
ENDIF
END DO
peopleConvIntoZone = peopleConvIntoZone + peopleConvFromSurf
equipConvIntoZone = equipConvIntoZone + equipConvFromSurf
hvacLossConvIntoZone = hvacLossConvIntoZone + hvacLossConvFromSurf
powerGenConvIntoZone = powerGenConvIntoZone + powerGenConvFromSurf
lightLWConvIntoZone = lightLWConvIntoZone + lightLWConvFromSurf
lightSWConvIntoZone = lightSWConvIntoZone + lightSWConvFromSurf
feneSolarConvIntoZone = feneSolarConvIntoZone + feneSolarConvFromSurf
! determine the remaining convective heat from the surfaces that are not based
! on any of these other loads
!negative because heat from surface should be positive
surfDelaySeq(jSurf,kTimeStep,desSelected) = -loadConvectedNormal(jSurf,kTimeStep,desSelected) &
- netSurfRadSeq(jSurf,kTimeStep,desSelected) & !remove net radiant for the surface
- (peopleConvFromSurf + equipConvFromSurf + hvacLossConvFromSurf + powerGenConvFromSurf &
+ lightLWConvFromSurf + lightSWConvFromSurf + feneSolarConvFromSurf)
! also remove the net radiant component on the instanteous conduction for fenestration
IF (surface(jSurf)%class .EQ. SurfaceClass_Window) THEN
adjFeneSurfNetRadSeq = adjFeneSurfNetRadSeq + netSurfRadSeq(jSurf,kTimeStep,desSelected)
END IF
END IF
END DO
peopleDelaySeq(iZone,kTimeStep,desSelected) = peopleConvIntoZone
equipDelaySeq(iZone,kTimeStep,desSelected) = equipConvIntoZone
hvacLossDelaySeq(iZone,kTimeStep,desSelected) = hvacLossConvIntoZone
powerGenDelaySeq(iZone,kTimeStep,desSelected) = powerGenConvIntoZone
!combine short wave (visible) and long wave (thermal) impacts
lightDelaySeq(iZone,kTimeStep,desSelected) = lightLWConvIntoZone + lightSWConvIntoZone
feneSolarDelaySeq(iZone,kTimeStep,desSelected) = feneSolarConvIntoZone
! also remove the net radiant component on the instanteous conduction for fenestration
feneCondInstantSeq(iZone,kTimeStep,desSelected) = feneCondInstantSeq(iZone,kTimeStep,desSelected) - adjFeneSurfNetRadSeq
END DO
END DO
END DO
ENDIF
END SUBROUTINE ComputeDelayedComponents