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 InitInternalHeatGains
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN September 1997
! MODIFIED November 1998, FW: add adjustment to elec lights for dayltg controls
! August 2003, FCW: add optional calculation of light-to-return fraction
! as a function of return plenum air temperature.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine sets up the zone internal heat gains
! that are independent of the zone air temperature.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE ScheduleManager
USE DataHeatBalFanSys, ONLY: MAT, SumConvHTRadSys, ZoneLatentGain
USE DataDaylighting
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE ZonePlenum, ONLY: ZoneRetPlenCond
USE Psychrometrics, ONLY: PsyRhoAirFnPbTdbW
USE DataRoomAirModel, ONLY: IsZoneDV, TCMF, IsZoneUI
USE WaterThermalTanks, ONLY: CalcWaterThermalTankZoneGains
USE PipeHeatTransfer, ONLY: CalcZonePipesHeatGain
USE WaterUse, ONLY: CalcWaterUseZoneGains
USE FuelCellElectricGenerator, ONLY: FigureFuelCellZoneGains
USE MicroCHPElectricGenerator, ONLY: FigureMicroCHPZoneGains
USE ManageElectricPower, ONLY: FigureInverterZoneGains, FigureElectricalStorageZoneGains, &
FigureTransformerZoneGains
USE DaylightingDevices, ONLY: FigureTDDZoneGains
USE RefrigeratedCase, ONLY: FigureRefrigerationZoneGains
USE OutputReportTabular, ONLY: radiantPulseUsed,radiantPulseTimestep,radiantPulseReceived
USE DataGlobals, ONLY: CompLoadReportIsReq
USE DataGlobalConstants, ONLY: endUseHeating,endUseCooling
USE OutputReportTabular, ONLY: AllocateLoadComponentArrays
USE DataSizing, ONLY: CurOverallSimDay
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER, dIMENSION(9) :: C=(/ 6.4611027d0, .946892d0, .0000255737d0, 7.139322d0, -.0627909d0, &
.0000589271d0, -.198550d0, .000940018d0, -.00000149532d0 /)
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: ActivityLevel_WperPerson ! Units on Activity Level (Schedule)
REAL(r64) :: NumberOccupants ! Number of occupants
INTEGER :: SurfNum ! DO loop counter for surfaces
INTEGER :: Loop
INTEGER :: NZ
REAL(r64) :: Q !, QR
REAL(r64) :: TotalPeopleGain ! Total heat gain from people (intermediate calculational variable)
REAL(r64) :: SensiblePeopleGain ! Sensible heat gain from people (intermediate calculational variable)
REAL(r64) :: FractionConvected ! For general lighting, fraction of heat from lights convected to zone air
REAL(r64) :: FractionReturnAir ! For general lighting, fraction of heat from lights convected to zone's return air
REAL(r64) :: FractionRadiant ! For general lighting, fraction of heat from lights to zone that is long wave
INTEGER :: ReturnZonePlenumCondNum ! Number of ZoneRetPlenCond for a zone's return air plenum, if it exists
REAL(r64) :: ReturnPlenumTemp ! Air temperature of a zone's return air plenum (C)
REAL(r64) :: pulseMultipler ! use to create a pulse for the load component report computations
REAL(r64) :: curQL = 0.0d0 ! radiant value prior to adjustment for pulse for load component report
REAL(r64) :: adjQL = 0.0d0 ! radiant value including adjustment for pulse for load component report
! REAL(r64), ALLOCATABLE, SAVE, DIMENSION(:) :: QSA
! IF (.NOT. ALLOCATED(QSA)) ALLOCATE(QSA(NumOfZones))
! Zero out time step variables
ZoneIntGain%NOFOCC = 0.d0
ZoneIntGain%QOCTOT = 0.d0
ZoneIntGain%QOCSEN = 0.d0
ZoneIntGain%QOCLAT = 0.d0
ZoneIntGain%QOCRAD = 0.d0
ZoneIntGain%QOCCON = 0.d0
ZoneIntGain%QLTSW = 0.d0
ZoneIntGain%QLTCRA = 0.d0
ZoneIntGain%QLTRAD = 0.d0
ZoneIntGain%QLTCON = 0.d0
ZoneIntGain%QLTTOT = 0.d0
ZoneIntGain%QEELAT = 0.d0
ZoneIntGain%QEERAD = 0.d0
ZoneIntGain%QEECON = 0.d0
ZoneIntGain%QEELost = 0.d0
ZoneIntGain%QGELAT = 0.d0
ZoneIntGain%QGERAD = 0.d0
ZoneIntGain%QGECON = 0.d0
ZoneIntGain%QGELost= 0.d0
ZoneIntGain%QBBRAD = 0.d0
ZoneIntGain%QBBCON = 0.d0
ZoneIntGain%QOELAT = 0.d0
ZoneIntGain%QOERAD = 0.d0
ZoneIntGain%QOECON = 0.d0
ZoneIntGain%QOELost= 0.d0
ZoneIntGain%QHWLAT = 0.d0
ZoneIntGain%QHWRAD = 0.d0
ZoneIntGain%QHWCON = 0.d0
ZoneIntGain%QHWLost= 0.d0
ZoneIntGain%QSELAT = 0.d0
ZoneIntGain%QSERAD = 0.d0
ZoneIntGain%QSECON = 0.d0
ZoneIntGain%QSELost= 0.d0
DO Loop = 0, 25
ZoneIntEEuse%EEConvected(Loop) = 0.0d0
ZoneIntEEuse%EERadiated(Loop) = 0.0d0
ZoneIntEEuse%EELost(Loop) = 0.0d0
ZoneIntEEuse%EELatent(Loop) = 0.0d0
ENDDO
ZnRpt%LtsPower = 0.0d0
ZnRpt%ElecPower = 0.0d0
ZnRpt%GasPower = 0.0d0
ZnRpt%HWPower = 0.0d0
ZnRpt%SteamPower = 0.0d0
ZnRpt%BaseHeatPower = 0.0d0
! QSA = 0.0
! Process Internal Heat Gains, People done below
! Occupant Stuff
! METHOD:
! The function is based on a curve fit to data presented in
! Table 48 'Heat Gain From People' of Chapter 1 of the 'Carrier
! Handbook of Air Conditioning System Design', 1965. Values of
! Sensible gain were obtained from the table at average adjusted
! metabolic rates 350, 400, 450, 500, 750, 850, 1000, and
! 1450 Btu/hr each at temperatures 82, 80, 78, 75, and 70F.
! Sensible gains of 0.0 at 96F and equal to the metabolic rate
! at 30F were assumed in order to give reasonable values beyond
! The reported temperature range.
DO Loop = 1, TotPeople
NZ = People(Loop)%ZonePtr
NumberOccupants = People(Loop)%NumberOfPeople * GetCurrentScheduleValue(People(Loop)%NumberOfPeoplePtr)
If (People(Loop)%EMSPeopleOn) NumberOccupants = People(Loop)%EMSNumberOfPeople
TotalPeopleGain = 0.0d0
SensiblePeopleGain = 0.0d0
IF (NumberOccupants > 0.0d0) THEN
ActivityLevel_WperPerson = GetCurrentScheduleValue(People(Loop)%ActivityLevelPtr)
TotalPeopleGain = NumberOccupants*ActivityLevel_WperPerson
! if the user did not specify a sensible fraction, calculate the sensible heat gain
IF (People(Loop)%UserSpecSensFrac == AutoCalculate ) THEN
IF ( .not. (IsZoneDV(NZ) .or. IsZoneUI(NZ)) ) THEN
SensiblePeopleGain = NumberOccupants*( C(1)+ActivityLevel_WperPerson*(C(2)+ActivityLevel_WperPerson*C(3)) &
+MAT(NZ)*((C(4)+ActivityLevel_WperPerson*(C(5)+ActivityLevel_WperPerson*C(6))) &
+MAT(NZ)*( C(7)+ActivityLevel_WperPerson*(C(8)+ActivityLevel_WperPerson*C(9)))) )
ELSE ! UCSD - DV or UI
SensiblePeopleGain = NumberOccupants*( C(1)+ActivityLevel_WperPerson*(C(2)+ActivityLevel_WperPerson*C(3)) &
+TCMF(NZ)*((C(4)+ActivityLevel_WperPerson*(C(5)+ActivityLevel_WperPerson*C(6))) &
+TCMF(NZ)*( C(7)+ActivityLevel_WperPerson*(C(8)+ActivityLevel_WperPerson*C(9)))) )
END IF
ELSE ! if the user did specify a sensible fraction, use it
SensiblePeopleGain = TotalPeopleGain * People(Loop)%UserSpecSensFrac
END IF
IF (SensiblePeopleGain > TotalPeopleGain) SensiblePeopleGain = TotalPeopleGain
IF (SensiblePeopleGain < 0.0d0) SensiblePeopleGain = 0.0d0
!For predefined tabular reports related to outside air ventilation
ZonePreDefRep(NZ)%isOccupied = .true. !set flag to occupied to be used in tabular reporting for ventilation
ZonePreDefRep(NZ)%NumOccAccum = ZonePreDefRep(NZ)%NumOccAccum + NumberOccupants * TimeStepZone
ZonePreDefRep(NZ)%NumOccAccumTime = ZonePreDefRep(NZ)%NumOccAccumTime + TimeStepZone
ELSE
ZonePreDefRep(NZ)%isOccupied = .false. !set flag to occupied to be used in tabular reporting for ventilation
END IF
People(Loop)%NumOcc = NumberOccupants
People(Loop)%RadGainRate = SensiblePeopleGain * People(Loop)%FractionRadiant
People(Loop)%ConGainRate = SensiblePeopleGain * People(Loop)%FractionConvected
People(Loop)%SenGainRate = SensiblePeopleGain
People(Loop)%LatGainRate = TotalPeopleGain - SensiblePeopleGain
People(Loop)%TotGainRate = TotalPeopleGain
People(Loop)%CO2GainRate = TotalPeopleGain * People(Loop)%CO2RateFactor
ZoneIntGain(NZ)%NOFOCC = ZoneIntGain(NZ)%NOFOCC + People(Loop)%NumOcc
ZoneIntGain(NZ)%QOCRAD = ZoneIntGain(NZ)%QOCRAD + People(Loop)%RadGainRate
ZoneIntGain(NZ)%QOCCON = ZoneIntGain(NZ)%QOCCON + People(Loop)%ConGainRate
ZoneIntGain(NZ)%QOCSEN = ZoneIntGain(NZ)%QOCSEN + People(Loop)%SenGainRate
ZoneIntGain(NZ)%QOCLAT = ZoneIntGain(NZ)%QOCLAT + People(Loop)%LatGainRate
ZoneIntGain(NZ)%QOCTOT = ZoneIntGain(NZ)%QOCTOT + People(Loop)%TotGainRate
END DO
DO Loop = 1, TotLights
NZ = Lights(Loop)%ZonePtr
Q = Lights(Loop)%DesignLevel * GetCurrentScheduleValue(Lights(Loop)%SchedPtr)
IF (ZoneDaylight(NZ)%DaylightType == DetailedDaylighting &
.OR. ZoneDaylight(NZ)%DaylightType == DElightDaylighting) THEN
IF (Lights(Loop)%FractionReplaceable > 0.0d0) THEN ! FractionReplaceable can only be 0 or 1 for these models
Q = Q * ZoneDaylight(NZ)%ZonePowerReductionFactor
END IF
END IF
! Reduce lighting power due to demand limiting
IF (Lights(Loop)%ManageDemand .AND. (Q > Lights(Loop)%DemandLimit)) Q = Lights(Loop)%DemandLimit
! Set Q to EMS override if being called for by EMs
IF (Lights(Loop)%EMSLightsOn) Q = Lights(Loop)%EMSLightingPower
FractionConvected = Lights(Loop)%FractionConvected
FractionReturnAir = Lights(Loop)%FractionReturnAir
FractionRadiant = Lights(Loop)%FractionRadiant
IF(Lights(Loop)%FractionReturnAirIsCalculated .AND. .NOT.ZoneSizingCalc .AND. SimTimeSteps > 1) THEN
! Calculate FractionReturnAir based on conditions in the zone's return air plenum, if there is one.
IF(Zone(NZ)%IsControlled) THEN
ReturnZonePlenumCondNum = ZoneEquipConfig(NZ)%ReturnZonePlenumCondNum
IF(ReturnZonePlenumCondNum > 0) THEN
ReturnPlenumTemp = ZoneRetPlenCond(ReturnZonePlenumCondNum)%ZoneTemp
FractionReturnAir = Lights(Loop)%FractionReturnAirPlenTempCoeff1 - &
Lights(Loop)%FractionReturnAirPlenTempCoeff2 * ReturnPlenumTemp
FractionReturnAir = MAX(0.0d0,MIN(1.0d0,FractionReturnAir))
IF(FractionReturnAir >= (1.0d0 - Lights(Loop)%FractionShortWave)) THEN
FractionReturnAir = 1.0d0 - Lights(Loop)%FractionShortWave
FractionRadiant = 0.0d0
FractionConvected = 0.0d0
ELSE
FractionRadiant = ((1.0d0 - FractionReturnAir - Lights(Loop)%FractionShortWave)/ &
(Lights(Loop)%FractionRadiant + Lights(Loop)%FractionConvected))* Lights(Loop)%FractionRadiant
FractionConvected = 1.0d0 - (FractionReturnAir + FractionRadiant + Lights(Loop)%FractionShortWave)
END IF
END IF
END IF
END IF
Lights(Loop)%Power = Q
Lights(Loop)%RadGainRate = Q * FractionRadiant
Lights(Loop)%VisGainRate = Q * Lights(Loop)%FractionShortWave
Lights(Loop)%ConGainRate = Q * FractionConvected
Lights(Loop)%RetAirGainRate = Q * FractionReturnAir
Lights(Loop)%TotGainRate = Q
ZnRpt(NZ)%LtsPower = ZnRpt(NZ)%LtsPower + Lights(Loop)%Power
ZoneIntGain(NZ)%QLTRAD = ZoneIntGain(NZ)%QLTRAD + Lights(Loop)%RadGainRate
ZoneIntGain(NZ)%QLTSW = ZoneIntGain(NZ)%QLTSW + Lights(Loop)%VisGainRate
ZoneIntGain(NZ)%QLTCON = ZoneIntGain(NZ)%QLTCON + Lights(Loop)%ConGainRate
ZoneIntGain(NZ)%QLTCRA = ZoneIntGain(NZ)%QLTCRA + Lights(Loop)%RetAirGainRate
ZoneIntGain(NZ)%QLTTOT = ZoneIntGain(NZ)%QLTTOT + Lights(Loop)%TotGainRate
END DO
DO Loop = 1, TotElecEquip
Q = ZoneElectric(Loop)%DesignLevel * GetCurrentScheduleValue(ZoneElectric(Loop)%SchedPtr)
! Reduce equipment power due to demand limiting
IF (ZoneElectric(Loop)%ManageDemand .AND. (Q > ZoneElectric(Loop)%DemandLimit)) Q = ZoneElectric(Loop)%DemandLimit
! Set Q to EMS override if being called for by EMs
IF (ZoneElectric(Loop)%EMSZoneEquipOverrideOn) Q = ZoneElectric(Loop)%EMSEquipPower
ZoneElectric(Loop)%Power = Q
ZoneElectric(Loop)%RadGainRate = Q * ZoneElectric(Loop)%FractionRadiant
ZoneElectric(Loop)%ConGainRate = Q * ZoneElectric(Loop)%FractionConvected
ZoneElectric(Loop)%LatGainRate = Q * ZoneElectric(Loop)%FractionLatent
ZoneElectric(Loop)%LostRate = Q * ZoneElectric(Loop)%FractionLost
ZoneElectric(Loop)%TotGainRate = Q - ZoneElectric(Loop)%LostRate
NZ = ZoneElectric(Loop)%ZonePtr
ZnRpt(NZ)%ElecPower = ZnRpt(NZ)%ElecPower + ZoneElectric(Loop)%Power
ZoneIntGain(NZ)%QEERAD = ZoneIntGain(NZ)%QEERAD + ZoneElectric(Loop)%RadGainRate
ZoneIntGain(NZ)%QEECON = ZoneIntGain(NZ)%QEECON + ZoneElectric(Loop)%ConGainRate
ZoneIntGain(NZ)%QEELAT = ZoneIntGain(NZ)%QEELAT + ZoneElectric(Loop)%LatGainRate
ZoneIntGain(NZ)%QEELost = ZoneIntGain(NZ)%QEELost + ZoneElectric(Loop)%LostRate
END DO
DO Loop = 1, TotGasEquip
Q = ZoneGas(Loop)%DesignLevel * GetCurrentScheduleValue(ZoneGas(Loop)%SchedPtr)
! Set Q to EMS override if being called for by EMs
IF (ZoneGas(Loop)%EMSZoneEquipOverrideOn) Q = ZoneGas(Loop)%EMSEquipPower
ZoneGas(Loop)%Power = Q
ZoneGas(Loop)%RadGainRate = Q * ZoneGas(Loop)%FractionRadiant
ZoneGas(Loop)%ConGainRate = Q * ZoneGas(Loop)%FractionConvected
ZoneGas(Loop)%LatGainRate = Q * ZoneGas(Loop)%FractionLatent
ZoneGas(Loop)%LostRate = Q * ZoneGas(Loop)%FractionLost
ZoneGas(Loop)%TotGainRate = Q - ZoneGas(Loop)%LostRate
ZoneGas(Loop)%CO2GainRate = Q * ZoneGas(Loop)%CO2RateFactor
NZ = ZoneGas(Loop)%ZonePtr
ZnRpt(NZ)%GasPower = ZnRpt(NZ)%GasPower + ZoneGas(Loop)%Power
ZoneIntGain(NZ)%QGERAD=ZoneIntGain(NZ)%QGERAD + ZoneGas(Loop)%RadGainRate
ZoneIntGain(NZ)%QGECON=ZoneIntGain(NZ)%QGECON + ZoneGas(Loop)%ConGainRate
ZoneIntGain(NZ)%QGELAT=ZoneIntGain(NZ)%QGELAT + ZoneGas(Loop)%LatGainRate
ZoneIntGain(NZ)%QGELost=ZoneIntGain(NZ)%QGELost + ZoneGas(Loop)%LostRate
END DO
DO Loop = 1, TotOthEquip
Q = ZoneOtherEq(Loop)%DesignLevel * GetCurrentScheduleValue(ZoneOtherEq(Loop)%SchedPtr)
! Set Q to EMS override if being called for by EMs
IF (ZoneOtherEq(Loop)%EMSZoneEquipOverrideOn) Q = ZoneOtherEq(Loop)%EMSEquipPower
ZoneOtherEq(Loop)%Power = Q
ZoneOtherEq(Loop)%RadGainRate = Q * ZoneOtherEq(Loop)%FractionRadiant
ZoneOtherEq(Loop)%ConGainRate = Q * ZoneOtherEq(Loop)%FractionConvected
ZoneOtherEq(Loop)%LatGainRate = Q * ZoneOtherEq(Loop)%FractionLatent
ZoneOtherEq(Loop)%LostRate = Q * ZoneOtherEq(Loop)%FractionLost
ZoneOtherEq(Loop)%TotGainRate = Q - ZoneOtherEq(Loop)%LostRate
NZ = ZoneOtherEq(Loop)%ZonePtr
ZoneIntGain(NZ)%QOERAD = ZoneIntGain(NZ)%QOERAD + ZoneOtherEq(Loop)%RadGainRate
ZoneIntGain(NZ)%QOECON = ZoneIntGain(NZ)%QOECON + ZoneOtherEq(Loop)%ConGainRate
ZoneIntGain(NZ)%QOELAT = ZoneIntGain(NZ)%QOELAT + ZoneOtherEq(Loop)%LatGainRate
ZoneIntGain(NZ)%QOELost = ZoneIntGain(NZ)%QOELost + ZoneOtherEq(Loop)%LostRate
END DO
DO Loop = 1, TotHWEquip
Q = ZoneHWEq(Loop)%DesignLevel * GetCurrentScheduleValue(ZoneHWEq(Loop)%SchedPtr)
! Set Q to EMS override if being called for by EMs
IF (ZoneHWEq(Loop)%EMSZoneEquipOverrideOn) Q = ZoneHWEq(Loop)%EMSEquipPower
ZoneHWEq(Loop)%Power = Q
ZoneHWEq(Loop)%RadGainRate = Q * ZoneHWEq(Loop)%FractionRadiant
ZoneHWEq(Loop)%ConGainRate = Q * ZoneHWEq(Loop)%FractionConvected
ZoneHWEq(Loop)%LatGainRate = Q * ZoneHWEq(Loop)%FractionLatent
ZoneHWEq(Loop)%LostRate = Q * ZoneHWEq(Loop)%FractionLost
ZoneHWEq(Loop)%TotGainRate = Q - ZoneHWEq(Loop)%LostRate
NZ = ZoneHWEq(Loop)%ZonePtr
ZnRpt(NZ)%HWPower = ZnRpt(NZ)%HWPower + ZoneHWEq(Loop)%Power
ZoneIntGain(NZ)%QHWRAD = ZoneIntGain(NZ)%QHWRAD + ZoneHWEq(Loop)%RadGainRate
ZoneIntGain(NZ)%QHWCON = ZoneIntGain(NZ)%QHWCON + ZoneHWEq(Loop)%ConGainRate
ZoneIntGain(NZ)%QHWLAT = ZoneIntGain(NZ)%QHWLAT + ZoneHWEq(Loop)%LatGainRate
ZoneIntGain(NZ)%QHWLost = ZoneIntGain(NZ)%QHWLost + ZoneHWEq(Loop)%LostRate
END DO
DO Loop = 1, TotStmEquip
Q = ZoneSteamEq(Loop)%DesignLevel * GetCurrentScheduleValue(ZoneSteamEq(Loop)%SchedPtr)
! Set Q to EMS override if being called for by EMs
IF (ZoneSteamEq(Loop)%EMSZoneEquipOverrideOn) Q = ZoneSteamEq(Loop)%EMSEquipPower
ZoneSteamEq(Loop)%Power = Q
ZoneSteamEq(Loop)%RadGainRate = Q * ZoneSteamEq(Loop)%FractionRadiant
ZoneSteamEq(Loop)%ConGainRate = Q * ZoneSteamEq(Loop)%FractionConvected
ZoneSteamEq(Loop)%LatGainRate = Q * ZoneSteamEq(Loop)%FractionLatent
ZoneSteamEq(Loop)%LostRate = Q * ZoneSteamEq(Loop)%FractionLost
ZoneSteamEq(Loop)%TotGainRate = Q - ZoneSteamEq(Loop)%LostRate
NZ = ZoneSteamEq(Loop)%ZonePtr
ZnRpt(NZ)%SteamPower = ZnRpt(NZ)%SteamPower + ZoneSteamEq(Loop)%Power
ZoneIntGain(NZ)%QSERAD = ZoneIntGain(NZ)%QSERAD + ZoneSteamEq(Loop)%RadGainRate
ZoneIntGain(NZ)%QSECON = ZoneIntGain(NZ)%QSECON + ZoneSteamEq(Loop)%ConGainRate
ZoneIntGain(NZ)%QSELAT = ZoneIntGain(NZ)%QSELAT + ZoneSteamEq(Loop)%LatGainRate
ZoneIntGain(NZ)%QSELost = ZoneIntGain(NZ)%QSELost + ZoneSteamEq(Loop)%LostRate
END DO
DO Loop = 1, TotBBHeat
NZ = ZoneBBHeat(Loop)%ZonePtr
IF (Zone(NZ)%OutDryBulbTemp >= ZoneBBHeat(Loop)%HighTemperature) THEN
Q = 0.0d0
ELSE IF (Zone(NZ)%OutDryBulbTemp > ZoneBBHeat(Loop)%LowTemperature) THEN
Q = (Zone(NZ)%OutDryBulbTemp - ZoneBBHeat(Loop)%LowTemperature) &
* (ZoneBBHeat(Loop)%CapatHighTemperature - ZoneBBHeat(Loop)%CapatLowTemperature) &
/ (ZoneBBHeat(Loop)%HighTemperature - ZoneBBHeat(Loop)%LowTemperature) &
+ ZoneBBHeat(Loop)%CapatLowTemperature
ELSE
Q = ZoneBBHeat(Loop)%CapatLowTemperature
END IF
Q = Q * GetCurrentScheduleValue(ZoneBBHeat(Loop)%SchedPtr)
! set with EMS value if being called for.
IF (ZoneBBHeat(Loop)%EMSZoneBaseboardOverrideOn) Q = ZoneBBHeat(Loop)%EMSZoneBaseboardPower
ZoneBBHeat(Loop)%Power = Q
ZoneBBHeat(Loop)%RadGainRate = Q * ZoneBBHeat(Loop)%FractionRadiant
ZoneBBHeat(Loop)%ConGainRate = Q * ZoneBBHeat(Loop)%FractionConvected
ZoneBBHeat(Loop)%TotGainRate = Q
NZ = ZoneBBHeat(Loop)%ZonePtr
ZnRpt(NZ)%BaseHeatPower = ZnRpt(NZ)%BaseHeatPower + ZoneBBHeat(Loop)%Power
ZoneIntGain(NZ)%QBBRAD = ZoneIntGain(NZ)%QBBRAD + ZoneBBHeat(Loop)%RadGainRate
ZoneIntGain(NZ)%QBBCON = ZoneIntGain(NZ)%QBBCON + ZoneBBHeat(Loop)%ConGainRate
END DO
DO Loop=1, TotCO2Gen
NZ = ZoneCO2Gen(Loop)%ZonePtr
ZoneCO2Gen(Loop)%CO2GainRate = ZoneCO2Gen(Loop)%CO2DesignRate * GetCurrentScheduleValue(ZoneCO2Gen(Loop)%SchedPtr)
ZnRpt(NZ)%CO2Rate = ZnRpt(NZ)%CO2Rate + ZoneCO2Gen(Loop)%CO2GainRate
ENDDO
CALL CalcWaterThermalTankZoneGains
CALL CalcZonePipesHeatGain
CALL CalcWaterUseZoneGains
CALL FigureFuelCellZoneGains
CALL FigureMicroCHPZoneGains
CALL FigureInverterZoneGains
CALL FigureElectricalStorageZoneGains
CALL FigureTransformerZoneGains
CALL FigureTDDZoneGains
CALL FigureRefrigerationZoneGains
! store pointer values to hold generic internal gain values constant for entire timestep
CALL UpdateInternalGainValues
DO NZ = 1, NumOfZones
CALL SumAllInternalRadiationGains(NZ, QL(NZ))
CALL SumAllInternalLatentGains(NZ, ZoneLatentGain(NZ))
END DO
SumConvHTRadSys = 0.0d0
pulseMultipler = 0.01d0 ! the W/sqft pulse for the zone
IF (CompLoadReportIsReq) THEN
CALL AllocateLoadComponentArrays
END IF
DO SurfNum = 1, TotSurfaces
NZ = Surface(SurfNum)%Zone
IF (.NOT. Surface(SurfNum)%HeatTransSurf .OR. NZ == 0) CYCLE ! Skip non-heat transfer surfaces
IF (.NOT. doLoadComponentPulseNow) THEN
QRadThermInAbs(SurfNum) = QL(NZ) * TMULT(NZ) * ITABSF(SurfNum)
ELSE
curQL = QL(NZ)
! for the loads component report during the special sizing run increase the radiant portion
! a small amount to create a "pulse" of heat that is used for the
adjQL = curQL + Zone(NZ)%FloorArea * pulseMultipler
! ITABSF is the Inside Thermal Absorptance
! TMULT is a mulipliter for each zone
! QRadThermInAbs is the thermal radiation absorbed on inside surfaces
QRadThermInAbs(SurfNum) = adjQL * TMULT(NZ) * ITABSF(SurfNum)
! store the magnitude and time of the pulse
radiantPulseUsed(NZ,CurOverallSimDay) = adjQL - curQL
radiantPulseTimestep(NZ,CurOverallSimDay) = (HourOfDay-1)*NumOfTimeStepInHour + TimeStep
radiantPulseReceived(SurfNum,CurOverallSimDay) = (adjQL - curQL) * TMULT(NZ) * ITABSF(SurfNum) * Surface(SurfNum)%area
END IF
END DO
RETURN
END SUBROUTINE InitInternalHeatGains