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) | :: | Item | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 UpdateVentilatedSlab(Item,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Young Tae Chae, Rick Strand
! DATE WRITTEN November 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine does any updating that needs to be done for low
! temperature radiant heating and cooling systems. One of the most
! important functions of this routine is to update the average heat
! source/sink for a particular system over the various system time
! steps that make up the zone time step. For hydronic systems,
! this routine must also set the outlet water conditions.
! METHODOLOGY EMPLOYED:
! For the source/sink average update, if the system time step elapsed
! is still what it used to be, then either we are still iterating or
! we had to go back and shorten the time step. As a result, we have
! to subtract out the previous value that we added. If the system
! time step elapsed is different, then we just need to add the new
! values to the running average.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY : TimeStepZone
USE DataHeatBalance, ONLY : Zone
USE DataHVACGlobals, ONLY : TimeStepSys, SysTimeElapsed
USE DataLoopNode, ONLY : Node
USE DataHeatBalFanSys, ONLY : MAT
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN) :: FirstHVACIteration ! TRUE if 1st HVAC simulation of system timestep !unused1208
INTEGER, INTENT(IN) :: Item ! Index for the ventilated slab under consideration within the derived types
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: CpAppAir ! Specific heat of air
INTEGER :: RadSurfNum ! DO loop counter for radiant surfaces in the ventilated slab
INTEGER :: SurfNum ! Surface index number for the current ventilated slab
INTEGER :: AirInletNode ! Node number for the air side inlet of the ventilated slab
REAL(r64) :: TotalHeatSource ! Total heat source or sink for a particular system (sum of all surface source/sinks)
INTEGER :: TotRadSurfaces ! Total number of radiant surfaces in this system
REAL(r64) :: AirMassFlow ! Flow rate of water in the radiant system
INTEGER :: AirOutletNode ! Node number for the water side outlet of the radiant system
INTEGER :: FanOutNode ! Node number for the water side outlet of the radiant system
REAL(r64) :: ZoneMult ! Zone multiplier
INTEGER :: ZoneNum ! Zone for this ventilated slab
INTEGER :: MixOutNode ! Node number for the water side outlet of the radiant system
INTEGER :: OANode ! Node number for the water side outlet of the radiant system
REAL(r64) :: OAFraction ! Outside air fraction of inlet air
INTEGER :: ZoneInletNode ! Node number for the air side inlet of the ventilated slab
! FLOW:
ZoneNum = VentSlab(Item)%ZonePtr
TotRadSurfaces = VentSlab(Item)%NumOfSurfaces
MixOutNode = VentSlab(Item)%OAMixerOutNode
OANode = VentSlab(Item)%OutsideAirNode
AirOutletNode = VentSlab(Item)%RadInNode
FanOutNode = VentSlab(Item)%FanOutletNode
AirMassFlow = Node(AirOutletNode)%MassFlowRate
ZoneInletNode = VentSlab(Item)%ZoneAirInNode
CpAppAir = PsyCpAirFnWTdb(Node(AirOutletNode)%HumRat, Node(AirOutletNode)%Temp)
AirInletNode = VentSlab(Item)%ReturnAirNode
DO RadSurfNum = 1, TotRadSurfaces
SurfNum = VentSlab(Item)%SurfacePtr(RadSurfNum)
IF (LastSysTimeElapsed(SurfNum) == SysTimeElapsed) THEN
! Still iterating or reducing system time step, so subtract old values which were
! not valid
QRadSysSrcAvg(SurfNum) = QRadSysSrcAvg(SurfNum) &
-LastQRadSysSrc(SurfNum)*LastTimeStepSys(SurfNum)/TimeStepZone
END IF
! Update the running average and the "last" values with the current values of the appropriate variables
QRadSysSrcAvg(SurfNum) = QRadSysSrcAvg(SurfNum) &
+QRadSysSource(SurfNum)*TimeStepSys/TimeStepZone
LastQRadSysSrc(SurfNum) = QRadSysSource(SurfNum)
LastSysTimeElapsed(SurfNum) = SysTimeElapsed
LastTimeStepSys(SurfNum) = TimeStepSys
END DO
! First sum up all of the heat sources/sinks associated with this system
TotalHeatSource = 0.0d0
DO RadSurfNum = 1, VentSlab(Item)%NumOfSurfaces
SurfNum = VentSlab(Item)%SurfacePtr(RadSurfNum)
TotalHeatSource = TotalHeatSource + QRadSysSource(SurfNum)
END DO
ZoneNum = VentSlab(Item)%ZonePtr
ZoneMult = REAL(Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier,r64)
TotalHeatSource = ZoneMult * TotalHeatSource
! Update the heating side of things
IF ((CpAppAir > 0.0d0) .AND. (AirMassFlow > 0.0d0)) THEN
IF ((VentSlab(Item)%SysConfg == SlabOnly).OR.(VentSlab(Item)%SysConfg==SeriesSlabs)) THEN
Node(AirInletNode) = Node(AirInletNode)
Node(AirInletNode)%Temp = Node(AirOutletNode)%Temp &
-TotalHeatSource/AirMassFlow/CpAppAir
Node(AirInletNode)%MassFlowRate = Node(AirOutletNode)%MassFlowRate
Node(AirInletNode)%HumRat = Node(AirOutletNode)%HumRat
ELSE IF (VentSlab(Item)%SysConfg == SlabandZone) THEN
Node(ZoneInletNode) = Node(ZoneInletNode)
Node(ZoneInletNode)%Temp = Node(AirOutletNode)%Temp &
-TotalHeatSource/AirMassFlow/CpAppAir
Node(ZoneInletNode)%MassFlowRate = Node(AirOutletNode)%MassFlowRate
Node(ZoneInletNode)%HumRat = Node(AirOutletNode)%HumRat
Node(VentSlab(Item)%ReturnAirNode)%Temp = MAT(Zonenum)
END IF
ELSE
IF ((VentSlab(Item)%SysConfg == SlabOnly).OR.(VentSlab(Item)%SysConfg == SeriesSlabs)) THEN
Node(FanOutNode)= Node(AirOutletNode)
QRadSysSource(SurfNum) = 0.0d0
ELSE IF (VentSlab(Item)%SysConfg == SlabandZone) THEN
Node(ZoneInletNode) = Node(AirInletNode)
Node(FanOutNode)= Node(AirOutletNode) ! Fan Resolve
QRadSysSource(SurfNum) = 0.0d0
END IF
END IF
! Resolve mixouttemp
IF (Node(AirInletNode)%MassFlowRate > 0.0d0) THEN
OAFraction = Node(OANode)%MassFlowRate/Node(AirInletNode)%MassFlowRate
ELSE
OAFraction = 0.0d0
END IF
IF (OAFraction <= 0.0d0) Then
Node(MixOutNode)%HumRat = Node(AirInletNode)%HumRat
Node(MixOutNode)%Temp = Node(AirInletNode)%Temp
Else
Node(MixOutNode)%Enthalpy = OAFraction*Node(OANode)%Enthalpy &
+(1.0d0-OAFraction)*Node(AirInletNode)%Enthalpy
Node(MixOutNode)%HumRat = OAFraction*Node(OANode)%HumRat &
+(1.0d0-OAFraction)*Node(AirInletNode)%HumRat
Node(MixOutNode)%Temp = PsyTdbFnHW(Node(MixOutNode)%Enthalpy,Node(MixOutNode)%HumRat)
END IF
RETURN
END SUBROUTINE UpdateVentilatedSlab