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(inout) | :: | ErrorsFound |
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 CheckNodeConnections(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN March 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine processes the node connection data structure looking at:
!
! 1. In the NodeConnections list, for any node which appears as a sensor or an
! actuator, the same node must also appear in the connections list at least once
! as a node type which is not sensor or actuator or outsideair.
!
! 2. In the NodeConnections list, for any node which appears as a setpoint, the
! same node must also appear in the connections list at least once as a node type
! which is not a setpoint or outsideair.
!
! 3. Every ZoneInlet must appear as an outlet from something, otherwise it will
! do nothing.
!
! 4. Every ZoneExhaust must appear as an inlet to something,
! otherwise it will do nothing.
!
! 5. Every inlet node should match either an Outlet, ZoneReturn, ZoneExhaust, ReliefAir,
! or OutsideAir node.
! With the current data structure, when checking inlets:
! a) If an InletNode's object is AirLoopHVAC, CondenserLoop, or PlantLoop, then skip the test.
! b) If an InletNode's object is not one of the above types, it is valid if the
! same node name appears as an INLET to an AirLoopHVAC, CondenserLoop, or PlantLoop.
!
! 6. Any given node can only be an inlet once in the list of Non-Parent Node Connections
!
! 7. Any given node can only be an outlet once in the list of Non-Parent Node Connections
! METHODOLOGY EMPLOYED:
! Needs description, as appropriate.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: SameString
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Loop1
INTEGER Loop2
LOGICAL IsValid
LOGICAL IsInlet
LOGICAL IsOutlet
LOGICAL MatchedAtLeastOne
INTEGER :: ErrorCounter
INTEGER :: Object
INTEGER :: StartConnect
INTEGER :: EndConnect
INTEGER, ALLOCATABLE, DIMENSION(:) :: FluidStreamInletCount
INTEGER, ALLOCATABLE, DIMENSION(:) :: FluidStreamOutletCount
INTEGER, ALLOCATABLE, DIMENSION(:) :: NodeObjects
LOGICAL, ALLOCATABLE, DIMENSION(:) :: FluidStreamCounts
INTEGER :: NumObjects
INTEGER :: MaxFluidStream
ErrorCounter=0
! Check 1 -- check sensor and actuator nodes
DO Loop1=1,NumOfNodeConnections
IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Sensor)) CYCLE
IsValid=.false.
DO Loop2=1, NumOfNodeConnections
IF (Loop1 == Loop2) CYCLE
IF (NodeConnections(Loop1)%NodeNumber /= NodeConnections(Loop2)%NodeNumber) CYCLE
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Actuator)) CYCLE
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Sensor)) CYCLE
IsValid=.true.
ENDDO
IF (.not. IsValid) THEN
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", Sensor node did not find a matching node of appropriate type (other than Actuator or Sensor).')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
ErrorCounter=ErrorCounter+1
ErrorsFound=.true.
ENDIF
ENDDO
DO Loop1=1,NumOfNodeConnections
IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Actuator)) CYCLE
IsValid=.false.
DO Loop2=1, NumOfNodeConnections
IF (Loop1 == Loop2) CYCLE
IF (NodeConnections(Loop1)%NodeNumber /= NodeConnections(Loop2)%NodeNumber) CYCLE
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Actuator)) CYCLE
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Sensor)) CYCLE
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_OutsideAir)) CYCLE
IsValid=.true.
ENDDO
IF (.not. IsValid) THEN
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", Actuator node did not find a matching node of appropriate type (other than Actuator, Sensor, OutsideAir).')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
ErrorCounter=ErrorCounter+1
ErrorsFound=.true.
ENDIF
ENDDO
! Check 2 -- setpoint nodes
! Check 2a -- setpoint node must also be an inlet or an outlet (CR8212)
DO Loop1=1,NumOfNodeConnections
IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Setpoint)) CYCLE
IsValid=.false.
isInlet=.false.
isOutlet=.false.
DO Loop2=1, NumOfNodeConnections
IF (Loop1 == Loop2) CYCLE
IF (NodeConnections(Loop1)%NodeNumber /= NodeConnections(Loop2)%NodeNumber) CYCLE
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Setpoint)) CYCLE
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_OutsideAir)) CYCLE
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Inlet)) isInlet=.true.
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Outlet)) isOutlet=.true.
IsValid=.true.
ENDDO
IF (.not. IsValid) THEN
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", Setpoint node did not find a matching node of appropriate type (other than Setpoint, OutsideAir).')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
ErrorCounter=ErrorCounter+1
ErrorsFound=.true.
ENDIF
IF (.not. isInlet .and. .not. isOutlet) THEN
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", Setpoint node did not find a matching node of type Inlet or Outlet.')
CALL ShowContinueError('It appears this node is not part of the HVAC system.')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
ErrorCounter=ErrorCounter+1
! ErrorsFound=.true.
ENDIF
ENDDO
! Check 2a -- setpoint node must also be an inlet or an outlet (CR8212)
! DO Loop1=1,NumOfNodeConnections
! IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Setpoint)) CYCLE
! IsValid=.false.
! isInlet=.false.
! isOutlet=.false.
! DO Loop2=1, NumOfNodeConnections
! IF (Loop1 == Loop2) CYCLE
! IF (NodeConnections(Loop1)%NodeNumber /= NodeConnections(Loop2)%NodeNumber) CYCLE
! IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Inlet)) isInlet=.true.
! IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Outlet)) isOutlet=.true.
! IF (isInlet .or. isOutlet) EXIT
! ENDDO
! IF (.not. isInlet .and. .not. isOutlet) THEN
! CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
! '", Setpoint node did not find a matching node of type Inlet or Outlet.')
! CALL ShowContinueError('It appears this node is not part of the HVAC system.')
! CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
! ', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
! ErrorCounter=ErrorCounter+1
! ErrorsFound=.true.
! ENDIF
! ENDDO
! Check 3 -- zone inlet nodes -- must be an outlet somewhere
DO Loop1=1,NumOfNodeConnections
IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_ZoneInlet)) CYCLE
IsValid=.false.
DO Loop2=1, NumOfNodeConnections
IF (Loop1 == Loop2) CYCLE
IF (NodeConnections(Loop1)%NodeNumber /= NodeConnections(Loop2)%NodeNumber) CYCLE
IF (NodeConnections(Loop2)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Outlet)) CYCLE
IsValid=.true.
ENDDO
IF (.not. IsValid) THEN
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", ZoneInlet node did not find an outlet node.')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
ErrorCounter=ErrorCounter+1
! ErrorsFound=.true.
ENDIF
ENDDO
! Check 4 -- zone exhaust nodes -- must be an inlet somewhere
DO Loop1=1,NumOfNodeConnections
IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_ZoneExhaust)) CYCLE
IsValid=.false.
DO Loop2=1, NumOfNodeConnections
IF (Loop1 == Loop2) CYCLE
IF (NodeConnections(Loop1)%NodeNumber /= NodeConnections(Loop2)%NodeNumber) CYCLE
IF (NodeConnections(Loop2)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Inlet)) CYCLE
IsValid=.true.
ENDDO
IF (.not. IsValid) THEN
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", ZoneExhaust node did not find a matching inlet node.')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
ErrorCounter=ErrorCounter+1
! ErrorsFound=.true.
ENDIF
ENDDO
! Check 5 -- return plenum induced air outlet nodes -- must be an inlet somewhere
DO Loop1=1,NumOfNodeConnections
IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_InducedAir)) CYCLE
IsValid=.false.
DO Loop2=1, NumOfNodeConnections
IF (Loop1 == Loop2) CYCLE
IF (NodeConnections(Loop1)%NodeNumber /= NodeConnections(Loop2)%NodeNumber) CYCLE
IF (NodeConnections(Loop2)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Inlet)) CYCLE
IsValid=.true.
ENDDO
IF (.not. IsValid) THEN
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", Return plenum induced air outlet node did not find a matching inlet node.')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
ErrorCounter=ErrorCounter+1
ErrorsFound=.true.
ENDIF
ENDDO
! Check 6 -- every inlet should have a matching outlet, zonereturn, zoneexhaust, induced air, reliefair or outsideair
! a) If an InletNode's object is AirLoopHVAC, CondenserLoop, or PlantLoop, then skip the test.
! b) If an InletNode's object is not one of the above types, it is valid if the
! same node name appears as an INLET to an AirLoopHVAC, CondenserLoop, or PlantLoop.
DO Loop1=1,NumOfNodeConnections
IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Inlet)) CYCLE
IF (NodeConnections(Loop1)%ObjectType == 'AIRLOOPHVAC' .or. &
NodeConnections(Loop1)%ObjectType == 'CONDENSERLOOP' .or. &
NodeConnections(Loop1)%ObjectType == 'PLANTLOOP' ) CYCLE
IsValid=.false.
MatchedAtLeastOne=.false.
DO Loop2=1, NumOfNodeConnections
IF (Loop1 == Loop2) CYCLE
IF (NodeConnections(Loop1)%NodeNumber /= NodeConnections(Loop2)%NodeNumber) CYCLE
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Outlet) .or. &
NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_ZoneReturn) .or. &
NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_ZoneExhaust) .or. &
NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_InducedAir) .or. &
NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_ReliefAir) .or. &
NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_OutsideAir)) THEN
MatchedAtLeastOne=.true.
CYCLE
ENDIF
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Inlet) .and. &
(NodeConnections(Loop2)%ObjectType == 'AIRLOOPHVAC' .or. &
NodeConnections(Loop2)%ObjectType == 'CONDENSERLOOP' .or. &
NodeConnections(Loop2)%ObjectType == 'PLANTLOOP' ) ) THEN
MatchedAtLeastOne=.true.
CYCLE
ENDIF
IsValid=.false.
ENDDO
IF (.not. IsValid .and. .not. MatchedAtLeastOne) THEN
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", Inlet node did not find an appropriate matching "outlet" node.')
CALL ShowContinueError('If this is an outdoor air inlet node, '// &
'it must be listed in an OutdoorAir:Node or OutdoorAir:NodeList object.')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
ErrorCounter=ErrorCounter+1
! ErrorsFound=.true.
ENDIF
ENDDO
! Check 7 -- non-parent inlet nodes -- must never be an inlet more than once
DO Loop1=1,NumOfNodeConnections
! Only non-parent node connections
IF (NodeConnections(Loop1)%ObjectIsParent) CYCLE
IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Inlet)) CYCLE
DO Loop2=Loop1, NumOfNodeConnections
IF (Loop1 == Loop2) CYCLE
IF (NodeConnections(Loop2)%ObjectIsParent) CYCLE
IF (NodeConnections(Loop2)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Inlet)) CYCLE
IF (NodeConnections(Loop2)%NodeNumber == NodeConnections(Loop1)%NodeNumber) THEN
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", The same node appears as a non-parent Inlet node more than once.')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop2)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop2)%ObjectName))
ErrorCounter=ErrorCounter+1
! ErrorsFound=.true.
EXIT
ENDIF
ENDDO
ENDDO
! Check 8 -- non-parent outlet nodes -- must never be an outlet more than once
DO Loop1=1,NumOfNodeConnections
! Only non-parent node connections
IF (NodeConnections(Loop1)%ObjectIsParent) CYCLE
IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Outlet)) CYCLE
! Skip if DIRECT AIR, because it only has one node which is an outlet, so it dupes the outlet which feeds it
IF (NodeConnections(Loop1)%ObjectType == 'AIRTERMINAL:SINGLEDUCT:UNCONTROLLED') CYCLE
IsValid=.true.
DO Loop2=Loop1, NumOfNodeConnections
IF (Loop1 == Loop2) CYCLE
IF (NodeConnections(Loop2)%ObjectIsParent) CYCLE
IF (NodeConnections(Loop2)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_Outlet)) CYCLE
! Skip if DIRECT AIR, because it only has one node which is an outlet, so it dupes the outlet which feeds it
IF (NodeConnections(Loop2)%ObjectType == 'AIRTERMINAL:SINGLEDUCT:UNCONTROLLED') CYCLE
IF (NodeConnections(Loop2)%NodeNumber == NodeConnections(Loop1)%NodeNumber) THEN
! Skip if one of the
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", The same node appears as a non-parent Outlet node more than once.')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop2)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop2)%ObjectName))
ErrorCounter=ErrorCounter+1
! ErrorsFound=.true.
EXIT
ENDIF
ENDDO
ENDDO
! Check 9 -- nodes of type OutsideAirReference must be registered as NodeConnectionType_OutsideAir
DO Loop1=1,NumOfNodeConnections
IF (NodeConnections(Loop1)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_OutsideAirReference)) CYCLE
IsValid=.false.
DO Loop2=1, NumOfNodeConnections
IF (Loop1 == Loop2) CYCLE
IF (NodeConnections(Loop1)%NodeNumber /= NodeConnections(Loop2)%NodeNumber) CYCLE
IF (NodeConnections(Loop2)%ConnectionType /= ValidConnectionTypes(NodeConnectionType_OutsideAir)) CYCLE
IsValid=.true.
EXIT
ENDDO
IF (.not. IsValid) THEN
CALL ShowSevereError('Node Connection Error, Node="'//TRIM(NodeConnections(Loop1)%NodeName)// &
'", Outdoor Air Reference did not find an appropriate "outdoor air" node.')
CALL ShowContinueError('This node must be listed in an OutdoorAir:Node or OutdoorAir:NodeList '// &
'object in order to set its conditions.')
CALL ShowContinueError('Reference Object='//TRIM(NodeConnections(Loop1)%ObjectType)// &
', Name='//TRIM(NodeConnections(Loop1)%ObjectName))
ErrorCounter=ErrorCounter+1
! ErrorsFound=.true.
ENDIF
ENDDO
! Check 10 -- fluid streams cannot have multiple inlet/outlet nodes on same component
! can have multiple inlets with one outlet or vice versa but cannot have multiple both inlet and outlet
IF (NumOfNodeConnections > 0) THEN
MaxFluidStream=MAXVAL(NodeConnections%FluidStream)
ALLOCATE(FluidStreamInletCount(MaxFluidStream))
ALLOCATE(FluidStreamOutletCount(MaxFluidStream))
ALLOCATE(FluidStreamCounts(MaxFluidStream))
ALLOCATE(NodeObjects(NumOfNodeConnections))
FluidStreamInletCount=0
FluidStreamOutletCount=0
NodeObjects=0
FluidStreamCounts=.false.
! Following code relies on node connections for single object type/name being grouped together
Object=1
StartConnect=1
EndConnect=0
NumObjects=2
NodeObjects(1)=1
DO WHILE (Object < NumOfNodeConnections)
IF (NodeConnections(Object)%ObjectType /= NodeConnections(Object+1)%ObjectType .or. &
NodeConnections(Object)%ObjectName /= NodeConnections(Object+1)%ObjectName) THEN
EndConnect=Object+1
NodeObjects(NumObjects)=EndConnect
IF (Object+1 < NumOfNodeConnections) NumObjects=NumObjects+1
ENDIF
Object=Object+1
ENDDO
! NodeObjects now contains each consecutive object...
DO Object=1,NumObjects-1
IsValid=.true.
FluidStreamInletCount=0
FluidStreamOutletCount=0
FluidStreamCounts=.false.
Loop1=NodeObjects(Object)
IF (NodeConnections(Loop1)%ObjectIsParent) CYCLE
IF (NodeConnections(Loop1)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Inlet)) &
FluidStreamInletCount(NodeConnections(Loop1)%FluidStream)=FluidStreamInletCount(NodeConnections(Loop1)%FluidStream)+1
IF (NodeConnections(Loop1)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Outlet)) &
FluidStreamOutletCount(NodeConnections(Loop1)%FluidStream)=FluidStreamOutletCount(NodeConnections(Loop1)%FluidStream)+1
DO Loop2=Loop1+1,NodeObjects(Object+1)-1
IF (NodeConnections(Loop2)%ObjectIsParent) CYCLE
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Inlet)) &
FluidStreamInletCount(NodeConnections(Loop2)%FluidStream)=FluidStreamInletCount(NodeConnections(Loop2)%FluidStream)+1
IF (NodeConnections(Loop2)%ConnectionType == ValidConnectionTypes(NodeConnectionType_Outlet)) &
FluidStreamOutletCount(NodeConnections(Loop2)%FluidStream)=FluidStreamOutletCount(NodeConnections(Loop2)%FluidStream)+1
ENDDO
DO Loop2=1,MaxFluidStream
IF (FluidStreamInletCount(Loop2) > 1 .and. FluidStreamOutletCount(Loop2) > 1) THEN
IsValid=.false.
FluidStreamCounts(Loop2)=.true.
ENDIF
ENDDO
IF (.not. IsValid) THEN
CALL ShowSevereError('(Developer) Node Connection Error, Object='//trim(NodeConnections(Loop1)%ObjectType)//':'// &
trim(NodeConnections(Loop1)%ObjectName))
CALL ShowContinueError('Object has multiple connections on both inlet and outlet fluid streams.')
DO Loop2=1,MaxFluidStream
IF (FluidStreamCounts(Loop2)) &
CALL ShowContinueError('...occurs in Fluid Stream ['//trim(RoundSigDigits(Loop2))//'].')
ENDDO
ErrorCounter=ErrorCounter+1
ErrorsFound=.true.
ENDIF
ENDDO
DEALLOCATE(FluidStreamInletCount)
DEALLOCATE(FluidStreamOutletCount)
DEALLOCATE(FluidStreamCounts)
DEALLOCATE(NodeObjects)
ENDIF
NumNodeConnectionErrors=NumNodeConnectionErrors+ErrorCounter
RETURN
END SUBROUTINE CheckNodeConnections