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) | :: | ZoneNum | 
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 InitFanCoilUnits(FanCoilNum, ZoneNum)
          ! 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:
          ! This subroutine is for initializations of the Fan Coil Components.
          ! METHODOLOGY EMPLOYED:
          ! Uses the status flags to trigger initializations.
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE Psychrometrics,     ONLY: PsyRhoAirFnPbTdbW
  USE DataZoneEquipment,  ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList, FanCoil4Pipe_Num
  USE DataPlant,          ONLY: PlantLoop, ScanPlantLoopsForObject, TypeOf_CoilWaterCooling, &
                                TypeOf_CoilWaterDetailedFlatCooling
  USE FluidProperties,    ONLY: GetDensityGlycol
  USE PlantUtilities,     ONLY: InitComponentNodes
  USE DataHVACGlobals,    ONLY: ZoneComp
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT (IN) :: FanCoilNum ! number of the current fan coil unit being simulated
  INTEGER, INTENT (IN) :: ZoneNum    ! number of zone being served
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER             :: InNode ! inlet node number in fan coil loop
  INTEGER             :: OutNode ! outlet node number in fan coil loop
  INTEGER             :: InletNode ! inlet node number for fan coil FanCoilNum
  INTEGER             :: HotConNode ! hot water control node number in fan coil loop
  INTEGER             :: ColdConNode ! hot water control node number in fan coil loop
  INTEGER             :: OutsideAirNode ! outside air node number in fan coil loop
  INTEGER             :: AirRelNode ! relief air node number in fan coil loop
  REAL(r64)           :: RhoAir ! air density at InNode
  LOGICAL,SAVE        :: MyOneTimeFlag = .true.
  LOGICAL,SAVE        :: ZoneEquipmentListChecked = .false.  ! True after the Zone Equipment List has been checked for items
  Integer             :: Loop
  LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyPlantScanFlag
  REAL(r64)           :: rho
  LOGICAL             :: errFlag
          ! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
  ALLOCATE(MyEnvrnFlag(NumFanCoils))
  ALLOCATE(MySizeFlag(NumFanCoils))
  ALLOCATE(MyPlantScanFlag(NumFanCoils))
  MyEnvrnFlag = .TRUE.
  MySizeFlag = .TRUE.
  MyPlantScanFlag = .TRUE.
  MyOneTimeFlag = .false.
END IF
IF (ALLOCATED(ZoneComp)) THEN
  ZoneComp(FanCoil4Pipe_Num)%ZoneCompAvailMgrs(FanCoilNum)%ZoneNum = ZoneNum
  FanCoil(FanCoilNum)%AvailStatus = ZoneComp(FanCoil4Pipe_Num)%ZoneCompAvailMgrs(FanCoilNum)%AvailStatus
