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) | :: | PIUNum | |||
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 InitPIU(PIUNum,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN August 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the powered induction unit
! terminal boxe.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList
USE DataDefineEquip, ONLY: AirDistUnit
USE DataPlant, ONLY: PlantLoop, ScanPlantLoopsForObject, TypeOf_CoilWaterSimpleHeating, &
TypeOf_CoilSteamAirHeating
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) :: PIUNum ! number of the current fan coil unit being simulated
LOGICAL, INTENT (IN) :: FirstHVACIteration ! TRUE if first zone equip 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 :: HotConNode ! hot water control node number in PIU
INTEGER :: OutletNode ! unit air outlet node number
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 plant fluid density
LOGICAL :: errFlag
! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumPIUs))
ALLOCATE(MySizeFlag(NumPIUs))
ALLOCATE(MyPlantScanFlag(NumPIUs))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
MyPlantScanFlag = .TRUE.
MyOneTimeFlag = .false.
END IF
IF (MyPlantScanFlag(PIUNum) .AND. ALLOCATED(PlantLoop)) THEN
IF ((PIU(PIUNum)%HCoil_PlantTypeNum == TypeOf_CoilWaterSimpleHeating) .OR. &
(PIU(PIUNum)%HCoil_PlantTypeNum == TypeOf_CoilSteamAirHeating) ) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject( PIU(PIUNum)%HCoil, &
PIU(PIUNum)%HCoil_PlantTypeNum, &
PIU(PIUNum)%HWLoopNum, &
PIU(PIUNum)%HWLoopSide, &
PIU(PIUNum)%HWBranchNum, &
PIU(PIUNum)%HWCompNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitPIU: Program terminated due to previous condition(s).')
ENDIF
PIU(PIUNum)%HotCoilOutNodeNum = &
PlantLoop(PIU(PIUNum)%HWLoopNum)%LoopSide(PIU(PIUNum)%HWLoopSide) &
%Branch(PIU(PIUNum)%HWBranchNum)%Comp(PIU(PIUNum)%HWCompNum)%NodeNumOut
ENDIF
MyPlantScanFlag(PIUNum) = .FALSE.
ELSEIF (MyPlantScanFlag(PIUNum) .AND. .NOT. AnyPlantInModel) THEN
MyPlantScanFlag(PIUNum) = .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,NumPIUs
IF (PIU(Loop)%ADUNum == 0) CYCLE
IF (CheckZoneEquipmentList('ZoneHVAC:AirDistributionUnit',AirDistUnit(PIU(Loop)%ADUNum)%Name)) CYCLE
CALL ShowSevereError('InitPIU: ADU=[Air Distribution Unit,'// &
TRIM(AirDistUnit(PIU(Loop)%ADUNum)%Name)// &
'] is not on any ZoneHVAC:EquipmentList.')
CALL ShowContinueError('...PIU=['//TRIM(PIU(Loop)%UnitType)//','//TRIM(PIU(Loop)%Name)// &
'] will not be simulated.')
ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(PIUNum) .AND. .NOT. MyPlantScanFlag(PIUNum)) THEN
CALL SizePIU(PIUNum)
HotConNode = PIU(PIUNum)%HotControlNode
IF (HotConNode.GT.0) THEN
!plant upgrade note? why no separate handling of steam coil? add it ?
rho = GetDensityGlycol( PlantLoop(PIU(PIUNum)%HWLoopNum)%FluidName, &
60.d0, &
PlantLoop(PIU(PIUNum)%HWLoopNum)%FluidIndex, &
'InitPIU')
PIU(PIUNum)%MaxHotWaterFlow = rho * PIU(PIUNum)%MaxVolHotWaterFlow
PIU(PIUNum)%MinHotWaterFlow = rho * PIU(PIUNum)%MinVolHotWaterFlow
CALL InitComponentNodes ( PIU(PIUNum)%MinHotWaterFlow, &
PIU(PIUNum)%MaxHotWaterFlow, &
PIU(PIUNum)%HotControlNode, &
PIU(PIUNum)%HotCoilOutNodeNum, &
PIU(PIUNum)%HWLoopNum, &
PIU(PIUNum)%HWLoopSide, &
PIU(PIUNum)%HWBranchNum, &
PIU(PIUNum)%HWCompNum )
END IF
MySizeFlag(PIUNum) = .FALSE.
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(PIUNum)) THEN
RhoAir = StdRhoAir
PriNode = PIU(PIUNum)%PriAirInNode
SecNode = PIU(PIUNum)%SecAirInNode
OutletNode = PIU(PIUNum)%OutAirNode
! set the mass flow rates from the input volume flow rates
IF (PIU(PIUNum)%UnitType.EQ.'AirTerminal:SingleDuct:SeriesPIU:Reheat') THEN
! series
PIU(PIUNum)%MaxTotAirMassFlow = RhoAir * PIU(PIUNum)%MaxTotAirVolFlow
PIU(PIUNum)%MaxPriAirMassFlow = RhoAir * PIU(PIUNum)%MaxPriAirVolFlow
PIU(PIUNum)%MinPriAirMassFlow = RhoAir * PIU(PIUNum)%MinPriAirFlowFrac * PIU(PIUNum)%MaxPriAirVolFlow
Node(PriNode)%MassFlowRateMax = PIU(PIUNum)%MaxPriAirMassFlow
Node(PriNode)%MassFlowRateMin = PIU(PIUNum)%MinPriAirMassFlow
Node(OutletNode)%MassFlowRateMax = PIU(PIUNum)%MaxTotAirMassFlow
ELSE
! parallel
PIU(PIUNum)%MaxPriAirMassFlow = RhoAir * PIU(PIUNum)%MaxPriAirVolFlow
PIU(PIUNum)%MinPriAirMassFlow = RhoAir * PIU(PIUNum)%MinPriAirFlowFrac * PIU(PIUNum)%MaxPriAirVolFlow
PIU(PIUNum)%MaxSecAirMassFlow = RhoAir * PIU(PIUNum)%MaxSecAirVolFlow
PIU(PIUNum)%FanOnAirMassFlow = RhoAir * PIU(PIUNum)%FanOnFlowFrac * PIU(PIUNum)%MaxPriAirVolFlow
Node(PriNode)%MassFlowRateMax = PIU(PIUNum)%MaxPriAirMassFlow
Node(PriNode)%MassFlowRateMin = PIU(PIUNum)%MinPriAirMassFlow
Node(OutletNode)%MassFlowRateMax = PIU(PIUNum)%MaxPriAirMassFlow
END IF
IF ( ((PIU(PIUNum)%HCoilType_Num == HCoilType_SimpleHeating) .OR. &
(PIU(PIUNum)%HCoilType_Num == HCoilType_SteamAirHeating)) &
.AND. .NOT. MyPlantScanFlag(PIUNum) ) THEN
CALL InitComponentNodes ( PIU(PIUNum)%MinHotWaterFlow, &
PIU(PIUNum)%MaxHotWaterFlow, &
PIU(PIUNum)%HotControlNode, &
PIU(PIUNum)%HotCoilOutNodeNum, &
PIU(PIUNum)%HWLoopNum, &
PIU(PIUNum)%HWLoopSide, &
PIU(PIUNum)%HWBranchNum, &
PIU(PIUNum)%HWCompNum )
ENDIF
MyEnvrnFlag(PIUNum) = .FALSE.
END IF ! end one time inits
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(PIUNum) = .true.
ENDIF
PriNode = PIU(PIUNum)%PriAirInNode
SecNode = PIU(PIUNum)%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(PIU(PIUNum)%SchedPtr) .GT. 0.0d0 .AND. &
Node(PriNode)%MassFlowRate .GT. 0.0d0) THEN
IF (PIU(PIUNum)%UnitType.EQ.'AirTerminal:SingleDuct:SeriesPIU:Reheat') THEN
Node(PriNode)%MassFlowRate = PIU(PIUNum)%MaxPriAirMassFlow
Node(SecNode)%MassFlowRate = MAX( 0.0d0, PIU(PIUNum)%MaxTotAirMassFlow - PIU(PIUNum)%MaxPriAirMassFlow )
ELSE
Node(PriNode)%MassFlowRate = PIU(PIUNum)%MaxPriAirMassFlow
Node(SecNode)%MassFlowRate = PIU(PIUNum)%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(PIU(PIUNum)%SchedPtr) .GT. 0.0d0 .AND. &
Node(PriNode)%MassFlowRateMaxAvail .GT. 0.0d0) THEN
IF (PIU(PIUNum)%UnitType.EQ.'AirTerminal:SingleDuct:SeriesPIU:Reheat') THEN
Node(PriNode)%MassFlowRateMaxAvail = PIU(PIUNum)%MaxPriAirMassFlow
Node(PriNode)%MassFlowRateMinAvail = PIU(PIUNum)%MinPriAirMassFlow
Node(SecNode)%MassFlowRateMaxAvail = MAX( 0.0d0, PIU(PIUNum)%MaxTotAirMassFlow - PIU(PIUNum)%MinPriAirMassFlow )
Node(SecNode)%MassFlowRateMinAvail = MAX( 0.0d0, PIU(PIUNum)%MaxTotAirMassFlow - PIU(PIUNum)%MaxPriAirMassFlow )
ELSE
Node(PriNode)%MassFlowRateMaxAvail = PIU(PIUNum)%MaxPriAirMassFlow
Node(PriNode)%MassFlowRateMinAvail = PIU(PIUNum)%MinPriAirMassFlow
Node(SecNode)%MassFlowRateMaxAvail = PIU(PIUNum)%MaxSecAirMassFlow
Node(SecNode)%MassFlowRateMinAvail = 0.0d0
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
! Do the following initializations every time step
! None needed
RETURN
END SUBROUTINE InitPIU