Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical, | intent(in) | :: | ShortenTimeStepSys | |||
logical, | intent(in) | :: | UseZoneTimeStepHistory | |||
real(kind=r64), | intent(in) | :: | PriorTimeStep |
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 PredictSystemLoads(ShortenTimeStepSys, UseZoneTimeStepHistory, PriorTimeStep )
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN May 1997
! MODIFIED na
! RE-ENGINEERED July 2003 (Peter Graham Ellis)
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is responsible for determining
! how much of each type of energy every zone requires.
! In effect, this subroutine defines and simulates all
! the system types and in the case of hybrid systems
! which use more than one type of energy must determine
! how to apportion the load. An example of a hybrid system
! is a water loop heat pump with supplemental air. In
! this case, a zone will require water from the loop and
! cooled or heated air from the air system. A simpler
! example would be a VAV system with baseboard heaters.
! Basic Air System Types
! 1) Constant Volume Single Duct
! 2) Variable Volume Single Duct
! 3) Constant Volume Dual Duct
! 4) Variable Volume Dual Duct
! METHODOLOGY EMPLOYED:
! 0. Determine if simulation has downstepped and readjust history and revert node results
! 1. Determine zone load - this is zone temperature dependent
! 2. Determine balance point - the temperature at which the
! zone load is balanced by the system output. The way the
! balance point is determined will be different depending on
! the type of system being simulated.
! 3. Calculate zone energy requirements
! REFERENCES:
! na
! USE STATEMENTS:
USE DataRoomAirModel, ONLY: AirModel,RoomAirModel_Mixing,RoomAirModel_UCSDDV,IsZoneDV,ZoneDVMixedFlag,IsZoneUI, &
ZTFloor,MATFloor,XMATFloor,XM2TFloor,XM3TFloor,XM4TFloor, &
ZTOC,ZTM1OC,MATOC,XMATOC,XM2TOC,XM3TOC,XM4TOC, &
ZTMX,ZTM1MX,MATMX,XMATMX,XM2TMX,XM3TMX,XM4TMX, RoomAirModel_Mundt, RoomAirModel_UserDefined
USE General, ONLY: TrimSigDigits
USE DataEnvironment, ONLY: Month, DayOfMonth
USE DataLoopNode, ONLY: Node
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataGlobals, ONLY: CurrentTime
Use DataEnvironment, ONLY: DayOfYear
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN) :: ShortenTimeStepSys
LOGICAL, INTENT(IN) :: UseZoneTimeStepHistory ! if true then use zone timestep history, if false use system time step
REAL(r64), INTENT(IN) :: PriorTimeStep ! the old value for timestep length is passed for possible use in interpolating
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: SumIntGain ! Zone sum of convective internal gains
REAL(r64) :: SumHA ! Zone sum of Hc*Area
REAL(r64) :: SumHATsurf ! Zone sum of Hc*Area*Tsurf
REAL(r64) :: SumHATref ! Zone sum of Hc*Area*Tref, for ceiling diffuser convection correlation
REAL(r64) :: SumMCp ! Zone sum of MassFlowRate*Cp
REAL(r64) :: SumMCpT ! Zone sum of MassFlowRate*Cp*T
REAL(r64) :: SumSysMCp ! Zone sum of air system MassFlowRate*Cp
REAL(r64) :: SumSysMCpT ! Zone sum of air system MassFlowRate*Cp*T
REAL(r64) :: TempDepCoef ! Formerly CoefSumha
REAL(r64) :: TempIndCoef ! Formerly CoefSumhat
REAL(r64) :: AirCap ! Formerly CoefAirrat
!unused1208 REAL(r64) :: TimeStepSeconds
REAL(r64) :: TempHistoryTerm
INTEGER :: ZoneNum
REAL(r64) :: ZoneT ! Zone temperature at previous time step
INTEGER :: RelativeZoneNum
INTEGER :: ActualZoneNum
INTEGER :: I
INTEGER :: Itemp
REAL(r64) :: SetpointOffset
! Staged thermostat setpoint
IF (NumStageCtrZone > 0) THEN
DO RelativeZoneNum = 1, NumStageCtrZone
ActualZoneNum = StageControlledZone(RelativeZoneNum)%ActualZoneNum
ZoneT = MAT(ActualZoneNum)
IF (ShortenTimeStepSys) ZoneT = XMPT(ActualZoneNum)
StageControlledZone(RelativeZoneNum)%HeatSetpoint=GetCurrentScheduleValue(StageControlledZone(RelativeZoneNum)%HSBchedIndex)
StageControlledZone(RelativeZoneNum)%CoolSetpoint=GetCurrentScheduleValue(StageControlledZone(RelativeZoneNum)%CSBchedIndex)
If (StageControlledZone(RelativeZoneNum)%HeatSetpoint .GE. StageControlledZone(RelativeZoneNum)%CoolSetpoint) Then
StageControlledZone(RelativeZoneNum)%StageErrCount = StageControlledZone(RelativeZoneNum)%StageErrCount + 1
if (StageControlledZone(RelativeZoneNum)%StageErrCount < 2) then
CALL ShowWarningError('ZoneControl:Thermostat:StagedDualSetpoint: The heating setpoint is equal to or above '// &
'the cooling setpoint in '//TRIM(StageControlledZone(RelativeZoneNum)%Name))
CALL ShowContinueError('The zone heating setpoint is set to the cooling setpoint - 0.1C.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
else
CALL ShowRecurringWarningErrorAtEnd('The heating setpoint is still above '// &
'the cooling setpoint',StageControlledZone(RelativeZoneNum)%StageErrIndex, &
StageControlledZone(RelativeZoneNum)%HeatSetpoint, StageControlledZone(RelativeZoneNum)%HeatSetpoint)
end if
StageControlledZone(RelativeZoneNum)%HeatSetpoint = StageControlledZone(RelativeZoneNum)%CoolSetpoint-0.1 !???????????
End If
! Determine either cooling or heating
If (StageControlledZone(RelativeZoneNum)%CoolSetpoint < ZoneT) Then ! Cooling
SetpointOffset = ZoneT - StageControlledZone(RelativeZoneNum)%CoolSetpoint
Itemp = 0
Do I=1, StageControlledZone(RelativeZoneNum)%NumOfCoolStages
If (SetpointOffset >= StageControlledZone(RelativeZoneNum)%CoolTOffset(I)) Then
Itemp = -I
End If
End Do
ZoneSysEnergyDemand(ActualZoneNum)%StageNum = Itemp
If (SetpointOffset >= 0.5d0* StageControlledZone(RelativeZoneNum)%CoolThroRange) Then
ZoneThermostatSetPointHi(ActualZoneNum) = StageControlledZone(RelativeZoneNum)%CoolSetpoint - &
0.5d0*StageControlledZone(RelativeZoneNum)%CoolThroRange
Else
ZoneThermostatSetPointHi(ActualZoneNum) = StageControlledZone(RelativeZoneNum)%CoolSetpoint + &
0.5d0*StageControlledZone(RelativeZoneNum)%CoolThroRange
End If
ZoneThermostatSetPointLo(ActualZoneNum) = ZoneThermostatSetPointHi(ActualZoneNum)
Else If (StageControlledZone(RelativeZoneNum)%HeatSetpoint > ZoneT) Then ! heating
SetpointOffset = ZoneT - StageControlledZone(RelativeZoneNum)%HeatSetpoint
Itemp = 0
Do I=1,StageControlledZone(RelativeZoneNum)%NumOfHeatStages
If (ABS(SetpointOffset) >= ABS(StageControlledZone(RelativeZoneNum)%HeatTOffset(I))) Then
Itemp = I
End If
End Do
ZoneSysEnergyDemand(ActualZoneNum)%StageNum = Itemp
If (ABS(SetpointOffset) >= 0.5d0* StageControlledZone(RelativeZoneNum)%CoolThroRange) Then
ZoneThermostatSetPointLo(ActualZoneNum) = StageControlledZone(RelativeZoneNum)%HeatSetpoint + &
0.5d0*StageControlledZone(RelativeZoneNum)%HeatThroRange
Else
ZoneThermostatSetPointLo(ActualZoneNum) = StageControlledZone(RelativeZoneNum)%HeatSetpoint - &
0.5d0*StageControlledZone(RelativeZoneNum)%HeatThroRange
End If
ZoneThermostatSetPointHi(ActualZoneNum) = ZoneThermostatSetPointLo(ActualZoneNum)
Else
ZoneThermostatSetPointHi(ActualZoneNum) = StageControlledZone(RelativeZoneNum)%CoolSetpoint + &
0.5* StageControlledZone(RelativeZoneNum)%CoolThroRange
ZoneThermostatSetPointLo(ActualZoneNum) = StageControlledZone(RelativeZoneNum)%HeatSetpoint - &
0.5* StageControlledZone(RelativeZoneNum)%HeatThroRange
ZoneSysEnergyDemand(ActualZoneNum)%StageNum = 0
End If
End Do
End If
! Update zone temperatures
DO ZoneNum = 1, NumofZones
IF (ShortenTimeStepSys) THEN !
! timestep has just shifted from full zone timestep to a new shorter system timestep
!throw away last updates in corrector and rewind for resimulating smaller timestep
IF (Zone(ZoneNum)%SystemZoneNodeNumber > 0) THEN ! roll back result for zone air node,
Node(Zone(ZoneNum)%SystemZoneNodeNumber)%Temp = XMAT(ZoneNum)
TempTstatAir(ZoneNum) = XMAT(ZoneNum)
Node(Zone(ZoneNum)%SystemZoneNodeNumber)%HumRat = WZoneTimeMinus1(ZoneNum)
Node(Zone(ZoneNum)%SystemZoneNodeNumber)%Enthalpy = PsyHFnTdbW(XMAT(ZoneNum),WZoneTimeMinus1(ZoneNum))
ENDIF
IF (NumOfSysTimeSteps /= NumOfSysTimeStepsLastZoneTimeStep) THEN ! cannot reuse existing DS data, interpolate from zone time
Call DownInterpolate4HistoryValues(PriorTimeStep,TimeStepSys, &
! MAT(ZoneNum), XMAT(ZoneNum), XM2T(ZoneNum), XM3T(ZoneNum), XM4T(ZoneNum), &
XMAT(ZoneNum), XM2T(ZoneNum), XM3T(ZoneNum), XM4T(ZoneNum), XM4T(ZoneNum), &
MAT(ZoneNum), DSXMAT(ZoneNum), DSXM2T(ZoneNum), DSXM3T(ZoneNum), DSXM4T(ZoneNum))
Call DownInterpolate4HistoryValues(PriorTimeStep,TimeStepSys, &
! ZoneAirHumRat(ZoneNum), WZoneTimeMinus1(ZoneNum), WZoneTimeMinus2(ZoneNum), &
! WZoneTimeMinus3(ZoneNum), WZoneTimeMinus4(ZoneNum), &
WZoneTimeMinus1(ZoneNum), WZoneTimeMinus2(ZoneNum), &
WZoneTimeMinus3(ZoneNum), WZoneTimeMinus4(ZoneNum), WZoneTimeMinus4(ZoneNum),&
ZoneAirHumRat(ZoneNum), DSWZoneTimeMinus1(ZoneNum), DSWZoneTimeMinus2(ZoneNum), &
DSWZoneTimeMinus3(ZoneNum), DSWZoneTimeMinus4(ZoneNum))
IF (IsZoneDV(ZoneNum) .or. IsZoneUI(ZoneNum)) THEN
CALL DownInterpolate4HistoryValues(PriorTimeStep,TimeStepSys, &
! MATFloor(ZoneNum), XMATFloor(ZoneNum), XM2TFloor(ZoneNum), &
! XM3TFloor(ZoneNum), XM4TFloor(ZoneNum) , &
XMATFloor(ZoneNum), XM2TFloor(ZoneNum), &
XM3TFloor(ZoneNum), XM4TFloor(ZoneNum) , XM4TFloor(ZoneNum) , &
MATFloor(ZoneNum), DSXMATFloor(ZoneNum), DSXM2TFloor(ZoneNum), &
DSXM3TFloor(ZoneNum), DSXM4TFloor(ZoneNum))
CALL DownInterpolate4HistoryValues(PriorTimeStep,TimeStepSys, &
! MATOC(ZoneNum), XMATOC(ZoneNum), XM2TOC(ZoneNum), &
! XM3TOC(ZoneNum), XM4TOC(ZoneNum) , &
XMATOC(ZoneNum), XM2TOC(ZoneNum), &
XM3TOC(ZoneNum), XM4TOC(ZoneNum) , XM4TOC(ZoneNum) , &
MATOC(ZoneNum), DSXMATOC(ZoneNum), DSXM2TOC(ZoneNum), &
DSXM3TOC(ZoneNum), DSXM4TOC(ZoneNum))
CALL DownInterpolate4HistoryValues(PriorTimeStep,TimeStepSys, &
! MATMX(ZoneNum), XMATMX(ZoneNum), XM2TMX(ZoneNum), &
! XM3TMX(ZoneNum), XM4TMX(ZoneNum) , &
XMATMX(ZoneNum), XM2TMX(ZoneNum), &
XM3TMX(ZoneNum), XM4TMX(ZoneNum) , XM4TMX(ZoneNum) , &
MATMX(ZoneNum), DSXMATMX(ZoneNum), DSXM2TMX(ZoneNum), &
DSXM3TMX(ZoneNum), DSXM4TMX(ZoneNum))
ENDIF
ELSE ! reuse history data in DS terms from last zone time step to preserve information that would be lost
! do nothing because DS history would have been pushed prior and should be ready
ENDIF
ENDIF
! now update the variables actually used in the balance equations.
IF(UseZoneTimeStepHistory) THEN
ZTM1(ZoneNum) = XMAT(ZoneNum)
ZTM2(ZoneNum) = XM2T(ZoneNum)
ZTM3(ZoneNum) = XM3T(ZoneNum)
WZoneTimeMinus1Temp(ZoneNum) = WZoneTimeMinus1(ZoneNum)
WZoneTimeMinus2Temp(ZoneNum) = WZoneTimeMinus2(ZoneNum)
WZoneTimeMinus3Temp(ZoneNum) = WZoneTimeMinus3(ZoneNum)
ELSE ! use down-stepped history
ZTM1(ZoneNum) = DSXMAT(ZoneNum)
ZTM2(ZoneNum) = DSXM2T(ZoneNum)
ZTM3(ZoneNum) = DSXM3T(ZoneNum)
WZoneTimeMinus1Temp(ZoneNum) = DSWZoneTimeMinus1(ZoneNum)
WZoneTimeMinus2Temp(ZoneNum) = DSWZoneTimeMinus2(ZoneNum)
WZoneTimeMinus3Temp(ZoneNum) = DSWZoneTimeMinus3(ZoneNum)
END IF
AIRRAT(ZoneNum) = Zone(ZoneNum)%Volume*ZoneVolCapMultpSens* &
PsyRhoAirFnPbTdbW(OutBaroPress,MAT(ZoneNum),ZoneAirHumRat(ZoneNum))* &
PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum),MAT(ZoneNum))/(TimeStepSys*SecInHour)
AirCap = AIRRAT(ZoneNum)
! Calculate the various heat balance sums
! NOTE: SumSysMCp and SumSysMCpT are not used in the predict step
CALL CalcZoneSums(ZoneNum, SumIntGain, SumHA, SumHATsurf, SumHATref, SumMCp, SumMCpT, SumSysMCp, SumSysMCpT)
TempDepCoef = SumHA + SumMCp
TempIndCoef = SumIntGain + SumHATsurf - SumHATref + SumMCpT + SysDepZoneLoadsLagged(ZoneNum)
IF (AirModel(ZoneNum)%AirModelType.EQ.RoomAirModel_Mixing) THEN
TempHistoryTerm = AirCap * (3.0d0 * ZTM1(ZoneNum) - (3.0d0/2.0d0) * ZTM2(ZoneNum) + (1.0d0/3.0d0) * ZTM3(ZoneNum))
TempDepZnLd(ZoneNum) = (11.0d0/6.0d0) * AirCap + TempDepCoef
TempIndZnLd(ZoneNum) = TempHistoryTerm + TempIndCoef
ELSEIF (IsZoneDV(ZoneNum)) THEN
! UCSD displacement ventilation model - make dynamic term independent of TimeStepSys
TempHistoryTerm = AirCap * (3.0d0 * ZTM1(ZoneNum) - (3.0d0/2.0d0) * ZTM2(ZoneNum) + (1.0d0/3.0d0) * ZTM3(ZoneNum))
TempDepZnLd(ZoneNum) = (11.0d0/6.0d0) * AirCap + TempDepCoef
TempIndZnLd(ZoneNum) = TempHistoryTerm + TempIndCoef
ELSEIF (IsZoneUI(ZoneNum)) THEN
! UCSD UFAD model - make dynamic term independent of TimeStepSys
TempHistoryTerm = AirCap * (3.0d0 * ZTM1(ZoneNum) - (3.0d0/2.0d0) * ZTM2(ZoneNum) + (1.0d0/3.0d0) * ZTM3(ZoneNum))
TempDepZnLd(ZoneNum) = (11.0d0/6.0d0) * AirCap + TempDepCoef
TempIndZnLd(ZoneNum) = TempHistoryTerm + TempIndCoef
ELSE ! other imperfectly mixed room models
TempHistoryTerm = AirCap * (3.0d0 * ZTM1(ZoneNum) - (3.0d0/2.0d0) * ZTM2(ZoneNum) + (1.0d0/3.0d0) * ZTM3(ZoneNum))
TempDepZnLd(ZoneNum) = (11.0d0/6.0d0) * AirCap + TempDepCoef
TempIndZnLd(ZoneNum) = TempHistoryTerm + TempIndCoef
END IF
! Exact solution or Euler method
ShortenTimeStepSysRoomAir = .FALSE.
If (ZoneAirSolutionAlgo .NE. Use3rdOrder) Then
If (ShortenTimeStepSys .and. TimeStepSys .LT. TimeStepZone) Then
If (PreviousTimeStep < TimeStepZone) Then
ZoneT1(ZoneNum) = ZoneTM2(ZoneNum)
ZoneW1(ZoneNum) = ZoneWM2(ZoneNum)
Else
ZoneT1(ZoneNum) = ZoneTMX(ZoneNum)
ZoneW1(ZoneNum) = ZoneWMX(ZoneNum)
End If
ShortenTimeStepSysRoomAir = .TRUE.
Else
ZoneT1(ZoneNum) = ZT(ZoneNum)
ZoneW1(ZoneNum) = ZoneAirHumRat(ZoneNum)
End If
TempDepZnLd(ZoneNum) = TempDepCoef
TempIndZnLd(ZoneNum) = TempIndCoef
End If
! Calculate the predicted zone load to be provided by the system with the given desired zone air temperature
CALL CalcPredictedSystemLoad(ZoneNum)
! Calculate the predicted zone load to be provided by the system with the given desired humidity ratio
CALL CalcPredictedHumidityRatio(ZoneNum)
END DO
RETURN
END SUBROUTINE PredictSystemLoads