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) | :: | PIUNum | |||
integer, | intent(in) | :: | ZoneNum | |||
integer, | intent(in) | :: | ZoneNode | |||
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 CalcParallelPIU(PIUNum,ZoneNum,ZoneNode,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN August 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulate a parallel powered induction unit; adjust its primary air flow
! and reheat coil output to match the zone load.
! METHODOLOGY EMPLOYED:
! If unit is on and there is a cooling load:
! (1) simulate fan at max secondary air flow and heating coil
! off. Obtains fan temperature increase.
! (2) Calculates primary and secomdary air flow to meet zone load.
! (a) Assume fan is off and calculate primary air flow to meet cooling load.
! (b) If calculated primary air flow is above the fan turn on ratio, fan is off.
! Otherwise fan is on; calculate mixed secondary and primary air flow that
! will meet the zone load
! (3) Simulate fan, mixer, and (off) heating coil to obtain zone inlet conditions.
! If unit is on and there is a heating load
! (1) sets primary air flow to a minimum.
! (2) simulates fan and mixer
! (3) if reheat is hot water, calls ControlCompOutput to simulate hot
! water coil and adjust water flow to match coil output to the zone load.
! (4) if reheat is electric or gas calls SimulateHeatingCoilComponents to
! simulate coil at coil output that matches the zone load
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEnergyDemands
USE MixerComponent, ONLY : SimAirMixer
Use HeatingCoils, Only: SimulateHeatingCoilComponents
USE Fans, ONLY : SimulateFanComponents
USE WaterCoils, ONLY: SimulateWaterCoilComponents
USE SteamCoils, ONLY: SimulateSteamCoilComponents
USE DataInterfaces, ONLY: ControlCompOutput
USE PlantUtilities, ONLY: SetComponentFlowRate
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
INTEGER, INTENT (IN) :: PIUNum ! number of the current PIU being simulated
INTEGER, INTENT (IN) :: ZoneNum ! number of zone being served
INTEGER, INTENT (IN) :: ZoneNode ! zone node number
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: MaxIter = 25 ! maximum number of iterations for controlling output
! INTERFACE BLOCK SPECIFICATIONS
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: QZnReq ! heating or cooling needed by zone [Watts]
REAL(r64) :: QToHeatSetPt ! [W] remaining load to heating setpoint
REAL(r64) :: QActualHeating ! the heating load seen by the reheat coil [W]
REAL(r64) :: PowerMet ! power supplied
LOGICAL :: UnitOn ! TRUE if unit is on
LOGICAL :: PriOn ! TRUE if primary air available
LOGICAL :: HCoilOn ! TRUE if heating coil is on
INTEGER :: ControlNode ! the hot water or cold water inlet node
REAL(r64) :: ControlOffset ! tolerance for output control
REAL(r64) :: MaxWaterFlow ! maximum water flow for heating or cooling [kg/s]
REAL(r64) :: MinWaterFlow ! minimum water flow for heating or cooling [kg/s]
INTEGER :: OutletNode ! unit air outlet node
INTEGER :: PriNode ! unit primary air inlet node
INTEGER :: SecNode ! unit secondary air inlet node
INTEGER :: HCoilInAirNode ! air inlet node of reheat coil
REAL(r64) :: QCoilReq ! required heating coil outlet to meet zone load
REAL(r64) :: PriAirMassFlow ! primary air mass flow rate [kg/s]
REAL(r64) :: PriAirMassFlowMax ! max primary air mass flow rate [kg/s]
REAL(r64) :: PriAirMassFlowMin ! min primary air mass flow rate [kg/s]
REAL(r64) :: SecAirMassFlow ! secondary air mass flow rate [kg/s]
REAL(r64) :: CpAirZn ! zone air specific heat [J/kg-C]
REAL(r64) :: FanDeltaTemp ! fan temperature rise [C]
!unusedREAL(r64) :: MaxSteamFlow
!unusedREAL(r64) :: MinSteamFlow
REAL(r64) :: mdot ! local fluid flow rate kg/s
! FLOW
FanElecPower = 0.0d0
! initialize local variables
FanDeltaTemp = 0.0d0
UnitOn = .TRUE.
PriOn = .TRUE.
HCoilOn = .TRUE.
ControlNode = 0
ControlOffset = PIU(PIUNum)%HotControlOffset
OutletNode = PIU(PIUNum)%OutAirNode
PriNode = PIU(PIUNum)%PriAirInNode
SecNode = PIU(PIUNum)%SecAirInNode
HCoilInAirNode = PIU(PIUNum)%HCoilInAirNode
ControlNode = PIU(PIUNum)%HotControlNode
PriAirMassFlow = Node(PriNode)%MassFlowRate
PriAirMassFlowMax = Node(PriNode)%MassFlowRateMaxAvail
PriAirMassFlowMin = Node(PriNode)%MassFlowRateMinAvail
SecAirMassFlow = Node(SecNode)%MassFlowRate
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired
QToHeatSetPt=ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
CpAirZn = PsyCpAirFnWTdb(Node(ZoneNode)%HumRat,Node(ZoneNode)%Temp)
!On the first HVAC iteration the system values are given to the controller, but after that
! the demand limits are in place and there needs to be feedback to the Zone Equipment
IF (ControlNode > 0) THEN
If(FirstHVACIteration) Then
MaxWaterFlow = PIU(PIUNum)%MaxHotWaterFlow
MinWaterFlow = PIU(PIUNum)%MinHotWaterFlow
Else
MaxWaterFlow = Node(ControlNode)%MassFlowRateMaxAvail
MinWaterFlow = Node(ControlNode)%MassFlowRateMinAvail
End If
END IF
IF (GetCurrentScheduleValue(PIU(PIUNum)%SchedPtr) .LE. 0.0d0) UnitOn = .FALSE.
IF (PriAirMassFlow.LE.SmallMassFlow .OR. PriAirMassFlowMax.LE.SmallMassFlow) PriOn = .FALSE.
! Set the mass flow rates
IF (UnitOn) THEN
! unit is on
IF (.NOT. PriOn) THEN
! no primary air flow
PriAirMassFlow = 0.0d0
SecAirMassFlow = PIU(PIUNum)%MaxSecAirMassFlow
ELSE IF (CurDeadBandOrSetback(ZoneNum) .OR. ABS(QZnReq).LT.SmallLoad) THEN
! in deadband or very small load: set primary air flow to the minimum
PriAirMassFlow = PriAirMassFlowMin
SecAirMassFlow = PIU(PIUNum)%MaxSecAirMassFlow
ELSE IF (QZnReq.GT.SmallLoad) THEN
! heating: set primary air flow to the minimum
PriAirMassFlow = PriAirMassFlowMin
SecAirMassFlow = PIU(PIUNum)%MaxSecAirMassFlow
ELSE
! cooling: set the primary air flow rate to meet the load.
! First calculate the fan temperature rise
Node(SecNode)%MassFlowRate = PIU(PIUNum)%MaxSecAirMassFlow
Node(SecNode)%MassFlowRateMaxAvail = PIU(PIUNum)%MaxSecAirMassFlow
Node(PriNode)%MassFlowRate = 0.0d0
CALL SimulateFanComponents(PIU(PIUNum)%FanName,FirstHVACIteration,PIU(PIUNum)%Fan_Index) ! fire the fan
CALL SimAirMixer(PIU(PIUNum)%MixerName,PIU(PIUNum)%Mixer_Num) ! fire the mixer
FanDeltaTemp = Node(HCoilInAirNode)%Temp - Node(SecNode)%Temp
! Assuming the fan is off, calculate the primary air flow needed to meet the zone cooling demand.
! CpAir*PriAirMassFlow*(Node(PriNode)%Temp - Node(ZoneNodeNum)%Temp) = QZnReq
PriAirMassFlow = QZnReq / (CpAirZn*MIN(-SmallTempDiff,(Node(PriNode)%Temp -Node(ZoneNode)%Temp)))
PriAirMassFlow = MIN(MAX(PriAirMassFlow,PriAirMassFlowMin),PriAirMassFlowMax)
! check for fan on or off
IF (PriAirMassFlow.GT.PIU(PIUNum)%FanOnAirMassFlow) THEN
SecAirMassFlow = 0.0d0 ! Fan is off; no secondary air
ELSE
! fan is on; recalc primary air flow
! CpAir*PriAirMassFlow*(Node(PriNode)%Temp - Node(ZoneNodeNum)%Temp) +
! CpAir*SecAirMassFlow*(Node(SecNode)%Temp + FanDeltaTemp - Node(ZoneNodeNum)%Temp) = QZnReq
PriAirMassFlow = (QZnReq - CpAirZn*SecAirMassFlow*(Node(SecNode)%Temp + FanDeltaTemp - Node(ZoneNode)%Temp)) / &
(CpAirZn*MIN(-SmallTempDiff,(Node(PriNode)%Temp -Node(ZoneNode)%Temp)))
PriAirMassFlow = MIN(MAX(PriAirMassFlow,PriAirMassFlowMin),PriAirMassFlowMax)
SecAirMassFlow = PIU(PIUNum)%MaxSecAirMassFlow
END IF
END IF
ELSE
! unit is off; no flow
PriAirMassFlow = 0.0d0
SecAirMassFlow = 0.0d0
END IF
! Set inlet node flowrates
Node(PriNode)%MassFlowRate = PriAirMassFlow
Node(SecNode)%MassFlowRate = SecAirMassFlow
Node(SecNode)%MassFlowRateMaxAvail = SecAirMassFlow
!now that inlet airflows have been set, the terminal bos components can be simulated.
! fire the fan
CALL SimulateFanComponents(PIU(PIUNum)%FanName,FirstHVACIteration,PIU(PIUNum)%Fan_Index)
! fire the mixer
CALL SimAirMixer(PIU(PIUNum)%MixerName,PIU(PIUNum)%Mixer_Num)
! check if heating coil is off
QActualHeating = QToHeatSetPt - Node(HCoilInAirNode)%MassFlowRate * CpAirZn * &
(Node(HCoilInAirNode)%Temp-Node(ZoneNode)%Temp)
IF ( (.NOT. UnitOn) .OR. (QActualHeating .LT. SmallLoad) .OR. &
(TempControlType(ZoneNum) == SingleCoolingSetPoint) .OR. &
(PriAirMassFlow > PriAirMassFlowMin) ) THEN
HCoilOn = .FALSE.
END IF
!fire the heating coil
SELECT CASE(PIU(PIUNum)%HCoilType_Num)
CASE(HCoilType_SimpleHeating) ! COIL:WATER:SIMPLEHEATING
IF ( .NOT. HCoilOn) THEN
!call the reheat coil with the NO FLOW condition
mdot = 0.d0
Call SetComponentFlowRate(mdot, &
PIU(PIUNum)%HotControlNode, &
PIU(PIUNum)%HotCoilOutNodeNum, &
PIU(PIUNum)%HWLoopNum, &
PIU(PIUNum)%HWLoopSide, &
PIU(PIUNum)%HWBranchNum, &
PIU(PIUNum)%HWCompNum)
CALL SimulateWaterCoilComponents(PIU(PIUNum)%HCoil,FirstHVACIteration,PIU(PIUNum)%HCoil_Index)
ELSE
! control water flow to obtain output matching QZnReq
CALL ControlCompOutput(CompType=PIU(PIUNum)%UnitType,CompName=PIU(PIUNum)%HCoil,CompNum=PIU(PIUNum)%HCoil_Index, &
FirstHVACIteration=FirstHVACIteration,QZnReq=QActualHeating, &
ActuatedNode=ControlNode,MaxFlow=MaxWaterFlow, &
TempInNode=HCoilInAirNode,TempOutNode=OutletNode, &
MinFlow=MinWaterFlow,ControlOffSet=ControlOffset, &
ControlCompTypeNum=PIU(PIUNum)%ControlCompTypeNum,&
CompErrIndex=PIU(PIUNum)%CompErrIndex, &
LoopNum = PIU(PIUNum)%HWLoopNum, &
LoopSide = PIU(PIUNum)%HWLoopSide, &
BranchIndex = PIU(PIUNum)%HWBranchNum)
END IF
CASE(HCoilType_SteamAirHeating) ! COIL:STEAM:AIRHEATING
IF ( .NOT. HCoilOn) THEN
QCoilReq = 0.0d0
ELSE
QCoilReq = QToHeatSetPt - Node(HCoilInAirNode)%MassFlowRate * CpAirZn * (Node(HCoilInAirNode)%Temp-Node(ZoneNode)%Temp)
END IF
CALL SimulateSteamCoilComponents(CompName=PIU(PIUNum)%HCoil, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=QCoilReq,CompIndex=PIU(PIUNum)%HCoil_Index)
CASE(HCoilType_Electric) ! COIL:ELECTRIC:HEATING
IF ( .NOT. HCoilOn) THEN
QCoilReq = 0.0d0
ELSE
QCoilReq = QToHeatSetPt - Node(HCoilInAirNode)%MassFlowRate * CpAirZn * (Node(HCoilInAirNode)%Temp-Node(ZoneNode)%Temp)
END IF
CALL SimulateHeatingCoilComponents(CompName=PIU(PIUNum)%HCoil, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=QCoilReq,CompIndex=PIU(PIUNum)%HCoil_Index)
CASE(HCoilType_Gas) ! COIL:GAS:HEATING
IF ( .NOT. HCoilOn) THEN
QCoilReq = 0.0d0
ELSE
QCoilReq = QToHeatSetPt - Node(HCoilInAirNode)%MassFlowRate * CpAirZn * (Node(HCoilInAirNode)%Temp-Node(ZoneNode)%Temp)
END IF
CALL SimulateHeatingCoilComponents(CompName=PIU(PIUNum)%HCoil, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=QCoilReq,CompIndex=PIU(PIUNum)%HCoil_Index)
END SELECT
PowerMet = Node(OutletNode)%MassFlowRate * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(ZoneNode)%HumRat) &
- PsyHFnTdbW(Node(ZoneNode)%Temp,Node(ZoneNode)%HumRat))
PIU(PIUNum)%HeatingRate = MAX(0.0d0,PowerMet)
PIU(PIUNum)%SensCoolRate = ABS(MIN(constant_zero,PowerMet))
IF (Node(OutletNode)%MassFlowRate .EQ. 0.0d0) THEN
Node(PriNode)%MassFlowRate = 0.0d0
Node(SecNode)%MassFlowRate = 0.0d0
END IF
IF (PIU(PIUNum)%InducesPlenumAir) THEN
PlenumInducedMassFlow = Node(SecNode)%MassFlowRate
ELSE
PlenumInducedMassFlow = 0.0d0
END IF
Node(OutletNode)%MassFlowRateMax = PIU(PIUNum)%MaxPriAirMassFlow
RETURN
END SUBROUTINE CalcParallelPIU