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) | :: | VRFTUNum | |||
| logical, | intent(in) | :: | FirstHVACIteration | |||
| real(kind=r64), | intent(in) | :: | PartLoadRatio | |||
| real(kind=r64), | intent(out) | :: | LoadMet | |||
| real(kind=r64), | intent(inout) | :: | OnOffAirFlowRatio | |||
| real(kind=r64), | intent(inout), | optional | :: | LatOutputProvided | 
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 CalcVRF(VRFTUNum, FirstHVACIteration, PartLoadRatio, LoadMet, OnOffAirFlowRatio, LatOutputProvided)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard Raustad
          !       DATE WRITTEN   July 2005
          !       MODIFIED       July 2012, Chandan Sharma - FSEC: Added zone sys avail managers
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! Simulate the components making up the VRF terminal unit.
          ! METHODOLOGY EMPLOYED:
          ! Simulates the unit components sequentially in the air flow direction.
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE Fans,                      ONLY: SimulateFanComponents
  USE DXCoils,                   ONLY: SimDXCoil
  USE MixedAir,                  ONLY: SimOAMixer
  USE HeatingCoils,              ONLY: SimulateHeatingCoilComponents
  USE SteamCoils,                ONLY: SimulateSteamCoilComponents
  USE WaterCoils,                ONLY: SimulateWaterCoilComponents
  USE InputProcessor,            ONLY: SameString
  USE HVACHXAssistedCoolingCoil, ONLY: SimHXAssistedCoolingCoil
  USE DataEnvironment,           ONLY: OutDryBulbTemp
  USE DataSizing,                ONLY: Autosize
