SUBROUTINE ControlCoolingSystem(UnitarySysNum, FirstHVACIteration, HXUnitOn)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad, FSEC
! DATE WRITTEN February 2013
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulate the coil object at the required PLR.
! METHODOLOGY EMPLOYED:
! Calculate operating PLR and adjust speed when using multispeed coils.
! Meet moisture load if required to do so.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataAirLoop, ONLY: LoopDXCoilRTF
USE Psychrometrics , ONLY: PsyHFnTdbW, PsyTdpFnWPb
USE General, ONLY: SolveRegulaFalsi, RoundSigDigits
USE DXCoils, ONLY: SimDXCoil, SimDXCoilMultiSpeed, DXCoilOutletTemp, SimDXCoilMultiMode, DXCoilOutletHumRat
USE HVACHXAssistedCoolingCoil, ONLY: SimHXAssistedCoolingCoil, HXAssistedCoilOutletTemp, HXAssistedCoilOutletHumRat
USE WaterCoils, ONLY: SimulateWaterCoilComponents
USE PlantUtilities, ONLY: SetComponentFlowRate
USE WatertoAirHeatPumpSimple, ONLY: SimWatertoAirHPSimple
USE WatertoAirHeatPump, ONLY: SimWaterToAirHP
USE VariableSpeedCoils, ONLY: SimVariableSpeedCoils, VarSpeedCoil
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
LOGICAL, Intent(InOut) :: HXUnitOn ! flag to enable heat exchanger heat recovery
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: MaxIte = 500 ! Maximum number of iterations for solver
REAL(r64), PARAMETER :: Acc = 1.d-3 ! Accuracy of solver result
REAL(r64), PARAMETER :: HumRatAcc = 1.d-6 ! Accuracy of solver result
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength) :: CompName ! Name of the DX cooling 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 setpoint 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 setpoint is placed to control the DX cooling coil
REAL(r64) :: PartLoadFrac ! The part-load fraction of the compressor
REAL(r64) :: SpeedRatio ! SpeedRatio = (CompressorSpeed - CompressorSpeedMin) /
! (CompressorSpeedMax - CompressorSpeedMin)
! for variable speed or 2 speed compressors
REAL(r64) :: CycRatio ! Cycling part-load ratio for variable speed or 2 speed compressors
REAL(r64) :: DesOutTemp ! Desired outlet temperature of the DX cooling coil
REAL(r64) :: DesOutHumRat ! Desired outlet humidity ratio of the DX cooling coil
REAL(r64) :: OutletTempDXCoil ! Actual outlet temperature of the DX cooling coil
REAL(r64) :: OutletHumRatLS ! Actual outlet humrat of the variable speed DX cooling coil at low speed
REAL(r64) :: OutletHumRatHS ! Actual outlet humrat of the variable speed DX cooling coil at high speed
REAL(r64) :: OutletHumRatDXCoil ! Actual outlet humidity ratio of the DX cooling coil
INTEGER :: SolFla ! Flag of solver, num iterations if >0, else error index
INTEGER :: SolFlaLat ! Flag of solver for dehumid calculations
REAL(r64), DIMENSION(8) :: Par ! Parameter array passed to solver
LOGICAL :: SensibleLoad ! True if there is a sensible cooling load on this system
LOGICAL :: LatentLoad ! True if there is a latent cooling load on this system
INTEGER :: DehumidMode ! dehumidification mode (0=normal, 1=enhanced)
INTEGER :: FanOpMode ! Supply air fan operating mode
REAL(r64) :: TempMinPLR ! Used to find latent PLR when max iterations exceeded
REAL(r64) :: TempMaxPLR ! Used to find latent PLR when max iterations exceeded
REAL(r64) :: TempOutletTempDXCoil ! Used to find latent PLR when max iterations exceeded
REAL(r64) :: TempOutletHumRatDXCoil ! Used to find latent PLR when max iterations exceeded
REAL(r64) :: NoLoadHumRatOut ! DX coil outlet air humidity ratio with comprssor off
REAL(r64) :: FullLoadHumRatOut ! DX coil outlet air humidity ratio with comprssor full on
REAL(r64) :: WSHPRuntimeFrac ! Run time fraction of water to air hp
REAL(r64) :: dummy ! dummy variable for heating latent demand
REAL(R64) :: OnOffAirFlowRatio
REAL(R64) :: OutletTemp
INTEGER :: SpeedNum
REAL(R64) :: LoopDXCoilMaxRTFSave ! Used to find RTF of DX heating coils without overwriting globabl variable
REAL(r64) :: NoLoadTempOut ! saves coil off outlet temp
! Set local variables
! Retrieve the load on the controlled zone
OutletNode = UnitarySystem(UnitarySysNum)%CoolCoilOutletNodeNum
InletNode = UnitarySystem(UnitarySysNum)%CoolCoilInletNodeNum
ControlNode = UnitarySystem(UnitarySysNum)%SystemCoolControlNodeNum
DesOutTemp = UnitarySystem(UnitarySysNum)%DesiredOutletTemp
DesOutHumRat = UnitarySystem(UnitarySysNum)%DesiredOutletHumRat
LoopDXCoilMaxRTFSave=LoopDXCoilRTF
LoopDXCoilRTF=0.0d0
CompName = UnitarySystem(UnitarySysNum)%CoolingCoilName
FanOpMode = UnitarySystem(UnitarySysNum)%FanOpMode
SpeedRatio = 0.0d0
CycRatio = 0.0d0
PartLoadFrac = 0.0d0
DehumidMode = 0
SensibleLoad = .FALSE.
LatentLoad = .FALSE.
WSHPRuntimeFrac = 0.0d0
Dummy = 0.0d0
SolFla = 0.0d0
SolFlaLat = 0.0d0
NoLoadTempOut = 0.0d0
NoLoadHumRatOut = 0.0d0
! Check the dehumidification control type. IF it's multimode, turn off the HX to find the sensible PLR. Then check to
! see if the humidity load is met without the use of the HX. Always run the HX for the other modes.
IF (UnitarySystem(UnitarySysNum)%DehumidControlType_Num .NE. DehumidControl_Multimode)THEN
HXUnitOn = .TRUE.
ELSE
HXUnitOn = .FALSE.
END IF
! IF DXCoolingSystem is scheduled on and there is flow
IF((GetCurrentScheduleValue(UnitarySystem(UnitarySysNum)%SysAvailSchedPtr) .gt. 0.0d0) .and. &
GetCurrentScheduleValue(UnitarySystem(UnitarySysNum)%CoolingCoilAvailSchPtr) > 0.0d0 .AND. &
(Node(InletNode)%MassFlowRate .gt. MinAirMassFlow) .AND. UnitarySystem(UnitarySysNum)%HeatingPartLoadFrac == 0.0d0) THEN
! Determine if there is a sensible load on this system (aren't the first 2 tests redundant?)
IF((Node(InletNode)%Temp > DesOutTemp) .and. &
(ABS(Node(InletNode)%Temp - DesOutTemp) .gt. TempControlTol) ) SensibleLoad = .TRUE.
! Determine if there is a latent load on this system - for future use to serve latent-only loads
IF(Node(InletNode)%HumRat > DesOutHumRat) LatentLoad = .TRUE.
! disable latent dehumidification if there is no sensible load and latent only is not allowed
IF(UnitarySystem(UnitarySysNum)%RunOnLatentOnlyWithSensible .AND. .NOT. SensibleLoad)LatentLoad = .FALSE.
! IF DXCoolingSystem runs with a cooling load then set PartLoadFrac on Cooling System and the Mass Flow
! Multimode coil will switch to enhanced dehumidification IF available and needed, but it
! still runs to meet the sensible load. Multimode applies to Multimode or HXAssistedCooling coils.
IF ((SensibleLoad .and. UnitarySystem(UnitarySysNum)%RunOnSensibleLoad) .OR. &
(LatentLoad .and. UnitarySystem(UnitarySysNum)%RunOnLatentLoad)) THEN
! calculate sensible PLR, don't care IF latent is true here but need to gaurd for
! when LatentLoad=TRUE and SensibleLoad=FALSE
ReqOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(DesOutTemp,Node(OutletNode)%HumRat) - &
PsyHFnTdbW(Node(InletNode)%Temp,Node(OutletNode)%HumRat))
PartLoadFrac = 0.0d0
SELECT CASE(UnitarySystem(UnitarySysNum)%CoolingCoilType_Num)
CASE (CoilDX_CoolingSingleSpeed) ! COIL:DX:COOLINGBYPASSFACTOREMPIRICAL
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CALL SimDXCoil(CompName,On,FirstHVACIteration,PartLoadFrac,UnitarySystem(UnitarySysNum)%CoolingCoilIndex,FanOpMode)
CASE (CoilDX_CoolingHXAssisted, CoilWater_CoolingHXAssisted) ! CoilSystem:Cooling:DX:HeatExchangerAssisted
IF(UnitarySystem(UnitarySysNum)%CoolCoilFluidInletNode .GT. 0) &
Node(UnitarySystem(UnitarySysNum)%CoolCoilFluidInletNode)%MassFlowRate = 0.0d0
CALL SimHXAssistedCoolingCoil(CompName,FirstHVACIteration,On,PartLoadFrac, &
UnitarySystem(UnitarySysNum)%CoolingCoilIndex, FanOpMode, &
HXUnitEnable=HXUnitOn,EconomizerFlag=EconomizerFlag)
IF(UnitarySystem(UnitarySysNum)%CoolingCoilType_Num==CoilDX_CoolingHXAssisted) &
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (CoilDX_CoolingTwoSpeed)
CALL SimDXCoilMultiSpeed(CompName,0.0d0,PartLoadFrac,UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
CASE (CoilDX_MultiSpeedCooling, Coil_CoolingAirToAirVariableSpeed, Coil_CoolingWaterToAirHPVSEquationFit)
CALL SimMultiSpeedCoils(UnitarySysNum, FirstHVACIteration, SensibleLoad, LatentLoad, PartLoadFrac, &
CoolingCoil)
CASE (CoilDX_CoolingTwoStageWHumControl) ! Coil:Cooling:DX:TwoStageWithHumidityControlMode
CALL SimDXCoilMultiMode(CompName,On,FirstHVACIteration,PartLoadFrac,DehumidMode, &
UnitarySystem(UnitarySysNum)%CoolingCoilIndex,FanOpMode)
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (Coil_CoolingWater, Coil_CoolingWaterDetailed) ! COIL:COOLING:WATER
CALL SimWaterCoils(UnitarySysNum, FirstHVACIteration, PartLoadFrac, CoolingCoil)
CASE(Coil_CoolingWaterToAirHPSimple)
CALL SimWatertoAirHPSimple(Blank, UnitarySystem(UnitarySysNum)%CoolingCoilIndex, ReqOutput, Dummy, &
FanOpMode,WSHPRuntimeFrac, UnitarySystem(UnitarySysNum)%MaxONOFFCyclesperHour, &
UnitarySystem(UnitarySysNum)%HPTimeConstant, UnitarySystem(UnitarySysNum)%FanDelayTime, &
0, PartLoadFrac, FirstHVACIteration)
CASE(Coil_CoolingWaterToAirHP)
CALL SimWatertoAirHP(Blank, UnitarySystem(UnitarySysNum)%CoolingCoilIndex, &
UnitarySystem(UnitarySysNum)%MaxCoolAirMassFlow,FanOpMode, &
FirstHVACIteration,WSHPRuntimeFrac,UnitarySystem(UnitarySysNum)%MaxONOFFCyclesperHour, &
UnitarySystem(UnitarySysNum)%HPTimeConstant, UnitarySystem(UnitarySysNum)%FanDelayTime, &
UnitarySystem(UnitarySysNum)%InitHeatPump, ReqOutput,Dummy,0, PartLoadFrac)
CASE DEFAULT
END SELECT
! NoOutput = Node(InletNode)%MassFlowRate * &
! (PsyHFnTdbW(Node(OutletNode)%Temp,Node(OutletNode)%HumRat) &
! - PsyHFnTdbW(Node(InletNode)%Temp,Node(OutletNode)%HumRat))
NoLoadTempOut = Node(OutletNode)%Temp
NoLoadHumRatOut = Node(OutletNode)%HumRat
! Changed logic to use temperature instead of load. The Psyc calcs can cause slight errors.
! For example it's possible that (NoOutput-ReqOutput) > Acc while (Node(OutletNode)%Temp-DesOutTemp) is not
! This can (and did) lead to RegulaFalsi errors
! IF ((NoOutput-ReqOutput) .LT. Acc) THEN
! IF outlet temp at no load is lower than DesOutTemp (set point), do not operate the coil
IF ((NoLoadTempOut-DesOutTemp) .LT. Acc) THEN
PartLoadFrac = 0.0d0
ELSE IF(SensibleLoad)THEN ! need to turn on compressor to see if load is met
PartLoadFrac = 1.0d0
WSHPRuntimeFrac = 1.0d0
SELECT CASE(UnitarySystem(UnitarySysNum)%CoolingCoilType_Num)
CASE (CoilDX_CoolingSingleSpeed) ! COIL:DX:COOLINGBYPASSFACTOREMPIRICAL
CALL SimDXCoil(CompName,On,FirstHVACIteration,PartLoadFrac,UnitarySystem(UnitarySysNum)%CoolingCoilIndex,FanOpMode)
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (CoilDX_CoolingHXAssisted,CoilWater_CoolingHXAssisted) ! CoilSystem:Cooling:DX:HeatExchangerAssisted
IF(UnitarySystem(UnitarySysNum)%CoolCoilFluidInletNode .GT. 0) &
Node(UnitarySystem(UnitarySysNum)%CoolCoilFluidInletNode)%MassFlowRate = &
MAX(0.0d0,UnitarySystem(UnitarySysNum)%MaxCoolCoilFluidFlow)
CALL SimHXAssistedCoolingCoil(CompName,FirstHVACIteration,On,PartLoadFrac, &
UnitarySystem(UnitarySysNum)%CoolingCoilIndex, FanOpMode, &
HXUnitEnable=HXUnitOn,EconomizerFlag=EconomizerFlag)
IF(UnitarySystem(UnitarySysNum)%CoolingCoilType_Num==CoilDX_CoolingHXAssisted) &
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (CoilDX_CoolingTwoSpeed)
CycRatio = 1.0d0
DO SpeedNum = 1, UnitarySystem(UnitarySysNum)%NumOfSpeedCooling
SpeedRatio = REAL(SpeedNum,r64) - 1.0d0
CALL SimDXCoilMultiSpeed(CompName,SpeedRatio,CycRatio,UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
OutletTemp = DXCoilOutletTemp(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
IF (OutletTemp < DesOutTemp .AND. SensibleLoad) EXIT ! this isn't going to work IF dehumidIFying
END DO
CASE (CoilDX_MultiSpeedCooling, Coil_CoolingAirToAirVariableSpeed, Coil_CoolingWaterToAirHPVSEquationFit)
CycRatio = 1.0d0
DO SpeedNum = 1, UnitarySystem(UnitarySysNum)%NumOfSpeedCooling
CALL SimMultiSpeedCoils(UnitarySysNum, FirstHVACIteration, SensibleLoad, LatentLoad, PartLoadFrac, &
CoolingCoil, SpeedNum)
OutletTemp = Node(OutletNode)%Temp
SpeedRatio = REAL(SpeedNum,r64) - 1.0d0
IF (OutletTemp < DesOutTemp .AND. SensibleLoad) EXIT
END DO
CASE (CoilDX_CoolingTwoStageWHumControl) ! Coil:Cooling:DX:TwoStageWithHumidityControlMode
CALL SimDXCoilMultiMode(CompName,On,FirstHVACIteration,PartLoadFrac,DehumidMode, &
UnitarySystem(UnitarySysNum)%CoolingCoilIndex,FanOpMode)
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (Coil_CoolingWater, Coil_CoolingWaterDetailed) ! COIL:COOLING:WATER
CALL SimWaterCoils(UnitarySysNum, FirstHVACIteration, PartLoadFrac, CoolingCoil)
CASE(Coil_CoolingWaterToAirHPSimple)
CALL SimWatertoAirHPSimple(Blank, UnitarySystem(UnitarySysNum)%CoolingCoilIndex, ReqOutput, Dummy, &
FanOpMode,WSHPRuntimeFrac, UnitarySystem(UnitarySysNum)%MaxONOFFCyclesperHour, &
UnitarySystem(UnitarySysNum)%HPTimeConstant, UnitarySystem(UnitarySysNum)%FanDelayTime, &
0, PartLoadFrac, FirstHVACIteration)
CASE(Coil_CoolingWaterToAirHP)
CALL SimWatertoAirHP(Blank, UnitarySystem(UnitarySysNum)%CoolingCoilIndex, &
UnitarySystem(UnitarySysNum)%MaxCoolAirMassFlow,FanOpMode, &
FirstHVACIteration,WSHPRuntimeFrac,UnitarySystem(UnitarySysNum)%MaxONOFFCyclesperHour, &
UnitarySystem(UnitarySysNum)%HPTimeConstant, UnitarySystem(UnitarySysNum)%FanDelayTime, &
UnitarySystem(UnitarySysNum)%InitHeatPump, ReqOutput,Dummy,0, PartLoadFrac)
CASE DEFAULT
END SELECT
FullOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(Node(OutletNode)%Temp,Node(OutletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(OutletNode)%HumRat))
FullLoadHumRatOut = Node(OutletNode)%HumRat
! IF ((FullOutput - ReqOutput) .GT. Acc) THEN ! old method
! IF ((Node(OutletNode)%Temp-DesOutTemp) .GT. Acc) THEN ! new method gets caught when temps are very close
IF (Node(OutletNode)%Temp .GT. DesOutTemp-Acc) THEN
PartLoadFrac = 1.0d0
ELSE
SELECT CASE(UnitarySystem(UnitarySysNum)%CoolingCoilType_Num)
CASE (CoilDX_CoolingSingleSpeed) ! COIL:DX:COOLINGBYPASSFACTOREMPIRICAL
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutTemp
Par(5) = REAL(FanOpMode,r64)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, DOE2DXCoilResidual, 0.0d0, &
1.0d0, Par)
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (CoilDX_CoolingHXAssisted,CoilWater_CoolingHXAssisted) ! CoilSystem:Cooling:DX:HeatExchangerAssisted
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutTemp
! FirstHVACIteration is a logical, Par is REAL(r64), so make TRUE = 1 and FALSE = 0
IF(FirstHVACIteration)THEN
Par(3) = 1.0d0
ELSE
Par(3) = 0.0d0
END IF
IF(HXUnitOn)THEN
Par(4) = 1.0d0
ELSE
Par(4) = 0.0d0
END IF
Par(5) = REAL(FanOpMode,r64)
Par(6) = REAL(UnitarySysNum,r64)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, HXAssistedCoolCoilTempResidual, 0.0d0, &
1.0d0, Par)
IF (SolFla == -1) THEN
! RegulaFalsi may not find sensible PLR when the latent degradation model is used.
! IF iteration limit is exceeded, find tighter boundary of solution and repeat RegulaFalsi
TempMaxPLR = -0.1d0
TempOutletTempDXCoil = Node(InletNode)%Temp
DO WHILE((TempOutletTempDXCoil-DesOutTemp) .GT. 0.0d0 .AND. TempMaxPLR .LE. 1.0d0)
! find upper limit of PLR
TempMaxPLR = TempMaxPLR + 0.1d0
CALL SimHXAssistedCoolingCoil(CompName,FirstHVACIteration,On,TempMaxPLR, &
UnitarySystem(UnitarySysNum)%CoolingCoilIndex, FanOpMOde, &
HXUnitEnable=HXUnitOn, EconomizerFlag=EconomizerFlag)
TempOutletTempDXCoil = HXAssistedCoilOutletTemp(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
END DO
TempMinPLR = TempMaxPLR
DO WHILE((TempOutletTempDXCoil-DesOutTemp) .LT. 0.0d0 .AND. TempMinPLR .GE. 0.0d0)
! pull upper limit of PLR DOwn to last valid limit (i.e. outlet temp still exceeds DesOutTemp)
TempMaxPLR = TempMinPLR
! find minimum limit of PLR
TempMinPLR = TempMinPLR - 0.01d0
CALL SimHXAssistedCoolingCoil(CompName,FirstHVACIteration,On,TempMinPLR, &
UnitarySystem(UnitarySysNum)%CoolingCoilIndex, FanOpMode, &
HXUnitEnable=HXUnitOn, EconomizerFlag=EconomizerFlag)
TempOutletTempDXCoil = HXAssistedCoilOutletTemp(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
END DO
! Relax boundary slightly to assure a solution can be found using RegulaFalsi (i.e. one boundary may be
! very near the desired result)
TempMinPLR = MAX(0.0d0,(TempMinPLR - 0.01d0))
TempMaxPLR = MIN(1.0d0,(TempMaxPLR + 0.01d0))
! tighter boundary of solution has been found, CALL RegulaFalsi a second time
CALL SolveRegulaFalsi(Acc,MaxIte,SolFla,PartLoadFrac,HXAssistedCoolCoilTempResidual,TempMinPLR,TempMaxPLR,Par)
IF (SolFla == -1) THEN
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%HXAssistedSensPLRIter .LT. 1)THEN
UnitarySystem(UnitarySysNum)%HXAssistedSensPLRIter = UnitarySystem(UnitarySysNum)%HXAssistedSensPLRIter+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' - Iteration limit'// &
' exceeded calculating DX unit 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: ')
END IF
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)%HXAssistedSensPLRIterIndex,PartLoadFrac,PartLoadFrac)
END IF
ELSEIF (SolFla == -2) THEN
PartLoadFrac = ReqOutput/FullOutput
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%HXAssistedSensPLRFail .LT. 1)THEN
UnitarySystem(UnitarySysNum)%HXAssistedSensPLRFail = UnitarySystem(UnitarySysNum)%HXAssistedSensPLRFail+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)// &
' - DX unit sensible part-load ratio calculation unexpectedly 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: ')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
//TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - DX unit sensible part-load ratio calculation'// &
' unexpectedly failed error continues. Sensible PLR statistics follow.' &
,UnitarySystem(UnitarySysNum)%HXAssistedSensPLRFailIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
ELSEIF (SolFla == -2) THEN
PartLoadFrac = ReqOutput/FullOutput
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%HXAssistedSensPLRFail2 .LT. 1)THEN
UnitarySystem(UnitarySysNum)%HXAssistedSensPLRFail2 = UnitarySystem(UnitarySysNum)%HXAssistedSensPLRFail2+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)// &
' - DX unit 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: ')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
//TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - DX unit sensible part-load ratio calculation'// &
' failed error continues. Sensible PLR statistics follow.' &
,UnitarySystem(UnitarySysNum)%HXAssistedSensPLRFailIndex2,PartLoadFrac,PartLoadFrac)
END IF
END IF
IF(UnitarySystem(UnitarySysNum)%CoolingCoilType_Num==CoilDX_CoolingHXAssisted) &
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (CoilDX_CoolingTwoSpeed)
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutTemp
! Par(3) is only needed for variable speed coils (see DXCoilVarSpeedResidual and DXCoilCyclingResidual)
Par(3) = UnitarySysNum
IF(SpeedRatio == 1.0d0)THEN
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, SpeedRatio, DXCoilVarSpeedResidual, 0.0d0, &
1.0d0, Par)
PartLoadFrac = SpeedRatio
ELSE
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, CycRatio, DXCoilCyclingResidual, 0.0d0, &
1.0d0, Par)
PartLoadFrac = CycRatio
END IF
CASE (CoilDX_MultiSpeedCooling, Coil_CoolingAirToAirVariableSpeed, Coil_CoolingWaterToAirHPVSEquationFit)
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutTemp
Par(3) = UnitarySysNum
! Par(4) = CycRatio or SpeedRatio
Par(5) = UnitarySystem(UnitarySysNum)%CoolingSpeedNum
Par(6) = 1.0d0 ! UnitarySystem(UnitarySysNum)%FanOpMode
Par(7) = 1.0d0 ! CompOp
Par(8) = ReqOutput
IF (SpeedRatio == 1.0d0) THEN
Par(4) = CycRatio
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, SpeedRatio, DXCoilVarSpeedResidual, 0.0d0, &
1.0d0, Par)
UnitarySystem(UnitarySysNum)%CoolingCycRatio = SpeedRatio
UnitarySystem(UnitarySysNum)%CoolingPartLoadFrac = SpeedRatio
CALL CalcPassiveSystem(UnitarySysNum, FirstHVACIteration)
PartLoadFrac = SpeedRatio
ELSE
SpeedRatio = 0.0d0
UnitarySystem(UnitarySysNum)%CoolingSpeedRatio = SpeedRatio
Par(4) = SpeedRatio
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, CycRatio, DXCoilCyclingResidual, 0.0d0, &
1.0d0, Par)
UnitarySystem(UnitarySysNum)%CoolingCycRatio = CycRatio
UnitarySystem(UnitarySysNum)%CoolingPartLoadFrac = CycRatio
CALL CalcPassiveSystem(UnitarySysNum, FirstHVACIteration)
PartLoadFrac = CycRatio
END IF
CASE (CoilDX_CoolingTwoStageWHumControl) ! Coil:Cooling:DX:TwoStageWithHumidityControlMode
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutTemp
! dehumidification mode = 0 for normal mode, 1+ for enhanced mode
Par(3) = REAL(DehumidMode,r64)
Par(4) = REAL(FanOpMode,r64)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, MultiModeDXCoilResidual, 0.0d0, &
1.0d0, Par)
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (Coil_CoolingWater, Coil_CoolingWaterDetailed) ! COIL:COOLING:WATER
Par(1) = REAL(UnitarySysNum,r64)
IF (FirstHVACIteration) THEN
Par(2) = 1.0d0
ELSE
Par(2) = 0.0d0
END IF
Par(3) = DesOutTemp
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, CoolWaterTempResidual, 0.0d0, &
1.0d0, Par)
CASE(Coil_CoolingWaterToAirHPSimple, Coil_CoolingWaterToAirHP)
Par(1) = REAL(UnitarySysNum,r64)
IF (FirstHVACIteration) THEN
Par(2) = 1.0d0
ELSE
Par(2) = 0.0d0
END IF
Par(3) = DesOutTemp
Par(4) = ReqOutput
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, CoolWatertoAirHPTempResidual, 0.0d0, &
1.0d0, Par)
CASE DEFAULT
CALL ShowMessage(' For :'//TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//'="'// &
TRIM(UnitarySystem(UnitarySysNum)%Name)//'"')
CALL ShowFatalError('ControlCoolingSystem: Invalid cooling coil type = '// &
TRIM(CALLCoilTypes(UnitarySystem(UnitarySysNum)%CoolingCoilType_Num)))
END SELECT
END IF
END IF
! IF system does not operate to meet sensible load, use no load humidity ratio to test against humidity setpoint,
! ELSE use operating humidity ratio to test against humidity setpoint
IF (PartLoadFrac .EQ. 0.0d0)THEN
OutletHumRatDXCoil = NoLoadHumRatOut
ELSE
OutletHumRatDXCoil = Node(OutletNode)%HumRat
END IF
! IF humidity setpoint is not satisfied and humidity control type is MultiMode,
! then enable heat exchanger and run to meet sensible load
IF (( OutletHumRatDXCoil > (DesOutHumRat + HumRatAcc)) .AND. (PartLoadFrac .LT. 1.0d0) .AND. &
(UnitarySystem(UnitarySysNum)%DehumidControlType_Num .EQ. DehumidControl_Multimode)) THEN
SELECT CASE(UnitarySystem(UnitarySysNum)%CoolingCoilType_Num)
CASE (CoilDX_CoolingHXAssisted) ! CoilSystem:Cooling:DX:HeatExchangerAssisted
! Determine required part load when heat exchanger is ON
HXUnitOn = .TRUE.
PartLoadFrac = 1.0d0
CALL SimHXAssistedCoolingCoil(CompName,FirstHVACIteration,On,PartLoadFrac, &
UnitarySystem(UnitarySysNum)%CoolingCoilIndex, FanOpMode, &
HXUnitEnable=HXUnitOn, EconomizerFlag=EconomizerFlag)
OutletTempDXCoil = HXAssistedCoilOutletTemp(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
! FullOutput will be different than the FullOutput determined above during sensible PLR calculations
FullOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(Node(OutletNode)%Temp,Node(OutletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(OutletNode)%HumRat))
! Check to see if the system can meet the load with the compressor off
! If NoOutput is lower than (more cooling than required) or very near the ReqOutput, do not run the compressor
IF ((NoLoadTempOut-DesOutTemp) .LT. Acc) THEN
PartLoadFrac = 0.0d0
! OutletTempDXCoil is the full capacity outlet temperature at PartLoadFrac = 1 from the CALL above.
! if this temp is greater than or very near the desired outlet temp, then run the compressor at PartLoadFrac = 1.
! ELSEIF ((OutletTempDXCoil > DesOutTemp) .OR. ABS(OutletTempDXCoil - DesOutTemp) .LE. (Acc*2.0d0)) THEN
ELSEIF (OutletTempDXCoil > DesOutTemp - (Acc*2.0d0)) THEN
PartLoadFrac = 1.0d0
ELSE
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutTemp
! FirstHVACIteration is a logical, Par is REAL(r64), so make TRUE = 1.0 and FALSE = 0.0
IF(FirstHVACIteration)THEN
Par(3) = 1.0d0
ELSE
Par(3) = 0.0d0
END IF
IF(HXUnitOn)THEN
Par(4) = 1.0d0
ELSE
Par(4) = 0.0d0
END IF
Par(5) = REAL(FanOpMode,r64)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, HXAssistedCoolCoilTempResidual, 0.0d0, &
1.0d0, Par)
END IF
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (CoilDX_CoolingTwoStageWHumControl) ! Coil:Cooling:DX:TwoStageWithHumidityControlMode
! formerly (v3 and beyond) COIL:DX:MULTIMODE:COOLINGEMPIRICAL)
! Get full load result
PartLoadFrac = 1.0d0
DehumidMode = 1
UnitarySystem(UnitarySysNum)%dehumidificationMode = DehumidMode
CALL SimDXCoilMultiMode(CompName,On,FirstHVACIteration,PartLoadFrac,DehumidMode, &
UnitarySystem(UnitarySysNum)%CoolingCoilIndex,FanOpMode)
FullOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
! Since we are cooling, we expect FullOutput to be < 0 and FullOutput < NoCoolOutput
! Check that this is the case; IF not set PartLoadFrac = 0.0 (off) and return
! Calculate the part load fraction
IF (FullOutput .GE. 0) THEN
PartLoadFrac = 0.0d0
ELSE
OutletTempDXCoil = DXCoilOutletTemp(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
OutletHumRatDXCoil = DXCoilOutletHumRat(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
! If sensible load and setpoint cannot be met, set PLR = 1. if no sensible load and
! latent load exists and setpoint cannot be met, set PLR = 1.
! why is our logic different? Did we figure something out that reduced the logic?
! IF ((SensibleLoad .and. LatentLoad .AND. .NOT. UnitarySystem(UnitarySysNum)%RunOnLatentLoad .AND. &
! OutletHumRatDXCoil >= DesOutHumRat)) THEN
IF ((OutletTempDXCoil > (DesOutTemp-(Acc*2.0d0)) .AND. SensibleLoad .and. &
UnitarySystem(UnitarySysNum)%RunOnSensibleLoad) .OR. &
(OutletHumRatDXCoil > (DesOutHumRat-(HumRatAcc*2.0d0)) .AND. &
.NOT. SensibleLoad .AND. LatentLoad .AND. UnitarySystem(UnitarySysNum)%RunOnLatentLoad)) THEN
PartLoadFrac = 1.0d0
! ELSEIF ((SensibleLoad .and. LatentLoad .AND. .NOT. UnitarySystem(UnitarySysNum)%RunOnLatentLoad .AND. &
! OutletHumRatDXCoil < DesOutHumRat)) THEN
ELSE IF (.NOT. SensibleLoad .AND. &
(OutletHumRatDXCoil < DesOutHumRat .AND. LatentLoad .AND. UnitarySystem(UnitarySysNum)%RunOnLatentLoad)) THEN
PartLoadFrac = ReqOutput/FullOutput
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutHumRat
! dehumidification mode = 0 for normal mode, 1+ for enhanced mode
Par(3) = REAL(DehumidMode,r64)
Par(4) = REAL(FanOpMode,r64)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, MultiModeDXCoilHumRatResidual, &
0.0d0, 1.0d0, Par)
ELSE ! must be a sensible load so find PLR
PartLoadFrac = ReqOutput/FullOutput
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutTemp
! Dehumidification mode = 0 for normal mode, 1+ for enhanced mode
Par(3) = REAL(DehumidMode,r64)
Par(4) = REAL(FanOpMode,r64)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, MultiModeDXCoilResidual, &
0.0d0, 1.0d0, Par)
END IF
END IF
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE DEFAULT
END SELECT
END IF ! END IF humidity ratio setpoint not met - Multimode humidity control
! IF humidity setpoint is not satisfied and humidity control type is CoolReheat,
! then overcool to meet moisture load
IF (( OutletHumRatDXCoil > DesOutHumRat) .AND. (PartLoadFrac .LT. 1.0d0) .AND. LatentLoad .AND. &
(UnitarySystem(UnitarySysNum)%DehumidControlType_Num .EQ. DehumidControl_CoolReheat)) THEN
! IF NoLoadHumRatOut is lower than (more dehumidification than required) or very near the DesOutHumRat,
! do not run the compressor
IF ((NoLoadHumRatOut-DesOutHumRat) .LT. HumRatAcc) THEN
PartLoadFrac = PartLoadFrac ! keep part-load fraction from sensible calculation
! If the FullLoadHumRatOut is greater than (insufficient dehumidification) or very near the DesOutHumRat,
! run the compressor at PartLoadFrac = 1.
! ELSEIF ((DesOutHumRat-FullLoadHumRatOut) .LT. HumRatAcc) THEN
ELSEIF (FullLoadHumRatOut .GT. (DesOutHumRat-HumRatAcc)) THEN
PartLoadFrac = 1.0d0
! ELSE find the PLR to meet the load
ELSE
SELECT CASE(UnitarySystem(UnitarySysNum)%CoolingCoilType_Num)
CASE (CoilDX_CoolingSingleSpeed) ! COIL:DX:COOLINGBYPASSFACTOREMPIRICAL
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutHumRat
Par(5) = REAL(FanOpMode,r64)
CALL SolveRegulaFalsi(HumRatAcc, MaxIte, SolFlaLat, PartLoadFrac, DOE2DXCoilHumRatResidual, 0.0d0, &
1.0d0, Par)
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (CoilDX_CoolingHXAssisted) ! CoilSystem:Cooling:DX:HeatExchangerAssisted
! IF NoLoadHumRatOut is lower than (more dehumidification than required) or very near the DesOutHumRat,
! do not run the compressor
IF ((NoLoadHumRatOut-DesOutHumRat) .LT. HumRatAcc*2.0d0) THEN
PartLoadFrac = PartLoadFrac ! keep part-load fraction from sensible calculation
! If the FullLoadHumRatOut is greater than (insufficient dehumidification) or very near the DesOutHumRat,
! run the compressor at PartLoadFrac = 1.
ELSEIF ((DesOutHumRat-FullLoadHumRatOut) .LT. HumRatAcc*2.0d0) THEN
PartLoadFrac = 1.0d0
! ELSE find the PLR to meet the load
ELSE
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutHumRat
! FirstHVACIteration is a logical, Par is REAL(r64), so make TRUE = 1 and FALSE = 0
IF(FirstHVACIteration)THEN
Par(3) = 1.0d0
ELSE
Par(3) = 0.0d0
END IF
IF(HXUnitOn)THEN
Par(4) = 1.0d0
ELSE
Par(4) = 0.0d0
END IF
Par(5) = REAL(FanOpMode,r64)
CALL SolveRegulaFalsi(HumRatAcc, MaxIte, SolFla, PartLoadFrac, HXAssistedCoolCoilHRResidual, 0.0d0, &
1.0d0, Par)
IF (SolFla == -1) THEN
! RegulaFalsi may not find latent PLR when the latent degradation model is used.
! IF iteration limit is exceeded, find tighter boundary of solution and repeat RegulaFalsi
TempMaxPLR = -0.1d0
TempOutletHumRatDXCoil = OutletHumRatDXCoil
DO WHILE((OutletHumRatDXCoil - TempOutletHumRatDXCoil) .GE. 0.0d0 .AND. TempMaxPLR .LE. 1.0d0)
! find upper limit of LatentPLR
TempMaxPLR = TempMaxPLR + 0.1d0
CALL SimHXAssistedCoolingCoil(CompName,FirstHVACIteration,On,TempMaxPLR, &
UnitarySystem(UnitarySysNum)%CoolingCoilIndex, FanOpMode, &
HXUnitEnable=HXUnitOn, EconomizerFlag=EconomizerFlag)
OutletHumRatDXCoil = HXAssistedCoilOutletHumRat(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
END DO
TempMinPLR = TempMaxPLR
DO WHILE((OutletHumRatDXCoil - TempOutletHumRatDXCoil) .LE. 0.0d0 .AND. TempMinPLR .GE. 0.0d0)
! pull upper limit of LatentPLR DOwn to last valid limit (i.e. latent output still exceeds SystemMoisuterLoad)
TempMaxPLR = TempMinPLR
! find minimum limit of Latent PLR
TempMinPLR = TempMinPLR - 0.01d0
CALL SimHXAssistedCoolingCoil(CompName,FirstHVACIteration,On,TempMaxPLR, &
UnitarySystem(UnitarySysNum)%CoolingCoilIndex, FanOpMode, &
HXUnitEnable=HXUnitOn, EconomizerFlag=EconomizerFlag)
OutletHumRatDXCoil = HXAssistedCoilOutletHumRat(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
END DO
! tighter boundary of solution has been found, CALL RegulaFalsi a second time
CALL SolveRegulaFalsi(HumRatAcc,MaxIte,SolFla,PartLoadFrac,HXAssistedCoolCoilHRResidual, &
TempMinPLR,TempMaxPLR,Par)
IF (SolFla == -1) THEN
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRIter .LT. 1)THEN
UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRIter = &
UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRIter+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)// &
' - Iteration limit exceeded calculating DX unit latent'// &
' part-load ratio for unit = '//TRIM(UnitarySystem(UnitarySysNum)%Name))
CALL ShowContinueError('Estimated latent part-load ratio = '//RoundSigDigits((ReqOutput/FullOutput),3))
CALL ShowContinueError('Calculated latent part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
CALL ShowContinueErrorTimeStamp('The calculated latent part-load ratio will be used and the'// &
' simulation continues. Occurrence info: ')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
//TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - Iteration limit exceeded calculating'// &
' latent part-load ratio error continues. Latent PLR statistics follow.' &
,UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRIterIndex,PartLoadFrac,PartLoadFrac)
END IF
ELSEIF (SolFla == -2) THEN
PartLoadFrac = ReqOutput/FullOutput
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRFail .LT. 1)THEN
UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRFail = &
UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRFail+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)// &
' - DX unit latent part-load ratio calculation failed unexpectedly:'// &
' 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: ')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
//TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - DX unit latent part-load ratio calculation'// &
' failed unexpectedly error continues. Latent PLR statistics follow.' &
,UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRFailIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
ELSEIF (SolFla == -2) THEN
PartLoadFrac = ReqOutput/FullOutput
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRFail2 .LT. 1)THEN
UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRFail2 = &
UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRFail2+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)// &
' - DX unit latent 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: ')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
//TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - DX unit latent part-load ratio calculation'// &
' failed error continues. Latent PLR statistics follow.' &
,UnitarySystem(UnitarySysNum)%HXAssistedCRLatPLRFailIndex2,PartLoadFrac,PartLoadFrac)
END IF
END IF
END IF
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (CoilDX_CoolingTwoSpeed)
! Simulate MultiSpeed DX coil at sensible result
CALL SimDXCoilMultiSpeed(CompName,SpeedRatio,CycRatio,UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
OutletHumRatDXCoil = DXCoilOutletHumRat(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
! IF humidity setpoint is not satisfied and humidity control type is CoolReheat,
! then overcool to meet moisture load
IF (OutletHumRatDXCoil > DesOutHumRat) THEN
CycRatio = 0.0d0
SpeedRatio = 0.0d0
CALL SimDXCoilMultiSpeed(CompName,0.0d0,1.0d0,UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
OutletHumRatLS = DXCoilOutletHumRat(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
IF (OutletHumRatLS > DesOutHumRat) THEN
CycRatio = 1.0d0
CALL SimDXCoilMultiSpeed(CompName,1.0d0,1.0d0,UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
OutletHumRatHS = DXCoilOutletHumRat(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
IF (OutletHumRatHS < DesOutHumRat) THEN
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutHumRat
CALL SolveRegulaFalsi(HumRatAcc, MaxIte, SolFla, SpeedRatio, DXCoilVarSpeedHumRatResidual, 0.0d0, &
1.0d0, Par)
ELSE
SpeedRatio = 1.0d0
END IF
ELSE
SpeedRatio = 0.0d0
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutHumRat
CALL SolveRegulaFalsi(HumRatAcc, MaxIte, SolFla, CycRatio, DXCoilCyclingHumRatResidual, 0.0d0, &
1.0d0, Par)
END IF
END IF
CASE (CoilDX_MultiSpeedCooling, Coil_CoolingAirToAirVariableSpeed, Coil_CoolingWaterToAirHPVSEquationFit)
IF (UnitarySystem(UnitarySysNum)%CoolingCoilType_Num == CoilDX_MultiSpeedCooling) THEN
CALL SimDXCoilMultiSpeed(CompName,SpeedRatio,CycRatio,UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
ELSE
CALL SimVariableSpeedCoils(CompName,UnitarySystem(UnitarySysNum)%CoolingCoilIndex, &
UnitarySystem(UnitarySysNum)%FanOpMode,UnitarySystem(UnitarySysNum)%MaxONOFFCyclesperHour, &
UnitarySystem(UnitarySysNum)%HPTimeConstant,UnitarySystem(UnitarySysNum)%FanDelayTime, &
1, CycRatio, OnOffAirFlowRatio,SpeedNum, SpeedRatio,ReqOutput,Dummy )
END IF
OutletHumRatDXCoil = DXCoilOutletHumRat(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
! IF humidity setpoint is not satisfied and humidity control type is CoolReheat,
! then overcool to meet moisture load
IF (OutletHumRatDXCoil > DesOutHumRat) THEN
CycRatio = 0.0d0
SpeedRatio = 0.0d0
IF (UnitarySystem(UnitarySysNum)%CoolingCoilType_Num == CoilDX_MultiSpeedCooling) THEN
CALL SimDXCoilMultiSpeed(CompName,0.0d0,1.0d0,UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
ELSE
CALL SimVariableSpeedCoils(CompName,UnitarySystem(UnitarySysNum)%CoolingCoilIndex, &
UnitarySystem(UnitarySysNum)%FanOpMode,UnitarySystem(UnitarySysNum)%MaxONOFFCyclesperHour, &
UnitarySystem(UnitarySysNum)%HPTimeConstant,UnitarySystem(UnitarySysNum)%FanDelayTime, &
1, 1.0d0, OnOffAirFlowRatio,SpeedNum, 1.0d0,ReqOutput,Dummy )
END IF
OutletHumRatLS = DXCoilOutletHumRat(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
IF (OutletHumRatLS > DesOutHumRat) THEN
CycRatio = 1.0d0
IF (UnitarySystem(UnitarySysNum)%CoolingCoilType_Num == CoilDX_MultiSpeedCooling) THEN
CALL SimDXCoilMultiSpeed(CompName,1.0d0,1.0d0,UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
ELSE
CALL SimVariableSpeedCoils(CompName,UnitarySystem(UnitarySysNum)%CoolingCoilIndex, &
UnitarySystem(UnitarySysNum)%FanOpMode,UnitarySystem(UnitarySysNum)%MaxONOFFCyclesperHour, &
UnitarySystem(UnitarySysNum)%HPTimeConstant,UnitarySystem(UnitarySysNum)%FanDelayTime, &
1, 1.0d0, OnOffAirFlowRatio,SpeedNum, 1.0d0,ReqOutput,Dummy )
END IF
OutletHumRatHS = DXCoilOutletHumRat(UnitarySystem(UnitarySysNum)%CoolingCoilIndex)
IF (OutletHumRatHS < DesOutHumRat) THEN
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutHumRat
Par(3) = ReqOutput
CALL SolveRegulaFalsi(HumRatAcc, MaxIte, SolFla, SpeedRatio, DXCoilVarSpeedHumRatResidual, 0.0d0, &
1.0d0, Par)
ELSE
SpeedRatio = 1.0d0
END IF
ELSE
SpeedRatio = 0.0d0
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutHumRat
Par(3) = ReqOutput
CALL SolveRegulaFalsi(HumRatAcc, MaxIte, SolFla, CycRatio, DXCoilCyclingHumRatResidual, 0.0d0, &
1.0d0, Par)
END IF
END IF
CASE (CoilDX_CoolingTwoStageWHumControl) ! Coil:Cooling:DX:TwoStageWithHumidityControlMode
Par(1) = REAL(UnitarySystem(UnitarySysNum)%CoolingCoilIndex,r64)
Par(2) = DesOutHumRat
! dehumidification mode = 0 for normal mode, 1+ for enhanced mode
Par(3) = REAL(DehumidMode,r64)
Par(4) = REAL(FanOpMode,r64)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFlaLat, PartLoadFrac, MultiModeDXCoilHumRatResidual, 0.0d0, &
1.0d0, Par)
UnitarySystem(UnitarySysNum)%CompPartLoadRatio = PartLoadFrac
CASE (Coil_CoolingWater, Coil_CoolingWaterDetailed) ! COIL:COOLING:WATER
Par(1) = REAL(UnitarySysNum,r64)
IF (FirstHVACIteration) THEN
Par(2) = 1.0d0
ELSE
Par(2) = 0.0d0
END IF
Par(3) = DesOutHumRat
CALL SolveRegulaFalsi(HumRatAcc, MaxIte, SolFlaLat, PartLoadFrac, CoolWaterHumRatResidual, 0.0d0, &
1.0d0, Par)
CASE(Coil_CoolingWaterToAirHPSimple, Coil_CoolingWaterToAirHP)
Par(1) = REAL(UnitarySysNum,r64)
IF (FirstHVACIteration) THEN
Par(2) = 1.0d0
ELSE
Par(2) = 0.0d0
END IF
Par(3) = DesOutHumRat
Par(4) = ReqOutput
CALL SolveRegulaFalsi(HumRatAcc, MaxIte, SolFlaLat, PartLoadFrac, CoolWatertoAirHPHumRatResidual, 0.0d0, &
1.0d0, Par)
CASE DEFAULT
END SELECT
END IF
END IF
END IF
END IF
IF (SolFla == -1) THEN
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%SensPLRIter .LT. 1)THEN
UnitarySystem(UnitarySysNum)%SensPLRIter = UnitarySystem(UnitarySysNum)%SensPLRIter+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)// &
' - Iteration limit exceeded calculating '// &
'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)%SensPLRIterIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
ELSEIF (SolFla == -2) THEN
PartLoadFrac = ReqOutput/FullOutput
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%SensPLRFail .LT. 1)THEN
UnitarySystem(UnitarySysNum)%SensPLRFail = UnitarySystem(UnitarySysNum)%SensPLRFail+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)%SensPLRFailIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
END IF
IF (SolFlaLat == -1 .AND. SolFla .NE. -1) THEN
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%LatPLRIter .LT. 1)THEN
UnitarySystem(UnitarySysNum)%LatPLRIter = UnitarySystem(UnitarySysNum)%LatPLRIter+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)// &
' - Iteration limit exceeded calculating latent 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: ')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
//TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - Iteration limit exceeded calculating'// &
' latent part-load ratio error continues. Latent PLR statistics follow.' &
,UnitarySystem(UnitarySysNum)%LatPLRIterIndex,PartLoadFrac,PartLoadFrac)
END IF
ELSEIF (SolFlaLat == -2 .AND. SolFla .NE. -2) THEN
! RegulaFalsi returns PLR = minPLR when a solution cannot be found, recalculate PartLoadFrac.
IF(NoLoadHumRatOut-FullLoadHumRatOut .NE. 0.0d0)THEN
PartLoadFrac = (NoLoadHumRatOut-DesOutHumRat)/(NoLoadHumRatOut-FullLoadHumRatOut)
ELSE
PartLoadFrac = 1.0d0
END IF
IF(.NOT. WarmupFlag)THEN
IF(UnitarySystem(UnitarySysNum)%LatPLRFail .LT. 1)THEN
UnitarySystem(UnitarySysNum)%LatPLRFail = UnitarySystem(UnitarySysNum)%LatPLRFail+1
CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' - latent 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: ')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
//TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - latent part-load ratio calculation'// &
' failed error continues. Latent PLR statistics follow.' &
,UnitarySystem(UnitarySysNum)%LatPLRFailIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
!Set the final results
IF(PartLoadFrac .GT. 1.0d0) THEN
PartLoadFrac = 1.0d0
ELSEIF(PartLoadFrac < 0.0d0) THEN
PartLoadFrac = 0.0d0
END IF
UnitarySystem(UnitarySysNum)%CoolingPartLoadFrac = PartLoadFrac
UnitarySystem(UnitarySysNum)%CoolingSpeedRatio = SpeedRatio
UnitarySystem(UnitarySysNum)%CoolingCycRatio = CycRatio
UnitarySystem(UnitarySysNum)%dehumidificationMode = DehumidMode
LoopDXCoilRTF = MAX(LoopDXCoilRTF, LoopDXCoilMaxRTFSave)
RETURN
END SUBROUTINE ControlCoolingSystem