Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical, | intent(out) | :: | 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 GetNodeListsInput(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN September 1999
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the Node Lists from the IDF and fills the
! Node List Data Structure.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(OUT) :: ErrorsFound
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetNodeListsInput: '
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='NodeList'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Loop ! Loop Variable
INTEGER Loop1 ! Loop Variable
INTEGER Loop2 ! Loop Variable
INTEGER :: NumAlphas ! Number of alphas in IDF item
INTEGER :: NumNumbers ! Number of numerics in IDF item
INTEGER :: IOStatus ! IOStatus for IDF item (not checked)
INTEGER :: NCount ! Actual number of node lists
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: flagError ! true when error node list name should be output
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphas
REAL(r64), ALLOCATABLE, DIMENSION(:) :: rNumbers
ErrorsFound=.false.
CALL GetObjectDefMaxArgs(CurrentModuleObject,NCount,NumAlphas,NumNumbers)
ALLOCATE(cAlphas(NumAlphas))
ALLOCATE(rNumbers(NumNumbers))
NumOfNodeLists=GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(NodeLists(NumOfNodeLists))
IF (NumOfNodeLists >0) THEN
NodeLists(1:NumOfNodeLists)%Name=' '
NodeLists(1:NumOfNodeLists)%NumOfNodesInList=0
ENDIF
NCount=0
DO Loop=1,NumOfNodeLists
CALL GetObjectItem(CurrentModuleObject,Loop,cAlphas,NumAlphas,rNumbers,NumNumbers,IOStatus)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphas(1),NodeLists%Name,NCount,IsNotOK,IsBlank,CurrentModuleObject//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
CYCLE
ENDIF
NCount=NCount+1
NodeLists(NCount)%Name=cAlphas(1)
ALLOCATE(NodeLists(NCount)%NodeNames(NumAlphas-1))
NodeLists(NCount)%NodeNames=' '
ALLOCATE(NodeLists(NCount)%NodeNumbers(NumAlphas-1))
NodeLists(NCount)%NodeNumbers=0
NodeLists(NCount)%NumOfNodesInList=NumAlphas-1
IF (NumAlphas <= 1) THEN
IF (NumAlphas == 1) THEN
CALL ShowSevereError(RoutineName//CurrentModuleObject//'="'//trim(cAlphas(1))//'" does not have any nodes.')
ELSE
CALL ShowSevereError(RoutineName//CurrentModuleObject//'=<blank> does not have any nodes or nodelist name.')
ENDIF
ErrorsFound=.true.
CYCLE
ENDIF
! Put all in, then determine unique
DO Loop1=1,NumAlphas-1
NodeLists(NCount)%NodeNames(Loop1)=cAlphas(Loop1+1)
IF (cAlphas(Loop1+1) == blank) THEN
CALL ShowWarningError(RoutineName//CurrentModuleObject//'="'//trim(cAlphas(1))//'", blank node name in list.')
NodeLists(NCount)%NumOfNodesInList=NodeLists(NCount)%NumOfNodesInList-1
IF (NodeLists(NCount)%NumOfNodesInList <= 0) THEN
CALL ShowSevereError(RoutineName//CurrentModuleObject//'="'//trim(cAlphas(1))//'" does not have any nodes.')
ErrorsFound=.true.
EXIT
ENDIF
CYCLE
ENDIF
NodeLists(NCount)%NodeNumbers(Loop1)=AssignNodeNumber(NodeLists(NCount)%NodeNames(Loop1),NodeType_Unknown,ErrorsFound)
IF (SameString(NodeLists(NCount)%NodeNames(Loop1),NodeLists(NCount)%Name)) THEN
CALL ShowSevereError(RoutineName//CurrentModuleObject//'="'//trim(cAlphas(1))//'", invalid node name in list.')
CALL ShowContinueError('... Node '//trim(TrimSigDigits(Loop1))//' Name="'//trim(cAlphas(Loop1+1))// &
'", duplicates NodeList Name.')
ErrorsFound=.true.
ENDIF
ENDDO
! Error on any duplicates
flagError=.true.
DO Loop1=1,NodeLists(NCount)%NumOfNodesInList
DO Loop2=Loop1+1,NodeLists(NCount)%NumOfNodesInList
IF (NodeLists(NCount)%NodeNumbers(Loop1) /= NodeLists(NCount)%NodeNumbers(Loop2)) CYCLE
IF (flagError) THEN ! only list nodelist name once
CALL ShowSevereError(RoutineName//CurrentModuleObject//'="'//trim(cAlphas(1))//'" has duplicate nodes:')
flagError=.false.
ENDIF
CALL ShowContinueError('...list item='// &
trim(TrimSigDigits(Loop1))//', "'//trim(NodeID(NodeLists(NCount)%NodeNumbers(Loop1)))//'", duplicate list item='// &
trim(TrimSigDigits(Loop2))//', "'//trim(NodeID(NodeLists(NCount)%NodeNumbers(Loop2)))//'".')
ErrorsFound=.true.
ENDDO
ENDDO
ENDDO
DO Loop=1,NumOfNodeLists
DO Loop2=1,NodeLists(Loop)%NumOfNodesInList
DO Loop1=1,NumOfNodeLists
IF (Loop == Loop1) CYCLE ! within a nodelist have already checked to see if node name duplicates nodelist name
IF (.not. SameString(NodeLists(Loop)%NodeNames(Loop2),NodeLists(Loop1)%Name)) CYCLE
CALL ShowSevereError(RoutineName//CurrentModuleObject//'="'//trim(NodeLists(Loop1)%Name)//'", invalid node name in list.')
CALL ShowContinueError('... Node '//trim(TrimSigDigits(Loop2))//' Name="'// &
trim(NodeLists(Loop)%NodeNames(Loop2))//'", duplicates NodeList Name.')
CALL ShowContinueError('... NodeList="'//trim(NodeLists(Loop1)%Name)//'", is duplicated.')
CALL ShowContinueError('... Items in NodeLists must not be the name of another NodeList.')
ErrorsFound=.true.
ENDDO
ENDDO
ENDDO
DEALLOCATE(cAlphas)
DEALLOCATE(rNumbers)
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//CurrentModuleObject//': Error getting input - causes termination.')
ENDIF
RETURN
END SUBROUTINE GetNodeListsInput