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 | |||
logical, | intent(in) | :: | InitFlag | |||
real(kind=r64), | intent(in) | :: | MaxONOFFCyclesperHour | |||
real(kind=r64), | intent(in) | :: | HPTimeConstant | |||
real(kind=r64), | intent(in) | :: | FanDelayTime | |||
real(kind=r64), | intent(in) | :: | SensLoad | |||
real(kind=r64), | intent(in) | :: | LatentLoad | |||
real(kind=r64), | intent(in) | :: | DesignAirFlow | |||
real(kind=r64), | intent(in) | :: | PartLoadRatio |
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 InitWatertoAirHP(HPNum,InitFlag,MaxONOFFCyclesperHour,HPTimeConstant,FanDelayTime, &
SensLoad,LatentLoad,DesignAirFlow,PartLoadRatio)
! SUBROUTINE INFORMATION:
! AUTHOR Hui Jin
! DATE WRITTEN Oct 2000
! MODIFIED Dan Fisher, Kenneth Tang (Jan 2004)
! Brent Griffith, Sept 2010, plant upgrades, general fluid properties
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Water to Air HP Components.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! USE STATEMENTS:
USE FluidProperties, ONLY : GetDensityGlycol, GetSpecificHeatGlycol
USE DataPlant, ONLY : ScanPlantLoopsForObject, PlantLoop
USE PlantUtilities, ONLY : InitComponentNodes, SetComponentFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: HPNum ! index to main heat pump data structure
REAL(r64), INTENT(IN) :: MaxONOFFCyclesperHour !Maximum cycling rate of heat pump [cycles/hr]
REAL(r64), INTENT(IN) :: HPTimeConstant !Heat pump time constant [s]
REAL(r64), INTENT(IN) :: FanDelayTime !Fan delay time, time delay for the HP's fan to
!shut off after compressor cycle off [s]
REAL(r64), INTENT(IN) :: SensLoad
REAL(r64), INTENT(IN) :: LatentLoad
REAL(r64), INTENT(IN) :: DesignAirFlow
LOGICAL, INTENT(IN) :: InitFlag
REAL(r64), INTENT(IN) :: PartLoadRatio
! SUBROUTINE PARAMETER DEFINITIONS:
! REAL(r64), PARAMETER :: CpWater=4210.d0 ! Specific heat of water J/kg_C
REAL(r64), PARAMETER :: TempTOL=0.2d0 ! air temperature tolerance to trigger resimulation
REAL(r64), PARAMETER :: EnthTOL=0.2d0 ! air enthalpy tolerance to trigger resimulation
REAL(r64), PARAMETER :: HumRatTOL=0.2d0 ! air humidity ratio tolerance
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! INTEGER :: WatertoAirHPNum ! heat pump number
INTEGER :: AirInletNode ! air inlet node number
INTEGER :: WaterInletNode ! water inlet node number
INTEGER :: PlantOutletNode
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyPlantScanFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
REAL(r64) :: rho ! local fluid density
REAL(r64) :: Cp ! local fluid specific heat
REAL(r64) :: Temptemp
LOGICAL :: errFlag
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumWatertoAirHPs))
ALLOCATE(MyPlantScanFlag(NumWatertoAirHPs))
MyEnvrnFlag = .TRUE.
MyPlantScanFlag = .TRUE.
MyOneTimeFlag = .false.
END IF
IF (MyPlantScanFlag(HPNum) .AND. ALLOCATED(PlantLoop)) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject(WatertoAirHP(HPNum)%Name, &
WatertoAirHP(HPNum)%WAHPPlantTypeOfNum, &
WatertoAirHP(HPNum)%LoopNum, &
WatertoAirHP(HPNum)%LoopSide, &
WatertoAirHP(HPNum)%BranchNum, &
WatertoAirHP(HPNum)%CompNum, &
errFlag=errFlag)
IF(PlantLoop(WatertoAirHP(HPNum)%LoopNum)%FluidName=='WATER') THEN
IF (WatertoAirHP(HPNum)%SourceSideUACoeff .LT. rTinyValue) THEN
CALL ShowSevereError('Input problem for water to air heat pump, "'//TRIM(WatertoAirHP(HPNum)%Name) //'".')
CALL ShowContinueError(' Source side UA value is less than tolerance, likely zero or blank.')
CALL ShowContinueError(' Verify inputs, as the parameter syntax for this object went through a change with')
CALL ShowContinueError(' the release of EnergyPlus version 5.')
errFlag = .TRUE.
END IF
ELSE
IF ((WatertoAirHP(HPNum)%SourceSideHTR1 .LT. rTinyValue) .OR. (WatertoAirHP(HPNum)%SourceSideHTR2 .LT. rTinyValue)) THEN
CALL ShowSevereError('Input problem for water to air heat pump, "'//TRIM(WatertoAirHP(HPNum)%Name)//'".')
CALL ShowContinueError(' A source side heat transfer resistance value is less than tolerance, likely zero or blank.')
CALL ShowContinueError(' Verify inputs, as the parameter syntax for this object went through a change with')
CALL ShowContinueError(' the release of EnergyPlus version 5.')
errFlag = .TRUE.
END IF
END IF
IF (errFlag) THEN
CALL ShowFatalError('InitWatertoAirHP: Program terminated for previous conditions.')
ENDIF
MyPlantScanFlag(HPNum) = .FALSE.
ENDIF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .AND. MyEnvrnFlag(HPNum) .AND. .NOT. MyPlantScanFlag(HPNum)) THEN
! Do the initializations to start simulation
! Set water and air inlet nodes
AirInletNode = WatertoAirHP(HPNum)%AirInletNodeNum
WaterInletNode = WatertoAirHP(HPNum)%WaterInletNodeNum
!Initialize all report variables to a known state at beginning of simulation
WatertoAirHP(HPNum)%Power=0.d0
WatertoAirHP(HPNum)%Energy=0.d0
WatertoAirHP(HPNum)%QLoadTotal=0.d0
WatertoAirHP(HPNum)%QSensible=0.d0
WatertoAirHP(HPNum)%QLatent=0.d0
WatertoAirHP(HPNum)%QSource=0.d0
WatertoAirHP(HPNum)%EnergyLoadTotal=0.d0
WatertoAirHP(HPNum)%EnergySensible=0.d0
WatertoAirHP(HPNum)%EnergyLatent=0.d0
WatertoAirHP(HPNum)%EnergySource=0.d0
WatertoAirHP(HPNum)%RunFrac=0.d0
WatertoAirHP(HPNum)%PartLoadRatio=0.d0
WatertoAirHP(HPNum)%OutletAirDBTemp=0.d0
WatertoAirHP(HPNum)%OutletAirHumRat=0.d0
WatertoAirHP(HPNum)%InletAirDBTemp=0.d0
WatertoAirHP(HPNum)%InletAirHumRat=0.d0
WatertoAirHP(HPNum)%OutletWaterTemp=0.d0
WatertoAirHP(HPNum)%InletWaterTemp=0.d0
WatertoAirHP(HPNum)%InletAirMassFlowRate=0.d0
WatertoAirHP(HPNum)%InletWaterMassFlowRate=0.d0
WatertoAirHP(HPNum)%OutletAirEnthalpy = 0.d0
WatertoAirHP(HPNum)%OutletWaterEnthalpy = 0.d0
! The rest of the one time initializations
rho = GetDensityGlycol(PlantLoop(WatertoAirHP(HPNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(WatertoAirHP(HPNum)%LoopNum)%FluidIndex, &
'InitWatertoAirHP')
Cp = GetSpecificHeatGlycol(PlantLoop(WatertoAirHP(HPNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(WatertoAirHP(HPNum)%LoopNum)%FluidIndex, &
'InitWatertoAirHP')
WatertoAirHP(HPNum)%DesignWaterMassFlowRate= rho * WatertoAirHP(HPNum)%DesignWaterVolFlowRate
WatertoAirHP(HPNum)%MaxONOFFCyclesperHour=MaxONOFFCyclesperHour
WatertoAirHP(HPNum)%HPTimeConstant=HPTimeConstant
WatertoAirHP(HPNum)%FanDelayTime=FanDelayTime
PlantOutletNode = PlantLoop(WatertoAirHP(HPNum)%LoopNum)%LoopSide(WatertoAirHP(HPNum)%LoopSide) &
%Branch(WatertoAirHP(HPNum)%BranchNum)%Comp(WatertoAirHP(HPNum)%CompNum)%NodeNumOut
Call InitComponentNodes(0.d0, WatertoAirHP(HPNum)%DesignWaterMassFlowRate, &
WaterInletNode, PlantOutletNode , &
WatertoAirHP(HPNum)%LoopNum, &
WatertoAirHP(HPNum)%LoopSide, &
WatertoAirHP(HPNum)%BranchNum, &
WatertoAirHP(HPNum)%CompNum )
Node(WaterInletNode)%Temp = 5.0d0
Node(WaterInletNode)%Enthalpy = Cp* Node(WaterInletNode)%Temp
Node(WaterInletNode)%Quality = 0.0d0
Node(WaterInletNode)%Press = 0.0d0
Node(WaterInletNode)%HumRat = 0.0d0
Node(PlantOutletNode)%Temp = 5.0d0
Node(PlantOutletNode)%Enthalpy = Cp* Node(WaterInletNode)%Temp
Node(PlantOutletNode)%Quality = 0.0d0
Node(PlantOutletNode)%Press = 0.0d0
Node(PlantOutletNode)%HumRat = 0.0d0
WatertoAirHP(HPNum)%SimFlag = .TRUE.
MyEnvrnFlag(HPNum) = .FALSE.
END IF ! End If for the Begin Environment initializations
IF (.NOT. BeginEnvrnFlag) THEN
MyEnvrnFlag(HPNum)=.TRUE.
ENDIF
! Do the following initializations (every time step): This should be the info from
! the previous components outlets or the node data in this section.
! First set the conditions for the air into the heat pump model
! Set water and air inlet nodes
AirInletNode = WatertoAirHP(HPNum)%AirInletNodeNum
WaterInletNode = WatertoAirHP(HPNum)%WaterInletNodeNum
! ! Set heat pump simulation flag to false if the air loop and water loop conditions have not changed
! IF( .NOT. (BeginEnvrnFlag .and. MyEnvrnFlag) .AND. (&
! WatertoAirHP(HPNum)%InletWaterTemp >= (Node(WaterInletNode)%Temp + TempTOL) .OR. &
! WatertoAirHP(HPNum)%InletWaterTemp <= (Node(WaterInletNode)%Temp - TempTOL) .OR. &
! WatertoAirHP(HPNum)%InletWaterEnthalpy >= (Node(WaterInletNode)%Enthalpy + EnthTOL) .OR. &
! WatertoAirHP(HPNum)%InletWaterEnthalpy <= (Node(WaterInletNode)%Enthalpy - EnthTOL) .OR. &!!
! WatertoAirHP(HPNum)%InletAirDBTemp >= (Node(AirInletNode)%Temp + TempTOL) .OR. &
! WatertoAirHP(HPNum)%InletAirDBTemp <= (Node(AirInletNode)%Temp - TempTOL) .OR. &
! WatertoAirHP(HPNum)%InletAirHumRat >= (Node(AirInletNode)%HumRat + HumRatTOL) .OR. &
! WatertoAirHP(HPNum)%InletAirHumRat <= (Node(AirInletNode)%HumRat - HumRatTOL) .OR. &
! WatertoAirHP(HPNum)%InletAirEnthalpy >= (Node(AirInletNode)%Enthalpy + EnthTOL) .OR. &
! WatertoAirHP(HPNum)%InletAirEnthalpy <= (Node(AirInletNode)%Enthalpy - EnthTOL) .OR. &
! WatertoAirHP(HPNum)%InletAirMassFlowRate > 0.0))THEN
! WatertoAirHP(HPNum)%SimFlag =.TRUE.
! ELSE
! WatertoAirHP(HPNum)%SimFlag =.FALSE.
! ENDIF
IF(((SensLoad .NE. 0.0d0 .OR. LatentLoad .NE. 0.0d0) .OR. (SensLoad .EQ. 0.0d0 .AND. InitFlag)) &
.AND. Node(AirInletNode)%MassFlowRate > 0.0d0 .AND. PartLoadRatio > 0.0d0) THEN
!set the water side flow rate to the design flow rate unless constrained by
!the demand side manager (MIN/MAX available). now done by call to setcomponentFlowRate
WatertoAirHP(HPNum)%InletWaterMassFlowRate = WatertoAirHP(HPNum)%DesignWaterMassFlowRate
WatertoAirHP(HPNum)%InletAirMassFlowRate = DesignAirFlow !This is required instead of the node temperature
!because the air loop operates handles part load for
!cycling equipment by modulating the air flow rate
!the heat pump model requires an accurate (i.e. full load
!flow rate for accurate simulation.
ELSE !heat pump is off
WatertoAirHP(HPNum)%InletWaterMassFlowRate = 0.d0
WatertoAirHP(HPNum)%InletAirMassFlowRate = 0.0d0
ENDIF
!constrain water flow provided by plant
CALL SetComponentFlowRate(WatertoAirHP(HPNum)%InletWaterMassFlowRate, &
WatertoAirHP(HPNum)%WaterInletNodeNum , &
WatertoAirHP(HPNum)%WaterOutletNodeNum, &
WatertoAirHP(HPNum)%LoopNum, &
WatertoAirHP(HPNum)%LoopSide, &
WatertoAirHP(HPNum)%BranchNum, &
WatertoAirHP(HPNum)%CompNum )
WatertoAirHP(HPNum)%InletWaterTemp = Node(WaterInletNode)%Temp
! IF (WatertoAirHP(HPNum)%InletWaterTemp < 0.0) THEN ! Debug trap
! Temptemp = Node(WaterInletNode)%Temp
! ENDIF
WatertoAirHP(HPNum)%InletWaterEnthalpy = Node(WaterInletNode)%Enthalpy
WatertoAirHP(HPNum)%InletAirDBTemp = Node(AirInletNode)%Temp
WatertoAirHP(HPNum)%InletAirHumRat = Node(AirInletNode)%HumRat
WatertoAirHP(HPNum)%InletAirEnthalpy = Node(AirInletNode)%Enthalpy
WatertoAirHP(HPNum)%Power=0.0d0
WatertoAirHP(HPNum)%Energy=0.0d0
WatertoAirHP(HPNum)%QLoadTotal=0.0d0
WatertoAirHP(HPNum)%QSensible=0.0d0
WatertoAirHP(HPNum)%QLatent=0.0d0
WatertoAirHP(HPNum)%QSource=0.0d0
WatertoAirHP(HPNum)%EnergyLoadTotal=0.0d0
WatertoAirHP(HPNum)%EnergySensible=0.0d0
WatertoAirHP(HPNum)%EnergyLatent=0.0d0
WatertoAirHP(HPNum)%EnergySource=0.0d0
WatertoAirHP(HPNum)%RunFrac=0.0d0
WatertoAirHP(HPNum)%OutletAirDBTemp=0.0d0
WatertoAirHP(HPNum)%OutletAirHumRat=0.0d0
WatertoAirHP(HPNum)%OutletWaterTemp=0.0d0
WatertoAirHP(HPNum)%OutletAirEnthalpy = 0.0d0
WatertoAirHP(HPNum)%OutletWaterEnthalpy = 0.0d0
RETURN
END SUBROUTINE InitWatertoAirHP