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) | :: | CompName | |||
integer, | intent(in) | :: | ZoneNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(out) | :: | SysOutputProvided | |||
real(kind=r64), | intent(out) | :: | LatOutputProvided | |||
integer, | intent(inout) | :: | CompIndex |
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 SimulateVRF(CompName, ZoneNum, FirstHVACIteration, SysOutputProvided, LatOutputProvided, CompIndex)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad, FSEC
! DATE WRITTEN August 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine manages VRF terminal unit simulation.
! METHODOLOGY EMPLOYED:
! Simulate all terminal units
! Once all terminal units have been simulated, simulate VRF condenser
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindIteminList
USE General, ONLY: TrimSigDigits
USE DXCoils, ONLY: DXCoilTotalCooling, DXCoilTotalHeating
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT (IN) :: CompName
INTEGER, INTENT (IN) :: ZoneNum
LOGICAL, INTENT (IN) :: FirstHVACIteration
REAL(r64), INTENT (OUT) :: SysOutputProvided
REAL(r64), INTENT (OUT) :: LatOutputProvided
INTEGER, INTENT (INOUT) :: CompIndex
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank = ' '
! INTERFACE BLOCK SPECIFICATIONS
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: VRFTUNum ! current VRF system terminal unit index
INTEGER :: VRFCondenser ! index to VRF AC system object - AirConditioner:VariableRefrigerantFlow
INTEGER :: TUListNum ! index to VRF AC system terminal unit list
INTEGER :: IndexToTUInTUList ! index to pointer in VRF AC system terminal unit list
REAL(r64) :: OnOffAirFlowRatio ! ratio of compressor ON airflow to average airflow over timestep
INTEGER :: DXCoolingCoilIndex ! index to this terminal units DX cooling coil
INTEGER :: DXHeatingCoilIndex ! index to this terminal units DX heating coil
REAL(r64) :: QZnReq
! FLOW:
! Obtains and Allocates VRF system related parameters from input file
IF (GetVRFInputFlag) THEN !First time subroutine has been entered
CALL GetVRFInput
GetVRFInputFlag=.false.
END IF
! CompIndex accounting
IF (CompIndex == 0) THEN
VRFTUNum = FindItemInList(CompName,VRFTU%Name,NumVRFTU)
IF (VRFTUNum == 0) THEN
CALL ShowFatalError('SimulateVRF: VRF Terminal Unit not found='//TRIM(CompName))
ENDIF
CompIndex=VRFTUNum
ELSE
VRFTUNum=CompIndex
IF (VRFTUNum > NumVRFTU .or. VRFTUNum < 1) THEN
CALL ShowFatalError('SimulateVRF: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(VRFTUNum))// &
', Number of VRF Terminal Units = '//TRIM(TrimSigDigits(NumVRFTU))// &
', VRF Terminal Unit name = '//TRIM(CompName))
ENDIF
IF (CheckEquipName(VRFTUNum)) THEN
IF (CompName /= Blank .AND. CompName /= VRFTU(VRFTUNum)%Name) THEN
CALL ShowFatalError('SimulateVRF: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(VRFTUNum))// &
', VRF Terminal Unit name='//TRIM(CompName)//', stored VRF TU Name for that index='// &
TRIM(VRFTU(VRFTUNum)%Name))
ENDIF
CheckEquipName(VRFTUNum)=.FALSE.
ENDIF
ENDIF
! the VRF condenser index
VRFCondenser = VRFTU(VRFTUNum)%VRFSysNum
! the terminal unit list object index
TUListNum = VRFTU(VRFTUNum)%TUListIndex
! the entry number in the terminal unit list (which item in the terminal unit list, e.g. second in list)
IndexToTUInTUList = VRFTU(VRFTUNum)%IndexToTUInTUList
! index to cooling coil (coil is optional but at least one must be present)
DXCoolingCoilIndex = VRFTU(VRFTUNum)%CoolCoilIndex
! index to heating coil (coil is optional but at least one must be present)
DXHeatingCoilIndex = VRFTU(VRFTUNum)%HeatCoilIndex
QZnReq = 0.d0
! Initialize terminal unit
CALL InitVRF(VRFTuNum, ZoneNum, FirstHVACIteration, OnOffAirFlowRatio, QZnReq) ! Initialize all VRFTU related parameters
! Simulate terminal unit
CALL SimVRF(VRFTUNum, FirstHVACIteration, OnOffAirFlowRatio, SysOutputProvided, LatOutputProvided, QZnReq)
! mark this terminal unit as simulated
TerminalUnitList(TUListNum)%IsSimulated(IndexToTUInTUList) = .TRUE.
! keep track of individual coil loads
If(DXCoolingCoilIndex .GT. 0)THEN
TerminalUnitList(TUListNum)%TotalCoolLoad(IndexToTUInTUList) = DXCoilTotalCooling(DXCoolingCoilIndex)
ELSE
TerminalUnitList(TUListNum)%TotalCoolLoad(IndexToTUInTUList) = 0.d0
END IF
IF(DXHeatingCoilIndex .GT. 0)THEN
TerminalUnitList(TUListNum)%TotalHeatLoad(IndexToTUInTUList) = DXCoilTotalHeating(DXHeatingCoilIndex)
ELSE
TerminalUnitList(TUListNum)%TotalHeatLoad(IndexToTUInTUList) = 0.d0
END IF
! Update the current VRF terminal unit to the outlet nodes
! CALL UpdateVRF(VRFTUNum)
! Report the current VRF terminal unit
CALL ReportVRFTerminalunit(VRFTUNum)
! make sure all TU in a list are able to get simulated, otherwise condenser is never simulated **
! either fatal on GetInput, or keep track of unused TU's and set their respective flag to TRUE **
! after all VRF terminal units have been simulated, call the VRF condenser model
IF(ALL(TerminalUnitList(TUListNum)%IsSimulated))THEN
CALL CalcVRFCondenser(VRFCondenser, FirstHVACIteration)
CALL ReportVRFCondenser(VRFCondenser)
IF(VRF(VRFCondenser)%CondenserType == WaterCooled)CALL UpdateVRFCondenser(VRFCondenser)
END IF
RETURN
END SUBROUTINE SimulateVRF