SUBROUTINE Sim4PipeFanCoil(FanCoilNum,ZoneNum,ControlledZoneNum,FirstHVACIteration,PowerMet,LatOutputProvided)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN March 2000
! MODIFIED Don Shirey, Aug 2009 (LatOutputProvided)
! MODIFIED Arnaud Flament June 2010 (added airflow capacity control methods)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulate a 4 pipe fan coil unit; adjust its output to match the
! remaining zone load.
! METHODOLOGY EMPLOYED:
! If unit is on, calls ControlCompOutput to obtain the desired unit output
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEnergyDemands
USE Psychrometrics, ONLY:PsyHFnTdbW
USE DataHeatBalFanSys, ONLY:TempControlType
USE DataInterfaces, ONLY: ControlCompOutput
USE General, ONLY: TrimSigDigits
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 (INOUT) :: FanCoilNum ! number of the current fan coil unit being simulated
INTEGER, INTENT (IN) :: ZoneNum ! number of zone being served
INTEGER, INTENT (IN) :: ControlledZoneNum ! index into ZoneEqupConfig
REAL(r64), INTENT (OUT) :: PowerMet ! Sensible power supplied (W)
REAL(r64), INTENT (OUT) :: LatOutputProvided ! Latent power supplied (kg/s), negative = dehumidification
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: MaxIter = 25 ! maximum number of iterations for controlling output
INTEGER, PARAMETER :: iReverseAction =1
INTEGER, PARAMETER :: iNormalAction =2
INTEGER, PARAMETER :: MaxIterCycl = 100
! INTERFACE BLOCK SPECIFICATIONS
! see use DataInterfaces
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: QZnReq ! heating or cooling needed by zone [watts]
REAL(r64) :: QUnitOut ! heating or sens. cooling provided by fan coil unit [watts]
REAL(r64) :: QUnitOutMax ! heating or sens. cooling provided by fan coil unit (running during an entire timestep)
REAL(r64) :: PLR ! Part Load Ratio, fraction of time step fancoil is on
LOGICAL :: UnitOn ! TRUE if unit 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/sec]
REAL(r64) :: MinWaterFlow ! minimum water flow for heating or cooling [kg/sec]
INTEGER :: OutletNode ! unit air outlet node
INTEGER :: InletNode ! unit air inlet node
REAL(r64) :: QTotUnitOut ! total unit output [watts]
REAL(r64) :: AirMassFlow ! air mass flow rate [kg/sec]
REAL(r64) :: QUnitOutNoHC ! unit output with no active heating or cooling [W]
REAL(r64) :: QUnitOutMaxHC ! unit output with full active heating or cooling [W]
REAL(r64) :: QCoilHeatSP ! coil load to the heating setpoint [W]
REAL(r64) :: QCoilCoolSP ! coil load to the cooling setpoint [W]
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) :: Error ! Error between QZnReq and QUnitOut
REAL(r64) :: AbsError ! Absolute error between QZnReq and QUnitOut [W] !FB
INTEGER :: Iter ! iteration counter
REAL (r64) :: Relax
REAL (r64) :: DelPLR
REAL(r64) :: mdot
! FLOW
FanElecPower = 0.0d0
! initialize local variables
UnitOn = .TRUE.
ControlNode = 0
QUnitOut = 0.0d0
QUnitOutMax = 0.0d0
PLR = 0.0d0
LatentOutput = 0.0d0
QUnitOutNoHC = 0.0d0
QCoilHeatSP = 0.0d0
QCoilCoolSP = 0.0d0
QZnReq = 0.0d0
ControlOffset = 0.0d0
MaxWaterFlow = 0.0d0
MinWaterFlow = 0.0d0
OutletNode = FanCoil(FanCoilNum)%AirOutNode
InletNode = FanCoil(FanCoilNum)%AirInNode
AirMassFlow = Node(InletNode)%MassFlowRate
Error = 1.0d0
AbsError = 2.0d0 * SmallLoad
Iter = 0
Relax = 1.0d0
! select capacity control method
SELECT CASE (FanCoil(FanCoilNum)%CapCtrlMeth_Num)
! constant fan variable flow
CASE(CCM_ConsFanVarFlow)
IF (AirMassFlow.LT.SmallMassFlow) UnitOn = .FALSE.
! zero the hot & cold water flows
! Node(FanCoil(FanCoilNum)%ColdControlNode)%MassFlowRate = 0.0
! Node(FanCoil(FanCoilNum)%HotControlNode)%MassFlowRate = 0.0
mdot = 0.d0
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%ColdControlNode, &
FanCoil(FanCoilNum)%ColdPlantOutletNode, &
FanCoil(FanCoilNum)%CWLoopNum, &
FanCoil(FanCoilNum)%CWLoopSide, &
FanCoil(FanCoilNum)%CWBranchNum, &
FanCoil(FanCoilNum)%CWCompNum)
mdot = 0.d0
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%HotControlNode, &
FanCoil(FanCoilNum)%HotPlantOutletNode, &
FanCoil(FanCoilNum)%HWLoopNum, &
FanCoil(FanCoilNum)%HWLoopSide, &
FanCoil(FanCoilNum)%HWBranchNum, &
FanCoil(FanCoilNum)%HWCompNum)
! obtain unit output with no active heating/cooling
CALL Calc4PipeFanCoil(FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutNoHC)
! get the loads at the coils
QCoilHeatSP = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP - QUnitOutNoHC
QCoilCoolSP = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP - QUnitOutNoHC
IF (UnitOn .and. QCoilCoolSP < (-1.d0*SmallLoad) .and. TempControlType(ZoneNum) .NE. SingleHeatingSetPoint) THEN
! get full load result
mdot = FanCoil(FanCoilNum)%MaxColdWaterFlow
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%ColdControlNode, &
FanCoil(FanCoilNum)%ColdPlantOutletNode, &
FanCoil(FanCoilNum)%CWLoopNum, &
FanCoil(FanCoilNum)%CWLoopSide, &
FanCoil(FanCoilNum)%CWBranchNum, &
FanCoil(FanCoilNum)%CWCompNum)
CALL Calc4PipeFanCoil(FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutMaxHC)
IF(QUnitOutMaxHC .LT. QCoilCoolSP)THEN
! more cooling than required, find reduced water flow rate to meet the load
ControlNode = FanCoil(FanCoilNum)%ColdControlNode
ControlOffset = FanCoil(FanCoilNum)%ColdControlOffset
MaxWaterFlow = FanCoil(FanCoilNum)%MaxColdWaterFlow
MinWaterFlow = FanCoil(FanCoilNum)%MinColdWaterFlow
!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(.not. FirstHVACIteration) Then
MaxWaterFlow = Node(ControlNode)%MassFlowRateMaxAvail
MinWaterFlow = Node(ControlNode)%MassFlowRateMinAvail
End If
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP
CALL ControlCompOutput(CompType=cMO_FanCoil,CompNum=FanCoilNum, &
FirstHVACIteration=FirstHVACIteration,QZnReq=QZnReq, &
ActuatedNode=ControlNode,MaxFlow=MaxWaterFlow, &
MinFlow=MinWaterFlow,ControlOffSet=ControlOffset,Action=iReverseAction, &
CompName = FanCoil(FanCoilNum)%Name, &
ControlCompTypeNum=FanCoil(FanCoilNum)%ControlCompTypeNum, &
CompErrIndex=FanCoil(FanCoilNum)%CompErrIndex, &
LoopNum = FanCoil(FanCoilNum)%CWLoopNum, &
LoopSide = FanCoil(FanCoilNum)%CWLoopSide, &
BranchIndex = FanCoil(FanCoilNum)%CWBranchNum, &
ControlledZoneIndex = ControlledZoneNum)
END IF
QUnitOut = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
ELSE IF (UnitOn .and. QCoilHeatSP > SmallLoad .and. TempControlType(ZoneNum) .NE. SingleCoolingSetPoint) THEN
! get full load result
mdot = FanCoil(FanCoilNum)%MaxHotWaterFlow
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%HotControlNode, &
FanCoil(FanCoilNum)%HotPlantOutletNode, &
FanCoil(FanCoilNum)%HWLoopNum, &
FanCoil(FanCoilNum)%HWLoopSide, &
FanCoil(FanCoilNum)%HWBranchNum, &
FanCoil(FanCoilNum)%HWCompNum)
CALL Calc4PipeFanCoil(FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutMaxHC)
IF(QUnitOutMaxHC .GT. QCoilHeatSP)THEN
! more heating than required, find reduced water flow rate to meet the load
ControlNode = FanCoil(FanCoilNum)%HotControlNode
ControlOffset = FanCoil(FanCoilNum)%HotControlOffset
MaxWaterFlow = FanCoil(FanCoilNum)%MaxHotWaterFlow
MinWaterFlow = FanCoil(FanCoilNum)%MinHotWaterFlow
!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(.not. FirstHVACIteration) Then
MaxWaterFlow = Node(ControlNode)%MassFlowRateMaxAvail
MinWaterFlow = Node(ControlNode)%MassFlowRateMinAvail
End If
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
CALL ControlCompOutput(CompType=cMO_FanCoil,CompNum=FanCoilNum, &
FirstHVACIteration=FirstHVACIteration,QZnReq=QZnReq, &
ActuatedNode=ControlNode,MaxFlow=MaxWaterFlow, &
MinFlow=MinWaterFlow,ControlOffSet=ControlOffset,Action=iNormalAction, &
CompName = FanCoil(FanCoilNum)%Name, &
ControlCompTypeNum=FanCoil(FanCoilNum)%ControlCompTypeNum, &
CompErrIndex=FanCoil(FanCoilNum)%CompErrIndex, &
LoopNum = FanCoil(FanCoilNum)%HWLoopNum, &
LoopSide = FanCoil(FanCoilNum)%HWLoopSide, &
BranchIndex = FanCoil(FanCoilNum)%HWBranchNum, &
ControlledZoneIndex = ControlledZoneNum)
ENDIF
QUnitOut = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
ELSE
! no action
QUnitOut = QUnitOutNoHC
END IF
! CR9155 Remove specific humidity calculations
SpecHumOut = Node(OutletNode)%HumRat
SpecHumIn = Node(InletNode)%HumRat
LatentOutput = AirMassFlow * (SpecHumOut - SpecHumIn) ! Latent rate (kg/s), dehumid = negative
QTotUnitOut = AirMassFlow * (Node(OutletNode)%Enthalpy - Node(InletNode)%Enthalpy)
! report variables
FanCoil(FanCoilNum)%HeatPower = MAX(0.0d0,QUnitOut)
FanCoil(FanCoilNum)%SensCoolPower = ABS(MIN(constant_zero,QUnitOut))
FanCoil(FanCoilNum)%TotCoolPower = ABS(MIN(constant_zero,QTotUnitOut))
FanCoil(FanCoilNum)%ElecPower = FanElecPower
PowerMet = QUnitOut
LatOutputProvided = LatentOutput
! cycling fan constant water flow AND VarFanVarFlow
CASE (CCM_CycFan,CCM_VarFanVarFlow)
IF (CurDeadbandOrSetback(ZoneNum) .OR. AirMassFlow < SmallMassFlow) UnitOn = .FALSE.
! speed fan selection only for multispeed cycling fan
IF (UnitOn .and. (FanCoil(FanCoilNum)%CapCtrlMeth_Num == CCM_CycFan)) THEN
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired
Node(InletNode)%MassFlowRateMax = FanCoil(FanCoilNum)%LowSpeedRatio * FanCoil(FanCoilNum)%MaxAirMassFlow
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutMax)
FanCoil(FanCoilNum)%SpeedFanSel = 1
FanCoil(FanCoilNum)%SpeedFanRatSel = FanCoil(FanCoilNum)%LowSpeedRatio
IF (ABS(QUnitOutMax) .lt. ABS(QZnReq)) THEN
Node(InletNode)%MassFlowRateMax = FanCoil(fanCoilNum)%MedSpeedRatio * FanCoil(FanCoilNum)%MaxAirMassFlow
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutMax)
FanCoil(FanCoilNum)%SpeedFanSel = 2
FanCoil(FanCoilNum)%SpeedFanRatSel = FanCoil(FanCoilNum)%MedSpeedRatio
END IF
IF (ABS(QUnitOutMax) .lt. ABS(QZnReq)) THEN
FanCoil(FanCoilNum)%SpeedFanSel = 3
FanCoil(FanCoilNum)%SpeedFanRatSel = 1.0d0
Node(InletNode)%MassFlowRateMax = FanCoil(FanCoilNum)%MaxAirMassFlow
END IF
ELSE
FanCoil(FanCoilNum)%SpeedFanSel = 0
END IF
! zero the hot & cold water flows
! Node(FanCoil(FanCoilNum)%ColdControlNode)%MassFlowRate = 0.0
! Node(FanCoil(FanCoilNum)%HotControlNode)%MassFlowRate = 0.0
mdot = 0.d0
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%ColdControlNode, &
FanCoil(FanCoilNum)%ColdPlantOutletNode, &
FanCoil(FanCoilNum)%CWLoopNum, &
FanCoil(FanCoilNum)%CWLoopSide, &
FanCoil(FanCoilNum)%CWBranchNum, &
FanCoil(FanCoilNum)%CWCompNum)
mdot = 0.d0
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%HotControlNode, &
FanCoil(FanCoilNum)%HotPlantOutletNode, &
FanCoil(FanCoilNum)%HWLoopNum, &
FanCoil(FanCoilNum)%HWLoopSide, &
FanCoil(FanCoilNum)%HWBranchNum, &
FanCoil(FanCoilNum)%HWCompNum)
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutNOHC)
IF (UnitOn .and. ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP < (-1.d0*SmallLoad) .and. &
TempControlType(ZoneNum) .NE. SingleHeatingSetPoint) THEN
! cooling coil action, maximum cold water flow
mdot = FanCoil(FanCoilNum)%MaxColdWaterFlow
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%ColdControlNode, &
FanCoil(FanCoilNum)%ColdPlantOutletNode, &
FanCoil(FanCoilNum)%CWLoopNum, &
FanCoil(FanCoilNum)%CWLoopSide, &
FanCoil(FanCoilNum)%CWBranchNum, &
FanCoil(FanCoilNum)%CWCompNum)
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP
ControlOffset = FanCoil(FanCoilNum)%ColdControlOffset
! get the maximum output of the fcu
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutMax)
! calculate the PLR, if load greater than output, PLR = 1 (output = max)
If(QUnitOutMax .Ne. 0.0d0) PLR = ABS(QZnReq/QUnitOutMax)
if (PLR .gt. 1.0d0) PLR = 1.0d0
! adjust the PLR to meet the cooling load calling Calc4PipeFanCoil repeatedly with the PLR adjusted
do while (ABS(Error) > ControlOffset .and. ABS(AbsError) > SmallLoad .and. Iter < MaxIterCycl .and. PLR.ne.1.0d0 )
! the water flow rate is at the maximum flow rate time the PLR
! Node(FanCoil(FanCoilNum)%ColdControlNode)%MassFlowRate = PLR * FanCoil(FanCoilNum)%MaxColdWaterFlow
mdot = PLR * FanCoil(FanCoilNum)%MaxColdWaterFlow
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%ColdControlNode, &
FanCoil(FanCoilNum)%ColdPlantOutletNode, &
FanCoil(FanCoilNum)%CWLoopNum, &
FanCoil(FanCoilNum)%CWLoopSide, &
FanCoil(FanCoilNum)%CWBranchNum, &
FanCoil(FanCoilNum)%CWCompNum)
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOut, PLR)
Error = (QZnReq - QUnitOut)/QZnReq
AbsError = QZnReq - QUnitOut
DelPLR = (QZnReq-QUnitOut)/QUnitOutMax
PLR = PLR + Relax * DelPLR
PLR = MAX(0.0d0,MIN(1.0d0,PLR))
Iter = Iter + 1
IF (Iter == 32) Relax = 0.5d0
IF (Iter == 65) Relax = 0.25d0
END DO
! warning if not converged
IF (Iter .GT. (MaxIterCycl-1)) THEN
IF (FanCoil(FanCoilNum)%MaxIterIndexC == 0) THEN
CALL ShowWarningMessage('ZoneHVAC:FourPipeFanCoil="'//TRIM(FanCoil(FanCoilNum)%Name)// &
'" -- Exceeded max iterations while adjusting cycling fan'// &
' sensible runtime to meet the zone load within the cooling convergence tolerance.')
CALL ShowContinueErrorTimeStamp('Iterations='//TRIM(TrimSigDigits(MaxIterCycl)))
ENDIF
CALL ShowRecurringWarningErrorAtEnd('ZoneHVAC:FourPipeFanCoil="'//TRIM(FanCoil(FanCoilNum)%Name)// &
'" -- Exceeded max iterations error (sensible runtime) continues...',FanCoil(FanCoilNum)%MaxIterIndexC)
END IF
! at the end calculate output with adjusted PLR
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOut, PLR)
ELSE IF (UnitOn .and. ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP > SmallLoad .and. &
TempControlType(ZoneNum) .NE. SingleCoolingSetPoint) THEN
! heating coil action, maximun hot water flow
! Node(FanCoil(FanCoilNum)%HotControlNode)%MassFlowRate = FanCoil(FanCoilNum)%MaxHotWaterFlow
mdot = FanCoil(FanCoilNum)%MaxHotWaterFlow
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%HotControlNode, &
FanCoil(FanCoilNum)%HotPlantOutletNode, &
FanCoil(FanCoilNum)%HWLoopNum, &
FanCoil(FanCoilNum)%HWLoopSide, &
FanCoil(FanCoilNum)%HWBranchNum, &
FanCoil(FanCoilNum)%HWCompNum)
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
ControlOffset = FanCoil(FanCoilNum)%HotControlOffset
! get the maximum output of the fcu
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutMax)
! calculate the PLR, if load greater than output, PLR = 1 (output = max)
If(QUnitOutMax .Ne. 0.0d0) THEN
PLR = ABS (QZnReq/QUnitOutMax)
ELSE
PLR = 1.0d0
ENDIF
if (PLR .gt. 1.0d0) PLR = 1.0d0
! adjust the PLR to meet the heating load calling Calc4PipeFanCoil repeatedly with the PLR adjusted
do while (ABS(Error) > ControlOffset .and. ABS(AbsError) > SmallLoad .and. Iter < MaxIterCycl .and. PLR.ne.1.0d0 )
! the water flow rate is at the maximum flow rate time the PLR
! Node(FanCoil(FanCoilNum)%HotControlNode)%MassFlowRate = PLR * FanCoil(FanCoilNum)%MaxHotWaterFlow
mdot = PLR * FanCoil(FanCoilNum)%MaxHotWaterFlow
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%HotControlNode, &
FanCoil(FanCoilNum)%HotPlantOutletNode, &
FanCoil(FanCoilNum)%HWLoopNum, &
FanCoil(FanCoilNum)%HWLoopSide, &
FanCoil(FanCoilNum)%HWBranchNum, &
FanCoil(FanCoilNum)%HWCompNum)
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOut, PLR)
Error = (QZnReq - QUnitOut)/QZnReq
AbsError = QZnReq - QUnitOut
DelPLR = (QZnReq-QUnitOut)/QUnitOutMax
PLR = PLR + Relax * DelPLR
PLR = MAX(0.0d0,MIN(1.0d0,PLR))
Iter = Iter + 1
IF (Iter == 32) Relax = 0.5d0
IF (Iter == 65) Relax = 0.25d0
END DO
! warning if not converged
IF (Iter .GT. (MaxIterCycl - 1)) THEN
IF (FanCoil(FanCoilNum)%MaxIterIndexH == 0) THEN
CALL ShowWarningMessage('ZoneHVAC:FourPipeFanCoil="'//TRIM(FanCoil(FanCoilNum)%Name)// &
'" -- Exceeded max iterations while adjusting cycling fan'// &
' sensible runtime to meet the zone load within the heating convergence tolerance.')
CALL ShowContinueErrorTimeStamp('Iterations='//TRIM(TrimSigDigits(MaxIterCycl)))
ENDIF
CALL ShowRecurringWarningErrorAtEnd('ZoneHVAC:FourPipeFanCoil="'//TRIM(FanCoil(FanCoilNum)%Name)// &
'" -- Exceeded max iterations error (sensible runtime) continues...',FanCoil(FanCoilNum)%MaxIterIndexH)
END IF
! at the end calculate output with adjusted PLR
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOut, PLR)
!this part of the code is just if we want ventilation in the deadband zone
!ELSE IF (AirMassFlow .gt. 0.0d0) THEN
! if fan scheduled available : just ventilation, PLR = 1
!QUnitOut = QUnitOutNOHC
!PLR = 1.
ELSE
! no action, zero the air flow rate, the unit is off
Node(InletNode)%MassFlowRate = 0.0d0
Node(OutletNode)%MassFlowRate = 0.0d0
FanCoil(FanCoilNum)%SpeedFanSel = 0
PLR = 0.0d0
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOut,PLR)
END IF
AirMassFlow = Node(InletNode)%MassFlowRate
! CR9155 Remove specific humidity calculations
SpecHumOut = Node(OutletNode)%HumRat
SpecHumIn = Node(InletNode)%HumRat
LatentOutput = AirMassFlow * (SpecHumOut - SpecHumIn) ! Latent rate (kg/s), dehumid = negative
QTotUnitOut = AirMassFlow * (Node(OutletNode)%Enthalpy - Node(InletNode)%Enthalpy)
! report variables
FanCoil(FanCoilNum)%HeatPower = MAX(0.0d0,QUnitOut)
FanCoil(FanCoilNum)%SensCoolPower = ABS(MIN(constant_zero,QUnitOut))
FanCoil(FanCoilNum)%TotCoolPower = ABS(MIN(constant_zero,QTotUnitOut))
FanCoil(FanCoilNum)%ElecPower = FanElecPower
FanCoil(FanCoilNum)%PLR = PLR
PowerMet = QUnitOut
LatOutputProvided = LatentOutput
! cycling fan constant water flow AND VarFanVarFlow
CASE (CCM_VarFanConsFlow)
IF (CurDeadbandOrSetback(ZoneNum) .OR. AirMassFlow < SmallMassFlow) UnitOn = .FALSE.
! zero the hot & cold water flows
! Node(FanCoil(FanCoilNum)%ColdControlNode)%MassFlowRate = 0.0
! Node(FanCoil(FanCoilNum)%HotControlNode)%MassFlowRate = 0.0
mdot = 0.d0
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%ColdControlNode, &
FanCoil(FanCoilNum)%ColdPlantOutletNode, &
FanCoil(FanCoilNum)%CWLoopNum, &
FanCoil(FanCoilNum)%CWLoopSide, &
FanCoil(FanCoilNum)%CWBranchNum, &
FanCoil(FanCoilNum)%CWCompNum)
mdot = 0.d0
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%HotControlNode, &
FanCoil(FanCoilNum)%HotPlantOutletNode, &
FanCoil(FanCoilNum)%HWLoopNum, &
FanCoil(FanCoilNum)%HWLoopSide, &
FanCoil(FanCoilNum)%HWBranchNum, &
FanCoil(FanCoilNum)%HWCompNum)
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutNOHC)
IF (UnitOn .and. ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP < (-1.d0*SmallLoad) .and. &
TempControlType(ZoneNum) .NE. SingleHeatingSetPoint) THEN
! cooling coil action, maximum cold water flow
mdot = FanCoil(FanCoilNum)%MaxColdWaterFlow
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%ColdControlNode, &
FanCoil(FanCoilNum)%ColdPlantOutletNode, &
FanCoil(FanCoilNum)%CWLoopNum, &
FanCoil(FanCoilNum)%CWLoopSide, &
FanCoil(FanCoilNum)%CWBranchNum, &
FanCoil(FanCoilNum)%CWCompNum)
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP
ControlOffset = FanCoil(FanCoilNum)%ColdControlOffset
! get the maximum output of the fcu
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutMax)
! calculate the PLR, if load greater than output, PLR = 1 (output = max)
If(QUnitOutMax .Ne. 0.0d0) PLR = ABS(QZnReq/QUnitOutMax)
if (PLR .gt. 1.0d0) PLR = 1.0d0
! adjust the PLR to meet the cooling load calling Calc4PipeFanCoil repeatedly with the PLR adjusted
do while (ABS(Error) > ControlOffset .and. ABS(AbsError) > SmallLoad .and. Iter < MaxIterCycl .and. PLR.ne.1.0d0 )
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOut, PLR)
Error = (QZnReq - QUnitOut)/QZnReq
AbsError = QZnReq - QUnitOut
DelPLR = (QZnReq-QUnitOut)/QUnitOutMax
PLR = PLR + Relax * DelPLR
PLR = MAX(0.0d0,MIN(1.0d0,PLR))
Iter = Iter + 1
IF (Iter == 32) Relax = 0.5d0
IF (Iter == 65) Relax = 0.25d0
END DO
! warning if not converged
IF (Iter .GT. (MaxIterCycl-1)) THEN
IF (FanCoil(FanCoilNum)%MaxIterIndexC == 0) THEN
CALL ShowWarningMessage('ZoneHVAC:FourPipeFanCoil="'//TRIM(FanCoil(FanCoilNum)%Name)// &
'" -- Exceeded max iterations while adjusting cycling fan'// &
' sensible runtime to meet the zone load within the cooling convergence tolerance.')
CALL ShowContinueErrorTimeStamp('Iterations='//TRIM(TrimSigDigits(MaxIterCycl)))
ENDIF
CALL ShowRecurringWarningErrorAtEnd('ZoneHVAC:FourPipeFanCoil="'//TRIM(FanCoil(FanCoilNum)%Name)// &
'" -- Exceeded max iterations error (sensible runtime) continues...',FanCoil(FanCoilNum)%MaxIterIndexC)
END IF
! at the end calculate output with adjusted PLR
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOut, PLR)
ELSE IF (UnitOn .and. ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP > SmallLoad .and. &
TempControlType(ZoneNum) .NE. SingleCoolingSetPoint) THEN
! heating coil action, maximun hot water flow
mdot = FanCoil(FanCoilNum)%MaxHotWaterFlow
CALL SetComponentFlowRate(mdot , &
FanCoil(FanCoilNum)%HotControlNode, &
FanCoil(FanCoilNum)%HotPlantOutletNode, &
FanCoil(FanCoilNum)%HWLoopNum, &
FanCoil(FanCoilNum)%HWLoopSide, &
FanCoil(FanCoilNum)%HWBranchNum, &
FanCoil(FanCoilNum)%HWCompNum)
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
ControlOffset = FanCoil(FanCoilNum)%HotControlOffset
! get the maximum output of the fcu
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOutMax)
! calculate the PLR, if load greater than output, PLR = 1 (output = max)
If(QUnitOutMax .Ne. 0.0d0) PLR = ABS (QZnReq/QUnitOutMax)
if (PLR .gt. 1.0d0) PLR = 1.0d0
! adjust the PLR to meet the heating load calling Calc4PipeFanCoil repeatedly with the PLR adjusted
do while (ABS(Error) > ControlOffset .and. ABS(AbsError) > SmallLoad .and. Iter < MaxIterCycl .and. PLR.ne.1.0d0 )
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOut, PLR)
Error = (QZnReq - QUnitOut)/QZnReq
AbsError = QZnReq - QUnitOut
DelPLR = (QZnReq-QUnitOut)/QUnitOutMax
PLR = PLR + Relax * DelPLR
PLR = MAX(0.0d0,MIN(1.0d0,PLR))
Iter = Iter + 1
IF (Iter == 32) Relax = 0.5d0
IF (Iter == 65) Relax = 0.25d0
END DO
! warning if not converged
IF (Iter .GT. (MaxIterCycl - 1)) THEN
IF (FanCoil(FanCoilNum)%MaxIterIndexH == 0) THEN
CALL ShowWarningMessage('ZoneHVAC:FourPipeFanCoil="'//TRIM(FanCoil(FanCoilNum)%Name)// &
'" -- Exceeded max iterations while adjusting cycling fan'// &
' sensible runtime to meet the zone load within the heating convergence tolerance.')
CALL ShowContinueErrorTimeStamp('Iterations='//TRIM(TrimSigDigits(MaxIterCycl)))
ENDIF
CALL ShowRecurringWarningErrorAtEnd('ZoneHVAC:FourPipeFanCoil="'//TRIM(FanCoil(FanCoilNum)%Name)// &
'" -- Exceeded max iterations error (sensible runtime) continues...',FanCoil(FanCoilNum)%MaxIterIndexH)
END IF
! at the end calculate output with adjusted PLR
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOut, PLR)
!this part of the code is just if we want ventilation in the deadband zone
!ELSE IF (AirMassFlow .gt. 0.0d0) THEN
! if fan scheduled available : just ventilation, PLR = 1
!QUnitOut = QUnitOutNOHC
!PLR = 1.
ELSE
! no action, zero the air flow rate, the unit is off
Node(InletNode)%MassFlowRate = 0.0d0
Node(OutletNode)%MassFlowRate = 0.0d0
FanCoil(FanCoilNum)%SpeedFanSel = 0
PLR = 0.0d0
CALL Calc4PipeFanCoil (FanCoilNum,ControlledZoneNum,FirstHVACIteration,QUnitOut,PLR)
END IF
AirMassFlow = Node(InletNode)%MassFlowRate
! CR9155 Remove specific humidity calculations
SpecHumOut = Node(OutletNode)%HumRat
SpecHumIn = Node(InletNode)%HumRat
LatentOutput = AirMassFlow * (SpecHumOut - SpecHumIn) ! Latent rate (kg/s), dehumid = negative
QTotUnitOut = AirMassFlow * (Node(OutletNode)%Enthalpy - Node(InletNode)%Enthalpy)
! report variables
FanCoil(FanCoilNum)%HeatPower = MAX(0.0d0,QUnitOut)
FanCoil(FanCoilNum)%SensCoolPower = ABS(MIN(constant_zero,QUnitOut))
FanCoil(FanCoilNum)%TotCoolPower = ABS(MIN(constant_zero,QTotUnitOut))
FanCoil(FanCoilNum)%ElecPower = FanElecPower
FanCoil(FanCoilNum)%PLR = PLR
PowerMet = QUnitOut
LatOutputProvided = LatentOutput
END SELECT
RETURN
END SUBROUTINE Sim4PipeFanCoil