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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ZoneNum | |||
real(kind=r64), | intent(in) | :: | SysOutputProvided | |||
real(kind=r64), | intent(in) | :: | LatOutputProvided | |||
integer, | intent(in), | optional | :: | EquipPriorityNum |
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 UpdateSystemOutputRequired(ZoneNum, SysOutputProvided, LatOutputProvided, EquipPriorityNum)
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN Unknown
! MODIFIED B. Griffith Sept 2011, add storage of requirements by sequence
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine needs a description.
! METHODOLOGY EMPLOYED:
! Needs description, as appropriate.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEnergyDemands, ONLY: ZoneSysEnergyDemand, DeadbandOrSetback, CurDeadbandOrSetback, &
ZoneSysMoistureDemand
USE DataHVACGlobals, ONLY: SingleHeatingSetPoint, SingleCoolingSetPoint, SingleHeatCoolSetPoint, &
DualSetPointWithDeadBand
USE DataHeatBalFanSys, ONLY: TempControlType
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ZoneNum
REAL(r64), INTENT(IN) :: SysOutputProvided ! sensible output provided by zone equipment (W)
REAL(r64), INTENT(IN) :: LatOutputProvided ! latent output provided by zone equipment (kg/s)
INTEGER , INTENT(IN), OPTIONAL :: EquipPriorityNum ! index in PrioritySimOrder for this update
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
! Determine flow rate and temperature of supply air based on type of damper
! Sensible output updates
ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired &
- SysOutputProvided
ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP &
- SysOutputProvided
ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP &
- SysOutputProvided
! Latent output updates
ZoneSysMoistureDemand(ZoneNum)%RemainingOutputRequired = &
ZoneSysMoistureDemand(ZoneNum)%RemainingOutputRequired - LatOutputProvided
ZoneSysMoistureDemand(ZoneNum)%RemainingOutputReqToHumidSP = &
ZoneSysMoistureDemand(ZoneNum)%RemainingOutputReqToHumidSP - LatOutputProvided
ZoneSysMoistureDemand(ZoneNum)%RemainingOutputReqToDehumidSP = &
ZoneSysMoistureDemand(ZoneNum)%RemainingOutputReqToDehumidSP - LatOutputProvided
! re-evaluate if loads are now such that in dead band or set back
SELECT CASE (TempControlType(ZoneNum))
CASE (0) ! uncontrolled zone; shouldn't ever get here, but who knows
CurDeadbandOrSetback(ZoneNum) = .FALSE.
CASE (SingleHeatingSetPoint)
IF ((ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired - 1.0d0) .LT. 0.0d0) THEN
CurDeadBandOrSetback(ZoneNum) = .TRUE.
ELSE
CurDeadBandOrSetback(ZoneNum) = .FALSE.
END IF
CASE (SingleCoolingSetPoint)
IF ((ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired + 1.0d0) .GT. 0.0d0) THEN
CurDeadBandOrSetback(ZoneNum) = .TRUE.
ELSE
CurDeadBandOrSetback(ZoneNum) = .FALSE.
END IF
CASE (SingleHeatCoolSetPoint)
IF (ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP .LT. 0.0d0 .AND. &
ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP .GT. 0.0d0) THEN
CurDeadBandOrSetback(ZoneNum) = .TRUE.
ELSE
CurDeadBandOrSetback(ZoneNum) = .FALSE.
END IF
CASE (DualSetPointWithDeadBand)
IF (ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP .LT. 0.0d0 .AND. &
ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP .GT. 0.0d0) THEN
CurDeadBandOrSetback(ZoneNum) = .TRUE.
ELSE
CurDeadBandOrSetback(ZoneNum) = .FALSE.
END IF
END SELECT
IF (PRESENT(EquipPriorityNum)) THEN
!now store remaining load at the by sequence level
IF (EquipPriorityNum +1 <= ZoneSysEnergyDemand(ZoneNum)%NumZoneEquipment) THEN
ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequired(EquipPriorityNum +1) = &
ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired
ZoneSysMoistureDemand(ZoneNum)%SequencedOutputRequired(EquipPriorityNum +1) = &
ZoneSysMoistureDemand(ZoneNum)%RemainingOutputRequired
ENDIF
IF (PrioritySimOrder(EquipPriorityNum)%HeatingPriority +1 <= ZoneSysEnergyDemand(ZoneNum)%NumZoneEquipment) THEN
ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequiredToHeatingSP(PrioritySimOrder(EquipPriorityNum)%HeatingPriority +1) = &
ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
ZoneSysMoistureDemand(ZoneNum)%SequencedOutputRequiredToHumidSP(PrioritySimOrder(EquipPriorityNum)%HeatingPriority +1) = &
ZoneSysMoistureDemand(ZoneNum)%RemainingOutputReqToHumidSP
ENDIF
IF (PrioritySimOrder(EquipPriorityNum)%CoolingPriority + 1 <= ZoneSysEnergyDemand(ZoneNum)%NumZoneEquipment) THEN
ZoneSysEnergyDemand(ZoneNum)%SequencedOutputRequiredToCoolingSP(PrioritySimOrder(EquipPriorityNum)%CoolingPriority + 1) = &
ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP
ZoneSysMoistureDemand(ZoneNum)%SequencedOutputRequiredToDehumidSP(PrioritySimOrder(EquipPriorityNum)%CoolingPriority +1) = &
ZoneSysMoistureDemand(ZoneNum)%RemainingOutputReqToDehumidSP
ENDIF
ENDIF
RETURN
END SUBROUTINE UpdateSystemOutputRequired