Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | Name | |||
integer, | intent(out) | :: | NumNodes | |||
integer, | intent(out), | DIMENSION(:) | :: | NodeNumbers | ||
logical, | intent(inout) | :: | ErrorsFound | |||
integer, | intent(in) | :: | NodeFluidType | |||
character(len=*), | intent(in) | :: | NodeObjectType | |||
character(len=*), | intent(in) | :: | NodeObjectName | |||
integer, | intent(in) | :: | NodeConnectionType | |||
integer, | intent(in) | :: | NodeFluidStream | |||
logical, | intent(in) | :: | ObjectIsParent | |||
logical, | intent(in), | optional | :: | IncrementFluidStream | ||
character(len=*), | intent(in), | optional | :: | InputFieldName |
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 GetNodeNums(Name,NumNodes,NodeNumbers,ErrorsFound,NodeFluidType,NodeObjectType,NodeObjectName, &
NodeConnectionType,NodeFluidStream,ObjectIsParent,IncrementFluidStream,InputFieldName)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN September 1999
! MODIFIED February 2004, Fluid Type checking/setting
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calls the Node Manager to determine if the
! entered name has already been assigned and if it is a list
! or if it is a single node. If it has not been assigned, then
! it is a single node and will need to be entered in the Node
! data structure.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: Name ! Name for which to obtain information
INTEGER, INTENT(OUT) :: NumNodes ! Number of nodes accompanying this Name
INTEGER, INTENT(OUT), DIMENSION(:) :: NodeNumbers ! Node Numbers accompanying this Name
LOGICAL, INTENT(INOUT) :: ErrorsFound ! True when errors are found...
INTEGER, INTENT(IN) :: NodeFluidType ! Fluidtype for checking/setting node FluidType
CHARACTER(len=*), INTENT(IN) :: NodeObjectType ! Node Object Type (i.e. "Chiller:Electric")
CHARACTER(len=*), INTENT(IN) :: NodeObjectName ! Node Object Name (i.e. "MyChiller")
INTEGER, INTENT(IN) :: NodeConnectionType ! Node Connection Type (see DataLoopNode)
INTEGER, INTENT(IN) :: NodeFluidStream ! Which Fluid Stream (1,2,3,...)
LOGICAL, INTENT(IN) :: ObjectIsParent ! True/False
LOGICAL, INTENT(IN), OPTIONAL :: IncrementFluidStream ! True/False
CHARACTER(len=*), INTENT(IN), OPTIONAL :: InputFieldName ! Input Field Name
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetNodeNums: '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER ThisOne ! Indicator for this Name
! CHARACTER(len=20) :: CaseNodeFluidType
CHARACTER(len=20) :: cNodeFluidType
CHARACTER(len=32) :: ConnectionType
INTEGER Loop
INTEGER FluidStreamNum ! Fluid stream number passed to RegisterNodeConnection
IF (GetNodeInputFlag) THEN
CALL GetNodeListsInput(ErrorsFound)
GetNodeInputFlag=.false.
ENDIF
IF (NodeFluidType /= NodeType_Air .and. NodeFluidType /= NodeType_Water .and. &
NodeFluidType /= NodeType_Electric .and.NodeFluidType /= NodeType_Steam .and. &
NodeFluidType /= NodeType_Unknown) THEN
WRITE(cNodeFluidType,*) NodeFluidType
cNodeFluidType=ADJUSTL(cNodeFluidType)
CALL ShowSevereError(RoutineName//trim(NodeObjectType)//'="'//trim(NodeObjectName)//'", invalid fluid type.')
CALL ShowContinueError('..Invalid FluidType='//TRIM(cNodeFluidType))
ErrorsFound=.true.
CALL ShowFatalError('Preceding issue causes termination.')
ENDIF
IF (Name /= ' ') THEN
ThisOne=FindItemInList(Name,NodeLists%Name,NumOfNodeLists)
IF (ThisOne /= 0) THEN
NumNodes=NodeLists(ThisOne)%NumOfNodesInList
NodeNumbers(1:NumNodes)=NodeLists(ThisOne)%NodeNumbers(1:NumNodes)
DO Loop=1,NumNodes
IF (NodeFluidType /= NodeType_Unknown .and. Node(NodeNumbers(Loop))%FluidType /= NodeType_Unknown) THEN
IF (Node(NodeNumbers(Loop))%FluidType /= NodeFluidType) THEN
CALL ShowSevereError(RoutineName//trim(NodeObjectType)//'="'//trim(NodeObjectName)//'", invalid data.')
IF (PRESENT(InputFieldName)) CALL ShowContinueError('...Ref field='//trim(InputFieldName))
CALL ShowContinueError('Existing Fluid type for node, incorrect for request. Node='//TRIM(NodeID(NodeNumbers(Loop))))
CALL ShowContinueError('Existing Fluid type='//TRIM(ValidNodeFluidTypes(Node(NodeNumbers(Loop))%FluidType))// &
', Requested Fluid Type='//TRIM(ValidNodeFluidTypes(NodeFluidType)))
ErrorsFound=.true.
ENDIF
ENDIF
IF (Node(NodeNumbers(Loop))%FluidType == NodeType_Unknown) THEN
Node(NodeNumbers(Loop))%FluidType=NodeFluidType
ENDIF
NodeRef(NodeNumbers(Loop))=NodeRef(NodeNumbers(Loop))+1
ENDDO
ELSE
ThisOne=AssignNodeNumber(Name,NodeFluidType,ErrorsFound)
NumNodes=1
NodeNumbers(1)=ThisOne
ENDIF
ELSE
NumNodes=0
NodeNumbers(1)=0
ENDIF
! Most calls to this routined use a fixed fluid stream number for all nodes, this is the default
FluidStreamNum = NodeFluidStream
DO Loop=1,NumNodes
IF (NodeConnectionType >= 1 .and. NodeConnectionType <= NumValidConnectionTypes) THEN
ConnectionType=ValidConnectionTypes(NodeConnectionType)
ELSE
ConnectionType=trim(TrimSigDigits(NodeConnectionType))//'-unknown'
ENDIF
! If requested, assign NodeFluidStream to the first node and increment the fluid stream number
! for each remaining node in the list
IF (PRESENT(IncrementFluidStream)) THEN
IF (IncrementFluidStream) FluidStreamNum = NodeFluidStream + (Loop - 1)
ENDIF
CALL RegisterNodeConnection(NodeNumbers(Loop),NodeID(NodeNumbers(Loop)),NodeObjectType,NodeObjectName, &
ConnectionType,FluidStreamNum,ObjectIsParent,ErrorsFound,InputFieldName=InputFieldName)
ENDDO
RETURN
END SUBROUTINE GetNodeNums