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.
!LKL Discrepancy with < 0
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | MSHeatPumpNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | CompOp | |||
integer, | intent(in) | :: | OpMode | |||
real(kind=r64), | intent(in) | :: | QZnReq | |||
integer, | intent(in) | :: | ZoneNum | |||
integer, | intent(out) | :: | SpeedNum | |||
real(kind=r64), | intent(out) | :: | SpeedRatio | |||
real(kind=r64), | intent(out) | :: | PartLoadFrac | |||
real(kind=r64), | intent(inout) | :: | OnOffAirFlowRatio | |||
real(kind=r64), | intent(inout) | :: | SupHeaterLoad |
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 ControlMSHPOutput(MSHeatPumpNum,FirstHVACIteration,CompOp,OpMode,QZnReq,ZoneNum,SpeedNum,SpeedRatio,PartLoadFrac, &
OnOffAirFlowRatio,SupHeaterLoad)
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN June 2007
! MODIFIED na
! RE-ENGINEERED Revised for multispeed heat pump use based on ControlPTHPOutput
! PURPOSE OF THIS SUBROUTINE:
! Determine the part load fraction at low speed, and speed ratio at high speed for this time step.
! METHODOLOGY EMPLOYED:
! Use RegulaFalsi technique to iterate on part-load ratio until convergence is achieved.
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: SolveRegulaFalsi, RoundSigDigits, TrimSigDigits
USE DataGlobals, ONLY: WarmUpFlag,CurrentTime
USE HeatingCoils, ONLY: SimulateHeatingCoilComponents
USE Psychrometrics, ONLY: PsyCpAirFnWTdb
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: MSHeatPumpNum ! Unit index of engine driven heat pump
LOGICAL, INTENT (IN) :: FirstHVACIteration ! flag for 1st HVAC iteration in the time step
INTEGER, INTENT (IN) :: CompOp ! compressor operation; 1=on, 0=off
INTEGER, INTENT (IN) :: OpMode ! operating mode: CycFanCycCoil | ContFanCycCoil
INTEGER, INTENT (OUT) :: SpeedNum ! Speed number
REAL(r64) , INTENT (IN) :: QZnReq ! cooling or heating output needed by zone [W]
INTEGER, INTENT (IN) :: ZoneNum ! Index to zone number
REAL(r64) , INTENT (OUT) :: SpeedRatio ! unit speed ratio for DX coils
REAL(r64) , INTENT (OUT) :: PartLoadFrac ! unit part load fraction
REAL(r64) , INTENT (INOUT) :: OnOffAirFlowRatio ! ratio of compressor ON airflow to AVERAGE airflow over timestep
REAL(r64) , INTENT (INOUT) :: SupHeaterLoad ! Supplemental heater load [W]
! SUBROUTINE PARAMETER DEFINITIONS:
!
INTEGER, PARAMETER :: MaxIte = 500 ! maximum number of iterations
REAL(r64), PARAMETER :: MinPLF = 0.0d0 ! minimum part load factor allowed
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: FullOutput ! unit full output when compressor is operating [W]
REAL(r64) :: LowOutput ! unit full output at low speed [W]
REAL(r64) :: TempOutput ! unit output when iteration limit exceeded [W]
REAL(r64) :: NoCompOutput ! output when no active compressor [W]
REAL(r64) :: ErrorToler ! error tolerance
INTEGER :: SolFla ! Flag of RegulaFalsi solver
REAL(r64), DIMENSION(9) :: Par ! Parameters passed to RegulaFalsi
REAL(r64) :: CpAir ! air specific heat
REAL(r64) :: OutsideDryBulbTemp ! Outside air temperature at external node height
REAL(r64) :: QCoilActual ! coil load actually delivered returned to calling component
INTEGER :: i ! Speed index
INTEGER,SAVE :: ErrCountCyc=0 ! Counter used to minimize the occurrence of output warnings
INTEGER,SAVE :: ErrCountVar=0 ! Counter used to minimize the occurrence of output warnings
! FLOW
SupHeaterLoad = 0.0d0
PartLoadFrac = 0.0d0
SpeedRatio = 0.0d0
SpeedNum = 1
OutsideDryBulbTemp = OutDryBulbTemp
!!!LKL Discrepancy with < 0
IF (GetCurrentScheduleValue(MSHeatPump(MSHeatPumpNum)%AvaiSchedPtr) .EQ. 0.0d0) RETURN
! Get result when DX coil is off
CALL CalcMSHeatPump(MSHeatPumpNum,FirstHVACIteration,CompOp,SpeedNum,SpeedRatio,PartLoadFrac,NoCompOutput, &
QZnReq,OnOffAirFlowRatio,SupHeaterLoad)
! If cooling and NoCompOutput < QZnReq, the coil needs to be off
! If heating and NoCompOutput > QZnReq, the coil needs to be off
IF ((QZnReq < (-1.d0*SmallLoad) .AND. NoCompOutput < QZnReq) .OR. (QZnReq > SmallLoad .AND. NoCompOutput > QZnReq) &
.OR. ABS(QZnReq) <= SmallLoad) THEN
RETURN
END IF
! Get full load result
PartLoadFrac = 1.0d0
SpeedRatio = 1.0d0
If (MSHeatPump(MSHeatPumpNum)%HeatCoolMode == HeatingMode) Then
SpeedNum = MSHeatPump(MSHeatPumpNum)%NumOfSpeedHeating
If (MSHeatPump(MSHeatPumpNum)%Staged .AND. ABS(MSHeatPump(MSHeatPumpNum)%StageNum) .LT. SpeedNum) Then
SpeedNum = ABS(MSHeatPump(MSHeatPumpNum)%StageNum)
If (SpeedNum == 1) SpeedRatio = 0.0d0
End If
End If
If (MSHeatPump(MSHeatPumpNum)%HeatCoolMode == CoolingMode) Then
SpeedNum = MSHeatPump(MSHeatPumpNum)%NumOfSpeedCooling
If (MSHeatPump(MSHeatPumpNum)%Staged .AND. ABS(MSHeatPump(MSHeatPumpNum)%StageNum) .LT. SpeedNum) Then
SpeedNum = ABS(MSHeatPump(MSHeatPumpNum)%StageNum)
If (SpeedNum == 1) SpeedRatio = 0.0d0
End If
End If
CALL CalcMSHeatPump(MSHeatPumpNum,FirstHVACIteration,CompOp,SpeedNum,SpeedRatio,PartLoadFrac,FullOutput,QZnReq, &
OnOffAirFlowRatio,SupHeaterLoad)
IF (QZnReq .LT. (-1.d0*SmallLoad)) THEN
! Since we are cooling, we expect FullOutput to be < 0 and FullOutput < NoCompOutput
! Check that this is the case; if not set PartLoadFrac = 0.0 (off) and return
IF (FullOutput >= 0.0d0 .OR. FullOutput >= NoCompOutput) THEN
PartLoadFrac = 0.0d0
SpeedRatio = 0.0d0
SpeedNum = 0
RETURN
END IF
! ! If the QZnReq <= FullOutput the unit needs to run full out
IF (QZnReq <= FullOutput) THEN
PartLoadFrac = 1.0d0
SpeedRatio = 1.0d0
If (MSHeatPump(MSHeatPumpNum)%Staged .AND. SpeedNum == 1) SpeedRatio = 0.0d0
MSHeatPumpReport(MSHeatPumpNum)%CycRatio = PartLoadFrac
MSHeatPumpReport(MSHeatPumpNum)%SpeedRatio = SpeedRatio
MSHeatPumpReport(MSHeatPumpNum)%SpeedNum = SpeedNum
RETURN
END IF
ErrorToler = 0.001d0 !Error tolerance for convergence from input deck
ELSE
! Since we are heating, we expect FullOutput to be > 0 and FullOutput > NoCompOutput
! Check that this is the case; if not set PartLoadFrac = 0.0 (off)
IF (FullOutput <= 0.0d0 .OR. FullOutput <= NoCompOutput) THEN
PartLoadFrac = 0.0d0
SpeedRatio = 0.0d0
! may need supplemental heating so don't return in heating mode
END IF
IF (QZnReq >= FullOutput) THEN
PartLoadFrac = 1.0d0
SpeedRatio = 1.0d0
! may need supplemental heating so don't return in heating mode
END IF
ErrorToler = 0.001d0 !Error tolerance for convergence from input deck
END IF
! Calculate the part load fraction
IF (((QZnReq .GT. SmallLoad .AND. QZnReq < FullOutput) .OR. (QZnReq .LT. (-1.d0*SmallLoad) .AND. QZnReq > FullOutput)) &
.AND. (.NOT. MSHeatPump(MSHeatPumpNum)%Staged)) THEN
Par(1) = MSHeatPumpNum
Par(2) = ZoneNum
IF (FirstHVACIteration) THEN
Par(3) = 1.0d0
ELSE
Par(3) = 0.0d0
END IF
Par(4) = OpMode
Par(5) = QZnReq
Par(6) = OnOffAirFlowRatio
Par(7) = SupHeaterLoad
Par(9) = CompOp
! Check whether the low speed coil can meet the load or not
CALL CalcMSHeatPump(MSHeatPumpNum,FirstHVACIteration,CompOp,1,0.0d0,1.0d0,LowOutput, &
QZnReq,OnOffAirFlowRatio,SupHeaterLoad)
IF ((QZnReq .GT. 0.0d0 .AND. QZnReq <= LowOutput) .OR. (QZnReq .LT. 0.0d0 .AND. QZnReq >= LowOutput)) THEN
SpeedRatio = 0.0d0
SpeedNum = 1
CALL SolveRegulaFalsi(ErrorToler, MaxIte, SolFla, PartLoadFrac, MSHPCyclingResidual, 0.0d0, 1.0d0, Par)
IF (SolFla == -1) THEN
If ( .NOT. WarmupFlag) Then
IF (ErrCountCyc .eq. 0) THEN
ErrCountCyc = ErrCountCyc+1
CALL ShowWarningError('Iteration limit exceeded calculating DX unit cycling ratio, for unit='// &
TRIM(MSHeatPump(MSHeatPumpNum)%Name))
CALL ShowContinueErrorTimeStamp('Cycling ratio returned='//RoundSigDigits(PartLoadFrac,2))
Else
ErrCountCyc = ErrCountCyc+1
CALL ShowRecurringWarningErrorAtEnd(TRIM(MSHeatPump(MSHeatPumpNum)%Name)//'":'//&
' Iteration limit warning exceeding calculating DX unit cycling ratio continues...' &
,MSHeatPump(MSHeatPumpNum)%ErrIndexCyc , PartLoadFrac, PartLoadFrac)
End If
End If
ELSE IF (SolFla == -2) THEN
CALL ShowFatalError('DX unit cycling ratio calculation failed: cycling limits exceeded, for unit='// &
TRIM(MSHeatPump(MSHeatPumpNum)%DXCoolCoilName))
END IF
Else
! Check to see which speed to meet the load
PartLoadFrac = 1.0d0
SpeedRatio = 1.0d0
If (QZnReq .LT. (-1.d0*SmallLoad)) Then ! Cooling
DO I=2,MSHeatPump(MSHeatPumpNum)%NumOfSpeedCooling
CALL CalcMSHeatPump(MSHeatPumpNum,FirstHVACIteration,CompOp,I,SpeedRatio,PartLoadFrac,TempOutput, &
QZnReq,OnOffAirFlowRatio,SupHeaterLoad)
If (QZnReq >= TempOutput) Then
SpeedNum = I
Exit
End If
END DO
ELSE
DO I=2,MSHeatPump(MSHeatPumpNum)%NumOfSpeedHeating
CALL CalcMSHeatPump(MSHeatPumpNum,FirstHVACIteration,CompOp,I,SpeedRatio,PartLoadFrac,TempOutput, &
QZnReq,OnOffAirFlowRatio,SupHeaterLoad)
If (QZnReq <= TempOutput) Then
SpeedNum = I
Exit
End If
END DO
END IF
Par(8) = SpeedNum
CALL SolveRegulaFalsi(ErrorToler, MaxIte, SolFla, SpeedRatio, MSHPVarSpeedResidual, 0.0d0, 1.0d0, Par)
IF (SolFla == -1) THEN
If ( .NOT. WarmupFlag) Then
IF (ErrCountVar .eq. 0) THEN
ErrCountVar = ErrCountVar+1
CALL ShowWarningError('Iteration limit exceeded calculating DX unit speed ratio, for unit='// &
TRIM(MSHeatPump(MSHeatPumpNum)%Name))
CALL ShowContinueErrorTimeStamp('Speed ratio returned=['//trim(RoundSigDigits(SpeedRatio,2))//'], Speed number =' &
//trim(RoundSigDigits(SpeedNum,0)))
Else
ErrCountVar = ErrCountVar+1
CALL ShowRecurringWarningErrorAtEnd(TRIM(MSHeatPump(MSHeatPumpNum)%Name)//'":'//&
' Iteration limit warning exceeding calculating DX unit speed ratio continues...' &
,MSHeatPump(MSHeatPumpNum)%ErrIndexVar, SpeedRatio, SpeedRatio)
End If
End If
ELSE IF (SolFla == -2) THEN
CALL ShowFatalError('DX unit compressor speed calculation failed: speed limits exceeded, for unit='// &
TRIM(MSHeatPump(MSHeatPumpNum)%DXCoolCoilName))
END IF
End If
Else
! Staged thermostat performance
If (MSHeatPump(MSHeatPumpNum)%StageNum .NE. 0) Then
Par(1) = MSHeatPumpNum
Par(2) = ZoneNum
IF (FirstHVACIteration) THEN
Par(3) = 1.0d0
ELSE
Par(3) = 0.0d0
END IF
Par(4) = OpMode
Par(5) = QZnReq
Par(6) = OnOffAirFlowRatio
Par(7) = SupHeaterLoad
Par(9) = CompOp
SpeedNum = ABS(MSHeatPump(MSHeatPumpNum)%StageNum)
Par(8) = SpeedNum
If (SpeedNum == 1) Then
CALL CalcMSHeatPump(MSHeatPumpNum,FirstHVACIteration,CompOp,1,0.0d0,1.0d0,LowOutput, &
QZnReq,OnOffAirFlowRatio,SupHeaterLoad)
SpeedRatio = 0.0d0
IF ((QZnReq .GT. 0.0 .AND. QZnReq <= LowOutput) .OR. (QZnReq .LT. 0.0 .AND. QZnReq >= LowOutput)) THEN
CALL SolveRegulaFalsi(ErrorToler, MaxIte, SolFla, PartLoadFrac, MSHPCyclingResidual, 0.0d0, 1.0d0, Par)
IF (SolFla == -1) THEN
If ( .NOT. WarmupFlag) Then
IF (ErrCountCyc .eq. 0) THEN
ErrCountCyc = ErrCountCyc+1
CALL ShowWarningError('Iteration limit exceeded calculating DX unit cycling ratio, for unit='// &
TRIM(MSHeatPump(MSHeatPumpNum)%Name))
CALL ShowContinueErrorTimeStamp('Cycling ratio returned='//RoundSigDigits(PartLoadFrac,2))
Else
ErrCountCyc = ErrCountCyc+1
CALL ShowRecurringWarningErrorAtEnd(TRIM(MSHeatPump(MSHeatPumpNum)%Name)//'":'//&
' Iteration limit warning exceeding calculating DX unit cycling ratio continues...' &
,MSHeatPump(MSHeatPumpNum)%ErrIndexCyc , PartLoadFrac, PartLoadFrac)
End If
End If
ELSE IF (SolFla == -2) THEN
CALL ShowFatalError('DX unit cycling ratio calculation failed: cycling limits exceeded, for unit='// &
TRIM(MSHeatPump(MSHeatPumpNum)%DXCoolCoilName))
END IF
Else
FullOutput = LowOutput
PartLoadFrac = 1.0d0
End If
Else
If (MSHeatPump(MSHeatPumpNum)%StageNum < 0) Then
SpeedNum = MIN(MSHeatPump(MSHeatPumpNum)%NumOfSpeedCooling,ABS(MSHeatPump(MSHeatPumpNum)%StageNum))
Else
SpeedNum = MIN(MSHeatPump(MSHeatPumpNum)%NumOfSpeedHeating,ABS(MSHeatPump(MSHeatPumpNum)%StageNum))
End If
CALL CalcMSHeatPump(MSHeatPumpNum,FirstHVACIteration,CompOp,SpeedNum,0.0d0,1.0d0,LowOutput, &
QZnReq,OnOffAirFlowRatio,SupHeaterLoad)
IF ((QZnReq .GT. 0.0 .AND. QZnReq >= LowOutput) .OR. (QZnReq .LT. 0.0 .AND. QZnReq <= LowOutput)) THEN
CALL CalcMSHeatPump(MSHeatPumpNum,FirstHVACIteration,CompOp,SpeedNum,1.0d0,1.0d0,FullOutput, &
QZnReq,OnOffAirFlowRatio,SupHeaterLoad)
IF ((QZnReq .GT. 0.0 .AND. QZnReq <= FullOutput) .OR. (QZnReq .LT. 0.0 .AND. QZnReq >= FullOutput)) THEN
Par(8) = SpeedNum
CALL SolveRegulaFalsi(ErrorToler, MaxIte, SolFla, SpeedRatio, MSHPVarSpeedResidual, 0.0d0, 1.0d0, Par)
IF (SolFla == -1) THEN
If ( .NOT. WarmupFlag) Then
IF (ErrCountVar .eq. 0) THEN
ErrCountVar = ErrCountVar+1
CALL ShowWarningError('Iteration limit exceeded calculating DX unit speed ratio, for unit='// &
TRIM(MSHeatPump(MSHeatPumpNum)%Name))
CALL ShowContinueErrorTimeStamp('Speed ratio returned=['//trim(RoundSigDigits(SpeedRatio,2))// &
'], Speed number ='//trim(RoundSigDigits(SpeedNum,0)))
Else
ErrCountVar = ErrCountVar+1
CALL ShowRecurringWarningErrorAtEnd(TRIM(MSHeatPump(MSHeatPumpNum)%Name)//'":'//&
' Iteration limit warning exceeding calculating DX unit speed ratio continues...' &
,MSHeatPump(MSHeatPumpNum)%ErrIndexVar, SpeedRatio, SpeedRatio)
End If
End If
ELSE IF (SolFla == -2) THEN
CALL ShowFatalError('DX unit compressor speed calculation failed: speed limits exceeded, for unit='// &
TRIM(MSHeatPump(MSHeatPumpNum)%DXCoolCoilName))
END IF
Else
SpeedRatio = 1.0d0
End If
Else ! lowOutput provides a larger capacity than needed
SpeedRatio = 0.0d0
End If
End If
End If
End If
! if the DX heating coil cannot meet the load, trim with supplemental heater
! occurs with constant fan mode when compressor is on or off
! occurs with cycling fan mode when compressor PLR is equal to 1
IF ((QZnReq .GT. SmallLoad .AND. QZnReq .GT. FullOutput))THEN
PartLoadFrac = 1.0d0
SpeedRatio = 1.0d0
If (MSHeatPump(MSHeatPumpNum)%Staged .AND. SpeedNum == 1) SpeedRatio = 0.0d0
IF (OutsideDryBulbTemp .LE. MSHeatPump(MSHeatPumpNum)%SuppMaxAirTemp) THEN
SupHeaterLoad = QZnReq - FullOutput
ELSE
SupHeaterLoad = 0.0d0
END IF
CALL CalcMSHeatPump(MSHeatPumpNum,FirstHVACIteration,CompOp,SpeedNum,SpeedRatio,PartLoadFrac,TempOutput,QZnReq, &
OnOffAirFlowRatio,SupHeaterLoad)
END IF
! check the outlet of the supplemental heater to be lower than the maximum supplemental heater supply air temperature
IF (Node(MSHeatPump(MSHeatPumpNum)%AirOutletNodeNum)%Temp .GT. MSHeatPump(MSHeatPumpNum)%SuppMaxAirTemp .AND. &
SupHeaterLoad .GT. 0.0d0) THEN
! If the supply air temperature is to high, turn off the supplemental heater to recalculate the outlet temperature
SupHeaterLoad = 0.0d0
CALL CalcNonDXHeatingCoils(MSHeatPumpNum,FirstHVACIteration, SupHeaterLoad, OpMode, QCoilActual)
! If the outlet temperature is below the maximum supplemental heater supply air temperature, reduce the load passed to
! the supplemental heater, otherwise leave the supplemental heater off. If the supplemental heater is to be turned on,
! use the outlet conditions when the supplemental heater was off (CALL above) as the inlet conditions for the calculation
! of supplemental heater load to just meet the maximum supply air temperature from the supplemental heater.
IF (Node(MSHeatPump(MSHeatPumpNum)%AirOutletNodeNum)%Temp .LT. MSHeatPump(MSHeatPumpNum)%SuppMaxAirTemp) THEN
CpAir = PsyCpAirFnWTdb(Node(MSHeatPump(MSHeatPumpNum)%AirOutletNodeNum)%HumRat, &
Node(MSHeatPump(MSHeatPumpNum)%AirOutletNodeNum)%Temp)
SupHeaterLoad = Node(MSHeatPump(MSHeatPumpNum)%AirInletNodeNum)%MassFlowRate * CpAir * &
(MSHeatPump(MSHeatPumpNum)%SuppMaxAirTemp - Node(MSHeatPump(MSHeatPumpNum)%AirOutletNodeNum)%Temp)
ELSE
SupHeaterLoad = 0.0d0
END IF
END IF
MSHeatPumpReport(MSHeatPumpNum)%CycRatio = PartLoadFrac
MSHeatPumpReport(MSHeatPumpNum)%SpeedRatio = SpeedRatio
MSHeatPumpReport(MSHeatPumpNum)%SpeedNum = SpeedNum
RETURN
END SUBROUTINE ControlMSHPOutput