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) | :: | FanCoilNum | |||
| integer, | intent(in) | :: | ControlledZoneNum | |||
| logical, | intent(in) | :: | FirstHVACIteration | |||
| real(kind=r64), | intent(out) | :: | LoadMet | |||
| real(kind=r64), | intent(inout), | optional | :: | PLR | 
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 Calc4PipeFanCoil(FanCoilNum,ControlledZoneNum,FirstHVACIteration,LoadMet,PLR)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Fred Buhl
          !       DATE WRITTEN   March 2000
          !       MODIFIED       July 2012, Chandan Sharma - FSEC: Added zone sys avail managers
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! Simulate the components making up the 4 pipe fan coil unit.
          ! METHODOLOGY EMPLOYED:
          ! Simulates the unit components sequentially in the air flow direction.
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
USE MixedAir,            ONLY: SimOAMixer
USE SingleDuct,          ONLY: SimATMixer
USE Fans,                ONLY: SimulateFanComponents
USE WaterCoils,          ONLY: SimulateWaterCoilComponents
USE HVACHXAssistedCoolingCoil, ONLY: SimHXAssistedCoolingCoil
USE Psychrometrics,      ONLY: PsyHFnTdbW
USE DataHVACGlobals,     ONLY: ZoneCompTurnFansOn, ZoneCompTurnFansOff
USE DataZoneEquipment,   ONLY: ZoneEquipConfig
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT (IN)  :: FanCoilNum         ! Unit index in fan coil array
  INTEGER, INTENT (IN)  :: ControlledZoneNum  ! ZoneEquipConfig index
  LOGICAL, INTENT (IN)  :: FirstHVACIteration ! flag for 1st HVAV iteration in the time step
  REAL(r64), INTENT (OUT) :: LoadMet          ! load met by unit (watts)
  REAL(r64), INTENT (INOUT), OPTIONAL :: PLR  ! Part Load Ratio, fraction of time step fancoil is on
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: OutletNode       ! unit air outlet node
INTEGER :: InletNode        ! unit air inlet node
INTEGER :: ATMixOutNode = 0 ! outlet node of ATM Mixer
INTEGER :: ZoneNode = 0     ! zone node
REAL(r64)    :: AirMassFlow      ! total mass flow through the unit
REAL (r64)   :: PartLoad         ! if PLR present PartLoad = PLR
REAL (r64)   :: OASchedValue     ! value of OASchedValue, =1 if not schedule
          ! FLOW
! if PLR present in arguments, get its value, else default PLR = 1
IF (PRESENT(PLR)) THEN
  PartLoad = PLR
ELSE
  PartLoad = 1.0d0
END IF
OutletNode = FanCoil(FanCoilNum)%AirOutNode
InletNode = FanCoil(FanCoilNum)%AirInNode
ZoneNode = ZoneEquipConfig(ControlledZoneNum)%ZoneNode
! Assume the unit is able to vary the flow. A cycling unit is treated as
! if it were variable flow, with the flow being the averaqe flow over the time step
IF (GetCurrentScheduleValue(FanCoil(FanCoilNum)%SchedPtr) .gt. 0.0d0)   &
     Node(InletNode)%MassFlowRate = PartLoad * Node(InletNode)%MassFlowRateMax
! use the value of the outside air schedule if present
IF (FanCoil(FanCoilNum)%SchedOutAirPtr > 0) THEN
  OASchedValue = GetCurrentScheduleValue(FanCoil(FanCoilNum)%SchedOutAirPtr)
ELSE
  OASchedValue = 1.0D0
END IF
IF (FanCoil(FanCoilNum)%ATMixerExists) THEN
  ATMixOutNode = FanCoil(FanCoilNum)%ATMixerOutNode
  IF (FanCoil(FanCoilNum)%ATMixerType == ATMixer_InletSide) THEN
    ! set the primary air inlet mass flow rate
    Node(FanCoil(FanCoilNum)%ATMixerPriNode)%MassFlowRate = MIN(Node(FanCoil(FanCoilNum)%ATMixerPriNode)%MassFlowRateMaxAvail, &
                                                              Node(InletNode)%MassFlowRate)
    ! now calculate the the mixer outlet conditions (and the secondary air inlet flow rate)
    ! the mixer outlet flow rate has already been set above (it is the "inlet" node flow rate)
    CALL SimATMixer(FanCoil(FanCoilNum)%ATMixerName,FirstHVACIteration,FanCoil(FanCoilNum)%ATMixerIndex)
  END IF
  AirMassFlow = Node(InletNode)%MassFlowRate
ELSE
  ! OutdoorAir:Mixer
  IF (FanCoil(FanCoilNum)%CapCtrlMeth_Num .eq. CCM_CycFan) THEN
    Node(FanCoil(FanCoilNum)%OutsideAirNode)%MassFlowRate =   &
        MIN(OASchedValue * Node(FanCoil(FanCoilNum)%OutsideAirNode)%MassFlowRateMax * &
        PartLoad * FanCoil(FanCoilNum)%SpeedFanRatSel,Node(InletNode)%MassFlowRate)
  ELSE
    Node(FanCoil(FanCoilNum)%OutsideAirNode)%MassFlowRate =   &
        MIN(OASchedValue * Node(FanCoil(FanCoilNum)%OutsideAirNode)%MassFlowRateMax * &
        PartLoad, Node(InletNode)%MassFlowRate)
  END IF
  Node(FanCoil(FanCoilNum)%AirReliefNode)%MassFlowRate = Node(FanCoil(FanCoilNum)%OutsideAirNode)%MassFlowRate
  AirMassFlow = Node(InletNode)%MassFlowRate
  CALL SimOAMixer(FanCoil(FanCoilNum)%OAMixName,FirstHVACIteration,FanCoil(FanCoilNum)%OAMixIndex)
