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) | :: | GSHPNum | |||
real(kind=r64), | intent(in) | :: | MyLoad |
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 CalcWatertoWaterHPHeating(GSHPNum, MyLoad)
! SUBROUTINE INFORMATION:
! AUTHOR Kenneth Tang
! DATE WRITTEN March 2005
! MODIFIED
!
! RE-ENGINEERED
! PURPOSE OF THIS SUBROUTINE:
! This routine simulate the heat pump peformance in heating mode
! METHODOLOGY EMPLOYED:
! REFERENCES:
! (1) 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 http://www.hvac.okstate.edu/)
! USE STATEMENTS:
USE DataHVACGlobals, ONLY : TimeStepSys
USE FluidProperties, ONLY : GetDensityGlycol, GetSpecificHeatGlycol
USE DataPlant, ONLY : PlantLoop
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: GSHPNum ! GSHP Number
REAL(r64), INTENT(IN) :: MyLoad ! Operating Load
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: CelsiustoKelvin = KelvinConv ! Conversion from Celsius to Kelvin
REAL(r64), PARAMETER :: Tref = 283.15d0 ! Reference Temperature for performance curves,10C [K]
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: HeatCapRated ! Rated Heating Capacity [W]
REAL(r64) :: HeatPowerRated ! Rated Heating Compressor Power[W]
REAL(r64) :: LoadSideVolFlowRateRated ! Rated Load Side Volumetric Flow Rate [m3/s]
REAL(r64) :: SourceSideVolFlowRateRated ! Rated Source Side 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) :: LoadSideMassFlowRate ! Load Side Mass Flow Rate [kg/s]
REAL(r64) :: LoadSideInletTemp ! Load Side Inlet Temperature [C]
REAL(r64) :: LoadSideOutletTemp ! Load side Outlet Temperature [C]
REAL(r64) :: SourceSideMassFlowRate ! Source Side Mass Flow Rate [kg/s]
REAL(r64) :: SourceSideInletTemp ! Source Side Inlet Temperature [C]
REAL(r64) :: SourceSideOutletTemp ! Source Side Outlet Temperature [C]
REAL(r64) :: func1 ! Portion of the heat transfer and power equation
REAL(r64) :: func2 ! Portion of the heat transfer and power equation
REAL(r64) :: func3 ! Portion of the heat transfer and power equation
REAL(r64) :: func4 ! Portion of the heat transfer and power equation
REAL(r64) :: Power ! Power Consumption [W]
REAL(r64) :: QLoad ! Cooling Capacity [W]
REAL(r64) :: QSource ! Source Side Heat Transfer Rate [W]
REAL(r64) :: PartLoadRatio ! Part Load Ratio
REAL(r64) :: ReportingConstant
REAL(r64) :: rhoLoadSide
REAL(r64) :: rhoSourceSide
REAL(r64) :: CpLoadSide
REAL(r64) :: CpSourceSide
! LOAD LOCAL VARIABLES FROM DATA STRUCTURE
LoadSideVolFlowRateRated = GSHP(GSHPNum)%RatedLoadVolFlowHeat
SourceSideVolFlowRateRated= GSHP(GSHPNum)%RatedSourceVolFlowHeat
HeatCapRated = GSHP(GSHPNum)%RatedCapHeat
HeatPowerRated = GSHP(GSHPNum)%RatedPowerHeat
HeatCapCoeff1 = GSHP(GSHPNum)%HeatCap1
HeatCapCoeff2 = GSHP(GSHPNum)%HeatCap2
HeatCapCoeff3 = GSHP(GSHPNum)%HeatCap3
HeatCapCoeff4 = GSHP(GSHPNum)%HeatCap4
HeatCapCoeff5 = GSHP(GSHPNum)%HeatCap5
HeatPowerCoeff1 = GSHP(GSHPNum)%HeatPower1
HeatPowerCoeff2 = GSHP(GSHPNum)%HeatPower2
HeatPowerCoeff3 = GSHP(GSHPNum)%HeatPower3
HeatPowerCoeff4 = GSHP(GSHPNum)%HeatPower4
HeatPowerCoeff5 = GSHP(GSHPNum)%HeatPower5
LoadSideMassFlowRate = GSHPReport(GSHPNum)%LoadSideMassFlowRate
LoadSideInletTemp = GSHPReport(GSHPNum)%LoadSideInletTemp
SourceSideMassFlowRate = GSHPReport(GSHPNum)%SourceSideMassFlowRate
SourceSideInletTemp = GSHPReport(GSHPNum)%SourceSideInletTemp
! If heat pump is not operating, THEN return
IF(.NOT. GSHP(GSHPNum)%MustRun) THEN
RETURN
ENDIF
rhoLoadSide = GetDensityGlycol(PlantLoop(GSHP(GSHPNum)%LoadLoopNum)%FluidName, &
LoadSideInletTemp, &
PlantLoop(GSHP(GSHPNum)%LoadLoopNum)%FluidIndex, &
'CalcWatertoWaterHPHeating')
rhoSourceSide = GetDensityGlycol(PlantLoop(GSHP(GSHPNum)%SourceLoopNum)%FluidName, &
SourceSideInletTemp, &
PlantLoop(GSHP(GSHPNum)%SourceLoopNum)%FluidIndex, &
'CalcWatertoWaterHPHeating')
func1 = ((LoadSideInletTemp+CelsiustoKelvin)/Tref)
func2 = ((SourceSideInletTemp+CelsiustoKelvin)/Tref)
func3 = (LoadSideMassFlowRate/(LoadSideVolFlowRateRated * rhoLoadSide ))
func4 = (SourceSideMassFlowRate/(SourceSideVolFlowRateRated * rhoSourceSide ))
QLoad = HeatCapRated*(HeatCapCoeff1 + (func1 * HeatCapCoeff2) + (func2 * HeatCapCoeff3) + (func3 * HeatCapCoeff4)+ &
(func4 * HeatCapCoeff5))
Power = HeatPowerRated*(HeatPowerCoeff1 + (func1 * HeatPowerCoeff2) + (func2 * HeatPowerCoeff3) + &
(func3 * HeatPowerCoeff4) + (func4 * HeatPowerCoeff5))
IF ( (Qload .LE. 0.0d0 .OR. Power .LE. 0.0d0) .AND. .NOT. WarmupFlag) THEN
IF (Qload .LE. 0.0d0) THEN
IF (GSHP(GSHPNum)%HeatCapNegativeCounter .LT. 1) THEN
GSHP(GSHPNum)%HeatCapNegativeCounter = GSHP(GSHPNum)%HeatCapNegativeCounter + 1
CALL ShowWarningError(TRIM(HPEqFitHeating)//' "'//TRIM(GSHP(GSHPNum)%Name)//'":')
CALL ShowContinueError(' Heating capacity curve output is <= 0.0 ('//TRIM(TrimSigDigits(QLoad,4))//').')
CALL ShowContinueError(' Zero or negative value occurs with a load-side inlet temperature of ' &
//TRIM(TrimSigDigits(LoadSideInletTemp,2))//' C,')
CALL ShowContinueError(' a source-side inlet temperature of ' &
//TRIM(TrimSigDigits(SourceSideInletTemp,2))//' C,')
CALL ShowContinueError(' a load-side mass flow rate of ' &
//TRIM(TrimSigDigits(LoadSideMassFlowRate,3))//' kg/s,')
CALL ShowContinueError(' and a source-side mass flow rate of ' &
//TRIM(TrimSigDigits(SourceSideMassFlowRate,3))//' kg/s.')
CALL ShowContinueErrorTimeStamp(' The heat pump is turned off for this time step but simulation continues.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(HPEqFitHeating)//' "'// TRIM(GSHP(GSHPNum)%Name)//'":'//&
' Heating capacity curve output is <= 0.0 warning continues...' &
, GSHP(GSHPNum)%HeatCapNegativeIndex, Qload, Qload)
END IF
END IF
IF (Power .LE. 0.0d0) THEN
IF (GSHP(GSHPNum)%HeatPowerNegativeCounter .LT. 1) THEN
GSHP(GSHPNum)%HeatPowerNegativeCounter = GSHP(GSHPNum)%HeatPowerNegativeCounter + 1
CALL ShowWarningError(TRIM(HPEqFitHeating)//' "'//TRIM(GSHP(GSHPNum)%Name)//'":')
CALL ShowContinueError(' Heating compressor power curve output is <= 0.0 ('//TRIM(TrimSigDigits(Power,4))//').')
CALL ShowContinueError(' Zero or negative value occurs with a load-side inlet temperature of ' &
//TRIM(TrimSigDigits(LoadSideInletTemp,2))//' C,')
CALL ShowContinueError(' a source-side inlet temperature of ' &
//TRIM(TrimSigDigits(SourceSideInletTemp,2))//' C,')
CALL ShowContinueError(' a load-side mass flow rate of ' &
//TRIM(TrimSigDigits(LoadSideMassFlowRate,3))//' kg/s,')
CALL ShowContinueError(' and a source-side mass flow rate of ' &
//TRIM(TrimSigDigits(SourceSideMassFlowRate,3))//' kg/s.')
CALL ShowContinueErrorTimeStamp(' The heat pump is turned off for this time step but simulation continues.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(HPEqFitHeating)//' "'// TRIM(GSHP(GSHPNum)%Name)//'":'//&
' Heating compressor power curve output is <= 0.0 warning continues...' &
, GSHP(GSHPNum)%HeatPowerNegativeIndex, Power, Power)
END IF
END IF
Qload = 0.0d0
Power = 0.0d0
END IF
QSource = QLoad-Power !assume no losses
!Control Strategy
IF(ABS(MyLoad) < QLoad .AND. Qload .NE. 0.0d0) THEN
PartLoadRatio = ABS(MyLoad)/QLoad
QLoad = ABS(MyLoad)
Power = Power * PartLoadRatio
QSource = QSource * PartLoadRatio
END IF
CpLoadSide = GetSpecificHeatGlycol(PlantLoop(GSHP(GSHPNum)%LoadLoopNum)%FluidName, &
LoadSideInletTemp, &
PlantLoop(GSHP(GSHPNum)%LoadLoopNum)%FluidIndex, &
'CalcWatertoWaterHPHeating')
CpSourceSide = GetSpecificHeatGlycol(PlantLoop(GSHP(GSHPNum)%SourceLoopNum)%FluidName, &
SourceSideInletTemp, &
PlantLoop(GSHP(GSHPNum)%SourceLoopNum)%FluidIndex, &
'CalcWatertoWaterHPHeating')
LoadSideOutletTemp = LoadSideInletTemp + QLoad/(LoadSideMassFlowRate * CpLoadSide)
SourceSideOutletTemp = SourceSideInletTemp - QSource/(SourceSideMassFlowRate * CpSourceSide )
ReportingConstant = TimeStepSys*SecInHour
GSHPReport(GSHPNum)%Power = Power
GSHPReport(GSHPNum)%Energy = Power*ReportingConstant
GSHPReport(GSHPNum)%QSource = QSource
GSHPReport(GSHPNum)%QLoad = QLoad
GSHPReport(GSHPNum)%QSourceEnergy = QSource*ReportingConstant
GSHPReport(GSHPNum)%QLoadEnergy = QLoad*ReportingConstant
GSHPReport(GSHPNum)%LoadSideOutletTemp = LoadSideOutletTemp
GSHPReport(GSHPNum)%SourceSideOutletTemp = SourceSideOutletTemp
RETURN
END SUBROUTINE CalcWatertoWaterHPHeating