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 | ||
---|---|---|---|---|---|---|
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 InitZoneEquipment(FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN Nov 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes the zone equipment prior to simulation.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: NoAction, ZoneComp
USE DataEnvironment, ONLY: OutBaroPress, OutHumRat
USE DataLoopNode, ONLY: Node
USE DataAirLoop, ONLY : AirLoopFlow
USE DataContaminantBalance, ONLY: Contaminant, OutdoorCO2, OutdoorGC
USE DataZoneEnergyDemands , ONLY: ZoneSysEnergyDemand, ZoneSysMoistureDemand
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN) :: FirstHVACIteration !unused 1208
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ZoneNodeNum
INTEGER :: InNodeNum
INTEGER :: ExhNodeNum
INTEGER :: ZoneInNode
INTEGER :: ZoneExhNode
INTEGER :: ControlledZoneNum
INTEGER :: ZoneReturnAirNode
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL,SAVE :: MyEnvrnFlag = .true.
INTEGER :: ZoneEquipType ! Type of zone equipment
INTEGER :: TotalNumComp ! Total number of zone components of ZoneEquipType
INTEGER :: ZoneCompNum ! Number/index of zone equipment component
INTEGER :: ZoneEquipCount !
! Flow
IF (MyOneTimeFlag) THEN
MyOneTimeFlag = .false.
ALLOCATE(TermUnitSizing(NumOfZones))
ALLOCATE(ZoneEqSizing(NumOfZones))
! setup zone equipment sequenced demand storage
DO ControlledZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ControlledZoneNum)%IsControlled) CYCLE
IF (ZoneEquipConfig(ControlledZoneNum)%EquipListIndex == 0) cycle
ZoneEquipCount = ZoneEquipList(ZoneEquipConfig(ControlledZoneNum)%EquipListIndex)%NumOfEquipTypes
ZoneSysEnergyDemand(ControlledZoneNum)%NumZoneEquipment = ZoneEquipCount
ALLOCATE(ZoneSysEnergyDemand(ControlledZoneNum)%SequencedOutputRequired(ZoneEquipCount))
ALLOCATE(ZoneSysEnergyDemand(ControlledZoneNum)%SequencedOutputRequiredToHeatingSP(ZoneEquipCount))
ALLOCATE(ZoneSysEnergyDemand(ControlledZoneNum)%SequencedOutputRequiredToCoolingSP(ZoneEquipCount))
ZoneSysMoistureDemand(ControlledZoneNum)%NumZoneEquipment = ZoneEquipCount
ALLOCATE(ZoneSysMoistureDemand(ControlledZoneNum)%SequencedOutputRequired(ZoneEquipCount))
ALLOCATE(ZoneSysMoistureDemand(ControlledZoneNum)%SequencedOutputRequiredToHumidSP(ZoneEquipCount))
ALLOCATE(ZoneSysMoistureDemand(ControlledZoneNum)%SequencedOutputRequiredToDehumidSP(ZoneEquipCount))
ENDDO
END IF
! Do the Begin Environment initializations
IF (MyEnvrnFlag .and. BeginEnvrnFlag) THEN
ZoneEquipAvail=NoAction
IF(ALLOCATED(ZoneComp))THEN
DO ZoneEquipType = 1, NumValidSysAvailZoneComponents
IF(ALLOCATED(ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs)) THEN
TotalNumComp = ZoneComp(ZoneEquipType)%TotalNumComp
DO ZoneCompNum = 1, TotalNumComp
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(ZoneCompNum)%AvailStatus = NoAction
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(ZoneCompNum)%StartTime = 0
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(ZoneCompNum)%StopTime = 0
END DO
ENDIF
END DO
ENDIF
DO ControlledZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ControlledZoneNum)%IsControlled) CYCLE
ZoneNodeNum = ZoneEquipConfig(ControlledZoneNum)%ZoneNode
Node(ZoneNodeNum)%Temp = 20.0d0
Node(ZoneNodeNum)%MassFlowRate = 0.0d0
Node(ZoneNodeNum)%Quality = 1.0d0
Node(ZoneNodeNum)%Press = OutBaroPress
Node(ZoneNodeNum)%HumRat = OutHumRat
Node(ZoneNodeNum)%Enthalpy = PsyHFnTdbW(Node(ZoneNodeNum)%Temp,Node(ZoneNodeNum)%HumRat)
IF (Contaminant%CO2Simulation) Then
Node(ZoneNodeNum)%CO2 = OutdoorCO2
End If
IF (Contaminant%GenericContamSimulation) Then
Node(ZoneNodeNum)%GenContam = OutdoorGC
End If
DO ZoneInNode = 1, ZoneEquipConfig(ControlledZoneNum)%NumInletNodes
InNodeNum = ZoneEquipConfig(ControlledZoneNum)%InletNode(ZoneInNode)
Node(InNodeNum)%Temp = 20.0d0
Node(InNodeNum)%MassFlowRate = 0.0d0
Node(InNodeNum)%Quality = 1.0d0
Node(InNodeNum)%Press = OutBaroPress
Node(InNodeNum)%HumRat = OutHumRat
Node(InNodeNum)%Enthalpy = PsyHFnTdbW(Node(InNodeNum)%Temp,Node(InNodeNum)%HumRat)
IF (Contaminant%CO2Simulation) Then
Node(InNodeNum)%CO2 = OutdoorCO2
End If
IF (Contaminant%GenericContamSimulation) Then
Node(InNodeNum)%GenContam = OutdoorGC
End If
END DO
DO ZoneExhNode = 1, ZoneEquipConfig(ControlledZoneNum)%NumExhaustNodes
ExhNodeNum = ZoneEquipConfig(ControlledZoneNum)%ExhaustNode(ZoneExhNode)
Node(ExhNodeNum)%Temp = 20.0d0
Node(ExhNodeNum)%MassFlowRate = 0.0d0
Node(ExhNodeNum)%Quality = 1.0d0
Node(ExhNodeNum)%Press = OutBaroPress
Node(ExhNodeNum)%HumRat = OutHumRat
Node(ExhNodeNum)%Enthalpy = PsyHFnTdbW(Node(ExhNodeNum)%Temp,Node(ExhNodeNum)%HumRat)
IF (Contaminant%CO2Simulation) Then
Node(ExhNodeNum)%CO2 = OutdoorCO2
End If
IF (Contaminant%GenericContamSimulation) Then
Node(ExhNodeNum)%GenContam = OutdoorGC
End If
END DO
! BG CR 7122 following resets return air node.
ZoneReturnAirNode = ZoneEquipConfig(ControlledZoneNum)%ReturnAirNode
IF (ZoneReturnAirNode > 0) THEN
Node(ZoneReturnAirNode)%Temp = 20.0d0
Node(ZoneReturnAirNode)%MassFlowRate = 0.0d0
Node(ZoneReturnAirNode)%Quality = 1.0d0
Node(ZoneReturnAirNode)%Press = OutBaroPress
Node(ZoneReturnAirNode)%HumRat = OutHumRat
Node(ZoneReturnAirNode)%Enthalpy = PsyHFnTdbW(Node(ZoneReturnAirNode)%Temp,Node(ZoneReturnAirNode)%HumRat)
IF (Contaminant%CO2Simulation) Then
Node(ZoneReturnAirNode)%CO2 = OutdoorCO2
End If
IF (Contaminant%GenericContamSimulation) Then
Node(ZoneReturnAirNode)%GenContam = OutdoorGC
End If
ENDIF
END DO
MyEnvrnFlag=.false.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag=.true.
ENDIF
! do the HVAC time step initializations
DO ControlledZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ControlledZoneNum)%IsControlled) CYCLE
ZoneNodeNum = ZoneEquipConfig(ControlledZoneNum)%ZoneNode
IF(FirstHVACIteration)THEN
DO ZoneExhNode = 1, ZoneEquipConfig(ControlledZoneNum)%NumExhaustNodes
ExhNodeNum = ZoneEquipConfig(ControlledZoneNum)%ExhaustNode(ZoneExhNode)
Node(ExhNodeNum)%Temp = Node(ZoneNodeNum)%Temp
Node(ExhNodeNum)%HumRat = Node(ZoneNodeNum)%HumRat
Node(ExhNodeNum)%Enthalpy = Node(ZoneNodeNum)%Enthalpy
Node(ExhNodeNum)%Press = Node(ZoneNodeNum)%Press
Node(ExhNodeNum)%Quality = Node(ZoneNodeNum)%Quality
Node(ExhNodeNum)%MassFlowRate = 0.0d0
Node(ExhNodeNum)%MassFlowRateMaxAvail = 0.0d0
Node(ExhNodeNum)%MassFlowRateMinAvail = 0.0d0
IF (Contaminant%CO2Simulation) Then
Node(ExhNodeNum)%CO2 = Node(ZoneNodeNum)%CO2
End If
IF (Contaminant%GenericContamSimulation) Then
Node(ExhNodeNum)%GenContam = Node(ZoneNodeNum)%GenContam
End If
END DO
END IF
IF (ZoneEquipConfig(ControlledZoneNum)%AirLoopNum > 0) THEN
AirLoopFlow(ZoneEquipConfig(ControlledZoneNum)%AirLoopNum)%ZoneExhaust = 0.d0
AirLoopFlow(ZoneEquipConfig(ControlledZoneNum)%AirLoopNum)%ZoneExhaustBalanced = 0.d0
AirLoopFlow(ZoneEquipConfig(ControlledZoneNum)%AirLoopNum)%SupFlow = 0.d0
AirLoopFlow(ZoneEquipConfig(ControlledZoneNum)%AirLoopNum)%RetFlow = 0.d0
AirLoopFlow(ZoneEquipConfig(ControlledZoneNum)%AirLoopNum)%RetFlow0 = 0.d0
AirLoopFlow(ZoneEquipConfig(ControlledZoneNum)%AirLoopNum)%RecircFlow = 0.d0
END IF
END DO
RETURN
END SUBROUTINE InitZoneEquipment