ENDIF
IF (MyPlantScanFlag(FanCoilNum) .AND. ALLOCATED(PlantLoop)) THEN
  errFlag=.false.
  CALL ScanPlantLoopsForObject( FanCoil(FanCoilNum)%HCoilName, &
                                FanCoil(FanCoilNum)%HCoilPlantTypeOfNum, &
                                FanCoil(FanCoilNum)%HWLoopNum,   &
                                FanCoil(FanCoilNum)%HWLoopSide,  &
                                FanCoil(FanCoilNum)%HWBranchNum, &
                                FanCoil(FanCoilNum)%HWCompNum,     &
                                errFlag=errFlag)
  IF (errFlag) THEN
    CALL ShowContinueError('Reference Unit="'//trim(FanCoil(FanCoilNum)%Name)//'", type='//trim(FanCoil(FanCoilNum)%UnitType))
    CALL ShowFatalError('InitFanCoilUnits: Program terminated for previous conditions.')
  ENDIF
  FanCoil(FanCoilNum)%HotPlantOutletNode = &
                      PlantLoop(FanCoil(FanCoilNum)%HWLoopNum)%LoopSide(FanCoil(FanCoilNum)%HWLoopSide) &
                         %Branch(FanCoil(FanCoilNum)%HWBranchNum)%Comp(FanCoil(FanCoilNum)%HWCompNum)%NodeNumOut
  IF ( (FanCoil(FanCoilNum)%CCoilPlantTypeOfNum == TypeOf_CoilWaterCooling) .OR. &
       (FanCoil(FanCoilNum)%CCoilPlantTypeOfNum == TypeOf_CoilWaterDetailedFlatCooling ) ) THEN
    CALL ScanPlantLoopsForObject( FanCoil(FanCoilNum)%CCoilPlantName, &
                                  FanCoil(FanCoilNum)%CCoilPlantTypeOfNum, &
                                  FanCoil(FanCoilNum)%CWLoopNum,   &
                                  FanCoil(FanCoilNum)%CWLoopSide,  &
                                  FanCoil(FanCoilNum)%CWBranchNum, &
                                  FanCoil(FanCoilNum)%CWCompNum,     &
                                  errFlag=errFlag)
    IF (errFlag) THEN
      CALL ShowContinueError('Reference Unit="'//trim(FanCoil(FanCoilNum)%Name)//'", type='//trim(FanCoil(FanCoilNum)%UnitType))
      CALL ShowFatalError('InitFanCoilUnits: Program terminated for previous conditions.')
    ENDIF
    FanCoil(FanCoilNum)%ColdPlantOutletNode = &
                      PlantLoop(FanCoil(FanCoilNum)%CWLoopNum)%LoopSide(FanCoil(FanCoilNum)%CWLoopSide) &
                         %Branch(FanCoil(FanCoilNum)%CWBranchNum)%Comp(FanCoil(FanCoilNum)%CWCompNum)%NodeNumOut
  ELSE
    CALL ShowFatalError('InitFanCoilUnits: FanCoil='//trim(FanCoil(FanCoilNum)%Name)//  &
          ', invalid cooling coil type. Program terminated.')
  ENDIF
  MyPlantScanFlag(FanCoilNum) = .FALSE.
ENDIF
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
  ZoneEquipmentListChecked=.true.
  DO Loop=1,NumFanCoils
    IF (CheckZoneEquipmentList(FanCoil(Loop)%UnitType,FanCoil(Loop)%Name)) CYCLE
    CALL ShowSevereError('InitFanCoil: FanCoil Unit=['//TRIM(FanCoil(Loop)%UnitType)//','//  &
       TRIM(FanCoil(Loop)%Name)//  &
         '] is not on any ZoneHVAC:EquipmentList.  It will not be simulated.')
  ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(FanCoilNum) .AND. .NOT. MyPlantScanFlag(FanCoilNum) ) THEN
  CALL SizeFanCoilUnit(FanCoilNum)
  MySizeFlag(FanCoilNum) = .FALSE.
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .AND. MyEnvrnFlag(FanCoilNum) .AND. .NOT. MyPlantScanFlag(FanCoilNum)) THEN
  InNode = FanCoil(FanCoilNum)%AirInNode
  OutNode = FanCoil(FanCoilNum)%AirOutNode
  OutsideAirNode = FanCoil(FanCoilNum)%OutsideAirNode
  RhoAir = StdRhoAir
  HotConNode = FanCoil(FanCoilNum)%HotControlNode
  ColdConNode = FanCoil(FanCoilNum)%ColdControlNode
  ! set the mass flow rates from the input volume flow rates
  FanCoil(FanCoilNum)%MaxAirMassFlow = RhoAir*FanCoil(FanCoilNum)%MaxAirVolFlow
  FanCoil(FanCoilNum)%OutAirMassFlow = RhoAir*FanCoil(FanCoilNum)%OutAirVolFlow
  rho = GetDensityGlycol(PlantLoop(FanCoil(FanCoilNum)%HWLoopNum)%FluidName, &
                         60.d0, &
                         PlantLoop(FanCoil(FanCoilNum)%HWLoopNum)%FluidIndex, &
                         'InitFanCoilUnits')
  FanCoil(FanCoilNum)%MaxHotWaterFlow = rho * FanCoil(FanCoilNum)%MaxHotWaterVolFlow
  FanCoil(FanCoilNum)%MinHotWaterFlow = rho * FanCoil(FanCoilNum)%MinHotWaterVolFlow
  rho = GetDensityGlycol(PlantLoop(FanCoil(FanCoilNum)%CWLoopNum)%FluidName, &
                         InitConvTemp, &
                         PlantLoop(FanCoil(FanCoilNum)%CWLoopNum)%FluidIndex, &
                         'InitFanCoilUnits')
  FanCoil(FanCoilNum)%MaxColdWaterFlow = rho * FanCoil(FanCoilNum)%MaxColdWaterVolFlow
  FanCoil(FanCoilNum)%MinColdWaterFlow = rho * FanCoil(FanCoilNum)%MinColdWaterVolFlow
  ! set the node max and min mass flow rates
  Call InitComponentNodes(FanCoil(FanCoilNum)%MinHotWaterFlow, &
                          FanCoil(FanCoilNum)%MaxHotWaterFlow, &
                          FanCoil(FanCoilNum)%HotControlNode, &
                          FanCoil(FanCoilNum)%HotPlantOutletNode, &
                          FanCoil(FanCoilNum)%HWLoopNum, &
                          FanCoil(FanCoilNum)%HWLoopSide, &
                          FanCoil(FanCoilNum)%HWBranchNum, &
                          FanCoil(FanCoilNum)%HWCompNum)
  Call InitComponentNodes(FanCoil(FanCoilNum)%MinColdWaterFlow, &
                          FanCoil(FanCoilNum)%MaxColdWaterFlow, &
                          FanCoil(FanCoilNum)%ColdControlNode, &
                          FanCoil(FanCoilNum)%ColdPlantOutletNode, &
                          FanCoil(FanCoilNum)%CWLoopNum, &
                          FanCoil(FanCoilNum)%CWLoopSide, &
                          FanCoil(FanCoilNum)%CWBranchNum, &
                          FanCoil(FanCoilNum)%CWCompNum)
