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 | |||
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 | |||
integer, | intent(in) | :: | CyclingScheme | |||
real(kind=r64), | intent(in) | :: | OnOffAirFlowRatio | |||
real(kind=r64), | intent(in) | :: | WaterPartLoad | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 InitSimpleWatertoAirHP(HPNum,MaxONOFFCyclesperHour,HPTimeConstant,FanDelayTime,SensLoad,LatentLoad,CyclingScheme, &
OnOffAirFlowRatio,WaterPartLoad,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Arun Shenoy
! DATE WRITTEN Nov 2003
! MODIFIED na
! RE-ENGINEERED Kenneth Tang (Jan 2005)
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Simple Water to Air HP Components.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! USE STATEMENTS:
USE Psychrometrics, ONLY: PsyRhoAirFnPbTdbW
USE DataGlobals, ONLY: SysSizingCalc
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 ! Current HPNum under simulation
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 ! Control zone sensible load[W]
REAL(r64), INTENT(IN) :: LatentLoad ! Control zone latent load[W]
INTEGER, INTENT(IN) :: CyclingScheme ! fan operating mode
REAL(r64), INTENT(IN) :: OnOffAirFlowRatio ! ratio of compressor on flow to average flow over time step
REAL(r64), INTENT(IN) :: WaterPartLoad
LOGICAL, INTENT(IN) :: FirstHVACIteration ! Iteration flag
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: AirInletNode ! Node Number of the air inlet
INTEGER :: WaterInletNode ! Node Number of the Water inlet
LOGICAL, SAVE :: MyOneTimeFlag = .TRUE. ! one time allocation flag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyEnvrnFlag ! used for initializations each begin environment flag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MySizeFlag ! used for sizing PTHP inputs one time
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyPlantScanFlag
REAL(r64) :: rho ! local fluid density
REAL(r64) :: Cp ! local fluid specific heat
LOGICAL :: errFlag
IF (MyOneTimeFlag) THEN
! initialize the environment and sizing flags
ALLOCATE(MySizeFlag(NumWatertoAirHPs))
ALLOCATE(MyEnvrnFlag(NumWatertoAirHPs))
ALLOCATE(MyPlantScanFlag(NumWatertoAirHPs))
MySizeFlag = .TRUE.
MyEnvrnFlag = .TRUE.
MyPlantScanFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF (MyPlantScanFlag(HPNum) .AND. ALLOCATED(PlantLoop)) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject(SimpleWatertoAirHP(HPNum)%Name, &
SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum, &
SimpleWatertoAirHP(HPNum)%LoopNum, &
SimpleWatertoAirHP(HPNum)%LoopSide, &
SimpleWatertoAirHP(HPNum)%BranchNum, &
SimpleWatertoAirHP(HPNum)%CompNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitSimpleWatertoAirHP: Program terminated for previous conditions.')
ENDIF
MyPlantScanFlag(HPNum) = .FALSE.
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(HPNum) .AND. .NOT. MyPlantScanFlag(HPNum) ) THEN
! for each furnace, do the sizing once.
CALL SizeHVACWaterToAir(HPNum)
MySizeFlag(HPNum) = .FALSE.
END IF
IF(FirstHVACIteration)THEN
IF(SimpleHPTimeStepFlag(HPNum))THEN
IF(SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum==TypeOf_CoilWAHPCoolingEquationFit)THEN
IF (SimpleWatertoAirHP(HPNum)%CompanionHeatingCoilNum .GT. 0) THEN
IF(SimpleWatertoAirHP(HPNum)%WaterFlowMode)THEN
SimpleWatertoAirHP(HPNum)%LastOperatingMode = Cooling
SimpleWatertoAirHP(SimpleWatertoAirHP(HPNum)%CompanionHeatingCoilNum)%LastOperatingMode = Cooling
ELSEIF(SimpleWatertoAirHP(SimpleWatertoAirHP(HPNum)%CompanionHeatingCoilNum)%WaterFlowMode)THEN
SimpleWatertoAirHP(HPNum)%LastOperatingMode = Heating
SimpleWatertoAirHP(SimpleWatertoAirHP(HPNum)%CompanionHeatingCoilNum)%LastOperatingMode = Heating
END IF
SimpleHPTimeStepFlag(SimpleWatertoAirHP(HPNum)%CompanionHeatingCoilNum) = .FALSE.
ELSE
IF(SimpleWatertoAirHP(HPNum)%WaterFlowMode)THEN
SimpleWatertoAirHP(HPNum)%LastOperatingMode = Cooling
ENDIF
ENDIF
SimpleHPTimeStepFlag(HPNum) = .FALSE.
ELSE
! it is a heating coil
IF(SimpleWatertoAirHP(HPNum)%CompanionCoolingCoilNum .GT. 0) THEN
IF(SimpleWatertoAirHP(HPNum)%WaterFlowMode)THEN
SimpleWatertoAirHP(HPNum)%LastOperatingMode = Heating
SimpleWatertoAirHP(SimpleWatertoAirHP(HPNum)%CompanionCoolingCoilNum)%LastOperatingMode = Heating
ELSEIF(SimpleWatertoAirHP(SimpleWatertoAirHP(HPNum)%CompanionCoolingCoilNum)%WaterFlowMode)THEN
SimpleWatertoAirHP(HPNum)%LastOperatingMode = Cooling
SimpleWatertoAirHP(SimpleWatertoAirHP(HPNum)%CompanionCoolingCoilNum)%LastOperatingMode = Cooling
END IF
SimpleHPTimeStepFlag(SimpleWatertoAirHP(HPNum)%CompanionCoolingCoilNum) = .FALSE.
ELSE
IF(SimpleWatertoAirHP(HPNum)%WaterFlowMode)THEN
SimpleWatertoAirHP(HPNum)%LastOperatingMode = Heating
ENDIF
ENDIF
SimpleHPTimeStepFlag(HPNum) = .FALSE.
END IF
END IF
ELSE
SimpleHPTimeStepFlag(HPNum) = .TRUE.
IF(SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum==TypeOf_CoilWAHPCoolingEquationFit)THEN
IF(SimpleWatertoAirHP(HPNum)%CompanionHeatingCoilNum .GT. 0) &
SimpleHPTimeStepFlag(SimpleWatertoAirHP(HPNum)%CompanionHeatingCoilNum) = .TRUE.
ELSE
IF(SimpleWatertoAirHP(HPNum)%CompanionCoolingCoilNum .GT. 0) &
SimpleHPTimeStepFlag(SimpleWatertoAirHP(HPNum)%CompanionCoolingCoilNum) = .TRUE.
END IF
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(HPNum) .AND. .NOT. MyPlantScanFlag(HPNum)) THEN
! Do the initializations to start simulation
AirInletNode = SimpleWatertoAirHP(HPNum)%AirInletNodeNum
WaterInletNode = SimpleWatertoAirHP(HPNum)%WaterInletNodeNum
!Initialize all report variables to a known state at beginning of simulation
SimpleWatertoAirHP(HPNum)%AirVolFlowRate=0.0d0
SimpleWatertoAirHP(HPNum)%InletAirDBTemp=0.0d0
SimpleWatertoAirHP(HPNum)%InletAirHumRat=0.0d0
SimpleWatertoAirHP(HPNum)%OutletAirDBTemp=0.0d0
SimpleWatertoAirHP(HPNum)%OutletAirHumRat=0.0d0
SimpleWatertoAirHP(HPNum)%WaterVolFlowRate=0.0d0
SimpleWatertoAirHP(HPNum)%WaterMassFlowRate=0.0d0
SimpleWatertoAirHP(HPNum)%InletWaterTemp=0.0d0
SimpleWatertoAirHP(HPNum)%InletWaterEnthalpy = 0.0d0
SimpleWatertoAirHP(HPNum)%OutletWaterEnthalpy = 0.0d0
SimpleWatertoAirHP(HPNum)%OutletWaterTemp=0.0d0
SimpleWatertoAirHP(HPNum)%Power=0.0d0
SimpleWatertoAirHP(HPNum)%QLoadTotal=0.0d0
SimpleWatertoAirHP(HPNum)%QSensible=0.0d0
SimpleWatertoAirHP(HPNum)%QLatent=0.0d0
SimpleWatertoAirHP(HPNum)%QSource=0.0d0
SimpleWatertoAirHP(HPNum)%Energy=0.0d0
SimpleWatertoAirHP(HPNum)%EnergyLoadTotal=0.0d0
SimpleWatertoAirHP(HPNum)%EnergySensible=0.0d0
SimpleWatertoAirHP(HPNum)%EnergyLatent=0.0d0
SimpleWatertoAirHP(HPNum)%EnergySource=0.0d0
SimpleWatertoAirHP(HPNum)%COP=0.0d0
SimpleWatertoAirHP(HPNum)%RunFrac=0.0d0
SimpleWatertoAirHP(HPNum)%PartLoadRatio=0.0d0
rho = GetDensityGlycol(PlantLoop(SimpleWatertoAirHP(HPNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(SimpleWatertoAirHP(HPNum)%LoopNum)%FluidIndex, &
'InitSimpleWatertoAirHP')
Cp = GetSpecificHeatGlycol(PlantLoop(SimpleWatertoAirHP(HPNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(SimpleWatertoAirHP(HPNum)%LoopNum)%FluidIndex, &
'InitSimpleWatertoAirHP')
SimpleWatertoAirHP(HPNum)%DesignWaterMassFlowRate= &
rho * SimpleWatertoAirHP(HPNum)%RatedWaterVolFlowRate
SimpleWatertoAirHP(HPNum)%MaxONOFFCyclesperHour=MaxONOFFCyclesperHour
SimpleWatertoAirHP(HPNum)%HPTimeConstant=HPTimeConstant
SimpleWatertoAirHP(HPNum)%FanDelayTime=FanDelayTime
CALL InitComponentNodes(0.d0, SimpleWatertoAirHP(HPNum)%DesignWaterMassFlowRate, &
SimpleWatertoAirHP(HPNum)%WaterInletNodeNum, &
SimpleWatertoAirHP(HPNum)%WaterOutletNodeNum , &
SimpleWatertoAirHP(HPNum)%LoopNum, &
SimpleWatertoAirHP(HPNum)%LoopSide, &
SimpleWatertoAirHP(HPNum)%BranchNum, &
SimpleWatertoAirHP(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(SimpleWatertoAirHP(HPNum)%WaterOutletNodeNum)%Temp = 5.0d0
Node(SimpleWatertoAirHP(HPNum)%WaterOutletNodeNum)%Enthalpy = Cp* Node(WaterInletNode)%Temp
Node(SimpleWatertoAirHP(HPNum)%WaterOutletNodeNum)%Quality = 0.0d0
Node(SimpleWatertoAirHP(HPNum)%WaterOutletNodeNum)%Press = 0.0d0
Node(SimpleWatertoAirHP(HPNum)%WaterOutletNodeNum)%HumRat = 0.0d0
SimpleWatertoAirHP(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 = SimpleWatertoAirHP(HPNum)%AirInletNodeNum
WaterInletNode = SimpleWatertoAirHP(HPNum)%WaterInletNodeNum
IF ((SensLoad .NE. 0.0d0 .OR. LatentLoad .NE. 0.0d0).AND.(Node(AirInletNode)%MassFlowRate > 0.0d0)) THEN
! changed the water mass flow rate to be equal to the design times run time fraction in order to account for
! cycling of equipment
SimpleWatertoAirHP(HPNum)%WaterMassFlowRate = SimpleWatertoAirHP(HPNum)%DesignWaterMassFlowRate*WaterPartLoad
! SimpleWatertoAirHP(HPNum)%WaterMassFlowRate = SimpleWatertoAirHP(HPNum)%DesignWaterMassFlowRate
! Model requires the values to be calculated at full design flow rate for air and then scaled to part load ratio.
! So always start the calculations by setting the air flow rate to design flow rate.
! SimpleWatertoAirHP(HPNum)%AirMassFlowRate = Node(AirInletNode)%MassFlowRate
SimpleWatertoAirHP(HPNum)%AirMassFlowRate = SimpleWatertoAirHP(HPNum)%RatedAirVolFlowRate* &
PsyRhoAirFnPbTdbW(StdBaroPress,Node(AirInletNode)%Temp,Node(AirInletNode)%HumRat)
!If air flow is less than 25% rated flow. Then set air flow to the 25% of rated conditions
IF(SimpleWatertoAirHP(HPNum)%AirMassFlowRate.LT. &
0.25d0*SimpleWatertoAirHP(HPNum)%RatedAirVolFlowRate* &
PsyRhoAirFnPbTdbW(StdBaroPress,Node(AirInletNode)%Temp,Node(AirInletNode)%HumRat)) THEN
SimpleWatertoAirHP(HPNum)%AirMassFlowRate = &
0.25d0*SimpleWatertoAirHP(HPNum)%RatedAirVolFlowRate* &
PsyRhoAirFnPbTdbW(StdBaroPress,Node(AirInletNode)%Temp,Node(AirInletNode)%HumRat)
END IF
SimpleWatertoAirHP(HPNum)%WaterFlowMode = .TRUE.
ELSE !heat pump is off
SimpleWatertoAirHP(HPNum)%WaterFlowMode = .FALSE.
SimpleWatertoAirHP(HPNum)%WaterMassFlowRate = 0.d0
SimpleWatertoAirHP(HPNum)%AirMassFlowRate = 0.d0
IF((SimpleWatertoAirHP(HPNum)%WaterCyclingMode)==WaterConstant)THEN
IF(SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum==TypeOf_CoilWAHPCoolingEquationFit)THEN
IF (SimpleWatertoAirHP(HPNum)%CompanionHeatingCoilNum .GT. 0) THEN
IF(SimpleWatertoAirHP(SimpleWatertoAirHP(HPNum)%CompanionHeatingCoilNum)%QLoadTotal .GT. 0.0d0)THEN
! do nothing, there will be flow through this coil
ELSEIF(SimpleWatertoAirHP(HPNum)%LastOperatingMode==Cooling)THEN
! set the flow rate to full design flow
SimpleWatertoAirHP(HPNum)%WaterMassFlowRate = SimpleWatertoAirHP(HPNum)%DesignWaterMassFlowRate
END IF
ELSE
IF(SimpleWatertoAirHP(HPNum)%LastOperatingMode==Cooling)THEN
! set the flow rate to full design flow
SimpleWatertoAirHP(HPNum)%WaterMassFlowRate = SimpleWatertoAirHP(HPNum)%DesignWaterMassFlowRate
END IF
ENDIF
ELSEIF(SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum==TypeOf_CoilWAHPHeatingEquationFit)THEN
! It's a heating coil
IF(SimpleWatertoAirHP(HPNum)%CompanionCoolingCoilNum .GT. 0) THEN
IF(SimpleWatertoAirHP(SimpleWatertoAirHP(HPNum)%CompanionCoolingCoilNum)%QLoadTotal .GT. 0.0d0)THEN
! do nothing, there will be flow through this coil
ELSEIF(SimpleWatertoAirHP(HPNum)%LastOperatingMode==Heating)THEN
! set the flow rate to full design flow
SimpleWatertoAirHP(HPNum)%WaterMassFlowRate = SimpleWatertoAirHP(HPNum)%DesignWaterMassFlowRate
END IF
ELSE
IF(SimpleWatertoAirHP(HPNum)%LastOperatingMode==Heating)THEN
! set the flow rate to full design flow
SimpleWatertoAirHP(HPNum)%WaterMassFlowRate = SimpleWatertoAirHP(HPNum)%DesignWaterMassFlowRate
END IF
ENDIF
END IF
ENDIF
ENDIF
CALL SetComponentFlowRate(SimpleWatertoAirHP(HPNum)%WaterMassFlowRate, &
SimpleWatertoAirHP(HPNum)%WaterInletNodeNum , &
SimpleWatertoAirHP(HPNum)%WaterOutletNodeNum, &
SimpleWatertoAirHP(HPNum)%LoopNum, &
SimpleWatertoAirHP(HPNum)%LoopSide, &
SimpleWatertoAirHP(HPNum)%BranchNum, &
SimpleWatertoAirHP(HPNum)%CompNum )
SimpleWatertoAirHP(HPNum)%InletAirDBTemp = Node(AirInletNode)%Temp
SimpleWatertoAirHP(HPNum)%InletAirHumRat = Node(AirInletNode)%HumRat
SimpleWatertoAirHP(HPNum)%InletAirEnthalpy = Node(AirInletNode)%Enthalpy
SimpleWatertoAirHP(HPNum)%InletWaterTemp = Node(WaterInletNode)%Temp
SimpleWatertoAirHP(HPNum)%InletWaterEnthalpy = Node(WaterInletNode)%Enthalpy
SimpleWatertoAirHP(HPNum)%MaxONOFFCyclesperHour= MaxONOFFCyclesperHour
SimpleWatertoAirHP(HPNum)%HPTimeConstant = HPTimeConstant
SimpleWatertoAirHP(HPNum)%FanDelayTime = FanDelayTime
! Outlet variables
SimpleWatertoAirHP(HPNum)%Power=0.0d0
SimpleWatertoAirHP(HPNum)%QLoadTotal=0.0d0
SimpleWatertoAirHP(HPNum)%QSensible=0.0d0
SimpleWatertoAirHP(HPNum)%QLatent=0.0d0
SimpleWatertoAirHP(HPNum)%QSource=0.0d0
SimpleWatertoAirHP(HPNum)%Energy=0.0d0
SimpleWatertoAirHP(HPNum)%EnergyLoadTotal=0.0d0
SimpleWatertoAirHP(HPNum)%EnergySensible=0.0d0
SimpleWatertoAirHP(HPNum)%EnergyLatent=0.0d0
SimpleWatertoAirHP(HPNum)%EnergySource=0.0d0
SimpleWatertoAirHP(HPNum)%COP=0.0d0
SimpleWatertoAirHP(HPNum)%OutletAirDBTemp=0.0d0
SimpleWatertoAirHP(HPNum)%OutletWaterTemp=0.0d0
SimpleWatertoAirHP(HPNum)%OutletAirHumRat=0.0d0
SimpleWatertoAirHP(HPNum)%OutletAirEnthalpy = 0.0d0
SimpleWatertoAirHP(HPNum)%OutletWaterEnthalpy = 0.0d0
RETURN
END SUBROUTINE InitSimpleWatertoAirHP