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) | :: | UnitVentNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
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 InitUnitVentilator(UnitVentNum,FirstHVACIteration, ZoneNum)
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN May 2000
! MODIFIED Chandan Sharma, FSEC, March 2011: Added zone sys avail manager
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes all of the data elements which are necessary
! to simulate a unit ventilator.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataEnvironment, ONLY: StdBaroPress, StdRhoAir
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList, UnitVentilator_Num
USE DataHVACGlobals, ONLY: ZoneComp, ZoneCompTurnFansOn, ZoneCompTurnFansOff
USE DataPlant, ONLY : ScanPlantLoopsForObject, PlantLoop,TypeOf_CoilWaterCooling, &
TypeOf_CoilWaterDetailedFlatCooling, TypeOf_CoilWaterSimpleHeating, &
TypeOf_CoilSteamAirHeating
USE FluidProperties, ONLY : GetDensityGlycol
USE PlantUtilities, ONLY : InitComponentNodes
USE DataGlobals, ONLY : AnyPlantInModel
USE DataZoneEnergyDemands
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: UnitVentNum ! index for the current unit ventilator
LOGICAL, INTENT(IN) :: FirstHVACIteration ! TRUE if 1st HVAC simulation of system timestep
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 :: AirRelNode ! relief air node number in unit ventilator loop
INTEGER :: ColdConNode ! cold water control node number in unit ventilator loop
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
INTEGER :: HotConNode ! hot water control node number in unit ventilator loop
INTEGER :: InNode ! inlet node number in unit ventilator loop
INTEGER :: OutNode ! outlet node number in unit ventilator loop
INTEGER :: OutsideAirNode ! outside air node number in unit ventilator loop
REAL(r64) :: RhoAir ! air density at InNode
REAL(r64) :: TempSteamIn
REAL(r64) :: SteamDensity
REAL(r64) :: rho ! local fluid density
LOGICAL :: errFlag
LOGICAL :: SetMassFlowRateToZero ! TRUE when mass flow rates need to be set to zero
SetMassFlowRateToZero = .FALSE.
! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumOfUnitVents))
ALLOCATE(MySizeFlag(NumOfUnitVents))
ALLOCATE(MyPlantScanFlag(NumOfUnitVents))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
MyPlantScanFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF (ALLOCATED(ZoneComp)) THEN
ZoneComp(UnitVentilator_Num)%ZoneCompAvailMgrs(UnitVentNum)%ZoneNum = ZoneNum
UnitVent(UnitVentNum)%AvailStatus = ZoneComp(UnitVentilator_Num)%ZoneCompAvailMgrs(UnitVentNum)%AvailStatus
ENDIF
IF (MyPlantScanFlag(UnitVentNum) .AND. ALLOCATED(PlantLoop)) THEN
IF ((UnitVent(UnitVentNum)%HCoil_PlantTypeNum == TypeOf_CoilWaterSimpleHeating) .OR. &
(UnitVent(UnitVentNum)%HCoil_PlantTypeNum == TypeOf_CoilSteamAirHeating)) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject( UnitVent(UnitVentNum)%HCoilName, &
UnitVent(UnitVentNum)%HCoil_PlantTypeNum, &
UnitVent(UnitVentNum)%HWLoopNum, &
UnitVent(UnitVentNum)%HWLoopSide, &
UnitVent(UnitVentNum)%HWBranchNum, &
UnitVent(UnitVentNum)%HWCompNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowContinueError('Reference Unit="'//trim(UnitVent(UnitVentNum)%Name)//'", type=ZoneHVAC:UnitVentilator')
CALL ShowFatalError('InitUnitVentilator: Program terminated due to previous condition(s).')
ENDIF
UnitVent(UnitVentNum)%HotCoilOutNodeNum = &
PlantLoop(UnitVent(UnitVentNum)%HWLoopNum)%LoopSide(UnitVent(UnitVentNum)%HWLoopSide) &
%Branch(UnitVent(UnitVentNum)%HWBranchNum)%Comp(UnitVent(UnitVentNum)%HWCompNum)%NodeNumOut
ENDIF
IF ((UnitVent(UnitVentNum)%CCoil_PlantTypeNum == TypeOf_CoilWaterCooling) .OR. &
(UnitVent(UnitVentNum)%CCoil_PlantTypeNum == TypeOf_CoilWaterDetailedFlatCooling)) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject( UnitVent(UnitVentNum)%CCoilPlantName, &
UnitVent(UnitVentNum)%CCoil_PlantTypeNum, &
UnitVent(UnitVentNum)%CWLoopNum, &
UnitVent(UnitVentNum)%CWLoopSide, &
UnitVent(UnitVentNum)%CWBranchNum, &
UnitVent(UnitVentNum)%CWCompNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowContinueError('Reference Unit="'//trim(UnitVent(UnitVentNum)%Name)//'", type=ZoneHVAC:UnitVentilator')
CALL ShowFatalError('InitUnitVentilator: Program terminated due to previous condition(s).')
ENDIF
UnitVent(UnitVentNum)%ColdCoilOutNodeNum = &
PlantLoop(UnitVent(UnitVentNum)%CWLoopNum)%LoopSide(UnitVent(UnitVentNum)%CWLoopSide) &
%Branch(UnitVent(UnitVentNum)%CWBranchNum)%Comp(UnitVent(UnitVentNum)%CWCompNum)%NodeNumOut
ELSE
IF (UnitVent(UnitVentNum)%CCoilPresent) &
CALL ShowFatalError('InitUnitVentilator: Unit='//trim(UnitVent(UnitVentNum)%Name)// &
', invalid cooling coil type. Program terminated.')
ENDIF
MyPlantScanFlag(UnitVentNum) = .FALSE.
ELSEIF (MyPlantScanFlag(UnitVentNum) .AND. .NOT. AnyPlantInModel)THEN
MyPlantScanFlag(UnitVentNum) = .FALSE.
ENDIF
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.TRUE.
DO Loop=1,NumOfUnitVents
IF (CheckZoneEquipmentList('ZoneHVAC:UnitVentilator',UnitVent(Loop)%Name)) CYCLE
CALL ShowSevereError('InitUnitVentilator: Unit=[UNIT VENTILATOR,'// &
TRIM(UnitVent(Loop)%Name)// &
'] is not on any ZoneHVAC:EquipmentList. It will not be simulated.')
ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(UnitVentNum) .AND. .NOT. MyPlantScanFlag(UnitVentNum)) THEN
CALL SizeUnitVentilator(UnitVentNum)
MySizeFlag(UnitVentNum) = .FALSE.
END IF
! Do the one time initializations
IF (BeginEnvrnFlag .AND. MyEnvrnFlag(UnitVentNum) .AND. .NOT. MyPlantScanFlag(UnitVentNum)) THEN
InNode = UnitVent(UnitVentNum)%AirInNode
OutNode = UnitVent(UnitVentNum)%AirOutNode
HotConNode = UnitVent(UnitVentNum)%HotControlNode
ColdConNode = UnitVent(UnitVentNum)%ColdControlNode
OutsideAirNode = UnitVent(UnitVentNum)%OutsideAirNode
RhoAir = StdRhoAir
! set the mass flow rates from the input volume flow rates
UnitVent(UnitVentNum)%MaxAirMassFlow = RhoAir*UnitVent(UnitVentNum)%MaxAirVolFlow
UnitVent(UnitVentNum)%OutAirMassFlow = RhoAir*UnitVent(UnitVentNum)%OutAirVolFlow
UnitVent(UnitVentNum)%MinOutAirMassFlow = RhoAir*UnitVent(UnitVentNum)%MinOutAirVolFlow
IF (UnitVent(UnitVentNum)%OutAirMassFlow > UnitVent(UnitVentNum)%MaxAirMassFlow) THEN
UnitVent(UnitVentNum)%OutAirMassFlow = UnitVent(UnitVentNum)%MaxAirMassFlow
UnitVent(UnitVentNum)%MinOutAirMassFlow = UnitVent(UnitVentNum)%OutAirMassFlow * &
(UnitVent(UnitVentNum)%MinOutAirVolFlow / UnitVent(UnitVentNum)%OutAirVolFlow)
CALL ShowWarningError('Outdoor air mass flow rate higher than unit flow rate, reset to unit flow rate for ' &
//TRIM(UnitVent(UnitVentNum)%Name))
END IF
! set the node max and min mass flow rates
Node(OutsideAirNode)%MassFlowRateMax = UnitVent(UnitVentNum)%OutAirMassFlow
Node(OutsideAirNode)%MassFlowRateMin = 0.0d0
Node(OutNode)%MassFlowRateMax = UnitVent(UnitVentNum)%MaxAirMassFlow
Node(OutNode)%MassFlowRateMin = 0.0d0
Node(InNode)%MassFlowRateMax = UnitVent(UnitVentNum)%MaxAirMassFlow
Node(InNode)%MassFlowRateMin = 0.0d0
IF (UnitVent(UnitVentNum)%HCoilPresent) THEN ! Only initialize these if a heating coil is actually present
IF (UnitVent(UnitVentNum)%HCoilType == Heating_WaterCoilType) THEN
rho = GetDensityGlycol( PlantLoop(UnitVent(UnitVentNum)%HWLoopNum)%FluidName, &
60.d0, &
PlantLoop(UnitVent(UnitVentNum)%HWLoopNum)%FluidIndex, &
'InitUnitVentilator')
UnitVent(UnitVentNum)%MaxHotWaterFlow = rho*UnitVent(UnitVentNum)%MaxVolHotWaterFlow
UnitVent(UnitVentNum)%MinHotWaterFlow = rho*UnitVent(UnitVentNum)%MinVolHotWaterFlow
CALL InitComponentNodes ( UnitVent(UnitVentNum)%MinHotWaterFlow, &
UnitVent(UnitVentNum)%MaxHotWaterFlow, &
UnitVent(UnitVentNum)%HotControlNode, &
UnitVent(UnitVentNum)%HotCoilOutNodeNum, &
UnitVent(UnitVentNum)%HWLoopNum, &
UnitVent(UnitVentNum)%HWLoopSide, &
UnitVent(UnitVentNum)%HWBranchNum, &
UnitVent(UnitVentNum)%HWCompNum )
END IF
IF (UnitVent(UnitVentNum)%HCoilType == Heating_SteamCoilType) THEN
TempSteamIn= 100.00d0
SteamDensity=GetSatDensityRefrig('STEAM',TempSteamIn,1.0d0,UnitVent(UnitVentNum)%HCoil_FluidIndex,'InitUnitVentilator')
UnitVent(UnitVentNum)%MaxHotSteamFlow = SteamDensity*UnitVent(UnitVentNum)%MaxVolHotSteamFlow
UnitVent(UnitVentNum)%MinHotSteamFlow = SteamDensity*UnitVent(UnitVentNum)%MinVolHotSteamFlow
CALL InitComponentNodes ( UnitVent(UnitVentNum)%MinHotSteamFlow, &
UnitVent(UnitVentNum)%MaxHotSteamFlow, &
UnitVent(UnitVentNum)%HotControlNode, &
UnitVent(UnitVentNum)%HotCoilOutNodeNum, &
UnitVent(UnitVentNum)%HWLoopNum, &
UnitVent(UnitVentNum)%HWLoopSide, &
UnitVent(UnitVentNum)%HWBranchNum, &
UnitVent(UnitVentNum)%HWCompNum )
END IF
END IF !(UnitVent(UnitVentNum)%HCoilPresent)
IF (UnitVent(UnitVentNum)%CCoilPresent) THEN ! Only initialize these if a cooling coil is actually present
rho = GetDensityGlycol( PlantLoop(UnitVent(UnitVentNum)%CWLoopNum)%FluidName, &
5.d0, &
PlantLoop(UnitVent(UnitVentNum)%CWLoopNum)%FluidIndex, &
'InitUnitVentilator')
UnitVent(UnitVentNum)%MaxColdWaterFlow = rho * UnitVent(UnitVentNum)%MaxVolColdWaterFlow
UnitVent(UnitVentNum)%MinColdWaterFlow = rho * UnitVent(UnitVentNum)%MinVolColdWaterFlow
CALL InitComponentNodes ( UnitVent(UnitVentNum)%MinColdWaterFlow, &
UnitVent(UnitVentNum)%MaxColdWaterFlow, &
UnitVent(UnitVentNum)%ColdControlNode, &
UnitVent(UnitVentNum)%ColdCoilOutNodeNum, &
UnitVent(UnitVentNum)%CWLoopNum, &
UnitVent(UnitVentNum)%CWLoopSide, &
UnitVent(UnitVentNum)%CWBranchNum, &
UnitVent(UnitVentNum)%CWCompNum )
END IF
MyEnvrnFlag(UnitVentNum) = .FALSE.
END IF ! ...end start of environment inits
IF (.NOT. BeginEnvrnFlag) MyEnvrnFlag(UnitVentNum) = .TRUE.
! These initializations are done every iteration...
InNode = UnitVent(UnitVentNum)%AirInNode
OutNode = UnitVent(UnitVentNum)%AirOutNode
OutsideAirNode = UnitVent(UnitVentNum)%OutsideAirNode
AirRelNode = UnitVent(UnitVentNum)%AirReliefNode
IF (GetCurrentScheduleValue(UnitVent(UnitVentNum)%SchedPtr) .GT. 0 ) THEN
IF((GetCurrentScheduleValue(UnitVent(UnitVentNum)%FanAvailSchedPtr) .GT. 0 &
.OR. ZoneCompTurnFansOn) .AND. .NOT. ZoneCompTurnFansOff)THEN
IF ((ABS(ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired) < SmallLoad) .OR. &
(CurDeadBandOrSetback(ZoneNum))) THEN
SetMassFlowRateToZero = .TRUE.
ENDIF
ELSE
SetMassFlowRateToZero = .TRUE.
ENDIF
ELSE
SetMassFlowRateToZero = .TRUE.
ENDIF
IF (SetMassFlowRateToZero) THEN
Node(InNode)%MassFlowRate = 0.0d0
Node(InNode)%MassFlowRateMaxAvail = 0.0d0
Node(InNode)%MassFlowRateMinAvail = 0.0d0
Node(OutNode)%MassFlowRate = 0.0d0
Node(OutNode)%MassFlowRateMaxAvail = 0.0d0
Node(OutNode)%MassFlowRateMinAvail = 0.0d0
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
ELSE
Node(InNode)%MassFlowRate = UnitVent(UnitVentNum)%MaxAirMassFlow
Node(InNode)%MassFlowRateMaxAvail = UnitVent(UnitVentNum)%MaxAirMassFlow
Node(InNode)%MassFlowRateMinAvail = UnitVent(UnitVentNum)%MaxAirMassFlow
Node(OutNode)%MassFlowRate = UnitVent(UnitVentNum)%MaxAirMassFlow
Node(OutNode)%MassFlowRateMaxAvail = UnitVent(UnitVentNum)%MaxAirMassFlow
Node(OutNode)%MassFlowRateMinAvail = UnitVent(UnitVentNum)%MaxAirMassFlow
Node(OutsideAirNode)%MassFlowRate = UnitVent(UnitVentNum)%OutAirMassFlow
Node(OutsideAirNode)%MassFlowRateMaxAvail = UnitVent(UnitVentNum)%OutAirMassFlow
Node(OutsideAirNode)%MassFlowRateMinAvail = UnitVent(UnitVentNum)%OutAirMassFlow
Node(AirRelNode)%MassFlowRate = UnitVent(UnitVentNum)%OutAirMassFlow
Node(AirRelNode)%MassFlowRateMaxAvail = UnitVent(UnitVentNum)%OutAirMassFlow
Node(AirRelNode)%MassFlowRateMinAvail = UnitVent(UnitVentNum)%OutAirMassFlow
ENDIF
! Initialize the relief air (same as inlet conditions to the unit ventilator...
! Note that mass flow rates will be taken care of later.
Node(AirRelNode) = Node(InNode)
OAMassFlowRate = 0.0d0
! Just in case the unit is off and conditions do not get sent through
! the unit for some reason, set the outlet conditions equal to the inlet
! conditions of the unit ventilator
Node(OutNode)%Temp = Node(InNode)%Temp
Node(OutNode)%Press = Node(InNode)%Press
Node(OutNode)%HumRat = Node(InNode)%HumRat
Node(OutNode)%Enthalpy = Node(InNode)%Enthalpy
! These initializations only need to be done once at the start of the iterations...
IF (FirstHVACIteration) THEN
! Initialize the outside air conditions...
Node(OutsideAirNode)%Temp = Node(OutsideAirNode)%OutAirDryBulb
! Node(OutsideAirNode)%HumRat = OutHumRat
! Node(OutsideAirNode)%Press = OutBaroPress
! Node(OutsideAirNode)%Enthalpy = PsyHFnTdbW(OutDryBulbTemp,OutHumRat)
END IF
RETURN
END SUBROUTINE InitUnitVentilator