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) | :: | PTUnitNum | |||
integer, | intent(in) | :: | ZoneNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(out) | :: | QSensUnitOut | |||
real(kind=r64), | intent(inout) | :: | OnOffAirFlowRatio | |||
real(kind=r64), | intent(in) | :: | QZnReq | |||
real(kind=r64), | intent(out) | :: | QLatUnitOut |
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 SimPTUnit(PTUnitNum,ZoneNum,FirstHVACIteration,QSensUnitOut,OnOffAirFlowRatio,QZnReq,QLatUnitOut)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN July 2005
! MODIFIED D. Shirey, Aug 2009 (QLatUnitOut)
! MODIFIED Bo Shen, March 2012, added switch to variable-speed water-source heat pump
! MODIFIED Bo Shen, July 2012, added variable-speed air-source heat pump
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulate a packaged terminal heat pump; adjust its output to match the
! remaining zone load.
! METHODOLOGY EMPLOYED:
! Calls ControlPTUnitOutput to obtain the desired unit output
! REFERENCES:
! na
! USE STATEMENTS:
! na
USE Psychrometrics, ONLY: PsyHFnTdbW
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) :: PTUnitNum ! number of the current Packaged Terminal Heat Pump being simulated
INTEGER, INTENT (IN) :: ZoneNum ! number of zone being served
REAL(r64), INTENT (OUT) :: QSensUnitOut ! sensible delivered capacity [W]
REAL(r64), INTENT (OUT) :: QLatUnitOut ! Latent delivered capacity [kg/s], dehumidification = negative
REAL(r64), INTENT (INOUT) :: OnOffAirFlowRatio ! ratio of compressor ON airflow to AVERAGE airflow over timestep
REAL(r64), INTENT (IN) :: QZnReq ! cooling/heating needed by zone [W]
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: PartLoadFrac ! compressor part load fraction
LOGICAL :: UnitOn ! TRUE if unit is on
INTEGER :: OutletNode ! PTUnit air outlet node
INTEGER :: InletNode ! PTUnit air inlet node
REAL(r64) :: QTotUnitOut ! total delivered capacity [W]
REAL(r64) :: AirMassFlow ! air mass flow rate [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)
INTEGER :: OpMode ! operating mode (fan cycling or continious; DX coil always cycles)
LOGICAL :: HXUnitOn ! flag to enable heat exchanger
REAL(r64) :: QLatReq ! latent cooling output needed by zone [W], now is zero
REAL(r64) :: QSensUnitOutMul ! sensible output for the variable speed HP
REAL(r64) :: QLatUnitOutMul ! latent output for the variable speed HP
REAL(r64) :: MinHumRat ! min humidity for calculating sensible capacity of VS WSHP
! zero the fan, DX coils, and supplemental electric heater electricity consumption
FanElecPower = 0.0d0
DXElecCoolingPower = 0.0d0
DXElecHeatingPower = 0.0d0
ElecHeatingCoilPower = 0.0d0
SaveCompressorPLR = 0.0d0
QLatReq = 0.0d0
! initialize local variables
UnitOn = .TRUE.
HXUnitOn = .TRUE.
QSensUnitOut = 0.0d0
QLatUnitOut = 0.0d0
OutletNode = PTUnit(PTUnitNum)%AirOutNode
InletNode = PTUnit(PTUnitNum)%AirInNode
AirMassFlow = Node(InletNode)%MassFlowRate
OpMode = PTUnit(PTUnitNum)%OpMode
! reset operation flag if unit is off
IF (PTUnit(PTUnitNum)%OPMode == CycFanCycCoil) THEN
! cycling unit: only runs if there is a cooling or heating load.
IF ((.NOT. CoolingLoad .AND. .NOT. HeatingLoad) .OR. AirMassFlow < SmallMassFlow) THEN
UnitOn = .FALSE.
END IF
ELSE IF (PTUnit(PTUnitNum)%OPMode == ContFanCycCoil) THEN
! continuous unit: fan runs if scheduled on; coil runs only if there is a cooling or heating load
IF (AirMassFlow.LT.SmallMassFlow) THEN
UnitOn = .FALSE.
END IF
END IF
OnOffFanPartLoadFraction = 1.0d0
IF(UnitOn)THEN
IF(PTUnit(PTUnitNum)%NumOfSpeedCooling > 0) THEN
CALL SimVariableSpeedHP(PTUnitNum,ZoneNum, FirstHVACIteration, QZnReq, QLatReq, OnOffAirFlowRatio, OpMode, HXUnitOn )
ELSE
CALL ControlPTUnitOutput(PTUnitNum,FirstHVACIteration,OpMode,QZnReq,ZoneNum,PartLoadFrac,OnOffAirFlowRatio, &
SupHeaterLoad,HXUnitOn)
END IF
ELSE
PartLoadFrac = 0.0d0
OnOffAirFlowRatio = 1.0d0
SupHeaterLoad = 0.0d0
IF(PTUnit(PTUnitNum)%NumOfSpeedCooling > 0) THEN
CALL CalcVarSpeedHeatPump(PTUnitNum, ZoneNum, FirstHVACIteration,0,1,0.0d0,PartLoadFrac,QSensUnitOutMul, QLatUnitOutMul, &
0.0d0,0.0d0,OnOffAirFlowRatio,SupHeaterLoad,HXUnitOn )
END IF
END IF
! calculate delivered capacity
AirMassFlow = Node(InletNode)%MassFlowRate
IF(PTUnit(PTUnitNum)%NumOfSpeedCooling == 0) THEN
CALL CalcPTUnit(PTUnitNum,FirstHVACIteration,PartLoadFrac,QSensUnitOut,QZnReq,OnOffAirFlowRatio,SupHeaterLoad, HXUnitOn)
ELSE
! calculate delivered capacity
MinHumRat = MIN(Node(InletNode)%HumRat,Node(OutletNode)%HumRat)
QSensUnitOut = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,MinHumRat) - PsyHFnTdbW(Node(InletNode)%Temp,MinHumRat))
END IF
! CR9155 Remove specific humidity calculations
SpecHumOut = Node(OutletNode)%HumRat
SpecHumIn = Node(InletNode)%HumRat
QLatUnitOut = AirMassFlow * (SpecHumOut - SpecHumIn) ! Latent rate, kg/s (dehumid = negative)
QTotUnitOut = AirMassFlow * (Node(OutletNode)%Enthalpy - Node(InletNode)%Enthalpy)
IF(PTUnit(PTUnitNum)%NumOfSpeedCooling == 0) THEN
! report variables
IF(PTUnit(PTUnitNum)%UnitType_Num == PTACUnit)THEN
PTUnit(PTUnitNum)%CompPartLoadRatio = PartLoadFrac
ELSE
PTUnit(PTUnitNum)%CompPartLoadRatio = SaveCompressorPLR
END IF
IF (PTUnit(PTUnitNum)%OpMode .EQ. CycFanCycCoil) THEN
PTUnit(PTUnitNum)%FanPartLoadRatio = PartLoadFrac
ELSE
IF (UnitOn) THEN
PTUnit(PTUnitNum)%FanPartLoadRatio = 1.0d0
ELSE
PTUnit(PTUnitNum)%FanPartLoadRatio = 0.0d0
END IF
END IF
END IF
PTUnit(PTUnitNum)%TotCoolEnergyRate = ABS(MIN(0.0d0, QTotUnitOut))
PTUnit(PTUnitNum)%TotHeatEnergyRate = ABS(MAX(0.0d0, QTotUnitOut))
PTUnit(PTUnitNum)%SensCoolEnergyRate = ABS(MIN(0.0d0, QSensUnitOut))
PTUnit(PTUnitNum)%SensHeatEnergyRate = ABS(MAX(0.0d0, QSensUnitOut))
PTUnit(PTUnitNum)%LatCoolEnergyRate = ABS(MIN(0.0d0, (QTotUnitOut - QSensUnitOut)))
PTUnit(PTUnitNum)%LatHeatEnergyRate = ABS(MAX(0.0d0, (QTotUnitOut - QSensUnitOut)))
IF(PTUnit(PTUnitNum)%UnitType_Num == PTACUnit)THEN
SELECT CASE (PTUnit(PTUnitNum)%ACHeatCoilType_Num)
CASE (Coil_HeatingGas, Coil_HeatingElectric)
PTUnit(PTUnitNum)%ElecPower = FanElecPower + DXElecCoolingPower + ElecHeatingCoilPower
CASE (Coil_HeatingWater, Coil_HeatingSteam)
PTUnit(PTUnitNum)%ElecPower = FanElecPower + DXElecCoolingPower
CASE DEFAULT
END SELECT
ELSE
PTUnit(PTUnitNum)%ElecPower = FanElecPower + DXElecCoolingPower + DXElecHeatingPower + ElecHeatingCoilPower
END IF
RETURN
END SUBROUTINE SimPTUnit