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) | :: | SysNum | |||
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 InitSys(SysNum,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN January 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Sys Components.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger events.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataAirflowNetwork, ONLY: SimulateAirflowNetwork,AirflowNetworkFanActivated,AirflowNetworkControlMultizone
USE DataDefineEquip, ONLY: AirDistUnit
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList,ZoneEquipConfig
USE InputProcessor, ONLY: SameString
USE DataPlant, ONLY: PlantLoop, ScanPlantLoopsForObject, TypeOf_CoilWaterSimpleHeating, &
TypeOf_CoilSteamAirHeating
USE PlantUtilities, ONLY: InitComponentNodes
USE DataGlobals, ONLY: AnyPlantInModel
USE HeatingCoils, ONLY: GetHeatingCoilCapacity=>GetCoilCapacity
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT (IN):: FirstHVACIteration
INTEGER, INTENT(IN) :: SysNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InletNode
INTEGER :: OutletNode
INTEGER :: ADUNum
INTEGER :: SysIndex
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL,SAVE :: ZoneEquipmentListChecked = .false. ! True after the Zone Equipment List has been checked for items
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MySizeFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: GetGasElecHeatCoilCap ! Gets autosized value of coil capacity
REAL(r64) :: SteamTemp
REAL(r64) :: SteamDensity
REAL(r64) :: rho
LOGICAL :: errFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: PlantLoopScanFlag
! FLOW:
! Do the Begin Simulation initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumSys))
ALLOCATE(MySizeFlag(NumSys))
ALLOCATE(PlantLoopScanFlag(NumSys))
ALLOCATE(GetGasElecHeatCoilCap(NumSys))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
PlantLoopScanFlag = .TRUE.
GetGasElecHeatCoilCap = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF (PlantLoopScanFlag(SysNum) .and. ALLOCATED(PlantLoop)) THEN
IF( (Sys(SysNum)%ReheatComp_PlantType == TypeOf_CoilWaterSimpleHeating) &
.OR. (Sys(SysNum)%ReheatComp_PlantType == TypeOf_CoilSteamAirHeating) ) THEN
! setup plant topology indices for plant fed heating coils
errFlag=.false.
CALL ScanPlantLoopsForObject(Sys(SysNum)%ReheatName, &
Sys(SysNum)%ReheatComp_PlantType, &
Sys(SysNum)%HWLoopNum, &
Sys(SysNum)%HWLoopSide, &
Sys(SysNum)%HWBranchIndex, &
Sys(SysNum)%HWCompIndex, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowContinueError('Reference Unit="'//trim(Sys(SysNum)%SysName)//'", type='//trim(Sys(SysNum)%SysType))
CALL ShowFatalError('InitSys: Program terminated for previous conditions.')
ENDIF
Sys(SysNum)%ReheatCoilOutletNode = &
PlantLoop(Sys(SysNum)%HWLoopNum)%LoopSide(Sys(SysNum)%HWLoopSide) &
%Branch(Sys(SysNum)%HWBranchIndex)%Comp(Sys(SysNum)%HWCompIndex)%NodeNumOut
PlantLoopScanFlag(SysNum) = .FALSE.
ELSE
PlantLoopScanFlag(SysNum) = .FALSE.
ENDIF
ELSEIF (PlantLoopScanFlag(SysNum) .AND. .NOT. AnyPlantInModel) THEN
PlantLoopScanFlag(SysNum) = .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 SysIndex=1,NumSys
IF (Sys(SysIndex)%ADUNum == 0) CYCLE
IF (CheckZoneEquipmentList('ZoneHVAC:AirDistributionUnit',AirDistUnit(Sys(SysIndex)%ADUNum)%Name)) CYCLE
CALL ShowSevereError('InitSingleDuctSystems: ADU=[Air Distribution Unit,'// &
TRIM(AirDistUnit(Sys(SysIndex)%ADUNum)%Name)// &
'] is not on any ZoneHVAC:EquipmentList.')
CALL ShowContinueError('...System=['//TRIM(Sys(SysIndex)%SysType)//','//TRIM(Sys(SysIndex)%SysName)// &
'] will not be simulated.')
ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(SysNum) ) THEN
CALL SizeSys(SysNum)
MySizeFlag(SysNum) = .FALSE.
END IF
IF(GetGasElecHeatCoilCap(SysNum))THEN
IF(Sys(SysNum)%ReheatComp_Num .EQ. HCoilType_Electric .OR. Sys(SysNum)%ReheatComp_Num .EQ. HCoilType_Gas)THEN
IF(Sys(SysNum)%ReheatCoilMaxCapacity == AutoSize)THEN
errFlag = .FALSE.
Sys(SysNum)%ReheatCoilMaxCapacity = &
GetHeatingCoilCapacity(Sys(SysNum)%ReheatComp,Sys(SysNum)%ReheatName,errFlag)
IF(errFlag) CALL ShowContinueError('Occurs for terminal unit '// &
TRIM(Sys(SysNum)%SysType)//' = '//TRIM(Sys(SysNum)%SysName))
END IF
IF(Sys(SysNum)%ReheatCoilMaxCapacity /= Autosize)THEN
GetGasElecHeatCoilCap(SysNum) = .FALSE.
END IF
ELSE
GetGasElecHeatCoilCap(SysNum) = .FALSE.
END IF
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(SysNum)) THEN
! Set the outlet node max mass flow rate to the Max Air Flow specified for the Sys
OutletNode = Sys(SysNum)%OutletNodeNum
InletNode = Sys(SysNum)%InletNodeNum
Node(OutletNode)%MassFlowRateMax = Sys(SysNum)%MaxAirVolFlowRate * StdRhoAir
Sys(SysNum)%AirMassFlowRateMax = Sys(SysNum)%MaxAirVolFlowRate * StdRhoAir
Sys(SysNum)%HeatAirMassFlowRateMax = Sys(SysNum)%MaxHeatAirVolFlowRate * StdRhoAir
Node(InletNode)%MassFlowRateMax = Sys(SysNum)%MaxAirVolFlowRate * StdRhoAir
MassFlowDiff(SysNum) = 1.0d-10 * Sys(SysNum)%AirMassFlowRateMax
IF (Sys(SysNum)%HWLoopNum > 0 .AND. &
Sys(SysNum)%ReheatComp_Num .NE. HCoilType_SteamAirHeating ) THEN !protect early calls before plant is setup
rho = GetDensityGlycol(PlantLoop(Sys(SysNum)%HWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(Sys(SysNum)%HWLoopNum)%FluidIndex,&
'InitSys' )
ELSE
rho = 1000.d0
ENDIF
Sys(SysNum)%MaxReheatWaterFlow = rho * Sys(SysNum)%MaxReheatWaterVolFlow
Sys(SysNum)%MinReheatWaterFlow = rho * Sys(SysNum)%MinReheatWaterVolFlow
Sys(SysNum)%AirMassFlowDuringReheatMax = Sys(SysNum)%MaxAirVolFlowRateDuringReheat * StdRhoAir
! set the upstream leakage flowrate
ADUNum = Sys(SysNum)%ADUNum
IF (AirDistUnit(ADUNum)%UpStreamLeak) THEN
AirDistUnit(ADUNum)%MassFlowRateUpStrLk = Sys(SysNum)%AirMassFlowRateMax * AirDistUnit(ADUNum)%UpStreamLeakFrac
ELSE
AirDistUnit(ADUNum)%MassFlowRateUpStrLk = 0.0D0
END IF
IF (Sys(SysNum)%ReheatComp_Num .EQ. HCoilType_SteamAirHeating)THEN
SteamTemp=100.d0
SteamDensity=GetSatDensityRefrig('STEAM',SteamTemp,1.0d0,Sys(SysNum)%FluidIndex,'InitHVACSingleDuct')
Sys(SysNum)%MaxReheatSteamFlow = SteamDensity * Sys(SysNum)%MaxReheatSteamVolFlow
Sys(SysNum)%MinReheatSteamFlow = SteamDensity * Sys(SysNum)%MinReheatSteamVolFlow
EndIf
IF (SameString(Sys(SysNum)%SysType,'AirTerminal:SingleDuct:VAV:Reheat') .or. &
SameString(Sys(SysNum)%SysType,'AirTerminal:SingleDuct:VAV:HeatAndCool:Reheat') .or. &
SameString(Sys(SysNum)%SysType,'AirTerminal:SingleDuct:VAV:HeatAndCool:NoReheat') .or. &
SameString(Sys(SysNum)%SysType,'AirTerminal:SingleDuct:VAV:NoReheat')) THEN
! need the lowest schedule value
If (Sys(SysNum)%ZoneMinAirFracMethod == ScheduledMinFrac) Then
Sys(SysNum)%ZoneMinAirFrac = GetScheduleMinValue(Sys(SysNum)%ZoneMinAirFracSchPtr)
ENDIF
Node(OutletNode)%MassFlowRateMin = Node(OutletNode)%MassFlowRateMax * &
Sys(SysNum)%ZoneMinAirFrac
Node(InletNode)%MassFlowRateMin = Node(InletNode)%MassFlowRateMax * &
Sys(SysNum)%ZoneMinAirFrac
ELSE
Node(OutletNode)%MassFlowRateMin = 0.0D0
Node(InletNode)%MassFlowRateMin = 0.0D0
END IF
IF ((Sys(SysNum)%ReheatControlNode .gt. 0) .AND. .NOT. PlantLoopScanFlag(SysNum)) THEN
IF (Sys(SysNum)%ReheatComp_Num .EQ. HCoilType_SteamAirHeating)THEN
CALL InitComponentNodes( Sys(SysNum)%MinReheatSteamFlow, &
Sys(SysNum)%MaxReheatSteamFlow, &
Sys(SysNum)%ReheatControlNode, &
Sys(SysNum)%ReheatCoilOutletNode, &
Sys(SysNum)%HWLoopNum, &
Sys(SysNum)%HWLoopSide, &
Sys(SysNum)%HWBranchIndex, &
Sys(SysNum)%HWCompIndex)
ELSE
CALL InitComponentNodes( Sys(SysNum)%MinReheatWaterFlow, &
Sys(SysNum)%MaxReheatWaterFlow, &
Sys(SysNum)%ReheatControlNode, &
Sys(SysNum)%ReheatCoilOutletNode, &
Sys(SysNum)%HWLoopNum, &
Sys(SysNum)%HWLoopSide, &
Sys(SysNum)%HWBranchIndex, &
Sys(SysNum)%HWCompIndex)
END IF
END IF
! Find air loop associated with terminal unit
IF (Sys(SysNum)%SysType_Num == SingleDuctVAVReheat .OR. Sys(SysNum)%SysType_Num == SingleDuctVAVNoReheat)THEN
IF (Sys(SysNum)%CtrlZoneNum .GT. 0) THEN
Sys(SysNum)%AirLoopNum = ZoneEquipConfig(Sys(SysNum)%CtrlZoneNum)%AirLoopNum
END IF
END IF
MyEnvrnFlag(SysNum) = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(SysNum) = .TRUE.
ENDIF
! Initialize the Inlet Nodes of the air side of air terminal
InletNode = Sys(SysNum)%InletNodeNum
OutletNode = Sys(SysNum)%OutletNodeNum
If (Sys(SysNum)%ZoneMinAirFracMethod == ScheduledMinFrac) Then
Sys(SysNum)%ZoneMinAirFrac = GetCurrentScheduleValue(Sys(SysNum)%ZoneMinAirFracSchPtr)
!now reset inlet node min avail
Node(InletNode)%MassFlowRateMinAvail = Sys(SysNum)%AirMassFlowRateMax * Sys(SysNum)%ZoneMinAirFrac
ENDIF
IF (FirstHVACIteration) THEN
!The first time through set the mass flow rate to the Max
If((Node(InletNode)%MassFlowRate > 0.0D0) .AND. &
(GetCurrentScheduleValue(Sys(SysNum)%SchedPtr) .gt. 0.0D0)) Then
if (.NOT. (SimulateAirflowNetwork .gt. AirflowNetworkControlMultizone .AND. AirflowNetworkFanActivated)) then
Node(InletNode)%MassFlowRate = Sys(SysNum)%AirMassFlowRateMax
endif
Else
Node(InletNode)%MassFlowRate = 0.0D0
END IF
If((Node(InletNode)%MassFlowRateMaxAvail > 0.0D0) .AND. &
(GetCurrentScheduleValue(Sys(SysNum)%SchedPtr) .gt. 0.0D0)) Then
if (.NOT. (SimulateAirflowNetwork .GT. AirflowNetworkControlMultizone .AND. AirflowNetworkFanActivated)) then
Node(InletNode)%MassFlowRateMaxAvail = Sys(SysNum)%AirMassFlowRateMax
endif
Else
Node(InletNode)%MassFlowRateMaxAvail = 0.0D0
END IF
If((Node(InletNode)%MassFlowRate > 0.0D0) .AND. &
(GetCurrentScheduleValue(Sys(SysNum)%SchedPtr) .gt. 0.0D0)) Then
if (.NOT. (SimulateAirflowNetwork .GT. AirflowNetworkControlMultizone .AND. AirflowNetworkFanActivated)) then
Node(InletNode)%MassFlowRateMinAvail = Sys(SysNum)%AirMassFlowRateMax * Sys(SysNum)%ZoneMinAirFrac
endif
Else
Node(InletNode)%MassFlowRateMinAvail = 0.0D0
END IF
! reset the mass flow rate histories
MassFlow1(SysNum) = 0.0D0
MassFlow2(SysNum) = 0.0D0
MassFlow3(SysNum) = 0.0D0
MassFlow3(SysNum) = 0.0D0
End If
!Do a check and make sure that the max and min available(control) flow is
! between the physical max and min while operating.
SysInlet(SysNum)%AirMassFlowRateMaxAvail = MIN(Sys(SysNum)%AirMassFlowRateMax, &
Node(InletNode)%MassFlowRateMaxAvail)
SysInlet(SysNum)%AirMassFlowRateMinAvail = Min(MAX(Node(OutletNode)%MassFlowRateMin, &
Node(InletNode)%MassFlowRateMinAvail), &
SysInlet(SysNum)%AirMassFlowRateMaxAvail)
! Do the following initializations (every time step): This should be the info from
! the previous components outlets or the node data in this section.
! Load the node data in this section for the component simulation
SysInlet(SysNum)%AirMassFlowRate = Node(InletNode)%MassFlowRate
SysInlet(SysNum)%AirTemp = Node(InletNode)%Temp
SysInlet(SysNum)%AirHumRat = Node(InletNode)%HumRat
SysInlet(SysNum)%AirEnthalpy = Node(InletNode)%Enthalpy
RETURN
END SUBROUTINE InitSys