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) | :: | ErrFound |
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 TestBranchIntegrity(ErrFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN November 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine tests branch integrity and displays the loop for each branch.
! Also, input and output nodes.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE NodeInputManager, ONLY: InitUniqueNodeCheck,CheckUniqueNodes,EndUniqueNodeCheck
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrFound
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
TYPE BranchUniqueNodes
INTEGER :: NumNodes=0
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: UniqueNodeNames
END TYPE
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Loop
INTEGER Count
INTEGER :: MatchNode ! Node Number for match
CHARACTER(len=MaxNameLength) &
:: MatchNodeName ! Name for error message if not matched
CHARACTER(len=MaxNameLength) &
:: BranchInletNodeName ! Branch Inlet Node Name
CHARACTER(len=MaxNameLength) &
:: BranchOutletNodeName ! Branch Outlet Node Name
CHARACTER(len=MaxNameLength) &
:: BranchLoopName ! Loop Name which Branch is part of
CHARACTER(len=MaxNameLength) &
:: BranchLoopType ! Loop Type which Branch is part of
INTEGER :: NumErr ! Error Counter
LOGICAL, ALLOCATABLE, DIMENSION(:) :: BranchReported
TYPE(BranchUniqueNodes), DIMENSION(:), ALLOCATABLE :: BranchNodes
INTEGER BCount
INTEGER Found
CHARACTER(len=20) ChrOut
CHARACTER(len=20) ChrOut1
! LOGICAL UniqueNodeError
INTEGER NodeNum
INTEGER Loop2
LOGICAL :: IsAirBranch
INTEGER :: BranchFluidType
LOGICAL :: MixedFluidTypesOnBranchList
INTEGER :: InitialBranchFluidNode
INTEGER,ALLOCATABLE, DIMENSION(:) :: BranchFluidNodes
INTEGER,ALLOCATABLE, DIMENSION(:) :: FoundBranches
INTEGER,ALLOCATABLE, DIMENSION(:) :: BranchPtrs
INTEGER :: NumNodesOnBranchList
INTEGER :: NumFluidNodes
CHARACTER(len=MaxNameLength) :: OriginalBranchFluidType
CHARACTER(len=MaxNameLength) :: cBranchFluidType
INTEGER :: Ptr
INTEGER :: EndPtr
ALLOCATE(BranchReported(NumOfBranches))
BranchReported=.false.
! Do by Branch Lists
CALL ShowMessage('Testing Individual Branch Integrity')
ErrFound=.false.
ALLOCATE(BranchNodes(NumOfBranches))
WRITE(OutputFileBNDetails,701) '! ==============================================================='
WRITE(OutputFileBNDetails,700)
WRITE(ChrOut,*) NumOfBranchLists
WRITE(OutputFileBNDetails,701) ' #Branch Lists,'//TRIM(ADJUSTL(ChrOut))
WRITE(OutputFileBNDetails,702)
WRITE(OutputFileBNDetails,704)
700 FORMAT('! <#Branch Lists>,<Number of Branch Lists>')
701 FORMAT(A)
702 FORMAT('! <Branch List>,<Branch List Count>,<Branch List Name>,<Loop Name>,<Loop Type>,<Number of Branches>')
704 FORMAT('! <Branch>,<Branch Count>,<Branch Name>,<Loop Name>,<Loop Type>,<Branch Inlet Node Name>,<Branch Outlet Node Name>')
706 FORMAT('! <# Orphaned Branches>,<Number of Branches not on Branch Lists>')
DO BCount=1,NumOfBranchLists
WRITE(ChrOut,*) BCount
WRITE(ChrOut1,*) BranchList(BCount)%NumOfBranchNames
WRITE(OutputFileBNDetails,701) ' Branch List,'//TRIM(ADJUSTL(ChrOut))//','//TRIM(BranchList(BCount)%Name)//','// &
TRIM(BranchList(BCount)%LoopName)//','//TRIM(BranchList(BCount)%LoopType)//','// &
TRIM(ADJUSTL(ChrOut1))
IsAirBranch=.false.
BranchFluidType=NodeType_Unknown
MixedFluidTypesOnBranchList=.false.
NumNodesOnBranchList=0
ALLOCATE(FoundBranches(BranchList(BCount)%NumOfBranchNames))
FoundBranches=0
ALLOCATE(BranchPtrs(BranchList(BCount)%NumOfBranchNames+2))
BranchPtrs=0
DO Count=1,BranchList(BCount)%NumOfBranchNames
Found=FindItemInList(BranchList(BCount)%BranchNames(Count),Branch%Name,NumOfBranches)
IF (Found > 0) THEN
NumNodesOnBranchList=NumNodesOnBranchList+Branch(Found)%NumOfComponents*2
FoundBranches(Count)=Found
BranchPtrs(Count)=NumNodesOnBranchList
ELSE
CALL ShowSevereError('Branch not found='//TRIM(BranchList(BCount)%BranchNames(Count)))
ErrFound=.true.
ENDIF
ENDDO
BranchPtrs(BranchList(BCount)%NumOfBranchNames+1)=BranchPtrs(BranchList(BCount)%NumOfBranchNames)+1
ALLOCATE(BranchFluidNodes(NumNodesOnBranchList))
BranchFluidNodes=0
OriginalBranchFluidType=Blank
NumFluidNodes=0
DO Count=1,BranchList(BCount)%NumOfBranchNames
ChrOut=RoundSigDigits(Count)
! WRITE(ChrOut,*) Count
! ChrOut=ADJUSTL(ChrOut)
Found=FoundBranches(Count)
IF (Found == 0) THEN
WRITE(OutputFileBNDetails,701) ' Branch,'//TRIM(ChrOut)//','// &
TRIM(BranchList(BCount)%BranchNames(Count))//'(not found),'// &
'**Unknown**,**Unknown**,**Unknown**,**Unknown**'
CYCLE
ENDIF
BranchReported(Found)=.true.
! Check Branch for connections
MatchNode=0
InitialBranchFluidNode=0
IF (Branch(Found)%NumOfComponents > 0) THEN
MatchNode=Branch(Found)%Component(1)%InletNode
MatchNodeName=Branch(Found)%Component(1)%InletNodeName
BranchInletNodeName=Branch(Found)%Component(1)%InletNodeName
ELSE
CALL ShowWarningError('Branch has no components='//TRIM(Branch(Found)%Name))
ENDIF
NumErr=0
DO Loop=1,Branch(Found)%NumOfComponents
IF (Node(Branch(Found)%Component(Loop)%InletNode)%FluidType == NodeType_Air) IsAirBranch=.true.
IF (BranchFluidType == NodeType_Unknown) THEN
NumFluidNodes=NumFluidNodes+1
BranchFluidNodes(NumFluidNodes)=Branch(Found)%Component(Loop)%InletNode
BranchFluidType=Node(Branch(Found)%Component(Loop)%InletNode)%FluidType
InitialBranchFluidNode=Branch(Found)%Component(Loop)%InletNode
OriginalBranchFluidType=ValidNodeFluidTypes(BranchFluidType)
ELSEIF (BranchFluidType /= Node(Branch(Found)%Component(Loop)%InletNode)%FluidType .and. &
Node(Branch(Found)%Component(Loop)%InletNode)%FluidType /= NodeType_Unknown ) THEN
NumFluidNodes=NumFluidNodes+1
BranchFluidNodes(NumFluidNodes)=Branch(Found)%Component(Loop)%InletNode
MixedFluidTypesOnBranchList=.true.
ELSE
NumFluidNodes=NumFluidNodes+1
BranchFluidNodes(NumFluidNodes)=Branch(Found)%Component(Loop)%InletNode
ENDIF
IF (Node(Branch(Found)%Component(Loop)%OutletNode)%FluidType == NodeType_Air) IsAirBranch=.true.
IF (BranchFluidType == NodeType_Unknown) THEN
NumFluidNodes=NumFluidNodes+1
BranchFluidNodes(NumFluidNodes)=Branch(Found)%Component(Loop)%InletNode
BranchFluidType=Node(Branch(Found)%Component(Loop)%OutletNode)%FluidType
InitialBranchFluidNode=Branch(Found)%Component(Loop)%OutletNode
OriginalBranchFluidType=ValidNodeFluidTypes(BranchFluidType)
ELSEIF (BranchFluidType /= Node(Branch(Found)%Component(Loop)%OutletNode)%FluidType .and. &
Node(Branch(Found)%Component(Loop)%OutletNode)%FluidType /= NodeType_Unknown ) THEN
NumFluidNodes=NumFluidNodes+1
BranchFluidNodes(NumFluidNodes)=Branch(Found)%Component(Loop)%OutletNode
MixedFluidTypesOnBranchList=.true.
ELSE
NumFluidNodes=NumFluidNodes+1
BranchFluidNodes(NumFluidNodes)=Branch(Found)%Component(Loop)%OutletNode
ENDIF
IF (Branch(Found)%Component(Loop)%InletNode /= MatchNode) THEN
CALL ShowSevereError('Error Detected in BranchList='//TRIM(BranchList(BCount)%Name))
CALL ShowContinueError('Actual Error occurs in Branch='//TRIM(Branch(Found)%Name))
CALL ShowContinueError('Branch Outlet does not match Inlet, Outlet='//TRIM(MatchNodeName))
CALL ShowContinueError('Inlet Name='//TRIM(Branch(Found)%Component(Loop)%InletNodeName))
ErrFound=.true.
NumErr=NumErr+1
ELSE
MatchNode=Branch(Found)%Component(Loop)%OutletNode
MatchNodeName=Branch(Found)%Component(Loop)%OutletNodeName
ENDIF
ENDDO
Branch(Found)%FluidType=BranchFluidType
IF (IsAirBranch .and. Branch(Found)%MaxFlowRate == 0.0d0) THEN
CALL ShowSevereError('Branch='//TRIM(Branch(Found)%Name)//' is an air branch with zero max flow rate.')
ErrFound=.true.
ENDIF
BranchOutletNodeName=MatchNodeName
IF (Branch(Found)%AssignedLoopName == Blank) THEN
BranchLoopName = '**Unknown**'
BranchLoopType = '**Unknown**'
ELSEIF (TRIM(Branch(Found)%AssignedLoopName) == TRIM(BranchList(BCount)%LoopName)) THEN
BranchLoopName = TRIM(BranchList(BCount)%LoopName)
BranchLoopType = TRIM(BranchList(BCount)%LoopType)
ELSE
BranchLoopName = TRIM(Branch(Found)%AssignedLoopName)
BranchLoopType = '**Unknown**'
ENDIF
WRITE(OutputFileBNDetails,701) ' Branch,'//TRIM(ChrOut)//','//TRIM(Branch(Found)%Name)//','// &
TRIM(BranchLoopName)//','//TRIM(BranchLoopType)//','// &
TRIM(BranchInletNodeName)//','//TRIM(BranchOutletNodeName)
ENDDO
IF (MixedFluidTypesOnBranchList) THEN
CALL ShowSevereError('BranchList='//TRIM(BranchList(BCount)%Name)//' has mixed fluid types in its nodes.')
Errfound=.true.
IF (OriginalBranchFluidType == Blank) OriginalBranchFluidType='**Unknown**'
CALL ShowContinueError('Initial Node='//trim(NodeID(InitialBranchFluidNode))// &
', Fluid Type='//trim(OriginalBranchFluidType))
CALL ShowContinueError('BranchList Topology - Note nodes which do not match that fluid type:')
Ptr=1
EndPtr=BranchPtrs(1)
DO Loop=1,BranchList(BCount)%NumOfBranchNames
IF (FoundBranches(Loop) /= 0) THEN
CALL ShowContinueError('..Branch='//trim(Branch(FoundBranches(Loop))%Name))
ELSE
CALL ShowContinueError('..Illegal Branch='//trim(BranchList(BCount)%BranchNames(Loop)))
CYCLE
ENDIF
DO Loop2=Ptr,EndPtr
cBranchFluidType=ValidNodeFluidTypes(Node(BranchFluidNodes(Loop2))%FluidType)
IF (cBranchFluidType == Blank) cBranchFluidType='**Unknown**'
CALL ShowContinueError('....Node='//trim(NodeID(BranchFluidNodes(Loop2)))//', Fluid Type='// &
trim(cBranchFluidType))
ENDDO
Ptr=EndPtr+1
EndPtr=BranchPtrs(Loop+1)
ENDDO
ENDIF
DEALLOCATE(BranchFluidNodes)
DEALLOCATE(BranchPtrs)
DEALLOCATE(FoundBranches)
ENDDO
! Build node names in branches
DO Count=1,NumOfBranches
ALLOCATE(BranchNodes(Count)%UniqueNodeNames(Branch(Count)%NumOfComponents*2))
BranchNodes(Count)%UniqueNodeNames=Blank
NodeNum=0
DO Loop=1,Branch(Count)%NumOfComponents
Found=FindItemInList(Branch(Count)%Component(Loop)%InletNodeName,BranchNodes(Count)%UniqueNodeNames,NodeNum)
IF (Found == 0) THEN
NodeNum=NodeNum+1
BranchNodes(Count)%UniqueNodeNames(NodeNum)=Branch(Count)%Component(Loop)%InletNodeName
ENDIF
Found=FindItemInList(Branch(Count)%Component(Loop)%OutletNodeName,BranchNodes(Count)%UniqueNodeNames,NodeNum)
IF (Found == 0) THEN
NodeNum=NodeNum+1
BranchNodes(Count)%UniqueNodeNames(NodeNum)=Branch(Count)%Component(Loop)%OutletNodeName
ENDIF
ENDDO
BranchNodes(Count)%NumNodes=NodeNum
ENDDO
! Check Uniqueness branch to branch
DO Count=1,NumOfBranches
DO Loop=Count+1,NumOfBranches
DO Loop2=1,BranchNodes(Count)%NumNodes
Found=FindItemInList(BranchNodes(Count)%UniqueNodeNames(Loop2), &
BranchNodes(Loop)%UniqueNodeNames,BranchNodes(Loop)%NumNodes)
IF (Found /= 0) THEN
CALL ShowSevereError('Non-unique node name found, name='//TRIM(BranchNodes(Count)%UniqueNodeNames(Loop2)))
CALL ShowContinueError('..1st occurence in Branch='//TRIM(Branch(Count)%Name))
CALL ShowContinueError('..duplicate occurrence in Branch='//TRIM(Branch(Loop)%Name))
ErrFound=.true.
ENDIF
ENDDO
ENDDO
ENDDO
DO Count=1,NumOfBranches
DEALLOCATE(BranchNodes(Count)%UniqueNodeNames)
ENDDO
DEALLOCATE(BranchNodes)
BCount=0
DO Count=1,NumOfBranches
IF (BranchReported(Count)) CYCLE
BCount=BCount+1
ENDDO
IF (BCount > 0) THEN
WRITE(OutputFileBNDetails,706)
ChrOut=RoundSigDigits(BCount)
! WRITE(ChrOut,*) BCount
WRITE(OutputFileBNDetails,701) ' #Orphaned Branches,'//TRIM(ChrOut)
CALL ShowWarningError('There are orphaned Branches in input. See .bnd file for details.')
BCount=0
DO Count=1,NumOfBranches
IF (BranchReported(Count)) CYCLE
BCount=BCount+1
CALL ShowWarningError('Orphan Branch="'//trim(Branch(Count)%Name)//'".')
! WRITE(ChrOut,*) BCount
! ChrOut=ADJUSTL(ChrOut)
ChrOut=RoundSigDigits(BCount)
IF (Branch(Count)%NumOfComponents > 0) THEN
MatchNode=Branch(Count)%Component(1)%InletNode
MatchNodeName=Branch(Count)%Component(1)%InletNodeName
BranchInletNodeName=Branch(Count)%Component(1)%InletNodeName
ELSE
CALL ShowWarningError('Branch has no components='//TRIM(Branch(Count)%Name))
ENDIF
NumErr=0
DO Loop=1,Branch(Count)%NumOfComponents
IF (Branch(Count)%Component(Loop)%InletNode /= MatchNode) THEN
CALL ShowSevereError('Error Detected in Branch='//TRIM(Branch(Count)%Name))
CALL ShowContinueError('Branch Outlet does not match Inlet, Outlet='//TRIM(MatchNodeName))
CALL ShowContinueError('Inlet Name='//TRIM(Branch(Count)%Component(Loop)%InletNodeName))
ErrFound=.true.
NumErr=NumErr+1
ELSE
MatchNode=Branch(Count)%Component(Loop)%OutletNode
MatchNodeName=Branch(Count)%Component(Loop)%OutletNodeName
ENDIF
ENDDO
BranchOutletNodeName=MatchNodeName
IF (Branch(Count)%AssignedLoopName == Blank) THEN
BranchLoopName = '**Unknown**'
BranchLoopType = '**Unknown**'
ELSE
BranchLoopName = TRIM(Branch(Count)%AssignedLoopName)
BranchLoopType = '**Unknown**'
ENDIF
WRITE(OutputFileBNDetails,701) ' Branch,'//TRIM(ChrOut)//','//TRIM(Branch(Count)%Name)//','// &
TRIM(BranchLoopName)//','//TRIM(BranchLoopType)//','// &
TRIM(BranchInletNodeName)//','//TRIM(BranchOutletNodeName)
ENDDO
ENDIF
IF (ErrFound) THEN
CALL ShowSevereError('Branch(es) did not pass integrity testing')
ELSE
CALL ShowMessage('All Branches passed integrity testing')
ENDIF
RETURN
END SUBROUTINE TestBranchIntegrity