!  Node(HotConNode)%MassFlowRateMax = FanCoil(FanCoilNum)%MaxHotWaterFlow
!  Node(HotConNode)%MassFlowRateMin = FanCoil(FanCoilNum)%MinHotWaterFlow
!  Node(ColdConNode)%MassFlowRateMax = FanCoil(FanCoilNum)%MaxColdWaterFlow
!  Node(ColdConNode)%MassFlowRateMin = FanCoil(FanCoilNum)%MinColdWaterFlow
  IF (FanCoil(FanCoilNum)%OutsideAirNode > 0) THEN
    Node(OutsideAirNode)%MassFlowRateMax = FanCoil(FanCoilNum)%OutAirMassFlow
    Node(OutsideAirNode)%MassFlowRateMin = 0.0d0
  END IF
  Node(OutNode)%MassFlowRateMax = FanCoil(FanCoilNum)%MaxAirMassFlow
  Node(OutNode)%MassFlowRateMin = 0.0d0
  Node(InNode)%MassFlowRateMax = FanCoil(FanCoilNum)%MaxAirMassFlow
  Node(InNode)%MassFlowRateMin = 0.0d0
  MyEnvrnFlag(FanCoilNum) = .FALSE.
END IF ! end one time inits
IF (.not. BeginEnvrnFlag) THEN
  MyEnvrnFlag(FanCoilNum)=.true.
ENDIF
! These initializations are done every iteration
InletNode = FanCoil(FanCoilNum)%AirInNode
OutsideAirNode = FanCoil(FanCoilNum)%OutsideAirNode
AirRelNode = FanCoil(FanCoilNum)%AirReliefNode
! Set the inlet node mass flow rate
IF (GetCurrentScheduleValue(FanCoil(FanCoilNum)%SchedPtr) .gt. 0.0d0) THEN
  Node(InletNode)%MassFlowRate = FanCoil(FanCoilNum)%MaxAirMassFlow
  Node(InletNode)%MassFlowRateMaxAvail = Node(InletNode)%MassFlowRate
  Node(InletNode)%MassFlowRateMinAvail = Node(InletNode)%MassFlowRate
  IF (OutsideAirNode > 0) THEN
    Node(OutsideAirNode)%MassFlowRate = FanCoil(FanCoilNum)%OutAirMassFlow
    Node(OutsideAirNode)%MassFlowRateMaxAvail = FanCoil(FanCoilNum)%OutAirMassFlow
    Node(OutsideAirNode)%MassFlowRateMinAvail = FanCoil(FanCoilNum)%OutAirMassFlow
    Node(AirRelNode)%MassFlowRate = FanCoil(FanCoilNum)%OutAirMassFlow
    Node(AirRelNode)%MassFlowRateMaxAvail = FanCoil(FanCoilNum)%OutAirMassFlow
    Node(AirRelNode)%MassFlowRateMinAvail = FanCoil(FanCoilNum)%OutAirMassFlow
  ENDIF
ELSE
  Node(InletNode)%MassFlowRate = 0.0d0
  Node(InletNode)%MassFlowRateMaxAvail = 0.0d0
  Node(InletNode)%MassFlowRateMinAvail = 0.0d0
  IF (OutsideAirNode > 0) THEN
    Node(OutsideAirNode)%MassFlowRate = 0.0d0
    Node(OutsideAirNode)%MassFlowRateMaxAvail = 0.0d0
    Node(OutsideAirNode)%MassFlowRateMinAvail = 0.0d0
    Node(AirRelNode)%MassFlowRate = 0.0d0
    Node(AirRelNode)%MassFlowRateMaxAvail = 0.0d0
    Node(AirRelNode)%MassFlowRateMinAvail = 0.0d0
  END IF
END IF
RETURN
END SUBROUTINE InitFanCoilUnits