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) | :: | IUNum | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 InitIndUnit(IUNum,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN June 21 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initialization of the passive induction
! terminal boxes
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList
USE DataDefineEquip, ONLY: AirDistUnit
USE InputProcessor, ONLY: SameString
USE DataPlant, ONLY: PlantLoop, ScanPlantLoopsForObject, TypeOf_CoilWaterSimpleHeating, &
TypeOf_CoilWaterCooling, TypeOf_CoilWaterDetailedFlatCooling
USE FluidProperties, ONLY: GetDensityGlycol
USE PlantUtilities, ONLY: InitComponentNodes
USE DataGlobals, ONLY: AnyPlantInModel
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: IUNum ! number of the current induction unit being simulated
LOGICAL, INTENT (IN) :: FirstHVACIteration ! TRUE if first air loop solution this HVAC step
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PriNode ! primary air inlet node number
INTEGER :: SecNode ! secondary air inlet node number
INTEGER :: OutletNode ! unit air outlet node
INTEGER :: HotConNode ! hot water control node number
INTEGER :: ColdConNode ! cold water control node number
REAL(r64) :: IndRat ! unit induction ratio
REAL(r64) :: RhoAir ! air density at outside pressure and standard temperature and humidity
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MySizeFlag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyPlantScanFlag
LOGICAL,SAVE :: ZoneEquipmentListChecked = .false. ! True after the Zone Equipment List has been checked for items
Integer :: Loop ! Loop checking control variable
REAL(r64) :: rho ! local fluid density
INTEGER :: HWOutletNode ! local node index for hot water coil's outlet node
INTEGER :: CWOutletNode ! local node index for cold water coil's outlet node
LOGICAL :: errFlag
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumIndUnits))
ALLOCATE(MySizeFlag(NumIndUnits))
ALLOCATE(MyPlantScanFlag(NumIndUnits))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
MyPlantScanFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF (MyPlantScanFlag(IUNum) .AND. ALLOCATED(PlantLoop)) THEN
IF (IndUnit(IUNum)%HCoil_PlantTypeNum == TypeOf_CoilWaterSimpleHeating) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject( IndUnit(IUNum)%HCoil, &
IndUnit(IUNum)%HCoil_PlantTypeNum, &
IndUnit(IUNum)%HWLoopNum, &
IndUnit(IUNum)%HWLoopSide, &
IndUnit(IUNum)%HWBranchNum, &
IndUnit(IUNum)%HWCompNum, &
errFlag=errFlag)
ENDIF
IF (errFlag) THEN
CALL ShowContinueError('Reference Unit="'//trim(IndUnit(IUNum)%Name)//'", type='//trim(IndUnit(IUNum)%UnitType))
ENDIF
IF (IndUnit(IUNum)%CCoil_PlantTypeNum == TypeOf_CoilWaterCooling .OR. &
IndUnit(IUNum)%CCoil_PlantTypeNum == TypeOf_CoilWaterDetailedFlatCooling ) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject( IndUnit(IUNum)%CCoil, &
IndUnit(IUNum)%CCoil_PlantTypeNum, &
IndUnit(IUNum)%CWLoopNum, &
IndUnit(IUNum)%CWLoopSide, &
IndUnit(IUNum)%CWBranchNum, &
IndUnit(IUNum)%CWCompNum, &
errFlag=errFlag)
ENDIF
IF (errFlag) THEN
CALL ShowContinueError('Reference Unit="'//trim(IndUnit(IUNum)%Name)//'", type='//trim(IndUnit(IUNum)%UnitType))
CALL ShowFatalError('InitIndUnit: Program terminated for previous conditions.')
ENDIF
MyPlantScanFlag(IUNum) = .FALSE.
ELSEIF(MyPlantScanFlag(IUNum) .AND. .NOT. AnyPlantInModel ) THEN
MyPlantScanFlag(IUNum) = .FALSE.
ENDIF
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.true.
! Check to see if there is a Air Distribution Unit on the Zone Equipment List
DO Loop=1,NumIndUnits
IF (IndUnit(Loop)%ADUNum == 0) CYCLE
IF (CheckZoneEquipmentList('ZONEHVAC:AIRDISTRIBUTIONUNIT',AirDistUnit(IndUnit(Loop)%ADUNum)%Name)) CYCLE
CALL ShowSevereError('InitIndUnit: ADU=[Air Distribution Unit,'// &
TRIM(AirDistUnit(IndUnit(Loop)%ADUNum)%Name)// &
'] is not on any ZoneHVAC:EquipmentList.')
CALL ShowContinueError('...Unit=['//TRIM(IndUnit(Loop)%UnitType)//','//TRIM(IndUnit(Loop)%Name)// &
'] will not be simulated.')
ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(IUNum) ) THEN
CALL SizeIndUnit(IUNum)
MySizeFlag(IUNum) = .FALSE.
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(IUNum)) THEN
RhoAir = StdRhoAir
PriNode = IndUnit(IUNum)%PriAirInNode
SecNode = IndUnit(IUNum)%SecAirInNode
OutletNode = IndUnit(IUNum)%OutAirNode
IndRat = IndUnit(IUNum)%InducRatio
! set the mass flow rates from the input volume flow rates
IF (SameString(IndUnit(IUNum)%UnitType,'AirTerminal:SingleDuct:ConstantVolume:FourPipeInduction')) THEN
IndUnit(IUNum)%MaxTotAirMassFlow = RhoAir * IndUnit(IUNum)%MaxTotAirVolFlow
IndUnit(IUNum)%MaxPriAirMassFlow = IndUnit(IUNum)%MaxTotAirMassFlow / (1.0d0+IndRat)
IndUnit(IUNum)%MaxSecAirMassFlow = IndRat*IndUnit(IUNum)%MaxTotAirMassFlow / (1.0d0+IndRat)
Node(PriNode)%MassFlowRateMax = IndUnit(IUNum)%MaxPriAirMassFlow
Node(PriNode)%MassFlowRateMin = IndUnit(IUNum)%MaxPriAirMassFlow
Node(SecNode)%MassFlowRateMax = IndUnit(IUNum)%MaxSecAirMassFlow
Node(SecNode)%MassFlowRateMin = IndUnit(IUNum)%MaxSecAirMassFlow
Node(OutletNode)%MassFlowRateMax = IndUnit(IUNum)%MaxTotAirMassFlow
END IF
HotConNode = IndUnit(IUNum)%HWControlNode
IF (HotConNode.GT.0 .AND. .NOT. MyPlantScanFlag(IUNum)) THEN
rho = GetDensityGlycol(PlantLoop(IndUnit(IUNum)%HWLoopNum)%FluidName, &
60.d0, &
PlantLoop(IndUnit(IUNum)%HWLoopNum)%FluidIndex,&
'InitIndUnit' )
IndUnit(IUNum)%MaxHotWaterFlow = rho * IndUnit(IUNum)%MaxVolHotWaterFlow
IndUnit(IUNum)%MinHotWaterFlow = rho * IndUnit(IUNum)%MinVolHotWaterFlow
! get component outlet node from plant structure
HWOutletNode = PlantLoop(IndUnit(IUNum)%HWLoopNum)%LoopSide(IndUnit(IUNum)%HWLoopSide) &
%Branch(IndUnit(IUNum)%HWBranchNum)%Comp(IndUnit(IUNum)%HWCompNum)%NodeNumOut
CALL InitComponentNodes(IndUnit(IUNum)%MinHotWaterFlow, IndUnit(IUNum)%MaxHotWaterFlow, &
HotConNode, HWOutletNode, &
IndUnit(IUNum)%HWLoopNum, &
IndUnit(IUNum)%HWLoopSide, &
IndUnit(IUNum)%HWBranchNum, &
IndUnit(IUNum)%HWCompNum)
END IF
ColdConNode = IndUnit(IUNum)%CWControlNode
IF (ColdConNode.GT.0) THEN
rho = GetDensityGlycol(PlantLoop(IndUnit(IUNum)%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(IndUnit(IUNum)%CWLoopNum)%FluidIndex,&
'InitIndUnit' )
IndUnit(IUNum)%MaxColdWaterFlow = rho * IndUnit(IUNum)%MaxVolColdWaterFlow
IndUnit(IUNum)%MinColdWaterFlow = rho * IndUnit(IUNum)%MinVolColdWaterFlow
CWOutletNode = PlantLoop(IndUnit(IUNum)%CWLoopNum)%LoopSide(IndUnit(IUNum)%CWLoopSide) &
%Branch(IndUnit(IUNum)%CWBranchNum)%Comp(IndUnit(IUNum)%CWCompNum)%NodeNumOut
CALL InitComponentNodes(IndUnit(IUNum)%MinColdWaterFlow, IndUnit(IUNum)%MaxColdWaterFlow, &
ColdConNode, CWOutletNode, &
IndUnit(IUNum)%CWLoopNum, &
IndUnit(IUNum)%CWLoopSide, &
IndUnit(IUNum)%CWBranchNum, &
IndUnit(IUNum)%CWCompNum)
END IF
MyEnvrnFlag(IUNum) = .FALSE.
END IF ! end one time inits
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(IUNum) = .true.
ENDIF
PriNode = IndUnit(IUNum)%PriAirInNode
SecNode = IndUnit(IUNum)%SecAirInNode
! Do the start of HVAC time step initializations
IF (FirstHVACIteration) THEN
! check for upstream zero flow. If nonzero and schedule ON, set primary flow to max
IF (GetCurrentScheduleValue(IndUnit(IUNum)%SchedPtr) .GT. 0.0d0 .AND. &
Node(PriNode)%MassFlowRate .GT. 0.0d0) THEN
IF (SameString(IndUnit(IUNum)%UnitType,'AirTerminal:SingleDuct:ConstantVolume:FourPipeInduction')) THEN
Node(PriNode)%MassFlowRate = IndUnit(IUNum)%MaxPriAirMassFlow
Node(SecNode)%MassFlowRate = IndUnit(IUNum)%MaxSecAirMassFlow
END IF
ELSE
Node(PriNode)%MassFlowRate = 0.0d0
Node(SecNode)%MassFlowRate = 0.0d0
END IF
! reset the max and min avail flows
IF (GetCurrentScheduleValue(IndUnit(IUNum)%SchedPtr) .GT. 0.0d0 .AND. &
Node(PriNode)%MassFlowRateMaxAvail .GT. 0.0d0) THEN
IF (SameString(IndUnit(IUNum)%UnitType,'AirTerminal:SingleDuct:ConstantVolume:FourPipeInduction')) THEN
Node(PriNode)%MassFlowRateMaxAvail = IndUnit(IUNum)%MaxPriAirMassFlow
Node(PriNode)%MassFlowRateMinAvail = IndUnit(IUNum)%MaxPriAirMassFlow
Node(SecNode)%MassFlowRateMaxAvail = IndUnit(IUNum)%MaxSecAirMassFlow
Node(SecNode)%MassFlowRateMinAvail = IndUnit(IUNum)%MaxSecAirMassFlow
END IF
ELSE
Node(PriNode)%MassFlowRateMaxAvail = 0.0d0
Node(PriNode)%MassFlowRateMinAvail = 0.0d0
Node(SecNode)%MassFlowRateMaxAvail = 0.0d0
Node(SecNode)%MassFlowRateMinAvail = 0.0d0
END IF
END IF
RETURN
END SUBROUTINE InitIndUnit