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) | :: | LoopName | |||
character(len=*), | intent(in) | :: | ConnectorListName | |||
character(len=MaxNameLength), | intent(out) | :: | MixerName | |||
logical, | intent(out) | :: | IsMixer | |||
character(len=MaxNameLength), | intent(out) | :: | OutletNodeName | |||
integer, | intent(out) | :: | OutletNodeNum | |||
integer, | intent(out) | :: | NumInletNodes | |||
character(len=MaxNameLength), | intent(out), | DIMENSION(:) | :: | InletNodeNames | ||
integer, | intent(out), | DIMENSION(:) | :: | InletNodeNums | ||
logical, | intent(inout) | :: | ErrorsFound | |||
integer, | intent(in), | optional | :: | ConnectorNumber | ||
integer, | intent(inout), | optional | :: | MixerNumber |
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 GetLoopMixer(LoopName,ConnectorListName,MixerName,IsMixer,OutletNodeName,OutletNodeNum,NumInletNodes, &
InletNodeNames,InletNodeNums,ErrorsFound,ConnectorNumber,MixerNumber)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN October 1999
! MODIFIED October 2001, Automatic Extensibility
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine gets the data for the requested Connector List and returns values indicating
! if this connector list name is a mixer or not.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: TrimSigDigits
USE InputProcessor, ONLY: SameString
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: LoopName ! Loop Name for Mixer
CHARACTER(len=*), INTENT(IN) :: ConnectorListName ! Requested Connector List Name
CHARACTER(len=MaxNameLength), INTENT(OUT) :: MixerName ! Name of Mixer
LOGICAL, INTENT(OUT) :: IsMixer ! True when Mixer is on this connector
CHARACTER(len=MaxNameLength), INTENT(OUT) :: OutletNodeName ! Outlet Node ID
INTEGER, INTENT(OUT) :: OutletNodeNum ! Outlet Node Number
INTEGER, INTENT(OUT) :: NumInletNodes ! Number of Inlet Nodes
CHARACTER(len=MaxNameLength), INTENT(OUT), &
DIMENSION(:) :: InletNodeNames ! Inlet Node IDs
INTEGER, INTENT(OUT), DIMENSION(:) :: InletNodeNums ! Inlet Node Numbers
LOGICAL, INTENT(INOUT) :: ErrorsFound
INTEGER, OPTIONAL, INTENT(IN) :: ConnectorNumber ! number of the current item in connector list
INTEGER, OPTIONAL, INTENT(INOUT) :: MixerNumber ! Mixer number for this specific splitter
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Count ! Loop Counter
INTEGER :: Loop ! Loop Counter
TYPE (ConnectorData) :: Connectoid ! Connector Data
TYPE (ComponentData), ALLOCATABLE, &
DIMENSION(:) :: BComponents ! Branch Component Data
INTEGER NumComps ! Number of Components on this Branch
REAL(r64) MaxFlowRate ! Branch Max Flow Rate
INTEGER :: PressCurveType
INTEGER :: PressCurveIndex
LOGICAL :: errFlag ! Error flag from RegisterNodeConnection
INTEGER :: NumParams
INTEGER :: NumAlphas
INTEGER :: NumNumbers
IF (GetMixerInputFlag) THEN
CALL GetMixerInput
GetMixerInputFlag=.false.
ENDIF
CALL GetConnectorList(ConnectorListName,Connectoid,ConnectorNumber)
IF (SameString(Connectoid%ConnectorType(1),cMIXER)) THEN
Count=FindItemInList(Connectoid%ConnectorName(1),Mixers%Name,NumMixers)
IF(PRESENT(MixerNumber)) MixerNumber = MixerNumber + 1
IF (Count == 0) THEN
CALL ShowFatalError('GetLoopMixer: No Mixer Found='//TRIM(Connectoid%ConnectorName(1)))
ENDIF
ELSEIF (SameString(Connectoid%ConnectorType(2),cMIXER)) THEN
Count=FindItemInList(Connectoid%ConnectorName(2),Mixers%Name,NumMixers)
IF (Count == 0) THEN
CALL ShowFatalError('GetLoopMixer: No Mixer Found='//TRIM(Connectoid%ConnectorName(2)))
ENDIF
ELSE
Count=0
ENDIF
! Set defaults for later error potential
IsMixer=.false.
MixerName=Blank
OutletNodeName=Blank
OutletNodeNum=0
NumInletNodes=0
InletNodeNames=Blank
InletNodeNums=0
IF (Count /= 0) THEN ! Build up Output list(s). For each component(?)
! The inlet nodes for the mixer will be the last "outlet" node of
! each corresponding inlet branch. The outlet node for the mixer
! will be the first "inlet" node of the outlet branch since that
! would be the first node on the branch.
MixerName=Mixers(Count)%Name
IsMixer=.true.
! The number of "components" on a Mixer is the number of branches. This is the number of alpha arguments -1.
CALL GetObjectDefMaxArgs('Branch',NumParams,NumAlphas,NumNumbers)
ALLOCATE(BComponents(NumAlphas-1))
errFlag=.false.
CALL GetInternalBranchData(LoopName,Mixers(Count)%OutletBranchName,MaxFlowRate,PressCurveType,PressCurveIndex, &
NumComps,BComponents,errFlag)
IF (errFlag) THEN
CALL ShowContinueError('..occurs for Connector:Mixer Name='//Mixers(Count)%Name)
ErrorsFound=.true.
ENDIF
IF (NumComps > 0) THEN
OutletNodeName=BComponents(1)%InletNodeName
OutletNodeNum=BComponents(1)%InletNode
NumInletNodes=Mixers(Count)%NumInletBranches
! Register this node connection because the mixer gets node information indirectly from the branch
errFlag=.false.
CALL RegisterNodeConnection(OutletNodeNum,NodeID(OutletNodeNum),'Connector:Mixer',MixerName, &
ValidConnectionTypes(NodeConnectionType_Outlet),1,ObjectIsNotParent,errFlag)
IF (NumInletNodes > SIZE(InletNodeNames) .or. NumInletNodes > SIZE(InletNodeNums)) THEN
CALL ShowSevereError('GetLoopMixer: Connector:Mixer='//TRIM(MixerName)//' contains too many inlets for size of '// &
'Inlet Array.')
CALL ShowContinueError('Max array size='//TRIM(TrimSigDigits(SIZE(InletNodeNames)))// &
', Mixer statement inlets='//TRIM(TrimSigDigits(NumInletNodes)))
CALL ShowFatalError('Program terminates due to preceding condition.')
ENDIF
InletNodeNums=0
InletNodeNames=Blank
DO Loop=1,Mixers(Count)%NumInletBranches
CALL GetInternalBranchData(LoopName,Mixers(Count)%InletBranchNames(Loop),MaxFlowRate,PressCurveType,PressCurveIndex, &
NumComps,BComponents,ErrorsFound)
IF (NumComps > 0) THEN
InletNodeNames(Loop)=BComponents(NumComps)%OutletNodeName
InletNodeNums(Loop)=BComponents(NumComps)%OutletNode
! Register this node connection because the mixer gets node information indirectly from the branch
errFlag=.false.
CALL RegisterNodeConnection(InletNodeNums(Loop),NodeID(InletNodeNums(Loop)),'Connector:Mixer',MixerName, &
ValidConnectionTypes(NodeConnectionType_Inlet),1,ObjectIsNotParent,errFlag)
ENDIF
ENDDO
ELSE
! Set so cascading errors don't happen?
IsMixer=.false.
ENDIF
DEALLOCATE(BComponents)
ENDIF
RETURN
END SUBROUTINE GetLoopMixer