END IF
IF(FanCoil(FanCoilNum)%CapCtrlMeth_Num .eq. CCM_CycFan)THEN
  ! cycling fan coil unit calculation
  IF (FanCoil(FanCoilNum)%SpeedFanSel .eq. 1)THEN
    CALL SimulateFanComponents(FanCoil(FanCoilNum)%FanName,FirstHVACIteration,  &
         FanCoil(FanCoilNum)%FanIndex,FanCoil(FanCoilNum)%LowSpeedRatio, &
         ZoneCompTurnFansOn, ZoneCompTurnFansOff)
  ELSE IF (FanCoil(FanCoilNum)%SpeedFanSel .eq. 2)THEN
    CALL SimulateFanComponents(FanCoil(FanCoilNum)%FanName,FirstHVACIteration,  &
         FanCoil(FanCoilNum)%FanIndex,FanCoil(FanCoilNum)%MedSpeedRatio, &
         ZoneCompTurnFansOn, ZoneCompTurnFansOff)
  ELSE
    CALL SimulateFanComponents(FanCoil(FanCoilNum)%FanName,FirstHVACIteration,  &
         FanCoil(FanCoilNum)%FanIndex, 1.0d0, ZoneCompTurnFansOn, ZoneCompTurnFansOff)
  END IF
  IF(FanCoil(FanCoilNum)%CCoilType_Num == CCoil_HXAssist) THEN
    CALL SimHXAssistedCoolingCoil(FanCoil(FanCoilNum)%CCoilName,FirstHVACIteration,On,  &
                                  0.0d0,FanCoil(FanCoilNum)%CCoilName_Index,ContFanCycCoil)
  ELSE
    CALL SimulateWaterCoilComponents(FanCoil(FanCoilNum)%CCoilName,FirstHVACIteration,&
                                     FanCoil(FanCoilNum)%CCoilName_Index,FanOpMode = 1,PartLoadRatio = PLR)
  END IF
  CALL SimulateWaterCoilComponents(FanCoil(FanCoilNum)%HCoilName,FirstHVACIteration,&
                                   FanCoil(FanCoilNum)%HCoilName_Index,FanOpMode = 1,PartLoadRatio = PLR)
ELSE
  ! Constant fan and variable flow calculation AND variable fan
  CALL SimulateFanComponents(FanCoil(FanCoilNum)%FanName,FirstHVACIteration,FanCoil(FanCoilNum)%FanIndex, &
                               ZoneCompTurnFansOn = ZoneCompTurnFansOn,ZoneCompTurnFansOff = ZoneCompTurnFansOff)
  IF(FanCoil(FanCoilNum)%CCoilType_Num == CCoil_HXAssist) THEN
    CALL SimHXAssistedCoolingCoil(FanCoil(FanCoilNum)%CCoilName,FirstHVACIteration,On,  &
                                   0.0d0,FanCoil(FanCoilNum)%CCoilName_Index,ContFanCycCoil)
  ELSE
    CALL SimulateWaterCoilComponents(FanCoil(FanCoilNum)%CCoilName,FirstHVACIteration,FanCoil(FanCoilNum)%CCoilName_Index)
  END IF
  CALL SimulateWaterCoilComponents(FanCoil(FanCoilNum)%HCoilName,FirstHVACIteration,FanCoil(FanCoilNum)%HCoilName_Index)
END IF
IF (FanCoil(FanCoilNum)%ATMixerExists) THEN
  IF (FanCoil(FanCoilNum)%ATMixerType == ATMixer_SupplySide) THEN
    ! Now calculate the ATM mixer if it is on the supply side of the zone unit
    CALL SimATMixer(FanCoil(FanCoilNum)%ATMixerName,FirstHVACIteration,FanCoil(FanCoilNum)%ATMixerIndex)
  END IF
END IF
IF (FanCoil(FanCoilNum)%ATMixerExists) THEN
  IF (FanCoil(FanCoilNum)%ATMixerType == ATMixer_SupplySide) THEN
    LoadMet = Node(ATMixOutNode)%MassFlowRate * (PsyHFnTdbW(Node(ATMixOutNode)%Temp,Node(ZoneNode)%HumRat) &
                                                 - PsyHFnTdbW(Node(ZoneNode)%Temp,Node(ZoneNode)%HumRat))
  ELSE
    ! ATM Mixer on inlet side
    LoadMet = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(ZoneNode)%HumRat)  &
                       - PsyHFnTdbW(Node(ZoneNode)%Temp,Node(ZoneNode)%HumRat))
  END IF
ELSE
  LoadMet = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat)  &
                       - PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
END IF
RETURN
END SUBROUTINE Calc4PipeFanCoil