SUBROUTINE WriteZoneLoadComponentTable
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN March 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Write the tables for the ZoneLoadComponentSummary and
! ZoneLoadComponentDetail reports which summarize the major
! load components for each zone in the building.
! METHODOLOGY EMPLOYED:
! Create arrays for the call to writeTable and then call it.
! This report actually consists of many sub-tables each with
! its own call to writeTable.
!
! The overall methodology is explained below:
!
! Determine decay curve - Pulse of radiant heat which is about 5% of lighting and
! equipment input [radiantPulseUsed(iZone)] for a single timestep a few hours after
! cooling or heat is scheduled on for each zone [radiantPulseTimestep(iZone)].
! The radiant heat received on each wall is stored [radiantPulseReceived(jSurface)].
! The load convected in the normal case [loadConvectedNormal(jSurface, kTime, mode)]
! and in the case with the pulse [loadConvectedWithPulse(jSurface, kTime, mode)].
! The difference divided by the pulse received by each surface
! [radiantPulseReceived(jSurface)] is stored in [decayCurve(jSurface,kTime,mode)].
!
! Determine delayed loads - From the last timestep of the peak load on the zone
! working backwards any radiant heat that was absorbed by the wall from an internal gain
! or solar gain is multiplied by the appropriate timesteps in the decay curve
! [decayCurve(jSurface,kTime,mode)] for timesteps that make up
! the number of averaged timesteps are used to determine the peak load
! [NumTimeStepsInAvg]. The sum for all surfaces in the zone are added together to
! determine the delayed load.
!
! Determine instant loads - Average the convective portion of the internal gains
! for the timesteps made up of the peak load period. Average those across the peak
! load period.
!
! REFERENCES:
! na
! USE STATEMENTS:
! na
USE DataHeatBalance, ONLY: Zone
USE SQLiteProcedures, ONLY: CreateSQLiteTabularDataRecords
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE DataSurfaces, ONLY: Surface, TotSurfaces,ExternalEnvironment,Ground,GroundFCfactorMethod, &
OtherSideCoefNoCalcExt,OtherSideCoefCalcExt,OtherSideCondModeledExt, &
SurfaceClass_Wall,SurfaceClass_Floor,SurfaceClass_Roof, &
SurfaceClass_Door,OSC
USE DataSizing, ONLY: CalcFinalZoneSizing,NumTimeStepsInAvg,CoolPeakDateHrMin,HeatPeakDateHrMin
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE DataGlobals, ONLY: NumOfTimeStepInHour, CompLoadReportIsReq,ShowDecayCurvesInEIO
USE General, ONLY: MovingAvg
USE Psychrometrics, ONLY: PsyTwbFnTdbWPb,PsyRhFnTdbWPb
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! These correspond to the columns in the load component table
INTEGER, PARAMETER :: cSensInst = 1
INTEGER, PARAMETER :: cSensDelay = 2
INTEGER, PARAMETER :: cSensRA = 3
INTEGER, PARAMETER :: cLatent = 4
INTEGER, PARAMETER :: cTotal = 5
INTEGER, PARAMETER :: cPerc = 6
!internal gains
INTEGER, PARAMETER :: rPeople = 1
INTEGER, PARAMETER :: rLights = 2
INTEGER, PARAMETER :: rEquip = 3
INTEGER, PARAMETER :: rRefrig = 4
INTEGER, PARAMETER :: rWaterUse = 5
INTEGER, PARAMETER :: rHvacLoss = 6
INTEGER, PARAMETER :: rPowerGen = 7
!misc
INTEGER, PARAMETER :: rInfil = 8
INTEGER, PARAMETER :: rZoneVent = 9
INTEGER, PARAMETER :: rIntZonMix = 10
!opaque surfaces
INTEGER, PARAMETER :: rRoof = 11
INTEGER, PARAMETER :: rIntZonCeil = 12
INTEGER, PARAMETER :: rOtherRoof = 13
INTEGER, PARAMETER :: rExtWall = 14
INTEGER, PARAMETER :: rIntZonWall = 15
INTEGER, PARAMETER :: rGrdWall = 16
INTEGER, PARAMETER :: rOtherWall = 17
INTEGER, PARAMETER :: rExtFlr = 18
INTEGER, PARAMETER :: rIntZonFlr = 19
INTEGER, PARAMETER :: rGrdFlr = 20
INTEGER, PARAMETER :: rOtherFlr = 21
!subsurfaces
INTEGER, PARAMETER :: rFeneCond = 22
INTEGER, PARAMETER :: rFeneSolr = 23
INTEGER, PARAMETER :: rOpqDoor = 24
!total
INTEGER, PARAMETER :: rGrdTot = 25
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: CoolDesSelected = 0 !design day selected for cooling
INTEGER :: HeatDesSelected = 0 !design day selected for heating
INTEGER :: timeCoolMax = 0 !Time Step at Cool max
INTEGER :: timeHeatMax = 0 !Time Step at Heat Max
INTEGER :: iZone = 0
INTEGER :: jTime = 0
INTEGER :: k = 0
INTEGER :: kSurf = 0
INTEGER :: numObj = 0
INTEGER :: objCount = 0
INTEGER :: ZoneNum = 0
INTEGER :: tempUnitConvIndex = 0
REAL(r64),ALLOCATABLE, DIMENSION(:) :: seqData !raw data sequence that has not been averaged yet
REAL(r64),ALLOCATABLE, DIMENSION(:) :: avgData !sequence data after averaging
INTEGER :: NumOfTimeStepInDay
REAL(r64),ALLOCATABLE, DIMENSION(:) :: delayOpaque !hold values for report for delayed opaque
REAL(r64) :: singleSurfDelay
REAL(r64),ALLOCATABLE, DIMENSION(:) :: totalColumn
REAL(r64),ALLOCATABLE, DIMENSION(:) :: percentColumn
REAL(r64),ALLOCATABLE, DIMENSION(:) :: grandTotalRow
REAL(r64) :: totalGrandTotal
REAL(r64) :: powerConversion
INTEGER :: tempConvIndx !temperature conversion index
CHARACTER(len=MaxNameLength) :: stringWithTemp
INTEGER :: curExtBoundCond
REAL(r64) :: mult !zone multiplier
! all arrays are in the format: (row, column)
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: columnHead
INTEGER,ALLOCATABLE,DIMENSION(:) :: columnWidth
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: rowHead
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:,:) :: tableBody
IF (displayZoneComponentLoadSummary .AND. CompLoadReportIsReq) THEN
CALL ComputeDelayedComponents
NumOfTimeStepInDay = NumOfTimeStepInHour*24
ALLOCATE(seqData(NumOfTimeStepInDay))
ALLOCATE(avgData(NumOfTimeStepInDay))
ALLOCATE(delayOpaque(rGrdTot))
ALLOCATE(totalColumn(rGrdTot))
ALLOCATE(percentColumn(rGrdTot))
ALLOCATE(grandTotalRow(cPerc))
!establish unit conversion factors
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
powerConversion = getSpecificUnitMultiplier('W','Btu/h') !or kBtuh?
tempConvIndx = getSpecificUnitIndex('C','F')
ELSE
powerConversion = 1.0d0
tempConvIndx = 0 !when zero is used with ConvertIP the value is returned unconverted
END IF
! show the line definition for the decay curves
IF (ShowDecayCurvesInEIO) THEN
WRITE (OutputFileInits, '(A)') '! <Radiant to Convective Decay Curves for Cooling>,Zone Name, Surface Name, Time ' &
// '1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36'
WRITE (OutputFileInits, '(A)') '! <Radiant to Convective Decay Curves for Heating>,Zone Name, Surface Name, Time ' &
// '1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36'
END IF
DO iZone = 1, NumOfZones
IF (.not. ZoneEquipConfig(iZone)%IsControlled) CYCLE
mult = Zone(iZone)%Multiplier * Zone(iZone)%ListMultiplier
IF (mult .EQ. 0.0) mult = 1.0
!
!---- Cooling Peak Load Components Sub-Table
!
CALL WriteReportHeaders('Zone Component Load Summary',TRIM(Zone(iZone)%Name),isAverage)
ALLOCATE(rowHead(rGrdTot))
ALLOCATE(columnHead(cPerc))
ALLOCATE(columnWidth(cPerc))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(rGrdTot,cPerc))
IF (unitsStyle .NE. unitsStyleInchPound) THEN
columnHead(cSensInst) = 'Sensible - Instant [W]'
columnHead(cSensDelay) = 'Sensible - Delayed [W]'
columnHead(cSensRA) = 'Sensible - Return Air [W]'
columnHead(cLatent) = 'Latent [W]'
columnHead(cTotal) = 'Total [W]'
columnHead(cPerc) = '%Grand Total'
ELSE
columnHead(cSensInst) = 'Sensible - Instant [Btu/h]'
columnHead(cSensDelay) = 'Sensible - Delayed [Btu/h]'
columnHead(cSensRA) = 'Sensible - Return Air [Btu/h]'
columnHead(cLatent) = 'Latent [Btu/h]'
columnHead(cTotal) = 'Total [Btu/h]'
columnHead(cPerc) = '%Grand Total'
END IF
!internal gains
rowHead(rPeople) = 'People'
rowHead(rLights) = 'Lights'
rowHead(rEquip) = 'Equipment'
rowHead(rRefrig) = 'Refrigeration Equipment'
rowHead(rWaterUse) = 'Water Use Equipment'
rowHead(rPowerGen) = 'Power Generation Equipment'
rowHead(rHvacLoss) = 'HVAC Equipment Losses'
rowHead(rRefrig) = 'Refrigeration'
!misc
rowHead(rInfil) = 'Infiltration'
rowHead(rZoneVent) = 'Zone Ventilation'
rowHead(rIntZonMix) = 'Interzone Mixing'
!opaque surfaces
rowHead(rRoof) = 'Roof'
rowHead(rIntZonCeil) = 'Interzone Ceiling'
rowHead(rOtherRoof) = 'Other Roof'
rowHead(rExtWall) = 'Exterior Wall'
rowHead(rIntZonWall) = 'Interzone Wall'
rowHead(rGrdWall) = 'Ground Contact Wall'
rowHead(rOtherWall) = 'Other Wall'
rowHead(rExtFlr) = 'Exterior Floor'
rowHead(rIntZonFlr) = 'Interzone Floor'
rowHead(rGrdFlr) = 'Ground Contact Floor'
rowHead(rOtherFlr) = 'Other Floor'
!subsurfaces
rowHead(rFeneCond) = 'Fenestration Conduction'
rowHead(rFeneSolr) = 'Fenestration Solar'
rowHead(rOpqDoor) = 'Opaque Door'
rowHead(rGrdTot) = 'Grand Total'
tableBody = ''
totalColumn = 0.0d0
percentColumn = 0.0d0
grandTotalRow = 0.0d0
CoolDesSelected = CalcFinalZoneSizing(iZone)%CoolDDNum
timeCoolMax = CalcFinalZoneSizing(iZone)%TimeStepNumAtCoolMax
IF (CoolDesSelected .NE. 0 .AND. timeCoolMax .NE. 0) THEN
!PEOPLE
seqData = peopleInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rPeople,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rPeople) = totalColumn(rPeople) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = peopleLatentSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rPeople,cLatent) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rPeople) = totalColumn(rPeople) + AvgData(timeCoolMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeCoolMax)
seqData = peopleDelaySeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rPeople,cSensDelay) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rPeople) = totalColumn(rPeople) + AvgData(timeCoolMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeCoolMax)
!LIGHTS
seqData = lightInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rLights,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rLights) = totalColumn(rLights) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = lightRetAirSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rLights,cSensRA) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rLights) = totalColumn(rLights) + AvgData(timeCoolMax)
grandTotalRow(cSensRA) = grandTotalRow(cSensRA) + AvgData(timeCoolMax)
seqData = lightDelaySeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rLights,cSensDelay) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rLights) = totalColumn(rLights) + AvgData(timeCoolMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeCoolMax)
!EQUIPMENT
seqData = equipInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rEquip,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rEquip) = totalColumn(rEquip) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = equipLatentSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rEquip,cLatent) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rEquip) = totalColumn(rEquip) + AvgData(timeCoolMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeCoolMax)
seqData = equipDelaySeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rEquip,cSensDelay) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rEquip) = totalColumn(rEquip) + AvgData(timeCoolMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeCoolMax)
!REFRIGERATION EQUIPMENT
seqData = refrigInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rRefrig,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rRefrig) = totalColumn(rRefrig) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = refrigRetAirSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rRefrig,cSensRA) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rRefrig) = totalColumn(rRefrig) + AvgData(timeCoolMax)
grandTotalRow(cSensRA) = grandTotalRow(cSensRA) + AvgData(timeCoolMax)
seqData = refrigLatentSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rRefrig,cLatent) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rRefrig) = totalColumn(rRefrig) + AvgData(timeCoolMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeCoolMax)
!WATER USE EQUIPMENT
seqData = waterUseInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rWaterUse,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rWaterUse) = totalColumn(rWaterUse) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = waterUseLatentSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rWaterUse,cLatent) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rWaterUse) = totalColumn(rWaterUse) + AvgData(timeCoolMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeCoolMax)
!HVAC EQUIPMENT LOSSES
seqData = hvacLossInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rHvacLoss,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rHvacLoss) = totalColumn(rHvacLoss) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = hvacLossDelaySeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rHvacLoss,cSensDelay) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rHvacLoss) = totalColumn(rHvacLoss) + AvgData(timeCoolMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeCoolMax)
!POWER GENERATION EQUIPMENT
seqData = powerGenInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rPowerGen,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rPowerGen) = totalColumn(rPowerGen) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = powerGenDelaySeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rPowerGen,cSensDelay) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rPowerGen) = totalColumn(rPowerGen) + AvgData(timeCoolMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeCoolMax)
!INFILTRATION
seqData = infilInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rInfil,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rInfil) = totalColumn(rInfil) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = infilLatentSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rInfil,cLatent) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rInfil) = totalColumn(rInfil) + AvgData(timeCoolMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeCoolMax)
!ZONE VENTILATION
seqData = zoneVentInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rZoneVent,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rZoneVent) = totalColumn(rZoneVent) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = zoneVentLatentSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rZoneVent,cLatent) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rZoneVent) = totalColumn(rZoneVent) + AvgData(timeCoolMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeCoolMax)
!INTERZONE MIXING
seqData = interZoneMixInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rIntZonMix,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rIntZonMix) = totalColumn(rIntZonMix) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = interZoneMixLatentSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rIntZonMix,cLatent) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rIntZonMix) = totalColumn(rIntZonMix) + AvgData(timeCoolMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeCoolMax)
!FENESTRATION CONDUCTION
seqData = feneCondInstantSeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rFeneCond,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rFeneCond) = totalColumn(rFeneCond) + AvgData(timeCoolMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
!FENESTRATION SOLAR
! seqData = feneSolarInstantSeq(iZone,:,CoolDesSelected) * powerConversion
! CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
! tableBody(rFeneSolr,cSensInst) = TRIM(RealToStr(AvgData(timeCoolMax),2))
! totalColumn(rFeneSolr) = totalColumn(rFeneSolr) + AvgData(timeCoolMax)
! grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeCoolMax)
seqData = feneSolarDelaySeq(iZone,:,CoolDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rFeneSolr,cSensDelay) = TRIM(RealToStr(AvgData(timeCoolMax),2))
totalColumn(rFeneSolr) = totalColumn(rFeneSolr) + AvgData(timeCoolMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeCoolMax)
!opaque surfaces - must combine individual surfaces by class and other side conditions
delayOpaque = 0.0d0
DO kSurf = 1,TotSurfaces
IF (.NOT. Surface(kSurf)%HeatTransSurf) CYCLE ! Skip non-heat transfer surfaces
IF (Surface(kSurf)%Zone .EQ. iZone) THEN
curExtBoundCond = surface(kSurf)%ExtBoundCond
!if exterior is other side coefficients using ground preprocessor terms then
!set it to ground instead of other side coefficients
IF (curExtBoundCond .EQ. OtherSideCoefNoCalcExt .OR. curExtBoundCond .EQ. OtherSideCoefCalcExt) THEN
IF (SameString(OSC(Surface(kSurf)%OSCPtr)%Name(1:17), 'surfPropOthSdCoef')) THEN
curExtBoundCond = Ground
END IF
END IF
seqData = surfDelaySeq(kSurf,:,CoolDesSelected)
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
singleSurfDelay = AvgData(timeCoolMax) * powerConversion
SELECT CASE (surface(kSurf)%class)
CASE (SurfaceClass_Wall)
SELECT CASE (curExtBoundCond)
CASE (ExternalEnvironment)
delayOpaque(rExtWall) = delayOpaque(rExtWall) + singleSurfDelay
CASE (Ground,GroundFCfactorMethod)
delayOpaque(rGrdWall) = delayOpaque(rGrdWall) + singleSurfDelay
CASE (OtherSideCoefNoCalcExt,OtherSideCoefCalcExt,OtherSideCondModeledExt)
delayOpaque(rOtherWall) = delayOpaque(rOtherWall) + singleSurfDelay
CASE DEFAULT !interzone
delayOpaque(rIntZonWall) = delayOpaque(rIntZonWall) + singleSurfDelay
END SELECT
CASE (SurfaceClass_Floor)
SELECT CASE (curExtBoundCond)
CASE (ExternalEnvironment)
delayOpaque(rExtFlr) = delayOpaque(rExtFlr) + singleSurfDelay
CASE (Ground,GroundFCfactorMethod)
delayOpaque(rGrdFlr) = delayOpaque(rGrdFlr) + singleSurfDelay
CASE (OtherSideCoefNoCalcExt,OtherSideCoefCalcExt,OtherSideCondModeledExt)
delayOpaque(rOtherFlr) = delayOpaque(rOtherFlr) + singleSurfDelay
CASE DEFAULT !interzone
delayOpaque(rIntZonFlr) = delayOpaque(rIntZonFlr) + singleSurfDelay
END SELECT
CASE (SurfaceClass_Roof)
SELECT CASE (curExtBoundCond)
CASE (ExternalEnvironment)
delayOpaque(rRoof) = delayOpaque(rRoof) + singleSurfDelay
CASE (Ground,GroundFCfactorMethod,OtherSideCoefNoCalcExt,OtherSideCoefCalcExt,OtherSideCondModeledExt)
delayOpaque(rOtherRoof) = delayOpaque(rOtherRoof) + singleSurfDelay
CASE DEFAULT !interzone
delayOpaque(rIntZonCeil) = delayOpaque(rIntZonCeil) + singleSurfDelay
END SELECT
CASE (SurfaceClass_Door)
delayOpaque(rOpqDoor) = delayOpaque(rOpqDoor) + singleSurfDelay
END SELECT
END IF
END DO
DO k = rRoof,rOtherFlr
tableBody(k,cSensDelay) = TRIM(RealToStr(delayOpaque(k),2))
totalColumn(k) = totalColumn(k) + delayOpaque(k)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + delayOpaque(k)
END DO
tableBody(rOpqDoor,cSensDelay) = TRIM(RealToStr(delayOpaque(rOpqDoor),2))
totalColumn(rOpqDoor) = totalColumn(rOpqDoor) + delayOpaque(rOpqDoor)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + delayOpaque(rOpqDoor)
END IF
!GRAND TOTAL ROW
totalGrandTotal = 0.0d0
DO k = 1,cLatent
tableBody(rGrdTot,k) = TRIM(RealToStr(grandTotalRow(k),2))
totalGrandTotal = totalGrandTotal + grandTotalRow(k)
END DO
tableBody(rGrdTot,cTotal) = TRIM(RealToStr(totalGrandTotal,2))
!TOTAL COLUMN AND PERCENT COLUMN
DO k = 1,rOpqDoor !to last row before total
tableBody(k,cTotal) = TRIM(RealToStr(totalColumn(k),2))
IF (totalGrandTotal .NE. 0.0d0) THEN
tableBody(k,cPerc) = TRIM(RealToStr(100 * totalColumn(k)/totalGrandTotal,2))
END IF
END DO
CALL writeSubtitle('Estimated Cooling Peak Load Components')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'ZoneComponentLoadSummary',&
TRIM(Zone(iZone)%Name),&
'Estimated Cooling Peak Load Components')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Cooling Peak Conditions
!
ALLOCATE(rowHead(10))
ALLOCATE(columnHead(1))
ALLOCATE(columnWidth(1))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(10,1))
columnHead(1) = 'Value'
IF (unitsStyle .NE. unitsStyleInchPound) THEN
rowHead(1) = 'Time of Peak Load'
rowHead(2) = 'Outside Dry Bulb Temperature [C]'
rowHead(3) = 'Outside Wet Bulb Temperature [C]'
rowHead(4) = 'Outside Humidity Ratio at Peak [kgWater/kgAir]'
rowHead(5) = 'Zone Dry Bulb Temperature [C]'
rowHead(6) = 'Zone Relative Humdity [%]'
rowHead(7) = 'Zone Humidity Ratio at Peak [kgWater/kgAir]'
rowHead(8) = 'Peak Design Sensible Load [W]'
rowHead(9) = 'Estimated Instant + Delayed Sensible Load [W]'
rowHead(10) = 'Difference [W]'
ELSE
rowHead(1) = 'Time of Peak Load'
rowHead(2) = 'Outside Dry Bulb Temperature [F]'
rowHead(3) = 'Outside Wet Bulb Temperature [F]'
rowHead(4) = 'Outside Humidity Ratio at Peak [lbWater/lbAir]'
rowHead(5) = 'Zone Dry Bulb Temperature [F]'
rowHead(6) = 'Zone Relative Humdity [%]'
rowHead(7) = 'Zone Humidity Ratio at Peak [lbWater/lbAir]'
rowHead(8) = 'Peak Design Sensible Load [Btu/h]'
rowHead(9) = 'Estimated Instant + Delayed Sensible Load [Btu/h]'
rowHead(10) = 'Difference [Btu/h]'
END IF
tableBody = ''
IF (timeCoolMax .NE. 0) THEN
!Time of Peak Load
tableBody(1,1) = TRIM(CoolPeakDateHrMin(iZone))
!Outside Dry Bulb Temperature
tableBody(2,1) = TRIM(RealToStr(convertIP(tempConvIndx,CalcFinalZoneSizing(iZone)%CoolOutTempSeq(timeCoolMax)),2))
!Outside Wet Bulb Temperature
!use standard sea level air pressure because air pressure is not tracked with sizing data
IF (CalcFinalZoneSizing(iZone)%CoolOutHumRatSeq(timeCoolMax) .LT. 1.0d0 .AND. &
CalcFinalZoneSizing(iZone)%CoolOutHumRatSeq(timeCoolMax) .GT. 0.0d0) THEN
tableBody(3,1) = TRIM(RealToStr(convertIP(tempConvIndx, &
PsyTwbFnTdbWPb(CalcFinalZoneSizing(iZone)%CoolOutTempSeq(timeCoolMax), &
CalcFinalZoneSizing(iZone)%CoolOutHumRatSeq(timeCoolMax), &
101325.0d0)) ,2))
END IF
!Outside Humidity Ratio at Peak
tableBody(4,1) = TRIM(RealToStr(CalcFinalZoneSizing(iZone)%CoolOutHumRatSeq(timeCoolMax),5))
!Zone Dry Bulb Temperature
tableBody(5,1) = TRIM(RealToStr(convertIP(tempConvIndx,CalcFinalZoneSizing(iZone)%CoolZoneTempSeq(timeCoolMax)),2))
!Zone Relative Humdity
!use standard sea level air pressure because air pressure is not tracked with sizing data
tableBody(6,1) = TRIM(RealToStr(100 * PsyRhFnTdbWPb(CalcFinalZoneSizing(iZone)%CoolZoneTempSeq(timeCoolMax), &
CalcFinalZoneSizing(iZone)%CoolZoneHumRatSeq(timeCoolMax), &
101325.0d0) ,2))
!Zone Humidity Ratio at Peak
tableBody(7,1) = TRIM(RealToStr(CalcFinalZoneSizing(iZone)%CoolZoneHumRatSeq(timeCoolMax),5))
END IF
!Peak Design Sensible Load
tableBody(8,1) = TRIM(RealToStr((CalcFinalZoneSizing(iZone)%DesCoolLoad / mult) * powerConversion,2))
!Estimated Instant + Delayed Sensible Load
tableBody(9,1) = TRIM(RealToStr(grandTotalRow(cSensInst) + grandTotalRow(cSensDelay),2))
!Difference
tableBody(10,1) = TRIM(RealToStr((CalcFinalZoneSizing(iZone)%DesCoolLoad / mult) * powerConversion &
- (grandTotalRow(cSensInst) + grandTotalRow(cSensDelay)),2))
CALL writeSubtitle('Cooling Peak Conditions')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'ZoneComponentLoadSummary',&
TRIM(Zone(iZone)%Name),&
'Cooling Peak Conditions')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
! !
! !---- Radiant to Convective Decay Curves for Cooling
! !
! numObj = 0
! !determine the number of surfaces to include
! DO kSurf = 1, TotSurfaces
! ZoneNum = Surface(kSurf)%Zone
! IF (ZoneNum .NE. iZone) CYCLE
! IF (ZoneNum .EQ. 0) CYCLE
! IF (.not. ZoneEquipConfig(ZoneNum)%IsControlled) CYCLE
! numObj = numObj + 1
! END DO
!
! ALLOCATE(rowHead(numObj))
! ALLOCATE(columnHead(16))
! ALLOCATE(columnWidth(16))
! columnWidth = 14 !array assignment - same for all columns
! ALLOCATE(tableBody(numObj,16))
!
! columnHead(1) = 'Time 1'
! columnHead(2) = 'Time 2'
! columnHead(3) = 'Time 3'
! columnHead(4) = 'Time 4'
! columnHead(5) = 'Time 5'
! columnHead(6) = 'Time 6'
! columnHead(7) = 'Time 7'
! columnHead(8) = 'Time 8'
! columnHead(9) = 'Time 9'
! columnHead(10) = 'Time 10'
! columnHead(11) = 'Time 11'
! columnHead(12) = 'Time 12'
! columnHead(13) = 'Time 13'
! columnHead(14) = 'Time 14'
! columnHead(15) = 'Time 15'
! columnHead(16) = 'Time 16'
!
! tableBody = ''
! objCount = 0
! DO kSurf = 1, TotSurfaces
! ZoneNum = Surface(kSurf)%Zone
! IF (ZoneNum .NE. iZone) CYCLE
! IF (ZoneNum .EQ. 0) CYCLE
! IF (.not. ZoneEquipConfig(ZoneNum)%IsControlled) CYCLE
! objCount = objCount + 1
! rowHead(objCount) = TRIM(Surface(kSurf)%Name)
! DO jTime = 1, 16
! tableBody(objCount,jTime) = TRIM(RealToStr(decayCurveCool(kSurf,jTime),3))
! END DO
! END DO
!
! CALL writeSubtitle('Radiant to Convective Decay Curves for Cooling')
! CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
! CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
! 'ZoneComponentLoadDetail',&
! TRIM(Zone(iZone)%Name),&
! 'Radiant to Convective Decay Curves for Cooling')
!
! DEALLOCATE(columnHead)
! DEALLOCATE(rowHead)
! DEALLOCATE(columnWidth)
! DEALLOCATE(tableBody)
! Put the decay curve into the EIO file
IF (ShowDecayCurvesInEIO) THEN
DO kSurf = 1, TotSurfaces
ZoneNum = Surface(kSurf)%Zone
IF (ZoneNum .NE. iZone) CYCLE
IF (ZoneNum .EQ. 0) CYCLE
IF (.not. ZoneEquipConfig(ZoneNum)%IsControlled) CYCLE
WRITE (OutputFileInits, '(4A)',ADVANCE='NO') 'Radiant to Convective Decay Curves for Cooling,' &
,TRIM(Zone(iZone)%Name),',',TRIM(Surface(kSurf)%Name)
DO jTime = 1, MIN(NumOfTimeStepInHour*24,36)
WRITE(OutputFileInits,'(A,F6.3)',ADVANCE='NO') ',',decayCurveCool(kSurf,jTime)
END DO
WRITE(OutputFileInits,'()',ADVANCE='YES') !put a line feed at the end of the line
END DO
END IF
!
!---- Heating Peak Load Components Sub-Table
!
ALLOCATE(rowHead(rGrdTot))
ALLOCATE(columnHead(cPerc))
ALLOCATE(columnWidth(cPerc))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(rGrdTot,cPerc))
IF (unitsStyle .NE. unitsStyleInchPound) THEN
columnHead(cSensInst) = 'Sensible - Instant [W]'
columnHead(cSensDelay) = 'Sensible - Delayed [W]'
columnHead(cSensRA) = 'Sensible - Return Air [W]'
columnHead(cLatent) = 'Latent [W]'
columnHead(cTotal) = 'Total [W]'
columnHead(cPerc) = '%Grand Total'
ELSE
columnHead(cSensInst) = 'Sensible - Instant [Btu/h]'
columnHead(cSensDelay) = 'Sensible - Delayed [Btu/h]'
columnHead(cSensRA) = 'Sensible - Return Air [Btu/h]'
columnHead(cLatent) = 'Latent [Btu/h]'
columnHead(cTotal) = 'Total [Btu/h]'
columnHead(cPerc) = '%Grand Total'
END IF
!internal gains
rowHead(rPeople) = 'People'
rowHead(rLights) = 'Lights'
rowHead(rEquip) = 'Equipment'
rowHead(rRefrig) = 'Refrigeration Equipment'
rowHead(rWaterUse) = 'Water Use Equipment'
rowHead(rPowerGen) = 'Power Generation Equipment'
rowHead(rHvacLoss) = 'HVAC Equipment Losses'
rowHead(rRefrig) = 'Refrigeration'
!misc
rowHead(rInfil) = 'Infiltration'
rowHead(rZoneVent) = 'Zone Ventilation'
rowHead(rIntZonMix) = 'Interzone Mixing'
!opaque surfaces
rowHead(rRoof) = 'Roof'
rowHead(rIntZonCeil) = 'Interzone Ceiling'
rowHead(rOtherRoof) = 'Other Roof'
rowHead(rExtWall) = 'Exterior Wall'
rowHead(rIntZonWall) = 'Interzone Wall'
rowHead(rGrdWall) = 'Ground Contact Wall'
rowHead(rOtherWall) = 'Other Wall'
rowHead(rExtFlr) = 'Exterior Floor'
rowHead(rIntZonFlr) = 'Interzone Floor'
rowHead(rGrdFlr) = 'Ground Contact Floor'
rowHead(rOtherFlr) = 'Other Floor'
!subsurfaces
rowHead(rFeneCond) = 'Fenestration Conduction'
rowHead(rFeneSolr) = 'Fenestration Solar'
rowHead(rOpqDoor) = 'Opaque Door'
rowHead(rGrdTot) = 'Grand Total'
tableBody = ''
totalColumn = 0.0d0
percentColumn = 0.0d0
grandTotalRow = 0.0d0
HeatDesSelected = CalcFinalZoneSizing(iZone)%HeatDDNum
timeHeatMax = CalcFinalZoneSizing(iZone)%TimeStepNumAtHeatMax
IF (HeatDesSelected .NE. 0 .AND. timeHeatMax .NE. 0) THEN
!PEOPLE
seqData = peopleInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rPeople,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rPeople) = totalColumn(rPeople) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = peopleLatentSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rPeople,cLatent) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rPeople) = totalColumn(rPeople) + AvgData(timeHeatMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeHeatMax)
seqData = peopleDelaySeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rPeople,cSensDelay) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rPeople) = totalColumn(rPeople) + AvgData(timeHeatMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeHeatMax)
!LIGHTS
seqData = lightInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rLights,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rLights) = totalColumn(rLights) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = lightRetAirSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rLights,cSensRA) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rLights) = totalColumn(rLights) + AvgData(timeHeatMax)
grandTotalRow(cSensRA) = grandTotalRow(cSensRA) + AvgData(timeHeatMax)
seqData = lightDelaySeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rLights,cSensDelay) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rLights) = totalColumn(rLights) + AvgData(timeHeatMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeHeatMax)
!EQUIPMENT
seqData = equipInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rEquip,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rEquip) = totalColumn(rEquip) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = equipLatentSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rEquip,cLatent) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rEquip) = totalColumn(rEquip) + AvgData(timeHeatMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeHeatMax)
seqData = equipDelaySeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rEquip,cSensDelay) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rEquip) = totalColumn(rEquip) + AvgData(timeHeatMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeHeatMax)
!REFRIGERATION EQUIPMENT
seqData = refrigInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rRefrig,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rRefrig) = totalColumn(rRefrig) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = refrigRetAirSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rRefrig,cSensRA) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rRefrig) = totalColumn(rRefrig) + AvgData(timeHeatMax)
grandTotalRow(cSensRA) = grandTotalRow(cSensRA) + AvgData(timeHeatMax)
seqData = refrigLatentSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rRefrig,cLatent) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rRefrig) = totalColumn(rRefrig) + AvgData(timeHeatMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeHeatMax)
!WATER USE EQUIPMENT
seqData = waterUseInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rWaterUse,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rWaterUse) = totalColumn(rWaterUse) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = waterUseLatentSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rWaterUse,cLatent) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rWaterUse) = totalColumn(rWaterUse) + AvgData(timeHeatMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeHeatMax)
!HVAC EQUIPMENT LOSSES
seqData = hvacLossInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rHvacLoss,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rHvacLoss) = totalColumn(rHvacLoss) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = hvacLossDelaySeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rHvacLoss,cSensDelay) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rHvacLoss) = totalColumn(rHvacLoss) + AvgData(timeHeatMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeHeatMax)
!POWER GENERATION EQUIPMENT
seqData = powerGenInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rPowerGen,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rPowerGen) = totalColumn(rPowerGen) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = powerGenDelaySeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rPowerGen,cSensDelay) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rPowerGen) = totalColumn(rPowerGen) + AvgData(timeHeatMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeHeatMax)
!INFILTRATION
seqData = infilInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rInfil,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rInfil) = totalColumn(rInfil) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = infilLatentSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rInfil,cLatent) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rInfil) = totalColumn(rInfil) + AvgData(timeHeatMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeHeatMax)
!ZONE VENTILATION
seqData = zoneVentInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rZoneVent,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rZoneVent) = totalColumn(rZoneVent) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = zoneVentLatentSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rZoneVent,cLatent) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rZoneVent) = totalColumn(rZoneVent) + AvgData(timeHeatMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeHeatMax)
!INTERZONE MIXING
seqData = interZoneMixInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rIntZonMix,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rIntZonMix) = totalColumn(rIntZonMix) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = interZoneMixLatentSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rIntZonMix,cLatent) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rIntZonMix) = totalColumn(rIntZonMix) + AvgData(timeHeatMax)
grandTotalRow(cLatent) = grandTotalRow(cLatent) + AvgData(timeHeatMax)
!FENESTRATION CONDUCTION
seqData = feneCondInstantSeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rFeneCond,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rFeneCond) = totalColumn(rFeneCond) + AvgData(timeHeatMax)
grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
!FENESTRATION SOLAR
! seqData = feneSolarInstantSeq(iZone,:,HeatDesSelected) * powerConversion
! CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
! tableBody(rFeneSolr,cSensInst) = TRIM(RealToStr(AvgData(timeHeatMax),2))
! totalColumn(rFeneSolr) = totalColumn(rFeneSolr) + AvgData(timeHeatMax)
! grandTotalRow(cSensInst) = grandTotalRow(cSensInst) + AvgData(timeHeatMax)
seqData = feneSolarDelaySeq(iZone,:,HeatDesSelected) * powerConversion
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
tableBody(rFeneSolr,cSensDelay) = TRIM(RealToStr(AvgData(timeHeatMax),2))
totalColumn(rFeneSolr) = totalColumn(rFeneSolr) + AvgData(timeHeatMax)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + AvgData(timeHeatMax)
!opaque surfaces - must combine individual surfaces by class and other side conditions
delayOpaque = 0.0d0
DO kSurf = 1,TotSurfaces
IF (.NOT. Surface(kSurf)%HeatTransSurf) CYCLE ! Skip non-heat transfer surfaces
IF (Surface(kSurf)%Zone .EQ. iZone) THEN
curExtBoundCond = surface(kSurf)%ExtBoundCond
!if exterior is other side coefficients using ground preprocessor terms then
!set it to ground instead of other side coefficients
IF (curExtBoundCond .EQ. OtherSideCoefNoCalcExt .OR. curExtBoundCond .EQ. OtherSideCoefCalcExt) THEN
IF (SameString(OSC(Surface(kSurf)%OSCPtr)%Name(1:17), 'surfPropOthSdCoef')) THEN
curExtBoundCond = Ground
END IF
END IF
seqData = surfDelaySeq(kSurf,:,HeatDesSelected)
CALL MovingAvg(seqData,NumOfTimeStepInDay,NumTimeStepsInAvg,AvgData)
singleSurfDelay = AvgData(timeHeatMax) * powerConversion
SELECT CASE (surface(kSurf)%class)
CASE (SurfaceClass_Wall)
SELECT CASE (curExtBoundCond)
CASE (ExternalEnvironment)
delayOpaque(rExtWall) = delayOpaque(rExtWall) + singleSurfDelay
CASE (Ground,GroundFCfactorMethod)
delayOpaque(rGrdWall) = delayOpaque(rGrdWall) + singleSurfDelay
CASE (OtherSideCoefNoCalcExt,OtherSideCoefCalcExt,OtherSideCondModeledExt)
delayOpaque(rOtherWall) = delayOpaque(rOtherWall) + singleSurfDelay
CASE DEFAULT !interzone
delayOpaque(rIntZonWall) = delayOpaque(rIntZonWall) + singleSurfDelay
END SELECT
CASE (SurfaceClass_Floor)
SELECT CASE (curExtBoundCond)
CASE (ExternalEnvironment)
delayOpaque(rExtFlr) = delayOpaque(rExtFlr) + singleSurfDelay
CASE (Ground,GroundFCfactorMethod)
delayOpaque(rGrdFlr) = delayOpaque(rGrdFlr) + singleSurfDelay
CASE (OtherSideCoefNoCalcExt,OtherSideCoefCalcExt,OtherSideCondModeledExt)
delayOpaque(rOtherFlr) = delayOpaque(rOtherFlr) + singleSurfDelay
CASE DEFAULT !interzone
delayOpaque(rIntZonFlr) = delayOpaque(rIntZonFlr) + singleSurfDelay
END SELECT
CASE (SurfaceClass_Roof)
SELECT CASE (curExtBoundCond)
CASE (ExternalEnvironment)
delayOpaque(rRoof) = delayOpaque(rRoof) + singleSurfDelay
CASE (Ground,GroundFCfactorMethod,OtherSideCoefNoCalcExt,OtherSideCoefCalcExt,OtherSideCondModeledExt)
delayOpaque(rOtherRoof) = delayOpaque(rOtherRoof) + singleSurfDelay
CASE DEFAULT !interzone
delayOpaque(rIntZonCeil) = delayOpaque(rIntZonCeil) + singleSurfDelay
END SELECT
CASE (SurfaceClass_Door)
delayOpaque(rOpqDoor) = delayOpaque(rOpqDoor) + singleSurfDelay
END SELECT
END IF
END DO
DO k = rRoof,rOtherFlr
tableBody(k,cSensDelay) = TRIM(RealToStr(delayOpaque(k),2))
totalColumn(k) = totalColumn(k) + delayOpaque(k)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + delayOpaque(k)
END DO
tableBody(rOpqDoor,cSensDelay) = TRIM(RealToStr(delayOpaque(rOpqDoor),2))
totalColumn(rOpqDoor) = totalColumn(rOpqDoor) + delayOpaque(rOpqDoor)
grandTotalRow(cSensDelay) = grandTotalRow(cSensDelay) + delayOpaque(rOpqDoor)
END IF
!GRAND TOTAL ROW
totalGrandTotal = 0.0d0
DO k = 1,cLatent
tableBody(rGrdTot,k) = TRIM(RealToStr(grandTotalRow(k),2))
totalGrandTotal = totalGrandTotal + grandTotalRow(k)
END DO
tableBody(rGrdTot,cTotal) = TRIM(RealToStr(totalGrandTotal,2))
!TOTAL COLUMN AND PERCENT COLUMN
DO k = 1,rOpqDoor !to last row before total
tableBody(k,cTotal) = TRIM(RealToStr(totalColumn(k),2))
IF (totalGrandTotal .NE. 0.0d0) THEN
tableBody(k,cPerc) = TRIM(RealToStr(100 * totalColumn(k)/totalGrandTotal,2))
END IF
END DO
CALL writeSubtitle('Estimated Heating Peak Load Components')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'ZoneComponentLoadSummary',&
TRIM(Zone(iZone)%Name),&
'Estimated Heating Peak Load Components')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Heating Peak Conditions Sub-Table
!
ALLOCATE(rowHead(10))
ALLOCATE(columnHead(1))
ALLOCATE(columnWidth(1))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(10,1))
columnHead(1) = 'Value'
IF (unitsStyle .NE. unitsStyleInchPound) THEN
rowHead(1) = 'Time of Peak Load'
rowHead(2) = 'Outside Dry Bulb Temperature [C]'
rowHead(3) = 'Outside Wet Bulb Temperature [C]'
rowHead(4) = 'Outside Humidity Ratio at Peak [kgWater/kgAir]'
rowHead(5) = 'Zone Dry Bulb Temperature [C]'
rowHead(6) = 'Zone Relative Humdity [%]'
rowHead(7) = 'Zone Humidity Ratio at Peak [kgWater/kgAir]'
rowHead(8) = 'Peak Design Sensible Load [W]'
rowHead(9) = 'Estimated Instant + Delayed Sensible Load [W]'
rowHead(10) = 'Difference [W]'
ELSE
rowHead(1) = 'Time of Peak Load'
rowHead(2) = 'Outside Dry Bulb Temperature [F]'
rowHead(3) = 'Outside Wet Bulb Temperature [F]'
rowHead(4) = 'Outside Humidity Ratio at Peak [lbWater/lbAir]'
rowHead(5) = 'Zone Dry Bulb Temperature [F]'
rowHead(6) = 'Zone Relative Humdity [%]'
rowHead(7) = 'Zone Humidity Ratio at Peak [lbWater/lbAir]'
rowHead(8) = 'Peak Design Sensible Load [Btu/h]'
rowHead(9) = 'Estimated Instant + Delayed Sensible Load [Btu/h]'
rowHead(10) = 'Difference [Btu/h]'
END IF
tableBody = ''
IF (timeHeatMax .NE. 0) THEN
!Time of Peak Load
tableBody(1,1) = TRIM(HeatPeakDateHrMin(iZone))
!Outside Dry Bulb Temperature
tableBody(2,1) = TRIM(RealToStr(convertIP(tempConvIndx,CalcFinalZoneSizing(iZone)%HeatOutTempSeq(timeHeatMax)),2))
!Outside Wet Bulb Temperature
!use standard sea level air pressure because air pressure is not tracked with sizing data
IF (CalcFinalZoneSizing(iZone)%HeatOutHumRatSeq(timeHeatMax) .LT. 1.0d0 .AND. &
CalcFinalZoneSizing(iZone)%HeatOutHumRatSeq(timeHeatMax) .GT. 0.0d0) THEN
tableBody(3,1) = TRIM(RealToStr(convertIP(tempConvIndx, &
PsyTwbFnTdbWPb(CalcFinalZoneSizing(iZone)%HeatOutTempSeq(timeHeatMax), &
CalcFinalZoneSizing(iZone)%HeatOutHumRatSeq(timeHeatMax), &
101325.0d0)) ,2))
END IF
!Humidity Ratio at Peak
tableBody(4,1) = TRIM(RealToStr(CalcFinalZoneSizing(iZone)%HeatOutHumRatSeq(timeHeatMax),5))
!Zone Dry Bulb Temperature
tableBody(5,1) = TRIM(RealToStr(convertIP(tempConvIndx,CalcFinalZoneSizing(iZone)%HeatZoneTempSeq(timeHeatMax)),2))
!Zone Relative Temperature
!use standard sea level air pressure because air pressure is not tracked with sizing data
tableBody(6,1) = TRIM(RealToStr(100 * PsyRhFnTdbWPb(CalcFinalZoneSizing(iZone)%HeatZoneTempSeq(timeHeatMax), &
CalcFinalZoneSizing(iZone)%HeatZoneHumRatSeq(timeHeatMax), &
101325.0d0) ,2))
!Zone Relative Humdity
tableBody(7,1) = TRIM(RealToStr(CalcFinalZoneSizing(iZone)%HeatZoneHumRatSeq(timeHeatMax),5))
END IF
!Peak Design Sensible Load
tableBody(8,1) = TRIM(RealToStr((-CalcFinalZoneSizing(iZone)%DesHeatLoad / mult) * powerConversion,2)) !change sign
!Estimated Instant + Delayed Sensible Load
tableBody(9,1) = TRIM(RealToStr(grandTotalRow(cSensInst) + grandTotalRow(cSensDelay),2))
!Difference
tableBody(10,1) = TRIM(RealToStr((-CalcFinalZoneSizing(iZone)%DesHeatLoad /mult) * powerConversion &
- (grandTotalRow(cSensInst) + grandTotalRow(cSensDelay)),2))
CALL writeSubtitle('Heating Peak Conditions')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'ZoneComponentLoadSummary',&
TRIM(Zone(iZone)%Name),&
'Heating Peak Conditions')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
! !
! !---- Radiant to Convective Decay Curves for Heating
! !
! numObj = 0
! !determine the number of surfaces to include
! DO kSurf = 1, TotSurfaces
! ZoneNum = Surface(kSurf)%Zone
! IF (ZoneNum .NE. iZone) CYCLE
! IF (ZoneNum .EQ. 0) CYCLE
! IF (.not. ZoneEquipConfig(ZoneNum)%IsControlled) CYCLE
! numObj = numObj + 1
! END DO
!
! ALLOCATE(rowHead(numObj))
! ALLOCATE(columnHead(16))
! ALLOCATE(columnWidth(16))
! columnWidth = 14 !array assignment - same for all columns
! ALLOCATE(tableBody(numObj,16))
!
! columnHead(1) = 'Time 1'
! columnHead(2) = 'Time 2'
! columnHead(3) = 'Time 3'
! columnHead(4) = 'Time 4'
! columnHead(5) = 'Time 5'
! columnHead(6) = 'Time 6'
! columnHead(7) = 'Time 7'
! columnHead(8) = 'Time 8'
! columnHead(9) = 'Time 9'
! columnHead(10) = 'Time 10'
! columnHead(11) = 'Time 11'
! columnHead(12) = 'Time 12'
! columnHead(13) = 'Time 13'
! columnHead(14) = 'Time 14'
! columnHead(15) = 'Time 15'
! columnHead(16) = 'Time 16'
!
! tableBody = ''
! objCount = 0
! DO kSurf = 1, TotSurfaces
! ZoneNum = Surface(kSurf)%Zone
! IF (ZoneNum .NE. iZone) CYCLE
! IF (ZoneNum .EQ. 0) CYCLE
! IF (.not. ZoneEquipConfig(ZoneNum)%IsControlled) CYCLE
! objCount = objCount + 1
! rowHead(objCount) = TRIM(Surface(kSurf)%Name)
! DO jTime = 1, 16
! tableBody(objCount,jTime) = TRIM(RealToStr(decayCurveHeat(kSurf,jTime),3))
! END DO
! END DO
!
! CALL writeSubtitle('Radiant to Convective Decay Curves for Heating')
! CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
! CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
! 'ZoneComponentLoadDetail',&
! TRIM(Zone(iZone)%Name),&
! 'Radiant to Convective Decay Curves for Heating')
!
! DEALLOCATE(columnHead)
! DEALLOCATE(rowHead)
! DEALLOCATE(columnWidth)
! DEALLOCATE(tableBody)
! Put the decay curve into the EIO file
IF (ShowDecayCurvesInEIO) THEN
DO kSurf = 1, TotSurfaces
ZoneNum = Surface(kSurf)%Zone
IF (ZoneNum .NE. iZone) CYCLE
IF (ZoneNum .EQ. 0) CYCLE
IF (.not. ZoneEquipConfig(ZoneNum)%IsControlled) CYCLE
WRITE (OutputFileInits, '(4A)',ADVANCE='NO') 'Radiant to Convective Decay Curves for Heating,', &
TRIM(Zone(iZone)%Name),',',TRIM(Surface(kSurf)%Name)
DO jTime = 1, MIN(NumOfTimeStepInHour*24,36)
WRITE(OutputFileInits,'(A,F6.3)',ADVANCE='NO') ',', decayCurveHeat(kSurf,jTime)
END DO
WRITE(OutputFileInits,'()',ADVANCE='YES') !put a line feed at the end of the line
END DO
END IF
END DO
END IF
END SUBROUTINE WriteZoneLoadComponentTable