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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | DXHeatPumpSystemName | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | AirLoopNum | |||
integer, | intent(inout) | :: | CompIndex | |||
integer, | intent(in), | optional | :: | OAUnitNum | ||
real(kind=r64), | intent(in), | optional | :: | OAUCoilOutTemp | ||
real(kind=r64), | intent(inout), | optional | :: | QTotOut |
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 SimDXHeatPumpSystem(DXHeatPumpSystemName, FirstHVACIteration, AirLoopNum,CompIndex,OAUnitNum,OAUCoilOutTemp,QTotOut)
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith (derived from HVACDXSystem.f90 by R.Liesen)
! DATE WRITTEN May 2011
! Feb 2013, Bo Shen, Oak Ridge National Lab
! Add Coil:Heating:DX:VariableSpeed
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine manages DXHeatPumpSystem component simulation.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DXCoils, ONLY: SimDXCoil
USE General, ONLY: TrimSigDigits
USE DataAirLoop, ONLY: AirLoopControlInfo
USE InputProcessor, ONLY: FindItemInList
USE HVACHXAssistedCoolingCoil, ONLY: SimHXAssistedCoolingCoil
USE VariableSpeedCoils, ONLY: SimVariableSpeedCoils
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: DXHeatPumpSystemName ! Name of DXSystem:Airloop object
LOGICAL, INTENT(IN) :: FirstHVACIteration ! True when first HVAC iteration
INTEGER, INTENT(IN) :: AirLoopNum ! Primary air loop number
INTEGER, INTENT(INOUT) :: CompIndex ! Index to CoilSystem:Heating:DX object
INTEGER, INTENT(IN), OPTIONAL:: OAUnitNum ! If the system is an equipment of OutdoorAirUnit
REAL(r64), INTENT(IN), OPTIONAL :: OAUCoilOutTemp ! the coil inlet temperature of OutdoorAirUnit
REAL(r64), INTENT(INOUT), OPTIONAL :: QTotOut ! the total cooling output of unit
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DEFINITIONS:
! na
! FLOW:
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength) :: CompName ! Name of CoilSystem:Heating:DX object
INTEGER :: DXSystemNum ! Index to CoilSystem:Heating:DX object
LOGICAL,SAVE :: GetInputFlag = .True. ! Flag to get input only once
LOGICAL :: HXUnitOn ! Flag to control HX for HXAssisted Cooling Coil
REAL(r64) :: AirMassFlow ! DX System air mass flow rate
INTEGER :: InletNodeNum ! DX System inlet node number
INTEGER :: OutletNodeNum ! DX System outlet node number
!local variables for calling variable speed coil
REAL(r64) :: QZnReq = 0.001d0 ! Zone load (W), input to variable-speed DX coil
REAL(r64) :: QLatReq = 0.0d0 ! Zone latent load, input to variable-speed DX coil
REAL(r64) :: MaxONOFFCyclesperHour = 4.0d0 ! Maximum cycling rate of heat pump [cycles/hr]
REAL(r64) :: HPTimeConstant = 0.0d0 ! Heat pump time constant [s]
REAL(r64) :: FanDelayTime = 0.0d0 ! Fan delay time, time delay for the HP's fan to
REAL(r64) :: OnOffAirFlowRatio = 1.0d0 ! ratio of compressor on flow to average flow over time step
! Obtains and Allocates DX Cooling System related parameters from input file
IF (GetInputFlag) THEN !First time subroutine has been entered
!Get the DXCoolingSystem input
CALL GetDXHeatPumpSystemInput
GetInputFlag=.false.
End If
! Find the correct DXSystemNumber
IF (CompIndex == 0) THEN
DXSystemNum = FindItemInList(DXHeatPumpSystemName,DXHeatPumpSystem%Name,NumDXHeatPumpSystems)
IF (DXSystemNum == 0) THEN
CALL ShowFatalError('SimDXHeatPumpSystem: DXUnit not found='//TRIM(DXHeatPumpSystemName))
ENDIF
CompIndex=DXSystemNum
ELSE
DXSystemNum=CompIndex
IF (DXSystemNum > NumDXHeatPumpSystems .or. DXSystemNum < 1) THEN
CALL ShowFatalError('SimDXHeatPumpSystem: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(DXSystemNum))// &
', Number of DX Units='//TRIM(TrimSigDigits(NumDXHeatPumpSystems))// &
', DX Unit name='//TRIM(DXHeatPumpSystemName))
ENDIF
IF (CheckEquipName(DXSystemNum)) THEN
IF (DXHeatPumpSystemName /= DXHeatPumpSystem(DXSystemNum)%Name) THEN
CALL ShowFatalError('SimDXHeatPumpSystem: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(DXSystemNum))// &
', DX Unit name='//TRIM(DXHeatPumpSystemName)//', stored DX Unit Name for that index='// &
TRIM(DXHeatPumpSystem(DXSystemNum)%Name))
ENDIF
CheckEquipName(DXSystemNum)=.false.
ENDIF
ENDIF
IF (PRESENT(OAUnitNum)) THEN
CALL InitDXHeatPumpSystem(DXSystemNum,AirLoopNum,OAUnitNum=OAUnitNum,OAUCoilOutTemp=OAUCoilOutTemp)
ELSE
CALL InitDXHeatPumpSystem(DXSystemNum,AirLoopNum)
ENDIF
!Call the series of components that simulate a DX Heating System
! Control the DX Heating System
CALL ControlDXHeatingSystem(DXSystemNum, FirstHVACIteration)
! simulate DX Heating System
CompName = DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilName
SELECT CASE(DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilType_Num)
CASE (CoilDX_HeatingEmpirical) ! COIL:DX:COOLINGBYPASSFACTOREMPIRICAL
CALL SimDXCoil(CompName,On,FirstHVACIteration, DXHeatPumpSystem(DXSystemNum)%PartLoadFrac, &
DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilIndex, &
DXHeatPumpSystem(DXSystemNum)%FanOpMode)
CASE (Coil_HeatingAirToAirVariableSpeed) ! Coil:Heating:DX:VariableSpeed
Call SimVariableSpeedCoils(CompName,DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilIndex,&
DXHeatPumpSystem(DXSystemNum)%FanOpMode, MaxONOFFCyclesperHour, &
HPTimeConstant,FanDelayTime,&
On, DXHeatPumpSystem(DXSystemNum)%PartLoadFrac, OnOffAirFlowRatio, &
DXHeatPumpSystem(DXSystemNum)%SpeedNum, DXHeatPumpSystem(DXSystemNum)%SpeedRatio, QZnReq, QLatReq)
CASE DEFAULT
CALL ShowFatalError('SimDXCoolingSystem: Invalid DX Heating System/Coil='// &
TRIM(DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilType))
END SELECT
! set econo lockout flag
! set econo lockout flag
IF (AirLoopNum /=-1) THEN ! IF the sysem is not an equipment of outdoor air unit
IF ( (DXHeatPumpSystem(DXSystemNum)%PartLoadFrac > 0.0d0 ) .AND. &
AirLoopControlInfo(AirLoopNum)%CanLockoutEconoWithCompressor) THEN
AirLoopControlInfo(AirLoopNum)%ReqstEconoLockoutWithCompressor = .TRUE.
ELSE
AirLoopControlInfo(AirLoopNum)%ReqstEconoLockoutWithCompressor = .FALSE.
END IF
END IF
IF(PRESENT(QTotOut))THEN
InletNodeNum = DXHeatPumpSystem(DXSystemNum)%DXHeatPumpCoilInletNodeNum
OutletNodeNum = DXHeatPumpSystem(DXSystemNum)%DXHeatPumpCoilOutletNodeNum
AirMassFlow = Node(OutletNodeNum)%MassFlowRate
QTotOut = AirMassFlow * (Node(InletNodeNum)%Enthalpy - Node(OutletNodeNum)%Enthalpy)
END IF
RETURN
END SUBROUTINE SimDXHeatPumpSystem