!  USE WatertoAirheatPumpSimple,  ONLY: SimWatertoAirHPSimple
  USE DataAirLoop,               ONLY: LoopDXCoilRTF
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER,   INTENT    (IN) :: VRFTUNum             ! Unit index in VRF terminal unit array
  LOGICAL,   INTENT    (IN) :: FirstHVACIteration   ! flag for 1st HVAC iteration in the time step
  REAL(r64), INTENT    (IN) :: PartLoadRatio        ! compressor part load fraction
  REAL(r64), INTENT   (OUT) :: LoadMet              ! load met by unit (W)
  REAL(r64), INTENT (INOUT) :: OnOffAirFlowRatio    ! ratio of ON air flow to average air flow
  REAL(r64), OPTIONAL, INTENT (INOUT) :: LatOutputProvided ! delivered latent capacity (W)
          ! SUBROUTINE PARAMETER DEFINITIONS:
  INTEGER, PARAMETER          :: MaxIte = 500       ! maximum number of iterations
  CHARACTER(len=*), PARAMETER :: Blank = ' '        ! subroutine argument when coil index is known
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER  :: VRFTUOutletNodeNum ! TU air outlet node
  INTEGER  :: VRFTUInletNodeNum  ! TU air inlet node
  REAL(r64):: AirMassFlow        ! total supply air mass flow [m3/s]
  REAL(r64):: MinHumRat          ! minimum humidity ratio for sensible capacity calculation (kg/kg)
  INTEGER  :: OpMode             ! fan operating mode, CycFanCycCoil or ContFanCycCoil
  INTEGER  :: VRFCond            ! index to VRF condenser
  REAL(r64):: SpecHumOut         ! specific humidity ratio at outlet node
  REAL(r64):: SpecHumIn          ! specific humidity ratio at inlet node
  INTEGER  :: TUListIndex        ! index to TU list for this VRF system
  INTEGER  :: IndexToTUInTUList        ! index to TU in specific list for the VRF system
          ! FLOW
  VRFCond = VRFTU(VRFTUNum)%VRFSysNum
  TUListIndex = VRF(VRFCond)%ZoneTUListPtr
  IndexToTUInTUList = VRFTU(VRFTUNum)%IndexToTUInTUList
  VRFTUOutletNodeNum = VRFTU(VRFTUNum)%VRFTUOutletNodeNum
  VRFTUInletNodeNum = VRFTU(VRFTUNum)%VRFTUInletNodeNum
  OpMode = VRFTU(VRFTUNum)%OpMode
  ! Set inlet air mass flow rate based on PLR and compressor on/off air flow rates
  CALL SetAverageAirFlow(VRFTUNum, PartLoadRatio, OnOffAirFlowRatio)
  AirMassFlow = Node(VRFTUInletNodeNum)%MassFlowRate
  IF(VRFTU(VRFTUNum)%OAMixerUsed)CALL SimOAMixer(VRFTU(VRFTUNum)%OAMixerName,FirstHVACIteration,VRFTU(VRFTUNum)%OAMixerIndex)
  ! if blow through, simulate fan then coils
  IF (VRFTU(VRFTUNum)%FanPlace .EQ. BlowThru) THEN
    CALL SimulateFanComponents(' ',FirstHVACIteration,VRFTU(VRFTUNum)%FanIndex,FanSpeedRatio, &
                                  ZoneCompTurnFansOn, ZoneCompTurnFansOff)
  END IF
  IF(VRFTU(VRFTUNum)%CoolingCoilPresent)THEN
    IF ((.NOT. VRF(VRFCond)%HeatRecoveryUsed .AND. CoolingLoad(VRFCond)) .OR. &
        ! above condition for heat pump mode, below condition for heat recovery mode
        (VRF(VRFCond)%HeatRecoveryUsed .AND. TerminalUnitList(TUListIndex)%HRCoolRequest(IndexToTUInTUList)))THEN
       CALL SimDXCoil(' ',On,FirstHVACIteration,PartLoadRatio,VRFTU(VRFTUNum)%CoolCoilIndex,  &
                    OpMode,OnOffAirFlowRatio, MaxCap=MaxCoolingCapacity(VRFCond), &
                    CompCyclingRatio = VRF(VRFTU(VRFTUNum)%VRFSysNum)%VRFCondCyclingRatio)
    ELSE ! cooling coil is off
       CALL SimDXCoil(' ',Off,FirstHVACIteration,0.0d0,  &
                    VRFTU(VRFTUNum)%CoolCoilIndex,OpMode,OnOffAirFlowRatio)
    END IF
    LoopDXCoolCoilRTF = LoopDXCoilRTF
  ELSE
    LoopDXCoolCoilRTF = 0.d0
  END IF
  IF(VRFTU(VRFTUNum)%HeatingCoilPresent)THEN
    IF ((.NOT. VRF(VRFCond)%HeatRecoveryUsed .AND. HeatingLoad(VRFCond)) .OR. &
        ! above condition for heat pump mode, below condition for heat recovery mode
        (VRF(VRFCond)%HeatRecoveryUsed .AND. TerminalUnitList(TUListIndex)%HRHeatRequest(IndexToTUInTUList)))THEN
       CALL SimDXCoil(' ',Off,FirstHVACIteration,PartLoadRatio,  &
                    VRFTU(VRFTUNum)%HeatCoilIndex,OpMode,OnOffAirFlowRatio, &
                    MaxCap=MaxHeatingCapacity(VRFCond))
    ELSE
       CALL SimDXCoil(' ',Off,FirstHVACIteration,0.0d0,  &
                    VRFTU(VRFTUNum)%HeatCoilIndex,OpMode,OnOffAirFlowRatio)
    END IF
    LoopDXHeatCoilRTF = LoopDXCoilRTF
  ELSE
    LoopDXHeatCoilRTF = 0.d0
  END IF
  ! if draw through, simulate coils then fan
  IF (VRFTU(VRFTUNum)%FanPlace .EQ. DrawThru) THEN
    CALL SimulateFanComponents(' ',FirstHVACIteration,VRFTU(VRFTUNum)%FanIndex,FanSpeedRatio, &
                                  ZoneCompTurnFansOn, ZoneCompTurnFansOff)
  END IF
  ! track fan power per terminal unit for calculating COP
  VRFTU(VRFTUNum)%FanPower = FanElecPower
! calculate sensible load met using delta enthalpy at a constant (minimum) humidity ratio
  MinHumRat = MIN(Node(VRFTUInletNodeNum)%HumRat,Node(VRFTUOutletNodeNum)%HumRat)
  LoadMet   = AirMassFlow * (PsyHFnTdbW(Node(VRFTUOutletNodeNum)%Temp,MinHumRat) - &
                             PsyHFnTdbW(Node(VRFTUInletNodeNum)%Temp,MinHumRat))
  IF(PRESENT(LatOutputProvided))THEN
!   CR9155 Remove specific humidity calculations
    SpecHumOut = Node(VRFTUOutletNodeNum)%HumRat
    SpecHumIn  = Node(VRFTUInletNodeNum)%HumRat
    LatOutputProvided = AirMassFlow * (SpecHumOut - SpecHumIn) ! Latent rate, kg/s (dehumid = negative)
  END IF
RETURN
END SUBROUTINE CalcVRF