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.
SUBROUTINE ManageSizing
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN December 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine manages the sizing simulations (using design day condiions)
! for zones, central air systems, and central plants and zone heating and cooling
! METHODOLOGY EMPLOYED:
! Design day simulations are run with the zones supplied with "Ideal Loads",
! yielding zone design supply air flow rates and zone heating and cooling capacities.
!
! Design day simulations are run again with central air systems supplied by
! purchased hot and cold water, yielding central heating and cooling capacities.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumRangeCheckErrorsFound
USE ZoneEquipmentManager, ONLY: UpdateZoneSizing, ManageZoneEquipment, RezeroZoneSizingArrays
USE SimAirServingZones, ONLY: ManageAirLoops, UpdateSysSizing
USE DataEnvironment, ONLY: TotDesDays, OutDryBulbTemp, OutHumRat, OutBaroPress, CurEnvirNum, Month, DayOfMonth, EndMonthFlag, &
EnvironmentName
USE OutputReportPredefined
USE DataHeatBalance, ONLY: Zone
USE General, ONLY: TrimSigDigits, RoundSigDigits
USE OutputReportTabular, ONLY: isCompLoadRepReq,AllocateLoadComponentArrays, DeallocateLoadComponentArrays, &
ComputeLoadComponentDecayCurve
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='ManageSizing: '
! INTERFACE BLOCK SPECIFICATIONS: none
! DERIVED TYPE DEFINITIONS: none
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: Available=.false. ! an environment is available to process
LOGICAL, SAVE :: ErrorsFound=.false.
INTEGER,EXTERNAL :: GetNewUnitNumber
LOGICAL :: SimAir=.false.
LOGICAL :: SimZoneEquip=.false.
INTEGER :: TimeStepInDay=0 ! time step number
INTEGER :: LastMonth=0
INTEGER :: LastDayOfMonth=0
INTEGER :: CtrlZoneNum=0 ! controlled zone index
INTEGER :: ZoneNum=0 ! index into the Zone data array for the controlled zone
REAL(r64) :: TempAtPeak=0.0d0 ! Outside temperature at peak cooling/heating for reporting
REAL(r64) :: HumRatAtPeak=0.0d0 ! Outside humidity ratio at peak cooling/heating for reporting
INTEGER :: TimeStepAtPeak=0 ! time step number at heat or cool peak
INTEGER :: DDNum=0 ! Design Day index
INTEGER :: AirLoopNum=0 ! air loop index
! EXTERNAL ReportZoneSizing
! EXTERNAL ReportSysSizing
CHARACTER(len=MaxNameLength) :: curName
INTEGER :: NumSizingPeriodsPerformed
INTEGER :: write_stat
INTEGER :: numZoneSizeIter !number of times to repeat zone sizing calcs. 1 normal, 2 load component reporting
INTEGER :: iZoneCalcIter !index for repeating the zone sizing calcs
LOGICAL :: runZeroingOnce = .TRUE.
LOGICAL :: isUserReqCompLoadReport
! FLOW:
OutputFileZoneSizing = 0
OutputFileSysSizing = 0
TimeStepInDay = 0
SysSizingRunDone = .FALSE.
ZoneSizingRunDone = .FALSE.
curName='Unknown'
CALL GetOARequirements ! get the OA requirements object
CALL GetZoneAirDistribution ! get zone air distribution objects
CALL GetSizingParams ! get the building level sizing paramets
CALL GetZoneSizingInput ! get the Zone Sizing input
CALL GetSystemSizingInput ! get the System Sizing input
CALL GetPlantSizingInput ! get the Plant Sizing input
! okay, check sizing inputs vs desires vs requirements
IF (DoZoneSizing .or. DoSystemSizing) THEN
IF ((NumSysSizInput > 0 .and. NumZoneSizingInput == 0) .or. &
(.not. DoZoneSizing .and. DoSystemSizing .and. NumSysSizInput > 0)) THEN
CALL ShowSevereError(RoutineName//'Requested System Sizing but did not request Zone Sizing.')
CALL ShowContinueError('System Sizing cannot be done without Zone Sizing')
CALL ShowFatalError('Program terminates for preceding conditions.')
ENDIF
ENDIF
! determine if the second set of zone sizing calculations should be performed
! that include a pulse for the load component reporting
isUserReqCompLoadReport = isCompLoadRepReq() !check getinput structure if load component report is requested
IF (DoZoneSizing .AND. (NumZoneSizingInput .GT. 0)) THEN
CompLoadReportIsReq = isUserReqCompLoadReport
ELSE ! produce a warning if the user asked for the report but it will not be generated because sizing is not done
IF (isUserReqCompLoadReport) THEN
CALL ShowWarningError(RoutineName//'The ZoneComponentLoadSummary report was requested ' // &
'but no sizing objects were found so that report cannot be generated.')
ENDIF
END IF
IF (CompLoadReportIsReq) THEN !if that report is created then zone sizing calculations are repeated
numZoneSizeIter = 2
ELSE
numZoneSizeIter = 1
END IF
IF ( (DoZoneSizing) .AND. (NumZoneSizingInput == 0) ) THEN
CALL ShowWarningError(RoutineName//'For a zone sizing run, there must be at least 1 Sizing:Zone input object.'// &
' SimulationControl Zone Sizing option ignored.')
END IF
IF ( (NumZoneSizingInput > 0) .AND. (DoZoneSizing.OR.DoSystemSizing.OR.DoPlantSizing) ) THEN
IF (DoDesDaySim .OR. DoWeathSim) THEN
DoOutputReporting = .FALSE.
END IF
DoOutputReporting=.false.
ZoneSizingCalc = .TRUE.
Available=.true.
OutputFileZoneSizing = GetNewUnitNumber()
IF (SizingFileColSep == CharComma) THEN
OPEN (OutputFileZoneSizing,FILE='epluszsz.csv',Action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError(RoutineName//'Could not open file "epluszsz.csv" for output (write).')
ENDIF
ELSEIF (SizingFileColSep == CharTab) THEN
OPEN (OutputFileZoneSizing,FILE='epluszsz.tab',Action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError(RoutineName//'Could not open file "epluszsz.tab" for output (write).')
ENDIF
ELSE
OPEN (OutputFileZoneSizing,FILE='epluszsz.txt',Action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError(RoutineName//'Could not open file "epluszsz.txt" for output (write).')
ENDIF
ENDIF
CALL ShowMessage('Beginning Zone Sizing Calculations')
CALL ResetEnvironmentCounter
KickOffSizing=.true.
CALL SetupZoneSizing(ErrorsFound) ! Should only be done ONCE
KickOffSizing=.false.
DO iZoneCalcIter = 1, numZoneSizeIter !normally this is performed once but if load component
!report is requested, these are repeated with a pulse in
!each zone.
!set flag if performing a "pulse" set of sizing calcs
!the pulse simulation needs to be done first (the 1 in the following line) otherwise
!the difference seen in the loads in the epluspls and epluszsz files are not
!simple decreasing curves but appear as amost random fluctuations.
isPulseZoneSizing = (CompLoadReportIsReq .AND. (iZoneCalcIter .EQ. 1))
Available=.true.
CALL ResetEnvironmentCounter
CurOverallSimDay=0
NumSizingPeriodsPerformed=0
DO WHILE (Available) ! loop over environments
CALL GetNextEnvironment(Available,ErrorsFound) ! get an environment
IF (.not. Available) EXIT
IF (ErrorsFound) EXIT
! check that environment is one of the design days
IF (KindOfSim == ksRunPeriodWeather) THEN
CYCLE
ENDIF
NumSizingPeriodsPerformed=NumSizingPeriodsPerformed+1
BeginEnvrnFlag = .TRUE.
EndEnvrnFlag = .FALSE.
EndMonthFlag = .FALSE.
WarmupFlag = .TRUE.
DayOfSim = 0
DayOfSimChr ='0'
CurEnvirNumSimDay=1
CurOverallSimDay=CurOverallSimDay+1
DO WHILE ((DayOfSim.LT.NumOfDayInEnvrn).OR.(WarmupFlag)) ! Begin day loop ...
DayOfSim = DayOfSim + 1
IF (.not. WarmupFlag .and. DayOfSim > 1) THEN
CurEnvirNumSimDay=CurEnvirNumSimDay+1
ENDIF
WRITE(DayOfSimChr,*) DayOfSim
DayOfSimChr=ADJUSTL(DayOfSimChr)
BeginDayFlag = .TRUE.
EndDayFlag = .FALSE.
IF (WarmupFlag) THEN
CALL DisplayString('Warming up')
ELSE ! (.NOT.WarmupFlag)
IF (DayOfSim.EQ.1) THEN
IF (.NOT. isPulseZoneSizing) THEN
CALL DisplayString('Performing Zone Sizing Simulation')
CALL DisplayString('...for Sizing Period: #'//trim(RoundSigDigits(NumSizingPeriodsPerformed))// &
' '//trim(EnvironmentName))
ELSE
CALL DisplayString('Performing Zone Sizing Simulation for Load Component Report')
CALL DisplayString('...for Sizing Period: #'//trim(RoundSigDigits(NumSizingPeriodsPerformed))// &
' '//trim(EnvironmentName))
END IF
END IF
CALL UpdateZoneSizing(BeginDay)
END IF
DO HourOfDay = 1, 24 ! Begin hour loop ...
BeginHourFlag = .TRUE.
EndHourFlag = .FALSE.
DO TimeStep = 1, NumOfTimeStepInHour ! Begin time step (TINC) loop ...
BeginTimeStepFlag = .TRUE.
! Set the End__Flag variables to true if necessary. Note that
! each flag builds on the previous level. EndDayFlag cannot be
! .true. unless EndHourFlag is also .true., etc. Note that the
! EndEnvrnFlag and the EndSimFlag cannot be set during warmup.
! Note also that BeginTimeStepFlag, EndTimeStepFlag, and the
! SubTimeStepFlags can/will be set/reset in the HVAC Manager.
IF ((TimeStep.EQ.NumOfTimeStepInHour)) THEN
EndHourFlag = .TRUE.
IF (HourOfDay.EQ.24) THEN
EndDayFlag = .TRUE.
IF ((.NOT.WarmupFlag).AND.(DayOfSim.EQ.NumOfDayInEnvrn)) THEN
EndEnvrnFlag = .TRUE.
END IF
END IF
END IF
!set flag for pulse used in load component reporting
doLoadComponentPulseNow = .FALSE.
IF (isPulseZoneSizing) THEN
IF (.NOT. WarmupFlag) THEN
IF (DayOfSim .EQ. 1) THEN !first day of sizing period
IF (HourOfDay .EQ. 10) THEN !at 10am
IF (TimeStep .EQ. 1) THEN !first timestep in hour
doLoadComponentPulseNow = .TRUE.
END IF
END IF
END IF
END IF
END IF
CALL ManageWeather
IF (.not. WarmupFlag) THEN
TimeStepInDay = (HourOfDay-1)*NumOfTimeStepInHour + TimeStep
IF (HourOfDay == 1 .and. TimeStep == 1) THEN
DesDayWeath(CurOverallSimDay)%DateString=TRIM(TrimSigDigits(Month))//'/'//TRIM(TrimSigDigits(DayOfMonth))
ENDIF
DesDayWeath(CurOverallSimDay)%Temp(TimeStepInDay) = OutDryBulbTemp
DesDayWeath(CurOverallSimDay)%HumRat(TimeStepInDay) = OutHumRat
DesDayWeath(CurOverallSimDay)%Press(TimeStepInDay) = OutBaroPress
ENDIF
CALL ManageHeatBalance
! After the first iteration of HeatBalance, all the "input" has been gotten
IF (BeginSimFlag) THEN
IF (GetNumRangeCheckErrorsFound() > 0) THEN
CALL ShowFatalError(RoutineName//'Out of "range" values found in input')
ENDIF
ENDIF
BeginHourFlag = .FALSE.
BeginDayFlag = .FALSE.
BeginEnvrnFlag = .FALSE.
BeginSimFlag = .FALSE.
END DO ! ... End time step (TINC) loop.
PreviousHour=HourOfDay
END DO ! ... End hour loop.
IF (EndDayFlag) CALL UpdateZoneSizing(EndDay)
IF (.not. WarmupFlag .and. (DayOfSim > 0) .and. (DayOfSim.LT.NumOfDayInEnvrn)) THEN
CurOverallSimDay=CurOverallSimDay+1
ENDIF
END DO ! ... End day loop.
LastMonth=Month
LastDayOfMonth=DayOfMonth
END DO ! ... End environment loop
IF (NumSizingPeriodsPerformed > 0) THEN
CALL UpdateZoneSizing(EndZoneSizingCalc)
ZoneSizingRunDone = .TRUE.
ELSE
CALL ShowSevereError(RoutineName//'No Sizing periods were performed for Zone Sizing.'// &
' No Zone Sizing calculations saved.')
ErrorsFound=.true.
ENDIF
IF (isPulseZoneSizing .AND. runZeroingOnce) THEN
CALL RezeroZoneSizingArrays !zero all arrays related to zone sizing.
runZeroingOnce = .FALSE.
END IF
END DO !loop that repeats the zone sizing calcs for the load component report, if requested
! both the pulse and normal zone sizing is complete so now post processing of the results is performed
IF (CompLoadReportIsReq) THEN
! call the routine that computes the decay curve
CALL ComputeLoadComponentDecayCurve
! remove some of the arrays used to derive the decay curves
CALL DeallocateLoadComponentArrays
END IF
END IF
ZoneSizingCalc = .FALSE.
DoOutputReporting = .FALSE.
Month=LastMonth
DayOfMonth=LastDayOfMonth
IF ( (DoSystemSizing) .AND. (NumSysSizInput == 0) .AND. (NumAirLoops > 0) ) THEN
CALL ShowWarningError(RoutineName//'For a system sizing run, there must be at least 1 Sizing:System object input.'// &
' SimulationControl System Sizing option ignored.')
END IF
IF ( (NumSysSizInput > 0) .AND. (DoSystemSizing.OR.DoPlantSizing) .and. .not. ErrorsFound) THEN
CALL ShowMessage('Beginning System Sizing Calculations')
SysSizingCalc = .TRUE.
Available=.true.
OutputFileSysSizing = GetNewUnitNumber()
IF (SizingFileColSep == CharComma) THEN
OPEN (OutputFileSysSizing,FILE='eplusssz.csv',Action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError(RoutineName//'Could not open file "eplusssz.csv" for output (write).')
ENDIF
ELSEIF (SizingFileColSep == CharTab) THEN
OPEN (OutputFileSysSizing,FILE='eplusssz.tab',Action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError(RoutineName//'Could not open file "eplusssz.tab" for output (write).')
ENDIF
ELSE
OPEN (OutputFileSysSizing,FILE='eplusssz.txt',Action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError(RoutineName//'Could not open file "eplusssz.txt" for output (write).')
ENDIF
ENDIF
SimAir = .TRUE.
SimZoneEquip = .TRUE.
CALL ManageZoneEquipment(.TRUE.,SimZoneEquip,SimAir)
CALL ManageAirLoops(.TRUE.,SimAir,SimZoneEquip)
IF (GetNumRangeCheckErrorsFound() > 0) THEN
CALL ShowFatalError(RoutineName//'Out of "range" values found in input')
ENDIF
CALL ResetEnvironmentCounter
CurEnvirNumSimDay=0
CurOverallSimDay=0
NumSizingPeriodsPerformed=0
DO WHILE (Available) ! loop over environments
CALL GetNextEnvironment(Available,ErrorsFound) ! get an environment
! check that environment is one of the design days
IF (KindOfSim == ksRunPeriodWeather) THEN
CYCLE
ENDIF
IF (.not. Available) EXIT
IF (ErrorsFound) EXIT
NumSizingPeriodsPerformed=NumSizingPeriodsPerformed+1
BeginEnvrnFlag = .TRUE.
EndEnvrnFlag = .FALSE.
WarmupFlag = .FALSE.
DayOfSim = 0
DayOfSimChr = '0'
CurEnvirNumSimDay=1
CurOverallSimDay=CurOverallSimDay+1
DO WHILE ((DayOfSim.LT.NumOfDayInEnvrn).OR.(WarmupFlag)) ! Begin day loop ...
DayOfSim = DayOfSim + 1
IF (.not. WarmupFlag .and. DayOfSim > 1) THEN
CurEnvirNumSimDay=CurEnvirNumSimDay+1
ENDIF
WRITE(DayOfSimChr,*) DayOfSim
DayOfSimChr=ADJUSTL(DayOfSimChr)
BeginDayFlag = .TRUE.
EndDayFlag = .FALSE.
IF (WarmupFlag) THEN
CALL DisplayString('Warming up')
ELSE ! (.NOT.WarmupFlag)
IF (DayOfSim.EQ.1) THEN
CALL DisplayString('Calculating System sizing')
CALL DisplayString('...for Sizing Period: #'//trim(RoundSigDigits(NumSizingPeriodsPerformed))// &
' '//trim(EnvironmentName))
ENDIF
CALL UpdateSysSizing(BeginDay)
END IF
DO HourOfDay = 1, 24 ! Begin hour loop ...
BeginHourFlag = .TRUE.
EndHourFlag = .FALSE.
DO TimeStep = 1, NumOfTimeStepInHour ! Begin time step (TINC) loop ...
BeginTimeStepFlag = .TRUE.
! Set the End__Flag variables to true if necessary. Note that
! each flag builds on the previous level. EndDayFlag cannot be
! .true. unless EndHourFlag is also .true., etc. Note that the
! EndEnvrnFlag and the EndSimFlag cannot be set during warmup.
IF ((TimeStep.EQ.NumOfTimeStepInHour)) THEN
EndHourFlag = .TRUE.
IF (HourOfDay.EQ.24) THEN
EndDayFlag = .TRUE.
IF ((.NOT.WarmupFlag).AND.(DayOfSim.EQ.NumOfDayInEnvrn)) THEN
EndEnvrnFlag = .TRUE.
END IF
END IF
END IF
CALL ManageWeather
CALL UpdateSysSizing(DuringDay)
BeginHourFlag = .FALSE.
BeginDayFlag = .FALSE.
BeginEnvrnFlag = .FALSE.
END DO ! ... End time step (TINC) loop.
PreviousHour=HourOfDay
END DO ! ... End hour loop.
IF (EndDayFlag) CALL UpdateSysSizing(EndDay)
IF (.not. WarmupFlag .and. (DayOfSim > 0) .and. (DayOfSim.LT.NumOfDayInEnvrn)) THEN
CurOverallSimDay=CurOverallSimDay+1
ENDIF
END DO ! ... End day loop.
END DO ! ... End environment loop
IF (NumSizingPeriodsPerformed > 0) THEN
CALL UpdateSysSizing(EndSysSizingCalc)
SysSizingRunDone = .TRUE.
ELSE
CALL ShowSevereError(RoutineName//'No Sizing periods were performed for System Sizing.'// &
' No System Sizing calculations saved.')
ErrorsFound=.true.
ENDIF
END IF
SysSizingCalc = .FALSE.
! report sizing results to eio file
IF (ZoneSizingRunDone) THEN
DO CtrlZoneNum = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZoneNum)%IsControlled) CYCLE
ZoneNum = FinalZoneSizing(CtrlZoneNum)%ActualZoneNum
IF (FinalZoneSizing(CtrlZoneNum)%DesCoolVolFlow > 0.0d0) THEN
TimeStepAtPeak = FinalZoneSizing(CtrlZoneNum)%TimeStepNumAtCoolMax
DDNum = FinalZoneSizing(CtrlZoneNum)%CoolDDNum
IF (DDNum > 0 .AND. TimeStepAtPeak > 0) THEN
TempAtPeak = DesDayWeath(DDNum)%Temp(TimeStepAtPeak)
HumRatAtPeak = DesDayWeath(DDNum)%HumRat(TimeStepAtPeak)
ELSE
TempAtPeak = 0.0d0
HumRatAtPeak = 0.0d0
END IF
CALL ReportZoneSizing(FinalZoneSizing(CtrlZoneNum)%ZoneName, &
'Cooling', &
CalcFinalZoneSizing(CtrlZoneNum)%DesCoolLoad, &
FinalZoneSizing(CtrlZoneNum)%DesCoolLoad, &
CalcFinalZoneSizing(CtrlZoneNum)%DesCoolVolFlow, &
FinalZoneSizing(CtrlZoneNum)%DesCoolVolFlow, &
FinalZoneSizing(CtrlZoneNum)%CoolDesDay, &
CoolPeakDateHrMin(CtrlZoneNum), &
TempAtPeak, &
HumRatAtPeak, &
Zone(ZoneNum)%FloorArea, &
Zone(ZoneNum)%TotOccupants, &
FinalZoneSizing(CtrlZoneNum)%MinOA)
curName = FinalZoneSizing(CtrlZoneNum)%ZoneName
CALL PreDefTableEntry(pdchZnClCalcDesLd,curName,CalcFinalZoneSizing(CtrlZoneNum)%DesCoolLoad)
CALL PreDefTableEntry(pdchZnClUserDesLd,curName,FinalZoneSizing(CtrlZoneNum)%DesCoolLoad)
IF (Zone(ZoneNum)%FloorArea .NE. 0.0d0) THEN
CALL PreDefTableEntry(pdchZnClUserDesLdPerArea,curName,FinalZoneSizing(CtrlZoneNum)%DesCoolLoad / Zone(ZoneNum)%FloorArea)
ENDIF
CALL PreDefTableEntry(pdchZnClCalcDesAirFlow,curName,CalcFinalZoneSizing(CtrlZoneNum)%DesCoolVolFlow,3)
CALL PreDefTableEntry(pdchZnClUserDesAirFlow,curName,FinalZoneSizing(CtrlZoneNum)%DesCoolVolFlow,3)
CALL PreDefTableEntry(pdchZnClDesDay,curName,FinalZoneSizing(CtrlZoneNum)%CoolDesDay)
CALL PreDefTableEntry(pdchZnClPkTime,curName,CoolPeakDateHrMin(CtrlZoneNum))
CALL PreDefTableEntry(pdchZnClPkTstatTemp,curName,CalcFinalZoneSizing(CtrlZoneNum)%CoolTstatTemp)
CALL PreDefTableEntry(pdchZnClPkIndTemp,curName,CalcFinalZoneSizing(CtrlZoneNum)%ZoneTempAtCoolPeak)
CALL PreDefTableEntry(pdchZnClPkIndHum,curName,CalcFinalZoneSizing(CtrlZoneNum)%ZoneHumRatAtCoolPeak,5)
CALL PreDefTableEntry(pdchZnClPkOATemp,curName,TempAtPeak)
CALL PreDefTableEntry(pdchZnClPkOAHum,curName,HumRatAtPeak,5)
END IF
IF (FinalZoneSizing(CtrlZoneNum)%DesHeatVolFlow > 0.0d0) THEN
TimeStepAtPeak = FinalZoneSizing(CtrlZoneNum)%TimeStepNumAtHeatMax
DDNum = FinalZoneSizing(CtrlZoneNum)%HeatDDNum
IF (DDNum > 0 .AND. TimeStepAtPeak > 0) THEN
TempAtPeak = DesDayWeath(DDNum)%Temp(TimeStepAtPeak)
HumRatAtPeak = DesDayWeath(DDNum)%HumRat(TimeStepAtPeak)
ELSE
TempAtPeak = 0.0d0
HumRatAtPeak = 0.0d0
END IF
CALL ReportZoneSizing(FinalZoneSizing(CtrlZoneNum)%ZoneName, &
'Heating', &
CalcFinalZoneSizing(CtrlZoneNum)%DesHeatLoad, &
FinalZoneSizing(CtrlZoneNum)%DesHeatLoad, &
CalcFinalZoneSizing(CtrlZoneNum)%DesHeatVolFlow, &
FinalZoneSizing(CtrlZoneNum)%DesHeatVolFlow, &
FinalZoneSizing(CtrlZoneNum)%HeatDesDay, &
HeatPeakDateHrMin(CtrlZoneNum), &
TempAtPeak, &
HumRatAtPeak, &
Zone(ZoneNum)%FloorArea, &
Zone(ZoneNum)%TotOccupants, &
FinalZoneSizing(CtrlZoneNum)%MinOA)
curName = FinalZoneSizing(CtrlZoneNum)%ZoneName
CALL PreDefTableEntry(pdchZnHtCalcDesLd,curName,CalcFinalZoneSizing(CtrlZoneNum)%DesHeatLoad)
CALL PreDefTableEntry(pdchZnHtUserDesLd,curName,FinalZoneSizing(CtrlZoneNum)%DesHeatLoad)
IF (Zone(ZoneNum)%FloorArea .NE. 0.0d0) THEN
CALL PreDefTableEntry(pdchZnHtUserDesLdPerArea,curName,FinalZoneSizing(CtrlZoneNum)%DesHeatLoad/Zone(ZoneNum)%FloorArea)
ENDIF
CALL PreDefTableEntry(pdchZnHtCalcDesAirFlow,curName,CalcFinalZoneSizing(CtrlZoneNum)%DesHeatVolFlow,3)
CALL PreDefTableEntry(pdchZnHtUserDesAirFlow,curName,FinalZoneSizing(CtrlZoneNum)%DesHeatVolFlow,3)
CALL PreDefTableEntry(pdchZnHtDesDay,curName,FinalZoneSizing(CtrlZoneNum)%HeatDesDay)
CALL PreDefTableEntry(pdchZnHtPkTime,curName,HeatPeakDateHrMin(CtrlZoneNum))
CALL PreDefTableEntry(pdchZnHtPkTstatTemp,curName,CalcFinalZoneSizing(CtrlZoneNum)%HeatTstatTemp)
CALL PreDefTableEntry(pdchZnHtPkIndTemp,curName,CalcFinalZoneSizing(CtrlZoneNum)%ZoneTempAtHeatPeak)
CALL PreDefTableEntry(pdchZnHtPkIndHum,curName,CalcFinalZoneSizing(CtrlZoneNum)%ZoneHumRatAtHeatPeak,5)
CALL PreDefTableEntry(pdchZnHtPkOATemp,curName,TempAtPeak)
CALL PreDefTableEntry(pdchZnHtPkOAHum,curName,HumRatAtPeak,5)
END IF
END DO
! Deallocate arrays no longer needed
DEALLOCATE(ZoneSizing)
DEALLOCATE(CalcZoneSizing)
END IF
IF (SysSizingRunDone) THEN
DO AirLoopNum=1,NumPrimaryAirSys
curName = FinalSysSizing(AirLoopNum)%AirPriLoopName
CALL ReportSysSizing(curName, &
'Calculated Cooling Design Air Flow Rate [m3/s]', &
CalcSysSizing(AirLoopNum)%DesCoolVolFlow)
CALL PreDefTableEntry(pdchSysSizCalcClAir,curName,CalcSysSizing(AirLoopNum)%DesCoolVolFlow)
IF (ABS(CalcSysSizing(AirLoopNum)%DesCoolVolFlow) <= 1.d-8) THEN
CALL ShowWarningError(RoutineName//'Calculated Cooling Design Air Flow Rate for System='// &
TRIM(FinalSysSizing(AirLoopNum)%AirPriLoopName)//' is zero.')
CALL ShowContinueError('Check Sizing:Zone and ZoneControl:Thermostat inputs.')
ENDIF
CALL ReportSysSizing(curName, &
'User Cooling Design Air Flow Rate [m3/s]', &
FinalSysSizing(AirLoopNum)%DesCoolVolFlow)
CALL PreDefTableEntry(pdchSysSizUserClAir,curName,FinalSysSizing(AirLoopNum)%DesCoolVolFlow)
CALL ReportSysSizing(curName, &
'Calculated Heating Design Air Flow Rate [m3/s]', &
CalcSysSizing(AirLoopNum)%DesHeatVolFlow)
CALL PreDefTableEntry(pdchSysSizCalcHtAir,curName,CalcSysSizing(AirLoopNum)%DesHeatVolFlow)
IF (ABS(CalcSysSizing(AirLoopNum)%DesHeatVolFlow) <= 1.d-8) THEN
CALL ShowWarningError(RoutineName//'Calculated Heating Design Air Flow Rate for System='// &
TRIM(FinalSysSizing(AirLoopNum)%AirPriLoopName)//' is zero.')
CALL ShowContinueError('Check Sizing:Zone and ZoneControl:Thermostat inputs.')
ENDIF
CALL ReportSysSizing(curName, &
'User Heating Design Air Flow Rate [m3/s]', &
FinalSysSizing(AirLoopNum)%DesHeatVolFlow)
CALL PreDefTableEntry(pdchSysSizUserHtAir,curName,FinalSysSizing(AirLoopNum)%DesHeatVolFlow)
END DO
! Deallocate arrays no longer needed
DEALLOCATE(SysSizing)
DEALLOCATE(CalcSysSizing)
END IF
IF ( (DoPlantSizing) .AND. (NumPltSizInput == 0)) THEN
CALL ShowWarningError(RoutineName//'For a plant sizing run, there must be at least 1 Sizing:Plant object input.'// &
' SimulationControl Plant Sizing option ignored.')
END IF
IF ( (NumPltSizInput > 0) .AND. (DoPlantSizing) .and. .not. ErrorsFound) THEN
CALL ShowMessage('Beginning Plant Sizing Calculations')
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Program terminates due to preceding conditions.')
ENDIF
RETURN
END SUBROUTINE ManageSizing