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(inout) | :: | UnitHeatNum | |||
integer, | intent(in) | :: | ZoneNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(out) | :: | PowerMet | |||
real(kind=r64), | intent(out) | :: | LatOutputProvided |
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 CalcUnitHeater(UnitHeatNum,ZoneNum,FirstHVACIteration,PowerMet,LatOutputProvided)
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN May 2000
! MODIFIED Don Shirey, Aug 2009 (LatOutputProvided)
! July 2012, Chandan Sharma - FSEC: Added zone sys avail managers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine mainly controls the action of the unit heater
! based on the user input for controls and the defined controls
! algorithms. There are currently (at the initial creation of this
! subroutine) two control methods: on-off fan operation or continuous
! fan operation.
! METHODOLOGY EMPLOYED:
! Unit is controlled based on user input and what is happening in the
! simulation. There are various cases to consider:
! 1. OFF: Unit is schedule off. All flow rates are set to zero and
! the temperatures are set to zone conditions.
! 2. NO LOAD OR COOLING/ON-OFF FAN CONTROL: Unit is available, but
! there is no heating load. All flow rates are set to zero and
! the temperatures are set to zone conditions.
! 3. NO LOAD OR COOLING/CONTINUOUS FAN CONTROL: Unit is available and
! the fan is running (if it is scheduled to be available also).
! No heating is provided, only circulation via the fan running.
! 4. HEATING: The unit is on/available and there is a heating load.
! The heating coil is modulated (constant fan speed) to meet the
! heating load.
! REFERENCES:
! ASHRAE Systems and Equipment Handbook (SI), 1996. page 31.7
! USE STATEMENTS:
USE DataZoneEnergyDemands
USE DataInterfaces, ONLY: ControlCompOutput
USE DataHVACGlobals, ONLY: ZoneCompTurnFansOn, ZoneCompTurnFansOff
USE DataZoneEquipment, ONLY: UnitHeater_Num
USE PlantUtilities, ONLY: SetComponentFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(INOUT) :: UnitHeatNum ! number of the current fan coil unit being simulated
INTEGER, INTENT(IN) :: ZoneNum ! number of zone being served
LOGICAL, INTENT(IN) :: FirstHVACIteration ! TRUE if 1st HVAC simulation of system timestep
REAL(r64), INTENT(OUT) :: PowerMet ! Sensible power supplied (W)
REAL(r64), INTENT (OUT) :: LatOutputProvided ! Latent power supplied (kg/s), negative = dehumidification
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! see use DataInterfaces
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ControlNode ! the hot water inlet node
REAL(r64) :: ControlOffset ! tolerance for output control
INTEGER :: InletNode ! unit air inlet node
REAL(r64) :: MaxWaterFlow ! maximum water flow for heating or cooling [kg/sec]
REAL(r64) :: MinWaterFlow ! minimum water flow for heating or cooling [kg/sec]
INTEGER :: OutletNode ! unit air outlet node
REAL(r64) :: QUnitOut ! heating or sens. cooling provided by fan coil unit [watts]
REAL(r64) :: LatentOutput ! Latent (moisture) add/removal rate, negative is dehumidification [kg/s]
REAL(r64) :: SpecHumOut ! Specific humidity ratio of outlet air (kg moisture / kg moist air)
REAL(r64) :: SpecHumIn ! Specific humidity ratio of inlet air (kg moisture / kg moist air)
REAL(r64) :: mdot ! local temporary for fluid mass flow rate
! FLOW:
FanElecPower = 0.0d0
! initialize local variables
QUnitOut = 0.0d0
LatentOutput = 0.0d0
MaxWaterFlow = 0.0d0
MinWaterFlow = 0.0d0
InletNode = UnitHeat(UnitHeatNum)%AirInNode
OutletNode = UnitHeat(UnitHeatNum)%AirOutNode
ControlNode = UnitHeat(UnitHeatNum)%HotControlNode
ControlOffset = UnitHeat(UnitHeatNum)%HotControlOffset
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired ! zone load needed
IF (GetCurrentScheduleValue(UnitHeat(UnitHeatNum)%SchedPtr) <= 0 .OR. &
((GetCurrentScheduleValue(UnitHeat(UnitHeatNum)%FanAvailSchedPtr) <= 0 &
.AND. .NOT. ZoneCompTurnFansOn) .OR. ZoneCompTurnFansOff)) THEN
! Case 1: OFF-->unit schedule says that it it not available
! OR child fan in not available OR child fan not being cycled ON by sys avail manager
! OR child fan being forced OFF by sys avail manager
HCoilOn = .FALSE.
IF (UnitHeat(UnitHeatNum)%HCoilType == WaterCoil) THEN
mdot = 0.d0 ! try to turn off
CALL SetComponentFlowRate( mdot, &
UnitHeat(UnitHeatNum)%HotControlNode, &
UnitHeat(UnitHeatNum)%HotCoilOutNodeNum, &
UnitHeat(UnitHeatNum)%HWLoopNum, &
UnitHeat(UnitHeatNum)%HWLoopSide, &
UnitHeat(UnitHeatNum)%HWBranchNum, &
UnitHeat(UnitHeatNum)%HWCompNum )
END IF
IF (UnitHeat(UnitHeatNum)%HCoilType == SteamCoil) THEN
mdot = 0.d0 ! try to turn off
CALL SetComponentFlowRate( mdot, &
UnitHeat(UnitHeatNum)%HotControlNode, &
UnitHeat(UnitHeatNum)%HotCoilOutNodeNum, &
UnitHeat(UnitHeatNum)%HWLoopNum, &
UnitHeat(UnitHeatNum)%HWLoopSide, &
UnitHeat(UnitHeatNum)%HWBranchNum, &
UnitHeat(UnitHeatNum)%HWCompNum )
END IF
CALL CalcUnitHeaterComponents(UnitHeatNum,FirstHVACIteration,QUnitOut)
ELSE IF ( (QZnReq < SmallLoad) .OR. (CurDeadBandOrSetback(ZoneNum)) ) THEN
! Unit is available, but there is no load on it or we are in setback/deadband
SELECT CASE (UnitHeat(UnitHeatNum)%FanControlType)
CASE (OnOffCtrl)
! Case 2: NO LOAD OR COOLING/ON-OFF FAN CONTROL-->turn everything off
! because there is no load on the unit heater
HCoilOn = .FALSE.
IF (UnitHeat(UnitHeatNum)%HCoilType == WaterCoil) THEN
mdot = 0.d0 ! try to turn off
CALL SetComponentFlowRate( mdot, &
UnitHeat(UnitHeatNum)%HotControlNode, &
UnitHeat(UnitHeatNum)%HotCoilOutNodeNum, &
UnitHeat(UnitHeatNum)%HWLoopNum, &
UnitHeat(UnitHeatNum)%HWLoopSide, &
UnitHeat(UnitHeatNum)%HWBranchNum, &
UnitHeat(UnitHeatNum)%HWCompNum )
END IF
IF (UnitHeat(UnitHeatNum)%HCoilType == SteamCoil) THEN
mdot = 0.d0 ! try to turn off
CALL SetComponentFlowRate( mdot, &
UnitHeat(UnitHeatNum)%HotControlNode, &
UnitHeat(UnitHeatNum)%HotCoilOutNodeNum, &
UnitHeat(UnitHeatNum)%HWLoopNum, &
UnitHeat(UnitHeatNum)%HWLoopSide, &
UnitHeat(UnitHeatNum)%HWBranchNum, &
UnitHeat(UnitHeatNum)%HWCompNum )
END IF
CALL CalcUnitHeaterComponents(UnitHeatNum,FirstHVACIteration,QUnitOut)
CASE (ContinuousCtrl)
! Case 3: NO LOAD OR COOLING/CONTINUOUS FAN CONTROL-->let the fan
! continue to run even though there is no load (air circulation)
! Note that the flow rates were already set in the initialization routine
! so there is really nothing else left to do except call the components.
HCoilOn = .FALSE.
IF (UnitHeat(UnitHeatNum)%HCoilType == WaterCoil) THEN
mdot = 0.d0 ! try to turn off
IF (UnitHeat(UnitHeatNum)%HWLoopNum > 0) THEN
CALL SetComponentFlowRate( mdot, &
UnitHeat(UnitHeatNum)%HotControlNode, &
UnitHeat(UnitHeatNum)%HotCoilOutNodeNum, &
UnitHeat(UnitHeatNum)%HWLoopNum, &
UnitHeat(UnitHeatNum)%HWLoopSide, &
UnitHeat(UnitHeatNum)%HWBranchNum, &
UnitHeat(UnitHeatNum)%HWCompNum )
ENDIF
END IF
IF (UnitHeat(UnitHeatNum)%HCoilType == SteamCoil) THEN
mdot = 0.d0 ! try to turn off
IF (UnitHeat(UnitHeatNum)%HWLoopNum > 0) THEN
CALL SetComponentFlowRate( mdot, &
UnitHeat(UnitHeatNum)%HotControlNode, &
UnitHeat(UnitHeatNum)%HotCoilOutNodeNum, &
UnitHeat(UnitHeatNum)%HWLoopNum, &
UnitHeat(UnitHeatNum)%HWLoopSide, &
UnitHeat(UnitHeatNum)%HWBranchNum, &
UnitHeat(UnitHeatNum)%HWCompNum )
ENDIF
END IF
CALL CalcUnitHeaterComponents(UnitHeatNum,FirstHVACIteration,QUnitOut)
END SELECT
ELSE ! Case 4: HEATING-->unit is available and there is a heating load
SELECT CASE (UnitHeat(UnitHeatNum)%HCoilType)
CASE (WaterCoil)
!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(FirstHVACIteration) Then
MaxWaterFlow = UnitHeat(UnitHeatNum)%MaxHotWaterFlow
MinWaterFlow = UnitHeat(UnitHeatNum)%MinHotWaterFlow
Else
MaxWaterFlow = Node(ControlNode)%MassFlowRateMaxAvail
MinWaterFlow = Node(ControlNode)%MassFlowRateMinAvail
End If
! control water flow to obtain output matching QZnReq
CALL ControlCompOutput(CompName=UnitHeat(UnitHeatNum)%Name,CompType=cMO_UnitHeater,CompNum=UnitHeatNum, &
FirstHVACIteration=FirstHVACIteration,QZnReq=QZnReq, &
ActuatedNode=ControlNode,MaxFlow=MaxWaterFlow, &
MinFlow=MinWaterFlow,ControlOffSet=ControlOffset, &
ControlCompTypeNum=UnitHeat(UnitHeatNum)%ControlCompTypeNum, &
CompErrIndex=UnitHeat(UnitHeatNum)%CompErrIndex, &
LoopNum = UnitHeat(UnitHeatNum)%HWLoopNum, &
LoopSide = UnitHeat(UnitHeatNum)%HWLoopSide, &
BranchIndex = UnitHeat(UnitHeatNum)%HWBranchNum)
CASE (ElectricCoil,GasCoil,SteamCoil)
HCoilOn = .TRUE.
CALL CalcUnitHeaterComponents(UnitHeatNum,FirstHVACIteration,QUnitOut)
END SELECT
END IF ! ...end of unit ON/OFF IF-THEN block
! CR9155 Remove specific humidity calculations
SpecHumOut = Node(OutletNode)%HumRat
SpecHumIn = Node(InletNode)%HumRat
LatentOutput = Node(OutletNode)%MassFlowRate * (SpecHumOut - SpecHumIn) ! Latent rate (kg/s), dehumid = negative
QUnitOut = Node(OutletNode)%MassFlowRate * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
! Report variables...
UnitHeat(UnitHeatNum)%HeatPower = MAX(0.0d0,QUnitOut)
UnitHeat(UnitHeatNum)%ElecPower = FanElecPower
PowerMet = QUnitOut
LatOutputProvided = LatentOutput
RETURN
END SUBROUTINE CalcUnitHeater