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) | :: | UnitarySysNum | |||
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 ControlSuppHeatSystem(UnitarySysNum, FirstHVACIteration )
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad, FSEC
! DATE WRITTEN February 2013
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine updates the System outlet nodes.
! METHODOLOGY EMPLOYED:
! Data is moved from the System data structure to the System outlet nodes.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataAirLoop, ONLY: LoopHeatingCoilMaxRTF, LoopDXCoilRTF
USE Psychrometrics, ONLY: PsyHFnTdbW, PsyTdpFnWPb
USE General, ONLY: SolveRegulaFalsi, RoundSigDigits
USE HeatingCoils, ONLY: SimulateHeatingCoilComponents
USE WaterCoils, ONLY: SimulateWaterCoilComponents
USE SteamCoils, ONLY: SimulateSteamCoilComponents
USE PlantUtilities, ONLY: SetComponentFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(In) :: UnitarySysNum ! index to Unitary System
LOGICAL, INTENT(In) :: FirstHVACIteration ! First HVAC iteration flag
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: MaxIte = 500 ! Maximum number of iterations for solver
REAL(r64), PARAMETER :: Acc = 1.0d-3 ! Accuracy of solver result
REAL(r64), PARAMETER :: HumRatAcc = 1.0d-6 ! Accuracy of solver result
INTEGER, PARAMETER :: SolveMaxIter=50
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength) :: CompName ! Name of the heating coil
INTEGER :: CompIndex ! Index to the heating coil
! REAL(r64) :: NoOutput ! Sensible capacity (outlet - inlet) when the compressor is off
REAL(r64) :: FullOutput ! Sensible capacity (outlet - inlet) when the compressor is on
REAL(r64) :: ReqOutput ! Sensible capacity (outlet - inlet) required to meet load or set point temperature
Integer :: InletNode ! Inlet node number of the DX cooling coil
Integer :: OutletNode ! Outlet node number of the DX cooling coil
Integer :: ControlNode ! The node number where a set point is placed to control the DX cooling coil
REAL(r64) :: PartLoadFrac ! The part-load fraction of the compressor
REAL(r64) :: DesOutTemp ! Desired outlet temperature of the DX cooling coil
REAL(r64) :: QCoilActual ! Heating coil operating capacity [W]
INTEGER :: SolFla ! Flag of solver, num iterations if >0, else error index
REAL(r64), DIMENSION(5) :: Par ! Parameter array passed to solver
LOGICAL :: SensibleLoad ! True if there is a sensible cooling load on this system
INTEGER :: FanOpMode ! Supply air fan operating mode
REAL(R64) :: LoopHeatingCoilMaxRTFSave ! Used to find RTF of heating coils without overwriting globabl variable
REAL(R64) :: LoopDXCoilMaxRTFSave ! Used to find RTF of DX heating coils without overwriting globabl variable
LOGICAL :: SuppHeatingCoilFlag = .TRUE.
REAL(r64) :: NoLoadTempOut ! save outlet temp when coil is off (C)
! Set local variables
! Retrieve the load on the controlled zone
OutletNode = UnitarySystem(UnitarySysNum)%SuppCoilAirOutletNode
InletNode = UnitarySystem(UnitarySysNum)%SuppCoilAirInletNode
ControlNode = UnitarySystem(UnitarySysNum)%SuppCoilAirOutletNode
DesOutTemp = UnitarySystem(UnitarySysNum)%DesiredOutletTemp
CompName = UnitarySystem(UnitarySysNum)%SuppHeatCoilName
CompIndex = UnitarySystem(UnitarySysNum)%SuppHeatCoilIndex
FanOpMode = UnitarySystem(UnitarySysNum)%FanOpMode
SolFla = 0.0d0
PartLoadFrac = 0.0d0
SensibleLoad = .FALSE.
LoopHeatingCoilMaxRTFSave=LoopHeatingCoilMaxRTF
LoopHeatingCoilMaxRTF = 0.0d0
LoopDXCoilMaxRTFSave=LoopDXCoilRTF
LoopDXCoilRTF=0.0d0
IF((GetCurrentScheduleValue(UnitarySystem(UnitarySysNum)%SysAvailSchedPtr) > 0.0d0) .AND. &
(Node(InletNode)%MassFlowRate .gt. MinAirMassFlow)) THEN
! Determine if there is a sensible load on this system
IF((Node(InletNode)%Temp < DesOutTemp) .AND. &
(ABS(Node(InletNode)%Temp - DesOutTemp) .gt. TempControlTol) ) SensibleLoad = .TRUE.
IF (SensibleLoad ) THEN
ReqOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(UnitarySystem(UnitarySysNum)%DesiredOutletTemp,Node(InletNode)%HumRat) - &
PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
! Get no load result
PartLoadFrac = 0.0d0
SELECT CASE(UnitarySystem(UnitarySysNum)%SuppHeatCoilType_Num)
CASE (Coil_HeatingGas,Coil_HeatingElectric,Coil_HeatingDesuperheater )
CALL SimulateHeatingCoilComponents(CompName,FirstHVACIteration, &
CompIndex=CompIndex, PartLoadRatio = PartLoadFrac, & ! QCoilReq= 0.0d0, &
SuppHeat=SuppHeatingCoilFlag,FanOpMode=FanOpMode,QCoilActual=QCoilActual)
PartLoadFrac=QCoilActual/UnitarySystem(UnitarySysNum)%DesignSuppHeatingCapacity
CASE (Coil_HeatingWater)
CALL SimWaterCoils(UnitarySysNum, FirstHVACIteration, PartLoadFrac, SuppHeatCoil)
CASE (Coil_HeatingSteam)
CALL SimSteamCoils(UnitarySysNum, FirstHVACIteration, PartLoadFrac, SuppHeatCoil)
CASE DEFAULT
END SELECT
NoLoadTempOut = Node(OutletNode)%Temp
! NoOutput = Node(InletNode)%MassFlowRate * &
! (PsyHFnTdbW(NoLoadTempOut,Node(OutletNode)%HumRat) &
! - PsyHFnTdbW(Node(InletNode)%Temp,Node(OutletNode)%HumRat))
! If OutletTemp is within ACC of set point, either coil operated or is not needed
IF(ABS(Node(OutletNode)%Temp-DesOutTemp) < Acc)THEN
! do nothing, coil is at set point (i.e., gas/elec/steam coil will try to hit set point
ELSE IF(PartLoadFrac .GT. 0.0d0)THEN
! do nothing, coil tried to hit set point (i.e., gas/elec/steam coil tried to hit set point but missed
ELSE IF (NoLoadTempOut .GT. (DesOutTemp - Acc)) THEN
PartLoadFrac = 0.0d0 ! outlet temp > set point, coil is not needed
ELSE ! outlet temp too low, turn on coil
! Get full load result
PartLoadFrac = 1.0d0
SELECT CASE(UnitarySystem(UnitarySysNum)%SuppHeatCoilType_Num)
CASE (Coil_HeatingGas,Coil_HeatingElectric)
CALL SimulateHeatingCoilComponents(CompName,FirstHVACIteration, &
! CompIndex=CompIndex, QCoilReq= UnitarySystem(UnitarySysNum)%DesignSuppHeatingCapacity, &
CompIndex=CompIndex, PartLoadRatio = PartLoadFrac, &
SuppHeat=SuppHeatingCoilFlag, FanOpMode=FanOpMode,QCoilActual=QCoilActual)
PartLoadFrac=QCoilActual/UnitarySystem(UnitarySysNum)%DesignSuppHeatingCapacity
CASE (Coil_HeatingDesuperheater )
CALL SimulateHeatingCoilComponents(CompName,FirstHVACIteration, &
CompIndex=CompIndex, QCoilReq= ReqOutput, &
SuppHeat=SuppHeatingCoilFlag, FanOpMode=FanOpMode)
CASE (Coil_HeatingWater)
CALL SimWaterCoils(UnitarySysNum, FirstHVACIteration, PartLoadFrac, SuppHeatCoil)
CASE (Coil_HeatingSteam)
CALL SimSteamCoils(UnitarySysNum, FirstHVACIteration, PartLoadFrac, SuppHeatCoil)
CASE DEFAULT
END SELECT
FullOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
! If the FullOutput outlet temp is less than (insufficient heating) or very near set point,
! run the coil at PartLoadFrac = 1.
IF (Node(OutletNode)%Temp .LT. (DesOutTemp+Acc)) THEN
PartLoadFrac = 1.0d0
ELSE
SELECT CASE(UnitarySystem(UnitarySysNum)%SuppHeatCoilType_Num)
CASE (Coil_HeatingGas,Coil_HeatingElectric, Coil_HeatingDesuperheater)
Par(1) = REAL(UnitarySysNum,r64)
IF (FirstHVACIteration) THEN
Par(2) = 1.0d0
ELSE
Par(2) = 0.0d0
END IF
Par(3) = DesOutTemp
IF (SuppHeatingCoilFlag) THEN
Par(4) = 1.0d0
ELSE
Par(4) = 0.0d0
END IF
Par(5) = FanOpMode
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, GasElecHeatingCoilResidual, 0.0d0, &
1.0d0, Par)
CASE (Coil_HeatingWater)
Par(1) = REAL(UnitarySysNum,r64)
IF (FirstHVACIteration) THEN
Par(2) = 1.0d0
ELSE
Par(2) = 0.0d0
END IF
Par(3) = DesOutTemp
IF (SuppHeatingCoilFlag) THEN
Par(4) = 1.0d0
ELSE
Par(4) = 0.0d0
END IF
Par(5)=0.0d0
CALL SolveRegulaFalsi(Acc, SolveMaxIter, SolFla, PartLoadFrac, HotWaterHeatingCoilResidual, &
0.0d0, 1.0d0, Par)
CASE (Coil_HeatingSteam)
Par(1) = REAL(UnitarySysNum,r64)
IF (FirstHVACIteration) THEN
Par(2) = 1.0d0
ELSE
Par(2) = 0.0d0
END IF
Par(3) = DesOutTemp
IF (SuppHeatingCoilFlag) THEN
Par(4) = 1.0d0
ELSE
Par(4) = 0.0d0
END IF
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, SteamHeatingCoilResidual, 0.0d0, &
1.0d0, Par)
CASE DEFAULT
END SELECT
END IF ! IF ((FullOutput - ReqOutput) < Acc) THEN
END IF ! IF ((NoOutput-ReqOutput) > Acc) THEN
END IF ! IF (SensibleLoad ) THEN
END IF ! IF((GetCurrentScheduleValue(UnitarySystem(UnitarySysNum)%SysAvailSchedPtr) > 0.0d0) .AND. &
IF(PartLoadFrac .GT. 1.0d0) THEN
PartLoadFrac = 1.0d0
ELSEIF(PartLoadFrac < 0.0d0) THEN
PartLoadFrac = 0.0d0
END IF
IF (SolFla == -1) THEN
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRIter .LT. 1)THEN
UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRIter = UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRIter+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)// &
' - Iteration limit exceeded calculating sensible '// &
'part-load ratio for unit = '//TRIM(UnitarySystem(UnitarySysNum)%Name))
CALL ShowContinueError('Estimated part-load ratio = '//RoundSigDigits((ReqOutput/FullOutput),3))
CALL ShowContinueError('Calculated part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
CALL ShowContinueErrorTimeStamp('The calculated part-load ratio will be used and the simulation'// &
' continues. Occurrence info: ')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
//TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - Iteration limit exceeded calculating'// &
' sensible part-load ratio error continues. Sensible PLR statistics follow.' &
,UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRIterIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF ! IF(.NOT. WarmupFlag)THEN
ELSEIF (SolFla == -2) THEN
PartLoadFrac = ReqOutput/FullOutput
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRFail .LT. 1)THEN
UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRFail = UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRFail+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' - sensible part-'// &
'load ratio calculation failed: part-load ratio limits exceeded, for unit = '// &
TRIM(UnitarySystem(UnitarySysNum)%Name))
CALL ShowContinueError('Estimated part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
CALL ShowContinueErrorTimeStamp('The estimated part-load ratio will be used and the simulation'// &
' continues. Occurrence info: ')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
//TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - sensible part-load ratio calculation'// &
' failed error continues. Sensible PLR statistics follow.' &
,UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRFailIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF ! IF(.NOT. WarmupFlag)THEN
END IF ! IF (SolFla == -1) THEN
UnitarySystem(UnitarySysNum)%SuppHeatPartLoadFrac = PartLoadFrac
LoopHeatingCoilMaxRTF = MAX(LoopHeatingCoilMaxRTF, LoopHeatingCoilMaxRTFSave)
LoopDXCoilRTF = MAX(LoopDXCoilRTF, LoopDXCoilMaxRTFSave)
RETURN
END SUBROUTINE ControlSuppHeatSystem