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) | :: | HPNum | |||
integer, | intent(in) | :: | CyclingScheme | |||
real(kind=r64), | intent(in) | :: | RuntimeFrac | |||
real(kind=r64), | intent(in) | :: | SensDemand | |||
integer, | intent(in) | :: | CompOp | |||
real(kind=r64), | intent(in) | :: | PartLoadRatio | |||
real(kind=r64), | intent(in) | :: | OnOffAirFlowRatio | |||
real(kind=r64), | intent(in) | :: | WaterPartLoad |
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 CalcHPHeatingSimple(HPNum,CyclingScheme,RuntimeFrac,SensDemand,CompOp,PartLoadRatio,OnOffAirFlowRatio,WaterPartLoad)
! AUTHOR Arun Shenoy
! DATE WRITTEN Jan 2004
! MODIFIED na
! RE-ENGINEERED Kenneth Tang (Jan 2005)
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for simulating the heating mode of the Water to Air HP Simple
! METHODOLOGY EMPLOYED:
! Simulate the heat pump performance using the coefficients and rated conditions
!
! Finally, adjust the heat pump outlet conditions based on the PartLoadRatio
! and RuntimeFrac.
! REFERENCES:
! (1) Lash.T.A.,1992.Simulation and Analysis of a Water Loop Heat Pump System.
! M.S. Thesis, University of Illinois at Urbana Champaign.
! (2) Shenoy, Arun. 2004. Simulation, Modeling and Analysis of Water to Air Heat Pump.
! State Energy Simulation Program. M.S. Thesis, Department of Mechanical and Aerospace Engineering,
! Oklahoma State University. (downloadable from www.hvac.okstate.edu)
! (3) Tang,C.C.. 2005. Modeling Packaged Heat Pumps in a Quasi-Steady
! State Energy Simulation Program. M.S. Thesis, Department of Mechanical and Aerospace Engineering,
! Oklahoma State University. (downloadable from www.hvac.okstate.edu)
! USE STATEMENTS:
USE DataHVACGlobals, ONLY:TimeStepSys, DXElecHeatingPower
USE Psychrometrics, ONLY:PsyWFnTdbTwbPb,PsyRhoAirFnPbTdbW,PsyCpAirFnWTdb,PsyTwbFnTdbWPb, &
PsyTdbFnHW,PsyWFnTdbH
USE FluidProperties, ONLY:GetSpecificHeatGlycol
USE DataPlant, ONLY: PlantLoop
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: HPNum ! Heat Pump Number
INTEGER, INTENT(IN) :: CyclingScheme ! Fan/Compressor cycling scheme indicator
REAL(r64), INTENT(IN) :: RuntimeFrac ! Runtime Fraction of compressor
REAL(r64), INTENT(IN) :: SensDemand ! Cooling Sensible Demand [W] !unused1208
INTEGER, INTENT(IN) :: CompOp ! compressor operation flag
REAL(r64), INTENT(IN) :: PartLoadRatio ! compressor part load ratio
REAL(r64), INTENT(IN) :: OnOffAirFlowRatio ! ratio of compressor on flow to average flow over time step
REAL(r64), INTENT(IN) :: WaterPartLoad ! water part load ratio
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: Tref=283.15d0 ! Reference Temperature for performance curves,10C [K]
CHARACTER(len=*), PARAMETER :: RoutineName='CalcHPHeatingSimple'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: HeatCapRated ! Rated Heating Capacity [W]
REAL(r64) :: HeatPowerRated ! Rated Heating Power Input[W]
REAL(r64) :: AirVolFlowRateRated ! Rated Air Volumetric Flow Rate [m3/s]
REAL(r64) :: WaterVolFlowRateRated ! Rated Water Volumetric Flow Rate [m3/s]
REAL(r64) :: HeatCapCoeff1 ! 1st coefficient of the heating capacity performance curve
REAL(r64) :: HeatCapCoeff2 ! 2nd coefficient of the heating capacity performance curve
REAL(r64) :: HeatCapCoeff3 ! 3rd coefficient of the heating capacity performance curve
REAL(r64) :: HeatCapCoeff4 ! 4th coefficient of the heating capacity performance curve
REAL(r64) :: HeatCapCoeff5 ! 5th coefficient of the heating capacity performance curve
REAL(r64) :: HeatPowerCoeff1 ! 1st coefficient of the heating power consumption curve
REAL(r64) :: HeatPowerCoeff2 ! 2nd coefficient of the heating power consumption curve
REAL(r64) :: HeatPowerCoeff3 ! 3rd coefficient of the heating power consumption curve
REAL(r64) :: HeatPowerCoeff4 ! 4th coefficient of the heating power consumption curve
REAL(r64) :: HeatPowerCoeff5 ! 5th coefficient of the heating power consumption curve
! REAL(r64) :: PartLoadRatio ! Part load ratio
REAL(r64) :: ratioTDB ! Ratio of the inlet air dry bulb temperature to the rated conditions
REAL(r64) :: ratioTS ! Ratio of the source side (water) inlet temperature to the rated conditions
REAL(r64) :: ratioVL ! Ratio of the load side flow rate to the rated conditions
REAL(r64) :: ratioVS ! Ratio of the source side flow rate to the rated conditions
REAL(r64) :: CpWater ! Specific heat of water [J/kg_C]
REAL(r64) :: CpAir ! Specific heat of air [J/kg_C]
REAL(r64) :: ReportingConstant
! LOAD LOCAL VARIABLES FROM DATA STRUCTURE (for code readability)
HeatCapRated = SimpleWatertoAirHP(HPNum)%RatedCapHeat
HeatPowerRated = SimpleWatertoAirHP(HPNum)%RatedPowerHeat
AirVolFlowRateRated = SimpleWatertoAirHP(HPNum)%RatedAirVolFlowRate
WaterVolFlowRateRated = SimpleWatertoAirHP(HPNum)%RatedWaterVolFlowRate
HeatCapCoeff1 = SimpleWatertoAirHP(HPNum)%HeatCap1
HeatCapCoeff2 = SimpleWatertoAirHP(HPNum)%HeatCap2
HeatCapCoeff3 = SimpleWatertoAirHP(HPNum)%HeatCap3
HeatCapCoeff4 = SimpleWatertoAirHP(HPNum)%HeatCap4
HeatCapCoeff5 = SimpleWatertoAirHP(HPNum)%HeatCap5
HeatPowerCoeff1 = SimpleWatertoAirHP(HPNum)%HeatPower1
HeatPowerCoeff2 = SimpleWatertoAirHP(HPNum)%HeatPower2
HeatPowerCoeff3 = SimpleWatertoAirHP(HPNum)%HeatPower3
HeatPowerCoeff4 = SimpleWatertoAirHP(HPNum)%HeatPower4
HeatPowerCoeff5 = SimpleWatertoAirHP(HPNum)%HeatPower5
LoadSideMassFlowRate = SimpleWatertoAirHP(HPNum)%AirMassFlowRate
LoadSideInletDBTemp = SimpleWatertoAirHP(HPNum)%InletAirDBTemp
LoadSideInletHumRat = SimpleWatertoAirHP(HPNum)%InletAirHumRat
LoadSideInletWBTemp = PsyTwbFnTdbWPb(LoadSideInletDBTemp,LoadSideInletHumRat,OutBaroPress,RoutineName)
LoadSideInletEnth = SimpleWatertoAirHP(HPNum)%InletAirEnthalpy
CpAir = PsyCpAirFnWTdb(LoadSideInletHumRat,LoadSideInletDBTemp,RoutineName)
SourceSideMassFlowRate = SimpleWatertoAirHP(HPNum)%WaterMassFlowRate
SourceSideInletTemp = SimpleWatertoAirHP(HPNum)%InletWaterTemp
SourceSideInletEnth = SimpleWatertoAirHP(HPNum)%InletWaterEnthalpy
CpWater = GetSpecificHeatGlycol(PlantLoop(SimpleWatertoAirHP(HPNum)%LoopNum)%FluidName, &
SourceSideInletTemp, &
PlantLoop(SimpleWatertoAirHP(HPNum)%LoopNum)%FluidIndex, &
RoutineName//':SourceSideInletTemp')
!Check for flows, do not perform simulation if no flow in load side or source side.
IF (SourceSideMassFlowRate <= 0.0d0 .OR. LoadSideMassFlowRate <= 0.0d0)THEN
SimpleWatertoAirHP(HPNum)%SimFlag = .FALSE.
RETURN
ELSE
SimpleWatertoAirHP(HPNum)%SimFlag = .TRUE.
ENDIF
IF (CompOp .EQ. 0) THEN
SimpleWaterToAirHP(HPNum)%SimFlag = .FALSE.
RETURN
ENDIF
ratioTDB = ((LoadSideInletDBTemp+CelsiustoKelvin)/Tref)
ratioTS = ((SourceSideInletTemp+CelsiustoKelvin)/Tref)
ratioVL = (LoadSideMassFlowRate/ &
(AirVolFlowRateRated*PsyRhoAirFnPbTdbW(StdBaroPress,LoadSideInletDBTemp,LoadSideInletHumRat,RoutineName)))
IF (WaterPartLoad > 0.0d0 .and. SimpleWatertoAirHP(HPNum)%DesignWaterMassFlowRate > 0.0d0) THEN
ratioVS = (SourceSideMassFlowRate)/(SimpleWatertoAirHP(HPNum)%DesignWaterMassFlowRate*WaterPartLoad)
ELSE
ratioVS = 0.0d0
ENDIF
QLoadTotal = HeatCapRated*(HeatCapCoeff1 + (ratioTDB * HeatCapCoeff2) + (ratioTS * HeatCapCoeff3) + &
(ratioVL * HeatCapCoeff4) + (ratioVS * HeatCapCoeff5))
QSensible = QLoadTotal
Winput = HeatPowerRated*(HeatPowerCoeff1 + (ratioTDB * HeatPowerCoeff2) + (ratioTS * HeatPowerCoeff3) + &
(ratioVL * HeatPowerCoeff4) + (ratioVS * HeatPowerCoeff5))
Qsource = QLoadTotal-Winput
! calculate coil outlet state variables
LoadSideOutletEnth = LoadSideInletEnth + QLoadTotal/LoadSideMassFlowRate
LoadSideOutletDBTemp = LoadSideInletDBTemp + QSensible/(LoadSideMassFlowRate * CpAir)
LoadsideOutletHumRat = PsyWFnTdbH(LoadSideOutletDBTemp,LoadSideOutletEnth,RoutineName)
! Actual outlet conditions are "average" for time step
IF (CyclingScheme .EQ. ContFanCycCoil) THEN
! continuous fan, cycling compressor
SimpleWatertoAirHP(HPNum)%OutletAirEnthalpy = PartLoadRatio*LoadSideOutletEnth + &
(1.d0-PartLoadRatio)*LoadSideInletEnth
SimpleWatertoAirHP(HPNum)%OutletAirHumRat = PartLoadRatio*LoadsideOutletHumRat + &
(1.d0-PartLoadRatio)*LoadSideInletHumRat
SimpleWatertoAirHP(HPNum)%OutletAirDBTemp = PsyTdbFnHW(SimpleWatertoAirHP(HPNum)%OutletAirEnthalpy, &
SimpleWatertoAirHP(HPNum)%OutletAirHumRat,RoutineName)
PLRCorrLoadSideMdot = LoadSideMassFlowRate
ELSE
! default to cycling fan, cycling compressor
SimpleWatertoAirHP(HPNum)%OutletAirEnthalpy = LoadSideOutletEnth
SimpleWatertoAirHP(HPNum)%OutletAirHumRat = LoadsideOutletHumRat
SimpleWatertoAirHP(HPNum)%OutletAirDBTemp = LoadSideOutletDBTemp
PLRCorrLoadSideMdot = LoadSideMassFlowRate*PartLoadRatio
END IF
! scale heat transfer rates to PLR and power to RTF
QLoadTotal = QLoadTotal*PartLoadRatio
QSensible = QSensible*PartLoadRatio
Winput = Winput*RuntimeFrac
QSource = QSource*PartLoadRatio
! Add power to global variable so power can be summed by parent object
DXElecHeatingPower = Winput
ReportingConstant=TimeStepSys*SecInHour
!Update heat pump data structure
SimpleWatertoAirHP(HPNum)%Power = Winput
SimpleWatertoAirHP(HPNum)%QLoadTotal = QLoadTotal
SimpleWatertoAirHP(HPNum)%QSensible = QSensible
SimpleWatertoAirHP(HPNum)%QSource = QSource
SimpleWatertoAirHP(HPNum)%Energy=Winput*ReportingConstant
SimpleWatertoAirHP(HPNum)%EnergyLoadTotal=QLoadTotal*ReportingConstant
SimpleWatertoAirHP(HPNum)%EnergySensible=QSensible*ReportingConstant
SimpleWatertoAirHP(HPNum)%EnergyLatent=0.0d0
SimpleWatertoAirHP(HPNum)%EnergySource=QSource*ReportingConstant
IF(RunTimeFrac == 0.0d0) THEN
SimpleWatertoAirHP(HPNum)%COP = 0.0d0
ELSE
SimpleWatertoAirHP(HPNum)%COP = QLoadTotal/Winput
END IF
SimpleWatertoAirHP(HPNum)%RunFrac = RuntimeFrac
SimpleWatertoAirHP(HPNum)%PartLoadRatio = PartLoadRatio
SimpleWatertoAirHP(HPNum)%AirMassFlowRate = PLRCorrLoadSideMdot
SimpleWatertoAirHP(HPNum)%WaterMassFlowRate = SourceSideMassFlowRate
SimpleWatertoAirHP(HPNum)%OutletWaterTemp = SourceSideInletTemp - QSource/(SourceSideMassFlowRate * CpWater)
SimpleWatertoAirHP(HPNum)%OutletWaterEnthalpy = SourceSideInletEnth - QSource/SourceSideMassFlowRate
END SUBROUTINE CalcHPHeatingSimple