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) | :: | IUNum | |||
integer, | intent(in) | :: | ZoneNum | |||
integer, | intent(in) | :: | ZoneNodeNum | |||
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 SimFourPipeIndUnit(IUNum,ZoneNum,ZoneNodeNum,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN June 23 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulate a 4 pipe induction unit; adjust its heating or cooling
! coil outputs to match the zone load.
! METHODOLOGY EMPLOYED:
! (1) From the zone load and the primary air inlet conditions calculate the coil load
! in the secondary air stream
! (2) If there is a cooling coil load, set the heating coil off and control the cooling
! coil to meet the coil load
! (3) If there is a heating coil load, control the heating coil to meet the load and keep
! the cooling coil off.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEnergyDemands
USE General, ONLY: SolveRegulaFalsi,RoundSigDigits
USE DataPlant, ONLY: PlantLoop
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) :: IUNum ! number of the current unit being simulated
INTEGER, INTENT (IN) :: ZoneNum ! number of zone being served
INTEGER, INTENT (IN) :: ZoneNodeNum ! zone node number
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: SolveMaxIter=50
! INTERFACE BLOCK SPECIFICATIONS:
! na
! 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) :: QToCoolSetPt ! [W] remaining load to cooling setpoint
REAL(r64) :: PowerMet ! power supplied
LOGICAL :: UnitOn ! TRUE if unit is on
REAL(r64) :: MaxHotWaterFlow ! maximum water flow for heating [kg/s]
REAL(r64) :: MinHotWaterFlow ! minimum water flow for heating [kg/s]
REAL(r64) :: MaxColdWaterFlow ! maximum water flow for cooling [kg/s]
REAL(r64) :: MinColdWaterFlow ! minimum water flow for cooling [kg/s]
REAL(r64) :: HWFlow ! hot water flow [kg/s]
REAL(r64) :: CWFlow ! cold water flow [kg/s]
INTEGER :: PriNode ! unit primary air inlet node
INTEGER :: SecNode ! unit secondary air inlet node
INTEGER :: OutletNode ! unit air outlet node
INTEGER :: HotControlNode ! hot water coil inlet node
INTEGER :: ColdControlNode ! cold water coil inlet node
REAL(r64) :: QPriOnly ! unit output with no zone coils active
REAL(r64) :: PriAirMassFlow ! primary air mass flow rate [kg/s]
REAL(r64) :: SecAirMassFlow ! secondary air mass flow rate [kg/s]
REAL(r64) :: InducRat ! Induction Ratio
REAL(r64), DIMENSION(7) :: Par
INTEGER :: SolFlag
REAL(r64) :: ErrTolerance
INTEGER :: HWOutletNode
INTEGER :: CWOutletNode
UnitOn = .TRUE.
PowerMet = 0.0d0
InducRat = IndUnit(IUNum)%InducRatio
PriNode = IndUnit(IUNum)%PriAirInNode
SecNode = IndUnit(IUNum)%SecAirInNode
OutletNode = IndUnit(IUNum)%OutAirNode
HotControlNode = IndUnit(IUNum)%HWControlNode
HWOutletNode = PlantLoop(IndUnit(IUNum)%HWLoopNum)%LoopSide(IndUnit(IUNum)%HWLoopSide) &
%Branch(IndUnit(IUNum)%HWBranchNum)%Comp(IndUnit(IUNum)%HWCompNum)%NodeNumOut
ColdControlNode = IndUnit(IUNum)%CWControlNode
CWOutletNode = PlantLoop(IndUnit(IUNum)%CWLoopNum)%LoopSide(IndUnit(IUNum)%CWLoopSide) &
%Branch(IndUnit(IUNum)%CWBranchNum)%Comp(IndUnit(IUNum)%CWCompNum)%NodeNumOut
PriAirMassFlow = Node(PriNode)%MassFlowRateMaxAvail
SecAirMassFlow = InducRat*PriAirMassFlow
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired
QToHeatSetPt=ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
QToCoolSetPt=ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP
!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
MaxHotWaterFlow = IndUnit(IUNum)%MaxHotWaterFlow
Call SetComponentFlowRate(MaxHotWaterFlow, &
HotControlNode, &
HWOutletNode, &
IndUnit(IUNum)%HWLoopNum, &
IndUnit(IUNum)%HWLoopSide, &
IndUnit(IUNum)%HWBranchNum, &
IndUnit(IUNum)%HWCompNum)
MinHotWaterFlow = IndUnit(IUNum)%MinHotWaterFlow
Call SetComponentFlowRate(MinHotWaterFlow, &
HotControlNode, &
HWOutletNode, &
IndUnit(IUNum)%HWLoopNum, &
IndUnit(IUNum)%HWLoopSide, &
IndUnit(IUNum)%HWBranchNum, &
IndUnit(IUNum)%HWCompNum)
MaxColdWaterFlow = IndUnit(IUNum)%MaxColdWaterFlow
Call SetComponentFlowRate(MaxColdWaterFlow, &
ColdControlNode, &
CWOutletNode, &
IndUnit(IUNum)%CWLoopNum, &
IndUnit(IUNum)%CWLoopSide, &
IndUnit(IUNum)%CWBranchNum, &
IndUnit(IUNum)%CWCompNum)
MinColdWaterFlow = IndUnit(IUNum)%MinColdWaterFlow
Call SetComponentFlowRate(MinColdWaterFlow, &
ColdControlNode, &
CWOutletNode, &
IndUnit(IUNum)%CWLoopNum, &
IndUnit(IUNum)%CWLoopSide, &
IndUnit(IUNum)%CWBranchNum, &
IndUnit(IUNum)%CWCompNum)
IF (GetCurrentScheduleValue(IndUnit(IUNum)%SchedPtr) .LE. 0.0d0) UnitOn = .FALSE.
IF (PriAirMassFlow.LE.SmallMassFlow) UnitOn = .FALSE.
! Set the unit's air inlet nodes mass flow rates
Node(PriNode)%MassFlowRate = PriAirMassFlow
Node(SecNode)%MassFlowRate = SecAirMassFlow
! initialize the water inlet nodes to minimum
! fire the unit at min water flow
CALL CalcFourPipeIndUnit(IUNum,FirstHVACIteration,ZoneNodeNum,MinHotWaterFlow,MinColdWaterFlow,QPriOnly)
! the load to be met by the secondary air stream coils is QZnReq-PowerMet
IF (UnitOn) THEN
IF (QToHeatSetPt-QPriOnly > SmallLoad) THEN
! heating coil
! check that it can meet the load
CALL CalcFourPipeIndUnit(IUNum,FirstHVACIteration,ZoneNodeNum,MaxHotWaterFlow,MinColdWaterFlow,PowerMet)
IF (PowerMet > QToHeatSetPt + SmallLoad) THEN
Par(1) = REAL(IUNum,r64)
IF (FirstHVACIteration) THEN
Par(2) = 1.d0
ELSE
Par(2) = 0.0d0
END IF
Par(3) = REAL(ZoneNodeNum,r64)
Par(4) = MinColdWaterFlow
Par(5) = QToHeatSetPt
Par(6) = QPriOnly
Par(7) = PowerMet
ErrTolerance=IndUnit(IUNum)%HotControlOffset
CALL SolveRegulaFalsi(ErrTolerance, SolveMaxIter, SolFlag, HWFlow, FourPipeIUHeatingResidual, &
MinHotWaterFlow, MaxHotWaterFlow, Par)
IF (SolFlag == -1) THEN
IF (IndUnit(IUNum)%HWCoilFailNum1 == 0) THEN
CALL ShowWarningMessage('SimFourPipeIndUnit: Hot water coil control failed for '// &
trim(IndUnit(IUNum)%UnitType)//'="'// &
TRIM(IndUnit(IUNum)%Name)//'"')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError(' Iteration limit ['//trim(RoundSigDigits(SolveMaxIter))// &
'] exceeded in calculating hot water mass flow rate')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('SimFourPipeIndUnit: Hot water coil control failed (iteration limit ['// &
trim(RoundSigDigits(SolveMaxIter))//']) for '//trim(IndUnit(IUNum)%UnitType)//'="'// &
TRIM(IndUnit(IUNum)%Name)//'"',IndUnit(IUNum)%HWCoilFailNum1)
ELSE IF (SolFlag == -2) THEN
IF (IndUnit(IUNum)%HWCoilFailNum2 == 0) THEN
CALL ShowWarningMessage('SimFourPipeIndUnit: Hot water coil control failed (maximum flow limits) for '// &
trim(IndUnit(IUNum)%UnitType)//'="'// &
TRIM(IndUnit(IUNum)%Name)//'"')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('...Bad hot water maximum flow rate limits')
CALL ShowContinueError('...Given minimum water flow rate='//trim(RoundSigDigits(MinHotWaterFlow,3))//' kg/s')
CALL ShowContinueError('...Given maximum water flow rate='//trim(RoundSigDigits(MaxHotWaterFlow,3))//' kg/s')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('SimFourPipeIndUnit: Hot water coil control failed (flow limits) for '// &
trim(IndUnit(IUNum)%UnitType)//'="'// &
TRIM(IndUnit(IUNum)%Name)//'"', &
IndUnit(IUNum)%HWCoilFailNum2, &
ReportMinOf=MinHotWaterFlow,ReportMaxOf=MaxHotWaterFlow,ReportMinUnits='[kg/s]',ReportMaxUnits='[kg/s]')
END IF
END IF
ELSE IF (QToCoolSetPt - QPriOnly < - SmallLoad) THEN
! cooling coil
! check that it can meet the load
CALL CalcFourPipeIndUnit(IUNum,FirstHVACIteration,ZoneNodeNum,MinHotWaterFlow,MaxColdWaterFlow,PowerMet)
IF (PowerMet < QToCoolSetPt - SmallLoad) THEN
Par(1) = REAL(IUNum,r64)
IF (FirstHVACIteration) THEN
Par(2) = 1.d0
ELSE
Par(2) = 0.0d0
END IF
Par(3) = REAL(ZoneNodeNum,r64)
Par(4) = MinHotWaterFlow
Par(5) = QToCoolSetPt
Par(6) = QPriOnly
Par(7) = PowerMet
ErrTolerance=IndUnit(IUNum)%ColdControlOffset
CALL SolveRegulaFalsi(ErrTolerance, SolveMaxIter, SolFlag, CWFlow, FourPipeIUCoolingResidual, &
MinColdWaterFlow, MaxColdWaterFlow, Par)
IF (SolFlag == -1) THEN
IF (IndUnit(IUNum)%CWCoilFailNum1 == 0) THEN
CALL ShowWarningMessage('SimFourPipeIndUnit: Cold water coil control failed for '// &
trim(IndUnit(IUNum)%UnitType)//'="'// &
TRIM(IndUnit(IUNum)%Name)//'"')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError(' Iteration limit ['//trim(RoundSigDigits(SolveMaxIter))// &
'] exceeded in calculating cold water mass flow rate')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('SimFourPipeIndUnit: Cold water coil control failed (iteration limit ['// &
trim(RoundSigDigits(SolveMaxIter))//']) for '//trim(IndUnit(IUNum)%UnitType)//'="'// &
TRIM(IndUnit(IUNum)%Name),IndUnit(IUNum)%CWCoilFailNum1)
ELSE IF (SolFlag == -2) THEN
IF (IndUnit(IUNum)%CWCoilFailNum2 == 0) THEN
CALL ShowWarningMessage('SimFourPipeIndUnit: Cold water coil control failed (maximum flow limits) for '// &
trim(IndUnit(IUNum)%UnitType)//'="'// &
TRIM(IndUnit(IUNum)%Name)//'"')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('...Bad cold water maximum flow rate limits')
CALL ShowContinueError('...Given minimum water flow rate='//trim(RoundSigDigits(MinColdWaterFlow,3))//' kg/s')
CALL ShowContinueError('...Given maximum water flow rate='//trim(RoundSigDigits(MaxColdWaterFlow,3))//' kg/s')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('SimFourPipeIndUnit: Cold water coil control failed (flow limits) for '// &
trim(IndUnit(IUNum)%UnitType)//'="'// &
TRIM(IndUnit(IUNum)%Name)//'"', &
IndUnit(IUNum)%CWCoilFailNum2, &
ReportMinOf=MinColdWaterFlow,ReportMaxOf=MaxColdWaterFlow,ReportMinUnits='[kg/s]',ReportMaxUnits='[kg/s]')
END IF
END IF
ELSE
CALL CalcFourPipeIndUnit(IUNum,FirstHVACIteration,ZoneNodeNum,MinHotWaterFlow,MinColdWaterFlow,PowerMet)
END IF
ELSE
! unit off
CALL CalcFourPipeIndUnit(IUNum,FirstHVACIteration,ZoneNodeNum,MinHotWaterFlow,MinColdWaterFlow,PowerMet)
END IF
Node(OutletNode)%MassFlowRateMax = IndUnit(IUNum)%MaxTotAirMassFlow
! At this point we are done. There is no output to report or pass back up: the output provided is calculated
! one level up in the calling routine SimZoneAirLoopEquipment. All the inlet and outlet flow rates and
! conditions have been set by CalcFourPipeIndUnit either explicitly or as a result of the simple component calls.
RETURN
END SUBROUTINE SimFourPipeIndUnit