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 | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(out) | :: | ZoneTempChange | |||
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 CorrectZoneAirTemp(ZoneTempChange, ShortenTimeStepSys, &
UseZoneTimeStepHistory, PriorTimeStep )
! SUBROUTINE INFORMATION:
! AUTHOR Russell Taylor
! DATE WRITTEN ???
! MODIFIED November 1999, LKL;
! RE-ENGINEERED July 2003 (Peter Graham Ellis)
! February 2008 (Brent Griffith reworked history )
! PURPOSE OF THIS SUBROUTINE:
! This subroutine updates the zone air temperature and modifies the system
! time step.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataLoopNode, ONLY: Node
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 RoomAirModelManager , ONLY: ManageAirModel
USE DataEnvironment, ONLY: Month, DayOfMonth
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64) , INTENT(OUT) :: ZoneTempChange ! Temperature change in zone air between previous and current timestep
LOGICAL, INTENT(IN) :: ShortenTimeStepSys
LOGICAL, INTENT(IN) :: UseZoneTimeStepHistory ! if true then use zone timestep history, if false use system time step history
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) :: CpAir !specific heat of air
REAL(r64) :: SumIntGain =0.0d0 ! Zone sum of convective internal gains
REAL(r64) :: SumHA =0.0d0 ! Zone sum of Hc*Area
REAL(r64) :: SumHATsurf =0.0d0 ! Zone sum of Hc*Area*Tsurf
REAL(r64) :: SumHATref =0.0d0 ! Zone sum of Hc*Area*Tref, for ceiling diffuser convection correlation
REAL(r64) :: SumMCp =0.0d0 ! Zone sum of MassFlowRate*Cp
REAL(r64) :: SumMCpT =0.0d0 ! Zone sum of MassFlowRate*Cp*T
REAL(r64) :: SumSysMCp =0.0d0 ! Zone sum of air system MassFlowRate*Cp
REAL(r64) :: SumSysMCpT =0.0d0 ! Zone sum of air system MassFlowRate*Cp*T
REAL(r64) :: ZoneEnthalpyIn =0.0d0 ! Zone inlet air enthalpy
REAL(r64) :: TempDepCoef=0.0d0 ! Formerly CoefSumha, coef in zone temp equation with dimensions of h*A
REAL(r64) :: TempIndCoef=0.0d0 ! Formerly CoefSumhat, coef in zone temp equation with dimensions of h*A(T1
REAL(r64) :: AirCap =0.0d0 ! Formerly CoefAirrat, coef in zone temp eqn with dim of "air power capacity"
REAL(r64) :: SNLoad =0.0d0 ! Sensible load calculated for zone in watts and then loaded in report variables
INTEGER :: ZoneNum =0
INTEGER :: ZoneNodeNum=0 ! System node number for air flow through zone either by system or as a plenum
! LOGICAL,SAVE :: OneTimeFlag = .TRUE.
!unusd1208 LOGICAL,SAVE :: MyEnvrnFlag = .TRUE.
REAL(r64) :: TempSupplyAir
REAL(r64) :: ZoneMult
!unused1208 REAL(r64) :: TimeStepSeconds ! dt term for denominator under Cz in Seconds
! FLOW:
! Initializations
ZoneTempChange = constant_zero
! Update zone temperatures
DO ZoneNum = 1, NumOfZones
ZoneMult = Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier
IF (ShortenTimeStepSys) THEN
!time step has gotten smaller, use zone timestep history to interpolate new set of "DS" history terms.
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) , & !
MAT(ZoneNum), DSXMAT(ZoneNum), DSXM2T(ZoneNum), DSXM3T(ZoneNum), DSXM4T(ZoneNum))
Call DownInterpolate4HistoryValues(PriorTimeStep,TimeStepSys, &
ZoneAirHumRat(ZoneNum), WZoneTimeMinus1(ZoneNum), WZoneTimeMinus2(ZoneNum), & !
WZoneTimeMinus3(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) , &
MATFloor(ZoneNum), DSXMATFloor(ZoneNum), DSXM2TFloor(ZoneNum), &
DSXM3TFloor(ZoneNum), DSXM4TFloor(ZoneNum))
CALL DownInterpolate4HistoryValues(PriorTimeStep,TimeStepSys, &
MATOC(ZoneNum), XMATOC(ZoneNum), XM2TOC(ZoneNum), &
XM3TOC(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) , &
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(.not. UseZoneTimeStepHistory) THEN
ZTM1(ZoneNum) = DSXMAT(ZoneNum)
ZTM2(ZoneNum) = DSXM2T(ZoneNum)
ZTM3(ZoneNum) = DSXM3T(ZoneNum)
WZoneTimeMinus1Temp(ZoneNum) = DSWZoneTimeMinus1(ZoneNum)
WZoneTimeMinus2Temp(ZoneNum) = DSWZoneTimeMinus2(ZoneNum)
WZoneTimeMinus3Temp(ZoneNum) = DSWZoneTimeMinus3(ZoneNum)
ELSE
ZTM1(ZoneNum) = XMAT(ZoneNum)
ZTM2(ZoneNum) = XM2T(ZoneNum)
ZTM3(ZoneNum) = XM3T(ZoneNum)
WZoneTimeMinus1Temp(ZoneNum) = WZoneTimeMinus1(ZoneNum)
WZoneTimeMinus2Temp(ZoneNum) = WZoneTimeMinus2(ZoneNum)
WZoneTimeMinus3Temp(ZoneNum) = WZoneTimeMinus3(ZoneNum)
END IF
AIRRAT(ZoneNum) = Zone(ZoneNum)%Volume*ZoneVolCapMultpSens* &
PsyRhoAirFnPbTdbW(OutBaroPress,MAT(ZoneNum),ZoneAirHumRat(ZoneNum),'CorrectZoneAirTemp')* &
PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum),MAT(ZoneNum),'CorrectZoneAirTemp')/(TimeStepSys*SecInHour)
AirCap = AIRRAT(ZoneNum)
CALL ManageAirModel(ZoneNum)
! Calculate the various heat balance sums
CALL CalcZoneSums(ZoneNum, SumIntGain, SumHA, SumHATsurf, SumHATref, SumMCp, SumMCpT, SumSysMCp, SumSysMCpT)
! ZoneTempHistoryTerm = (3.0D0 * ZTM1(ZoneNum) - (3.0D0/2.0D0) * ZTM2(ZoneNum) + (1.0D0/3.0D0) * ZTM3(ZoneNum))
ZoneNodeNum = Zone(ZoneNum)%SystemZoneNodeNumber
SNLOAD=0.0d0
IF (ZoneNodeNum > 0) THEN ! This zone is controlled by a zone equipment configuration or zone plenum
! Heat balance coefficients for controlled zone, i.e. with system air flow
TempDepCoef = SumHA + SumMCp + SumSysMCp
TempIndCoef = SumIntGain + SumHATsurf - SumHATref + SumMCpT + SumSysMCpT + (NonAirSystemResponse(ZoneNum) / ZoneMult + &
SysDepZoneLoadsLagged(ZoneNum))
! TempHistoryTerm = AirCap * (3.0 * ZTM1(ZoneNum) - (3.0/2.0) * ZTM2(ZoneNum) + (1.0/3.0) * ZTM3(ZoneNum)) !debug only
if (SimulateAirflowNetwork .GT. AirflowNetworkControlMultizone) then
TempIndCoef = TempIndCoef+AirflowNetworkExchangeData(ZoneNum)%TotalSen
end if
! TempDepZnLd(ZoneNum) = (11.0/6.0) * AirCap + TempDepCoef
! TempIndZnLd(ZoneNum) = TempHistoryTerm + TempIndCoef
! Solve for zone air temperature
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
ZT(ZoneNum) = (TempIndCoef + AirCap*(3.0d0*ZTM1(ZoneNum) - (3.0d0/2.0d0)*ZTM2(ZoneNum) + (1.0d0/3.0d0)*ZTM3(ZoneNum))) &
/ ((11.0d0/6.0d0) * AirCap + TempDepCoef)
! Exact solution
CASE (UseAnalyticalSolution)
If (TempDepCoef .eq. 0.0d0) Then ! B=0
ZT(ZoneNum) = ZoneT1(ZoneNum) + TempIndCoef/AirCap
Else
ZT(ZoneNum) = (ZoneT1(ZoneNum)-TempIndCoef/TempDepCoef)*exp(MIN(700.d0,-TempDepCoef/AirCap))+TempIndCoef/TempDepCoef
End If
CASE (UseEulerMethod)
ZT(ZoneNum) = (AirCap*ZoneT1(ZoneNum)+TempIndCoef)/(AirCap+TempDepCoef)
END SELECT
! Update zone node temperature and thermostat temperature unless already updated in Room Air Model,
! calculate load correction factor
IF ((AirModel(ZoneNum)%AirModelType == RoomAirModel_Mixing) .or. (.not.AirModel(ZoneNum)%SimAirModel)) THEN
! Fully mixed
Node(ZoneNodeNum)%Temp = ZT(ZoneNum)
TempTstatAir(ZoneNum) = ZT(ZoneNum)
LoadCorrectionFactor(ZoneNum) = 1.0d0
ELSEIF (IsZoneDV(ZoneNum) .or. IsZoneUI(ZoneNum)) THEN
! UCSDDV: Not fully mixed - calculate factor to correct load for fully mixed assumption
IF (SumSysMCp > SmallMassFlow) THEN
TempSupplyAir = SumSysMCpT / SumSysMCp ! Non-negligible flow, calculate supply air temperature
IF (ABS(TempSupplyAir - ZT(ZoneNum)) > TempConvergTol) THEN
LoadCorrectionFactor(ZoneNum) = (TempSupplyAir-Node(ZoneNodeNum)%Temp)/(TempSupplyAir-ZT(ZoneNum))
! constrain value to something reasonable
LoadCorrectionFactor(ZoneNum) = MAX(-3.d0, LoadCorrectionFactor(ZoneNum))
LoadCorrectionFactor(ZoneNum) = MIN(3.d0, LoadCorrectionFactor(ZoneNum))
ELSE
LoadCorrectionFactor(ZoneNum) = 1.0d0 ! Indeterminate
ENDIF
ELSE
! Negligible flow, assume mixed - reasonable lagged starting value for first step time with significant flow
LoadCorrectionFactor(ZoneNum) = 1.0d0
ENDIF
ELSEIF (AirModel(ZoneNum)%SimAirModel .AND. &
((AirModel(ZoneNum)%AirModelType == RoomAirModel_UserDefined) &
.OR. (AirModel(ZoneNum)%AirModelType == RoomAirModel_Mundt)) ) THEN
IF (SumSysMCp > SmallMassFlow) THEN
TempSupplyAir = SumSysMCpT / SumSysMCp ! Non-negligible flow, calculate supply air temperature
IF (ABS(TempSupplyAir - ZT(ZoneNum)) > TempConvergTol) THEN
LoadCorrectionFactor(ZoneNum) = (TempSupplyAir-Node(ZoneNodeNum)%Temp)/(TempSupplyAir-ZT(ZoneNum))
! constrain value
LoadCorrectionFactor(ZoneNum) = MAX(-3.d0, LoadCorrectionFactor(ZoneNum))
LoadCorrectionFactor(ZoneNum) = MIN(3.d0, LoadCorrectionFactor(ZoneNum))
ELSE
LoadCorrectionFactor(ZoneNum) = 1.0d0 ! Indeterminate
ENDIF
ELSE
! Negligible flow, assume mixed - reasonable lagged starting value for first step time with significant flow
LoadCorrectionFactor(ZoneNum) = 1.0d0
ENDIF
ELSE
Node(ZoneNodeNum)%Temp = ZT(ZoneNum)
TempTstatAir(ZoneNum) = ZT(ZoneNum)
LoadCorrectionFactor(ZoneNum) = 1.0d0
ENDIF
! Sensible load is the enthalpy into the zone minus the enthalpy that leaves the zone.
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), Node(ZoneNodeNum)%Temp)
ZoneEnthalpyIn = SumSysMCpT
! SNLOAD is the single zone load, without Zone Multiplier or Zone List Multiplier
SNLOAD = ZoneEnthalpyIn - (Node(ZoneNodeNum)%MassFlowRate / ZoneMult) * CpAir * Node(ZoneNodeNum)%Temp &
+ NonAirSystemResponse(ZoneNum) / ZoneMult + SysDepZoneLoadsLagged(ZoneNum)
ELSE
! Heat balance coefficients for uncontrolled zone, i.e. without system air flow
TempDepCoef = SumHA + SumMCp
TempIndCoef = SumIntGain + SumHATsurf - SumHATref + SumMCpT
! TempHistoryTerm = AirCap * (3.0 * ZTM1(ZoneNum) - (3.0/2.0) * ZTM2(ZoneNum) + (1.0/3.0) * ZTM3(ZoneNum)) !debug only
if (SimulateAirflowNetwork > AirflowNetworkControlMultizone) then
TempIndCoef = TempIndCoef+AirflowNetworkExchangeData(ZoneNum)%TotalSen
end if
! TempDepZnLd(ZoneNum) = (11.0/6.0) * AirCap + TempDepCoef
! TempIndZnLd(ZoneNum) = TempHistoryTerm + TempIndCoef
! Solve for zone air temperature
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
ZT(ZoneNum) = (TempIndCoef + AirCap*(3.0d0*ZTM1(ZoneNum) - (3.0d0/2.0d0)*ZTM2(ZoneNum) + (1.0d0/3.0d0)*ZTM3(ZoneNum))) &
/ ((11.0d0/6.0d0)*AirCap + TempDepCoef)
! Exact solution
CASE (UseAnalyticalSolution)
If (TempDepCoef .eq. 0.0d0) Then ! B=0
ZT(ZoneNum) = ZoneT1(ZoneNum) + TempIndCoef/AirCap
Else
ZT(ZoneNum) = (ZoneT1(ZoneNum)-TempIndCoef/TempDepCoef)*exp(MIN(700.d0,-TempDepCoef/AirCap))+TempIndCoef/TempDepCoef
End If
CASE (UseEulerMethod)
ZT(ZoneNum) = (AirCap*ZoneT1(ZoneNum)+TempIndCoef)/(AirCap+TempDepCoef)
END SELECT
! No sensible load
SNLOAD = 0.0d0
END IF
MAT(ZoneNum) = ZT(ZoneNum)
! Determine sensible load heating/cooling rate and energy
SNLoadHeatRate(ZoneNum) = MAX(SNLOAD,0.0d0)
SNLoadCoolRate(ZoneNum) = ABS(MIN(SNLOAD,0.0d0))
SNLoadHeatEnergy(ZoneNum) = MAX(SNLOAD,0.0d0) * TimeStepSys * SecInHour
SNLoadCoolEnergy(ZoneNum) = ABS(MIN(SNLOAD,0.0d0) * TimeStepSys * SecInHour)
! Final humidity calcs
CALL CorrectZoneHumRat(ZoneNum)
ZoneAirHumRat(ZoneNum) = ZoneAirHumRatTemp(ZoneNum)
ZoneAirRelHum(ZoneNum) = 100.0d0 * PsyRhFnTdbWPb(ZT(ZoneNum),ZoneAirHumRat(ZoneNum),OutBaroPress,'CorrectZoneAirTemp')
! ZoneTempChange is used by HVACManager to determine if the timestep needs to be shortened.
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
IF (IsZoneDV(ZoneNum)) THEN
IF (ZoneDVMixedFlag(ZoneNum)==0) THEN
ZoneTempChange = MAX(ZoneTempChange,MAX(ABS(ZTOC(ZoneNum) - ZTM1OC(ZoneNum)),ABS(ZTMX(ZoneNum) - ZTM1MX(ZoneNum))))
ELSE
ZoneTempChange = MAX(ZoneTempChange, ABS(ZT(ZoneNum) - ZTM1(ZoneNum)))
ENDIF
ELSE IF (IsZoneUI(ZoneNum)) THEN
IF (ZoneUFMixedFlag(ZoneNum)==0) THEN
ZoneTempChange = MAX(ZoneTempChange,MAX(ABS(ZTOC(ZoneNum) - ZTM1OC(ZoneNum)),ABS(ZTMX(ZoneNum) - ZTM1MX(ZoneNum))))
ELSE
ZoneTempChange = MAX(ZoneTempChange, ABS(ZT(ZoneNum) - ZTM1(ZoneNum)))
ENDIF
ELSE
ZoneTempChange = MAX(ZoneTempChange, ABS(ZT(ZoneNum) - ZTM1(ZoneNum)))
ENDIF
CASE (UseAnalyticalSolution,UseEulerMethod)
IF (IsZoneDV(ZoneNum)) THEN
IF (ZoneDVMixedFlag(ZoneNum)==0) THEN
ZoneTempChange = MAX(ZoneTempChange,MAX(ABS(ZTOC(ZoneNum) - Zone1OC(ZoneNum)),ABS(ZTMX(ZoneNum) - Zone1MX(ZoneNum))))
ELSE
ZoneTempChange = MAX(ZoneTempChange, ABS(ZT(ZoneNum) - ZoneT1(ZoneNum)))
ENDIF
ELSE IF (IsZoneUI(ZoneNum)) THEN
IF (ZoneUFMixedFlag(ZoneNum)==0) THEN
ZoneTempChange = MAX(ZoneTempChange,MAX(ABS(ZTOC(ZoneNum) - Zone1OC(ZoneNum)),ABS(ZTMX(ZoneNum) - Zone1MX(ZoneNum))))
ELSE
ZoneTempChange = MAX(ZoneTempChange, ABS(ZT(ZoneNum) - ZoneT1(ZoneNum)))
ENDIF
ELSE
ZoneTempChange = MAX(ZoneTempChange, ABS(ZT(ZoneNum) - ZoneT1(ZoneNum)))
ENDIF
END SELECT
Call CalcZoneComponentLoadSums(ZoneNum, TempDepCoef, TempIndCoef, &
ZnAirRPT(ZoneNum)%SumIntGains, & ! convection part of internal gains
ZnAirRPT(ZoneNum)%SumHADTsurfs, & ! surface convection heat transfer
ZnAirRPT(ZoneNum)%SumMCpDTzones, & ! interzone mixing
ZnAirRPT(ZoneNum)%SumMCpDtInfil, & ! OA of various kinds except via system
ZnAirRPT(ZoneNum)%SumMCpDTsystem, & ! air system
ZnAirRpt(ZoneNum)%SumNonAirSystem, & ! non air system
ZnAirRPT(ZoneNum)%CzdTdt , & ! air mass energy storage term
ZnAirRPT(ZoneNum)%imBalance ) ! measure of imbalance in zone air heat balance
END DO ! ZoneNum
RETURN
END SUBROUTINE CorrectZoneAirTemp