Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | NodeTypes | |||
character(len=*), | intent(in) | :: | CheckType | |||
logical, | intent(inout) | :: | ErrorsFound | |||
character(len=*), | intent(in), | optional | :: | CheckName | ||
integer, | intent(in), | optional | :: | CheckNumber | ||
character(len=*), | intent(in), | optional | :: | ObjectName |
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 CheckUniqueNodes(NodeTypes,CheckType,ErrorsFound,CheckName,CheckNumber,ObjectName)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN November 2002
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine checks the appropriate input argument for uniqueness.
! Call CheckUniqueNodes(NodeTypes,CheckType,ErrorsFound,CheckName,CheckNumber)
! NodeTypes - used in error message (if any produced)
! CheckType - "NodeName' or 'NodeNumber' (only 1 can be input per time)
! ErrorsFound - true if error found by routine
! CheckName - NodeName entered
! CheckNumber - Node Number entered
! only 1 of CheckName or CheckNumber need be entered.
! ObjectName - "Name" field of object (i.e., CurCheckContextName)
! METHODOLOGY EMPLOYED:
! checks the current list of items for this (again)
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: NodeTypes
CHARACTER(len=*), INTENT(IN) :: CheckType
LOGICAL, INTENT(INOUT) :: ErrorsFound
CHARACTER(len=*), INTENT(IN), OPTIONAL :: CheckName
INTEGER, INTENT(IN), OPTIONAL :: CheckNumber
CHARACTER(len=*), INTENT(IN), OPTIONAL :: ObjectName
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Found
SELECT CASE (MakeUPPERCase(CheckType))
CASE ('NODENAME','NODENAMES','NODE NAME','NODE NAMES')
IF (.not. PRESENT(CheckName)) THEN
CALL ShowFatalError('Routine CheckUniqueNodes called with Nodetypes=NodeName, '// &
'but did not include CheckName argument.')
ENDIF
IF (CheckName /= Blank) THEN
Found=FindItemInList(CheckName,UniqueNodeNames,NumCheckNodes)
IF (Found /= 0) THEN
CALL ShowSevereError(trim(CurCheckContextName)//'="'//trim(ObjectName)//'", duplicate node names found.')
CALL ShowContinueError('...for Node Type(s)='//trim(NodeTypes)//', duplicate node name="'//trim(CheckName)//'".')
CALL ShowContinueError('...Nodes must be unique across instances of this object.')
! CALL ShowSevereError('Node Types='//TRIM(NodeTypes)//', Non Unique Name found='//TRIM(CheckName))
! CALL ShowContinueError('Context='//TRIM(CurCheckContextName))
ErrorsFound=.true.
ELSE
NumCheckNodes=NumCheckNodes+1
IF (NumCheckNodes > MaxCheckNodes) THEN
ALLOCATE(TmpNodeID(MaxCheckNodes+100))
TmpNodeID=Blank
TmpNodeID(1:NumCheckNodes-1)=UniqueNodeNames
DEALLOCATE(UniqueNodeNames)
MaxCheckNodes=MaxCheckNodes+100
ALLOCATE(UniqueNodeNames(MaxCheckNodes))
UniqueNodeNames=TmpNodeID
DEALLOCATE(TmpNodeID)
ENDIF
UniqueNodeNames(NumCheckNodes)=CheckName
ENDIF
ENDIF
CASE ('NODENUMBER','NODENUMBERS','NODE NUMBER','NODE NUMBERS')
IF (.not. PRESENT(CheckNumber)) THEN
CALL ShowFatalError('Routine CheckUniqueNodes called with Nodetypes=NodeNumber, '// &
'but did not include CheckNumber argument.')
ENDIF
IF (CheckNumber /= 0) THEN
Found=FindItemInList(NodeID(CheckNumber),UniqueNodeNames,NumCheckNodes)
IF (Found /= 0) THEN
CALL ShowSevereError(trim(CurCheckContextName)//'="'//trim(ObjectName)//'", duplicate node names found.')
CALL ShowContinueError('...for Node Type(s)='//trim(NodeTypes)//', duplicate node name="'//trim(CheckName)//'".')
CALL ShowContinueError('...Nodes must be unique across instances of this object.')
! CALL ShowSevereError('Node Types='//TRIM(NodeTypes)//', Non Unique Name found='//TRIM(NodeID(CheckNumber)))
! CALL ShowContinueError('Context='//TRIM(CurCheckContextName))
ErrorsFound=.true.
ELSE
NumCheckNodes=NumCheckNodes+1
IF (NumCheckNodes > MaxCheckNodes) THEN
ALLOCATE(TmpNodeID(MaxCheckNodes+100))
TmpNodeID=Blank
TmpNodeID(1:NumCheckNodes-1)=UniqueNodeNames
DEALLOCATE(UniqueNodeNames)
MaxCheckNodes=MaxCheckNodes+100
ALLOCATE(UniqueNodeNames(MaxCheckNodes))
UniqueNodeNames=TmpNodeID
DEALLOCATE(TmpNodeID)
ENDIF
UniqueNodeNames(NumCheckNodes)=NodeID(CheckNumber)
ENDIF
ENDIF
CASE DEFAULT
CALL ShowFatalError('CheckUniqueNodes called with invalid Check Type='//TRIM(CheckType))
ErrorsFound=.true.
END SELECT
RETURN
END SUBROUTINE CheckUniqueNodes