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.
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 ValidateDistributionSystem
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Oct. 2005
! MODIFIED L. Gu, Jan. 2009: allow a desuperheater coil and three heat exchangers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine validates the inputs of distribution system, since node data from a pimary airloop
! are nor available in the first call during reading input data of airflownetwrok objects.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
Use DataAirLoop , Only: AirToZoneNodeInfo,AirToOANodeInfo
USE DataZoneEquipment, ONLY: ZoneEquipConfig
Use MixedAir, Only: GetNumOAMixers, GetOAMixerReliefNodeNumber, GetOAMixerInletNodeNumber
USE HeatingCoils, ONLY: HeatingCoil, NumHeatingCoils
USE SingleDuct, ONLY: GetHVACSingleDuctSysIndex
USE InputProcessor, ONLY: SameString,MakeUPPERCase ! NEEDS TO BE CHANGED AFTER V1.3 RELEASE
USE BranchNodeConnections, ONLY: GetNodeConnectionType
USE DataLoopNode
USE DataBranchNodeConnections, ONLY: NodeConnections,NumOfNodeConnections
USE ZoneDehumidifier, ONLY: GetZoneDehumidifierNodeNumber
USE SplitterComponent, ONLY: GetSplitterNodeNumbers, GetSplitterOutletNumber
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER (len=*), PARAMETER :: RoutineName='ValidateDistributionSystem: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
integer I,j,k,N, S1,S2,R1,R2
LOGICAL,SAVE :: OneTimeFlag = .True.
LOGICAL :: ErrorsFound=.false.
LOGICAL LocalError
LOGICAL, ALLOCATABLE, DIMENSION(:) :: NodeFound
REAL(r64) FanFlow
LOGICAL :: IsNotOk=.false.
LOGICAL :: ErrFlag=.false.
INTEGER, ALLOCATABLE, DIMENSION(:) :: NodeConnectionType ! Specifies the type of node connection
CHARACTER(len=MaxNameLength) :: CurrentModuleObject
! Validate supply and return connections
if (OneTimeFlag) then
Allocate(NodeFound(NumOfNodes))
NodeFound = .False.
! Validate inlet and outlet nodes for zone exhaust fans
Do i=1,AirflowNetworkNumOfExhFan
NodeFound(MultizoneCompExhaustFanData(i)%InletNode) = .True.
NodeFound(MultizoneCompExhaustFanData(i)%OutletNode) = .True.
End Do
! Validate EPlus Node names and types
do i=1,DisSysNumOfNodes
if (SameString(DisSysNodeData(i)%EPlusName,' ') .or. &
SameString(DisSysNodeData(i)%EPlusName,'Other')) cycle
LocalError=.false.
do j=1,NumOfNodes ! NodeID
if (DisSysNodeData(i)%EPlusName == NodeID(j)) then
DisSysNodeData(i)%EPlusNodeNum = j
AirflowNetworkNodeData(NumOfNodesMultiZone+i)%EPlusNodeNum = j
NodeFound(j) = .True.
LocalError=.True.
Exit
end if
end do
! Check outdoor air node
If (SameString(DisSysNodeData(i)%EPlusType,'OutdoorAir:NodeList') .OR. &
SameString(DisSysNodeData(i)%EPlusType,'OutdoorAir:Node')) then
If (.NOT. LocalError) Then
CALL ShowSevereError(RoutineName //'The Node or Component Name defined in '//Trim(DisSysNodeData(i)%Name) // &
' is not found in the '//Trim(DisSysNodeData(i)%EPlusType))
CALL ShowContinueError('The entered name is '//Trim(DisSysNodeData(i)%EPlusName) &
//' in an AirflowNetwork:Distribution:Node object.')
ErrorsFound=.true.
End If
End If
if (DisSysNodeData(i)%EPlusNodeNum .EQ. 0) then
CALL ShowSevereError(RoutineName//'Primary Air Loop Node is not found in AIRFLOWNETWORK:DISTRIBUTION:NODE = ' &
//TRIM(DisSysNodeData(i)%Name))
ErrorsFound=.true.
end if
end do
! Determine node numbers for zone inlets
DO i=1,NumOfZones
IF (.not. ZoneEquipConfig(i)%IsControlled) CYCLE
Do j=1, ZoneEquipConfig(i)%NumInletNodes
Do k=1,AirflowNetworkNumOfNodes
If (ZoneEquipConfig(i)%InletNode(j) == AirflowNetworkNodeData(k)%EPlusNodeNum) then
AirflowNetworkNodeData(k)%EPlusTypeNum = EPlusTypeNum_ZIN
Exit
End If
end do
End Do
end do
! Eliminate node not related to AirLoopHVAC
DO k=1,NumOfNodeConnections
If (NodeFound(NodeConnections(k)%NodeNumber)) cycle
If (NodeConnections(k)%FluidStream == 2) then
NodeFound(NodeConnections(k)%NodeNumber) = .True.
End If
End Do
! Eliminate nodes with fluidtype = water
DO k=1,NumOfNodes
If (NodeFound(k)) cycle
If (Node(k)%FluidType == 2) then
NodeFound(k) = .True.
End If
End Do
! Ensure all the nodes used in Eplus are a subset of AirflowNetwork Nodes
Do i=1,NumOfNodes
If (NodeFound(i)) cycle
! Skip the inlet and outlet nodes of zone dehumidifiers
If (GetZoneDehumidifierNodeNumber(i)) NodeFound(i) = .TRUE.
Do j=1,NumOfZones
IF (.not. ZoneEquipConfig(j)%IsControlled) CYCLE
If (ZoneEquipConfig(j)%ZoneNode == i) then
NodeFound(i) = .True.
AirflowNetworkNodeData(ZoneEquipConfig(j)%ActualZoneNum)%EPlusNodeNum = i
Exit
end if
End Do
! skip nodes that are not part of an airflow network
! DX COIL CONDENSER NODE TEST:
!
! Outside air nodes are used for DX coil condenser inlet nodes, these are specified in an outside air node or
! OutdoorAir:NodeList object (and classified with NodeConnectionType as OutsideAir). In addition,
! this same node is specified in a Coil:DX:CoolingBypassFactorEmpirical object (and classified with
! NodeConnectionType as OutsideAirReference). In the NodeConnectionType structure, both of these nodes have a
! unique index but have the same node number. The Outside Air Node will usually be listed first. Search for all
! indexs with the same node number and check if it is classified as NodeConnectionType = OutsideAirReference.
! Mark this node as found since it is not used in an airflownetwork simulation.
!
! Example (using AirflowNetwork_MultiZone_SmallOffice.idf with a single OA Mixer):
! (the example shown below is identical to AirflowNetwork_SimpleHouse.idf with no OA Mixer except
! that the NodeConnections indexs are (7) and (31), respectively and the NodeNumber = 6)
!
! The GetNodeConnectionType CALL below returns NodeConnectionType_OutsideAir = 7 and NodeConnectionType_OutsideAirReference = 14.
!
! NodeConnections info from OUTSIDE AIR NODE object read:
! NodeConnections(9)NodeNumber = 10
! NodeConnections(9)NodeName = ACDXCOIL 1 CONDENSER NODE
! NodeConnections(9)ObjectType = OUTSIDE AIR NODE
! NodeConnections(9)ObjectName = OUTSIDE AIR NODE
! NodeConnections(9)ConnectionType = OutsideAir
!
! NodeConnections info from Coil:DX:CoolingBypassFactorEmpirical object read:
! NodeConnections(64)NodeNumber = 10
! NodeConnections(64)NodeName = ACDXCOIL 1 CONDENSER NODE
! NodeConnections(64)ObjectType = COIL:DX:COOLINGBYPASSFACTOREMPIRICAL
! NodeConnections(64)ObjectName = ACDXCOIL 1
! NodeConnections(64)ConnectionType = OutsideAirReference
ErrFlag = .FALSE.
CALL GetNodeConnectionType(i, NodeConnectionType, ErrFlag) ! Gets all connection types for a given node number
IF(ErrFlag)THEN
CALL ShowContinueError('...occurs in Airflow Network simulation.')
ELSE
! skip nodes for air cooled condensers
DO j = 1, SIZE(NodeConnectionType)
if (NodeConnectionType(j) .EQ. NodeConnectionType_OutsideAirReference) then
NodeFound(i) = .TRUE.
end if
END DO
END IF
If (.NOT. NodeFound(i)) then
! Check if this node is the OA relief node. For the time being, OA relief node is not used
If (GetNumOAMixers() .GT. 1) then
CALL ShowSevereError(RoutineName//'Only one OutdoorAir:Mixer is allowed in the AirflowNetwork model.')
ErrorsFound=.true.
ElseIf (GetNumOAMixers() .EQ. 0) Then
CALL ShowSevereError(RoutineName //Trim(NodeID(I)) //' is not defined as an ' &
//'AirflowNetwork:Distribution:Node object.')
ErrorsFound=.true.
Else
if (i .EQ. GetOAMixerReliefNodeNumber(1)) then
NodeFound(i) = .TRUE.
ElseIf (i .EQ. GetOAMixerInletNodeNumber(1)) Then
NodeFound(i) = .TRUE.
Else
CALL ShowSevereError(RoutineName //Trim(NodeID(I)) //' is not defined as an ' &
//'AirflowNetwork:Distribution:Node object.')
ErrorsFound=.true.
end if
end if
End If
End Do
Deallocate(NodeFound)
! Validate coil name and type
CurrentModuleObject = 'AirflowNetwork:Distribution:Component:Coil'
MultiSpeedHPIndicator = 0
Do i=1,DisSysNumOfCoils
SELECT CASE(MakeUPPERCase(DisSysCompCoilData(i)%EPlusType))
CASE ('COIL:COOLING:DX:SINGLESPEED')
CALL ValidateComponent('Coil:Cooling:DX:SingleSpeed',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:HEATING:DX:SINGLESPEED')
CALL ValidateComponent('Coil:Heating:DX:SingleSpeed',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:HEATING:GAS')
CALL ValidateComponent('Coil:Heating:Gas',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:HEATING:ELECTRIC')
CALL ValidateComponent('Coil:Heating:Electric',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:COOLING:WATER')
CALL ValidateComponent('Coil:Cooling:Water',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:HEATING:WATER')
CALL ValidateComponent('Coil:Heating:Water',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:COOLING:WATER:DETAILEDGEOMETRY')
CALL ValidateComponent('Coil:Cooling:Water:DetailedGeometry',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:COOLING:DX:TWOSTAGEWITHHUMIDITYCONTROLMODE')
CALL ValidateComponent('Coil:Cooling:DX:TwoStageWithHumidityControlMode',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:COOLING:DX:MULTISPEED')
CALL ValidateComponent('Coil:Cooling:DX:MultiSpeed',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
MultiSpeedHPIndicator = MultiSpeedHPIndicator+1
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:HEATING:DX:MULTISPEED')
CALL ValidateComponent('Coil:Heating:DX:MultiSpeed',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
MultiSpeedHPIndicator = MultiSpeedHPIndicator+1
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:HEATING:DESUPERHEATER')
CALL ValidateComponent('Coil:Heating:Desuperheater',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('COIL:COOLING:DX:TWOSPEED')
CALL ValidateComponent('Coil:Cooling:DX:TwoSpeed',DisSysCompCoilData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' Invalid coil type = ' &
//DisSysCompCoilData(i)%Name)
ErrorsFound=.true.
END SELECT
end do
! Validate ternimal unit name and type
Do i=1,DisSysNumOfTermUnits
if (SameString(DisSysCompTermUnitData(i)%EPlusType,'AirTerminal:SingleDuct:ConstantVolume:Reheat') .OR. &
SameString(DisSysCompTermUnitData(i)%EPlusType,'AirTerminal:SingleDuct:VAV:Reheat') ) then
LocalError=.false.
If (SameString(DisSysCompTermUnitData(i)%EPlusType,'AirTerminal:SingleDuct:ConstantVolume:Reheat')) &
CALL GetHVACSingleDuctSysIndex(DisSysCompTermUnitData(i)%Name,n,LocalError, &
'AirflowNetwork:Distribution:Component:TerminalUnit')
If (SameString(DisSysCompTermUnitData(i)%EPlusType,'AirTerminal:SingleDuct:VAV:Reheat')) &
CALL GetHVACSingleDuctSysIndex(DisSysCompTermUnitData(i)%Name,n,LocalError, &
'AirflowNetwork:Distribution:Component:TerminalUnit',DisSysCompTermUnitData(i)%DamperInletNode, &
DisSysCompTermUnitData(i)%DamperOutletNode)
if (LocalError) ErrorsFound = .True.
If (VAVSystem) Then
If (.NOT. SameString(DisSysCompTermUnitData(i)%EPlusType,'AirTerminal:SingleDuct:VAV:Reheat')) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' Invalid terminal type for a VAV system = ' &
//DisSysCompTermUnitData(i)%Name)
CALL ShowContinueError('The input type = '//TRIM(DisSysCompTermUnitData(i)%EPlusType))
CALL ShowContinueError('A VAV system requires all ternimal units with type = AirTerminal:SingleDuct:VAV:Reheat')
ErrorsFound=.true.
End If
End If
else
CALL ShowSevereError(RoutineName//'AIRFLOWNETWORK:DISTRIBUTION:COMPONENT TERMINAL UNIT: ' &
//'Invalid Terminal unit type = '//DisSysCompTermUnitData(i)%Name)
ErrorsFound=.true.
end if
end do
! Validate heat exchanger name and type
CurrentModuleObject = 'AirflowNetwork:Distribution:Component:HeatExchanger'
Do i=1,DisSysNumOfHXs
SELECT CASE(MakeUPPERCase(DisSysCompHXData(i)%EPlusType))
CASE ('HEATEXCHANGER:AIRTOAIR:FLATPLATE')
CALL ValidateComponent('HeatExchanger:AirToAir:FlatPlate',DisSysCompHXData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('HEATEXCHANGER:AIRTOAIR:SENSIBLEANDLATENT')
CALL ValidateComponent('HeatExchanger:AirToAir:SensibleAndLatent',DisSysCompHXData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE ('HEATEXCHANGER:DESICCANT:BALANCEDFLOW')
CALL ValidateComponent('HeatExchanger:Desiccant:BalancedFlow',DisSysCompHXData(i)%Name,IsNotOK, &
RoutineName//TRIM(CurrentModuleObject))
If (IsNotOk) then
ErrorsFound=.true.
end if
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' Invalid heat exchanger type = ' &
//DisSysCompHXData(i)%EPlusType)
ErrorsFound=.true.
END SELECT
end do
! Assign supply and return connection
S1 = 0
S2 = 0
R1 = 0
R2 = 0
Do I=1,AirflowNetworkNumOfNodes
If (AirflowNetworkNodeData(i)%EPlusNodeNum .EQ. AirToZoneNodeInfo(1)%AirLoopSupplyNodeNum(1)) S1=I
If (AirflowNetworkNodeData(i)%EPlusNodeNum .EQ. AirToZoneNodeInfo(1)%ZoneEquipSupplyNodeNum(1)) S2=I
If (AirflowNetworkNodeData(i)%EPlusNodeNum .EQ. AirToZoneNodeInfo(1)%ZoneEquipReturnNodeNum(1)) R1=I
If (AirflowNetworkNodeData(i)%EPlusNodeNum .EQ. AirToZoneNodeInfo(1)%AirLoopReturnNodeNum(1)) R2=I
End Do
Do i=1,AirflowNetworkNumOfLinks
If (AirflowNetworkLinkageData(i)%NodeNums(1) .eq. R1 .and.AirflowNetworkLinkageData(i)%NodeNums(2) .eq. R2) then
AirflowNetworkLinkageData(i)%ConnectionFlag = EPlusTypeNum_RCN
end if
If (AirflowNetworkLinkageData(i)%NodeNums(1) .eq. S1 .and.AirflowNetworkLinkageData(i)%NodeNums(2) .eq. S2) then
AirflowNetworkLinkageData(i)%ConnectionFlag = EPlusTypeNum_SCN
end if
End Do
! Assign fan inlet and outlet node, and coil outlet
Do i=1,AirflowNetworkNumOfLinks
J = AirflowNetworkLinkageData(i)%CompNum
If (AirflowNetworkCompData(J)%CompTypeNum == CompTypeNum_CVF) then
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%EPlusTypeNum == 0) &
AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%EPlusTypeNum = EPlusTypeNum_FIN
AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%EPlusTypeNum = EPlusTypeNum_FOU
end if
If (AirflowNetworkCompData(J)%EPlusTypeNum == EPlusTypeNum_COI) then
AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%EPlusTypeNum = EPlusTypeNum_COU
end if
If (AirflowNetworkCompData(J)%EPlusTypeNum == EPlusTypeNum_HEX) then
AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%EPlusTypeNum = EPlusTypeNum_HXO
end if
If (AirflowNetworkCompData(J)%CompTypeNum == CompTypeNum_TMU) Then
If (DisSysCompTermUnitData(AirflowNetworkCompData(j)%TypeNum)%DamperInletNode > 0) Then
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%EPlusNodeNum == &
DisSysCompTermUnitData(AirflowNetworkCompData(j)%TypeNum)%DamperInletNode .AND. &
AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%EPlusNodeNum == &
DisSysCompTermUnitData(AirflowNetworkCompData(j)%TypeNum)%DamperOutletNode) Then
AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%EPlusTypeNum = EPlusTypeNum_DIN
AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%EPlusTypeNum = EPlusTypeNum_DOU
AirflowNetworkLinkageData(i)%VAVTermDamper = .TRUE.
End If
End If
End If
End Do
! Validate the position of constant pressure drop component
CurrentModuleObject = 'AirflowNetwork:Distribution:Component:ConstantPressureDrop'
do i=1,AirflowNetworkNumOfLinks
If (AirflowNetworkCompData(AirflowNetworkLinkageData(i)%CompNum)%CompTypeNum == CompTypeNum_CPD) then
Do j=1,AirflowNetworkNumOfLinks
If (AirflowNetworkLinkageData(i)%NodeNums(1) == AirflowNetworkLinkageData(j)%NodeNums(2)) then
If (AirflowNetworkCompData(AirflowNetworkLinkageData(j)%CompNum)%CompTypeNum /= CompTypeNum_DWC) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject) &
//' object ('//TRIM(AirflowNetworkLinkageData(i)%CompName)//')')
CALL ShowContinueError('must connect a duct component upstream and not ' &
//TRIM(AirflowNetworkLinkageData(j)%Name))
ErrorsFound=.true.
End If
End If
End Do
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%EPlusTypeNum == EPlusTypeNum_SPL) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject) &
//' object ('//TRIM(AirflowNetworkLinkageData(i)%CompName)//')')
CALL ShowContinueError('does not allow a AirLoopHVAC:ZoneSplitter node = ' &
//TRIM(AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%Name))
ErrorsFound=.true.
End If
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%EPlusTypeNum == EPlusTypeNum_SPL) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject) &
//' object ('//TRIM(AirflowNetworkLinkageData(i)%CompName)//')')
CALL ShowContinueError('does not allow a AirLoopHVAC:ZoneSplitter node = ' &
//TRIM(AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%Name))
ErrorsFound=.true.
End If
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%EPlusTypeNum == EPlusTypeNum_MIX) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject) &
//' object ('//TRIM(AirflowNetworkLinkageData(i)%CompName)//')')
CALL ShowContinueError('does not allow a AirLoopHVAC:ZoneMixer node = ' &
//Trim(AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%Name))
ErrorsFound=.true.
End If
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%EPlusTypeNum == EPlusTypeNum_MIX) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject) &
//' object ('//TRIM(AirflowNetworkLinkageData(i)%CompName)//')')
CALL ShowContinueError('does not allow a AirLoopHVAC:ZoneMixer node = ' &
//TRIM(AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%Name))
ErrorsFound=.true.
End If
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%EPlusNodeNum >0) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject) &
//' object ('//TRIM(AirflowNetworkLinkageData(i)%CompName)//')')
CALL ShowContinueError('does not allow to connect an EnergyPlus node = ' &
//TRIM(AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%Name))
ErrorsFound=.true.
End If
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%EPlusNodeNum >0) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject) &
//' object ('//TRIM(AirflowNetworkLinkageData(i)%CompName)//')')
CALL ShowContinueError('does not allow to connect an EnergyPlus node = ' &
//TRIM(AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%Name))
ErrorsFound=.true.
End If
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%EPlusZoneNum >0) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject) &
//' object ('//TRIM(AirflowNetworkLinkageData(i)%CompName)//')')
CALL ShowContinueError('does not allow to connect an EnergyPlus zone = ' &
//TRIM(AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(1))%Name))
ErrorsFound=.true.
End If
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%EPlusZoneNum >0) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject) &
//' object ('//TRIM(AirflowNetworkLinkageData(i)%CompName)//')')
CALL ShowContinueError('does not allow to connect an EnergyPlus zone = ' &
//TRIM(AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%Name))
ErrorsFound=.true.
End If
End If
End Do
Do I=NumOfNodesMultiZone+1,AirflowNetworkNumOfNodes
If (AirflowNetworkNodeData(i)%EPlusTypeNum == EPlusTypeNum_SPL) then
LocalError=.false.
j = GetSplitterOutletNumber('',1,LocalError)
ALLOCATE(SplitterNodeNumbers(j+2))
SplitterNodeNumbers = GetSplitterNodeNumbers('',1,LocalError)
if (LocalError) ErrorsFound = .True.
End If
End Do
! Assing inlet and oulet nodes for a splitter
DO I=1,AirflowNetworkNumOfNodes
If (AirflowNetworkNodeData(I)%EplusNodeNum == SplitterNodeNumbers(1)) Then
If (AirflowNetworkNodeData(I)%EPlusTypeNum .EQ. 0) AirflowNetworkNodeData(I)%EPlusTypeNum = EPlusTypeNum_SPI
End If
Do j=1,SplitterNodeNumbers(2)
If (AirflowNetworkNodeData(I)%EplusNodeNum == SplitterNodeNumbers(j+2)) Then
If (AirflowNetworkNodeData(I)%EPlusTypeNum .EQ. 0) AirflowNetworkNodeData(I)%EPlusTypeNum = EPlusTypeNum_SPO
End If
End Do
End Do
OneTimeFlag = .False.
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Program terminates for preceding reason(s).')
ENDIF
end if
! Catch a fan flow rate from EPlus input file and add a flag for VAV teminal damper
DO I=1,AirflowNetworkNumOfLinks
select case (AirflowNetworkCompData(AirflowNetworkLinkageData(i)%CompNum)%CompTypeNum)
CASE (CompTypeNum_CVF) ! 'CVF'
j=AirflowNetworkNodeData(AirflowNetworkLinkageData(i)%NodeNums(2))%EPlusNodeNum
k = AirflowNetworkCompData(AirflowNetworkLinkageData(i)%CompNum)%TypeNum
FanFlow=Node(j)%MassFlowRate
If (DisSysCompCVFData(k)%FanTypeNum .eq. FanType_SimpleVAV) Then
Call GetFanVolFlow(DisSysCompCVFData(k)%FanIndex, FanFlow)
DisSysCompCVFData(k)%MaxAirMassFlowRate = FanFlow*StdRhoAir
End If
CASE (CompTypeNum_FAN) !'FAN'
! Check ventilation status for large openings
CASE (CompTypeNum_SOP) !'Simple opening'
CASE (CompTypeNum_TMU) ! Terminal unit
CASE Default
end select
END DO
END SUBROUTINE ValidateDistributionSystem