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