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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | ComponentType | |||
character(len=*), | intent(in) | :: | ComponentName | |||
integer, | intent(inout) | :: | NumChildren | |||
character(len=*), | DIMENSION(:) | :: | ChildrenCType | |||
character(len=*), | DIMENSION(:) | :: | ChildrenCName | |||
character(len=*), | DIMENSION(:) | :: | InletNodeName | |||
integer, | DIMENSION(:) | :: | InletNodeNum | |||
character(len=*), | DIMENSION(:) | :: | OutletNodeName | |||
integer, | DIMENSION(:) | :: | OutletNodeNum | |||
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.
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 GetChildrenData(ComponentType,ComponentName,NumChildren, &
ChildrenCType,ChildrenCName, &
InletNodeName,InletNodeNum, &
OutletNodeName,OutletNodeNum, &
ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN May 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine gets children data for given parent node.
! METHODOLOGY EMPLOYED:
! Traverses CompSet structure.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: ComponentType
CHARACTER(len=*), INTENT(IN) :: ComponentName
INTEGER, INTENT(INOUT) :: NumChildren
CHARACTER(len=*), DIMENSION(:) :: ChildrenCType
CHARACTER(len=*), DIMENSION(:) :: ChildrenCName
CHARACTER(len=*), DIMENSION(:) :: InletNodeName
INTEGER, DIMENSION(:) :: InletNodeNum
CHARACTER(len=*), DIMENSION(:) :: OutletNodeName
INTEGER, DIMENSION(:) :: OutletNodeNum
LOGICAL, INTENT(INOUT) :: ErrorsFound
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: ChildCType
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: ChildCName
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: ChildInNodeName
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: ChildOutNodeName
INTEGER, ALLOCATABLE, DIMENSION(:) :: ChildInNodeNum
INTEGER, ALLOCATABLE, DIMENSION(:) :: ChildOutNodeNum
INTEGER Loop
INTEGER CountNum
LOGICAL ErrInObject
CHARACTER(len=MaxNameLength) :: MatchNodeName
CHARACTER(len=MaxNameLength) :: ParentInletNodeName
CHARACTER(len=MaxNameLength) :: ParentOutletNodeName
INTEGER ParentInletNodeNum
INTEGER ParentOutletNodeNum
!unused1109 LOGICAL Matched
INTEGER CountMatchLoop
ChildrenCType=Blank
ChildrenCName=Blank
InletNodeName=Blank
InletNodeNum=0
OutletNodeName=Blank
OutletNodeNum=0
ErrInObject=.false.
IF (IsParentObject(ComponentType,ComponentName)) THEN
NumChildren=GetNumChildren(ComponentType,ComponentName)
IF (NumChildren == 0) THEN
CALL ShowWarningError('GetChildrenData: Parent Node has no children, node='// &
TRIM(ComponentType)//':'//TRIM(ComponentName))
ELSE
CALL GetParentData(ComponentType,ComponentName,ParentInletNodeName,ParentInletNodeNum, &
ParentOutletNodeName,ParentOutletNodeNum,ErrInObject)
ALLOCATE(ChildCType(NumChildren))
ALLOCATE(ChildCName(NumChildren))
ALLOCATE(ChildInNodeName(NumChildren))
ALLOCATE(ChildOutNodeName(NumChildren))
ALLOCATE(ChildInNodeNum(NumChildren))
ALLOCATE(ChildOutNodeNum(NumChildren))
ChildCType=Blank
ChildCName=Blank
ChildInNodeName=Blank
ChildOutNodeName=Blank
ChildInNodeNum=0
ChildOutNodeNum=0
CountNum=0
DO Loop=1,NumCompSets
IF (CompSets(Loop)%ParentCType == ComponentType .and. CompSets(Loop)%ParentCName == ComponentName) THEN
CountNum=CountNum+1
ChildCType(CountNum)=CompSets(Loop)%CType
ChildCName(CountNum)=CompSets(Loop)%CName
ChildInNodeName(CountNum)=CompSets(Loop)%InletNodeName
ChildOutNodeName(CountNum)=CompSets(Loop)%OutletNodeName
! Get Node Numbers
ChildInNodeNum(CountNum)=FindItemInList(ChildInNodeName(CountNum),NodeID(1:NumOfNodes),NumOfNodes)
! IF (ChildInNodeNum(CountNum) == 0) THEN
! CALL ShowSevereError('GetChildrenData: Inlet Node not previously assigned, Node='// &
! TRIM(ChildInNodeName(CountNum)))
! CALL ShowContinueError('..Component='//TRIM(ChildCType(CountNum))//':'//TRIM(ChildCName(CountNum)))
! CALL ShowContinueError('..Parent Object='//TRIM(ComponentType)//':'//TRIM(ComponentName))
! ErrInObject=.true.
! ENDIF
ChildOutNodeNum(CountNum)=FindItemInList(ChildOutNodeName(CountNum),NodeID(1:NumOfNodes),NumOfNodes)
! IF (ChildOutNodeNum(CountNum) == 0) THEN
! CALL ShowSevereError('GetChildrenData: Outlet Node not previously assigned, Node='// &
! TRIM(ChildOutNodeName(CountNum)))
! CALL ShowContinueError('..Component='//TRIM(ChildCType(CountNum))//':'//TRIM(ChildCName(CountNum)))
! CALL ShowContinueError('..Parent Object='//TRIM(ComponentType)//':'//TRIM(ComponentName))
! ErrInObject=.true.
! ENDIF
ENDIF
ENDDO
IF (CountNum /= NumChildren) THEN
CALL ShowSevereError('GetChildrenData: Counted nodes not equal to GetNumChildren count')
ErrInObject=.true.
ELSE
! Children arrays built. Now "sort" for flow connection order(?)
MatchNodeName=ParentInletNodeName
CountNum=0
CountMatchLoop=0
DO WHILE (CountMatchLoop < NumChildren)
CountMatchLoop=CountMatchLoop+1
! Matched=.false.
DO Loop=1,NumChildren
IF (ChildInNodeName(Loop) == MatchNodeName) THEN
CountNum=CountNum+1
ChildrenCType(CountNum)=ChildCType(Loop)
ChildrenCName(CountNum)=ChildCName(Loop)
InletNodeName(CountNum)=ChildInNodeName(Loop)
InletNodeNum(CountNum)=ChildInNodeNum(Loop)
OutletNodeName(CountNum)=ChildOutNodeName(Loop)
OutletNodeNum(CountNum)=ChildOutNodeNum(Loop)
ChildInNodeName(Loop)=Blank ! So it won't match anymore
! Matched=.true.
MatchNodeName=ChildOutNodeName(Loop)
EXIT
ENDIF
ENDDO
! IF (.not. Matched .and. MatchNodeName /= blank) THEN
! IF (CountMatchLoop > 1) THEN
! CALL ShowSevereError('GetChildrenData: Sorting for flow connection order..'// &
! 'Required Child Node, not matched. Expected Inlet Node='// &
! TRIM(MatchNodeName))
! ELSE
! CALL ShowSevereError('GetChildrenData: Sorting for 1st node in flow connection order..'// &
! 'Required Child Node, not matched. Expected Inlet Node='// &
! TRIM(MatchNodeName))
! ENDIF
! CALL ShowContinueError('..Parent Object='//TRIM(ComponentType)//':'//TRIM(ComponentName))
! ErrInObject=.true.
! ENDIF
ENDDO
IF (MatchNodeName /= ParentOutletNodeName) THEN
DO Loop=1,NumChildren
IF (ChildInNodeName(Loop) == Blank) CYCLE
IF (ChildOutNodeName(Loop) == ParentOutletNodeName) EXIT
! CALL ShowSevereError('GetChildrenData: Sorting for flow connection order..'// &
! 'Required Child Node, not matched. Expected (Last) Outlet Node='// &
! TRIM(MatchNodeName))
! CALL ShowContinueError('..does not match Parent Outlet Node='//TRIM(ParentOutletNodeName))
! CALL ShowContinueError('..Parent Object='//TRIM(ComponentType)//':'//TRIM(ComponentName))
EXIT
! ErrInObject=.true.
ENDDO
ENDIF
DO Loop=1,NumChildren
IF (ChildInNodeName(Loop) == Blank) CYCLE
CountNum=CountNum+1
ChildrenCType(CountNum)=ChildCType(Loop)
ChildrenCName(CountNum)=ChildCName(Loop)
InletNodeName(CountNum)=ChildInNodeName(Loop)
InletNodeNum(CountNum)=ChildInNodeNum(Loop)
OutletNodeName(CountNum)=ChildOutNodeName(Loop)
OutletNodeNum(CountNum)=ChildOutNodeNum(Loop)
ENDDO
DEALLOCATE(ChildCType)
DEALLOCATE(ChildCName)
DEALLOCATE(ChildInNodeName)
DEALLOCATE(ChildOutNodeName)
DEALLOCATE(ChildInNodeNum)
DEALLOCATE(ChildOutNodeNum)
ENDIF
ENDIF
ELSE
CALL ShowSevereError('GetChildrenData: Requested Children Data for non Parent Node='// &
TRIM(ComponentType)//':'//TRIM(ComponentName))
ErrInObject=.true.
ENDIF
IF (ErrInObject) ErrorsFound=.true.
RETURN
END SUBROUTINE GetChildrenData