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.
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 GetConnectorListInput
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN October 1999
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains connector list input from IDF.
! ConnectorList,
! \memo only two connectors allowed per loop
! \memo if two entered, one must be Connector:Splitter and one must be Connector:Mixer
! A1, \field Name
! \required-field
! \reference ConnectorLists
! A2, \field Connector 1 Object Type
! \required-field
! \key Connector:Splitter
! \key Connector:Mixer
! A3, \field Connector 1 Name
! \required-field
! A4, \field Connector 2 Object Type
! \key Connector:Splitter
! \key Connector:Mixer
! A5; \field Connector 2 Name
! This is in the process of possibly being extended, thus the code herein.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY : SameString
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Count ! Loop Counter
INTEGER :: NumAlphas ! Used to retrieve names from IDF
CHARACTER(len=MaxNameLength), ALLOCATABLE, &
DIMENSION(:):: Alphas ! Used to retrieve names from IDF
INTEGER NumNumbers ! Used to retrieve numbers from IDF
REAL(r64), ALLOCATABLE, DIMENSION(:) :: Numbers ! Used to retrieve numbers from IDF
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cAlphaFields
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cNumericFields
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks
INTEGER :: IOStat ! Could be used in the Get Routines, not currently checked
INTEGER :: NumParams
INTEGER :: NumConnectors
INTEGER :: CCount
INTEGER :: Arg
INTEGER :: SplitNum
INTEGER :: MixerNum
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: BranchNames
INTEGER :: NumBranchNames
LOGICAL :: ErrorsFound
INTEGER :: Loop
INTEGER :: Loop1
INTEGER :: Loop2
LOGICAL :: CurMixer
LOGICAL :: CurSplitter
INTEGER :: TestNum
LOGICAL :: MatchFound
IF (.not. GetConnectorListInputFlag) RETURN
ErrorsFound=.false.
CurrentModuleObject='ConnectorList'
NumOfConnectorLists=GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(ConnectorLists(NumOfConnectorLists))
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumParams,NumAlphas,NumNumbers)
IF (NumAlphas /= 5 .or. NumNumbers /= 0) THEN
CALL ShowWarningError('GetConnectorList: Illegal "extension" to '//TRIM(CurrentModuleObject)//' object. '// &
'Internal code does not support > 2 connectors (Connector:Splitter and Connector:Mixer)')
ENDIF
ALLOCATE(Alphas(NumAlphas))
Alphas=' '
ALLOCATE(Numbers(NumNumbers))
Numbers=0.0d0
ALLOCATE(cAlphaFields(NumAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(NumNumbers))
cNumericFields=' '
ALLOCATE(lAlphaBlanks(NumAlphas))
lAlphaBlanks=.true.
ALLOCATE(lNumericBlanks(NumNumbers))
lNumericBlanks=.true.
DO Count=1,NumOfConnectorLists
CALL GetObjectItem(CurrentModuleObject,Count,Alphas,NumAlphas,Numbers,NumNumbers,IOStat, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
ConnectorLists(Count)%Name=Alphas(1)
NumConnectors=(NumAlphas-1)/2 ! potential problem if puts in type but not name
IF (MOD(NumAlphas-1,2) /= 0) NumConnectors=NumConnectors+1
ConnectorLists(Count)%NumOfConnectors=NumConnectors
ALLOCATE(ConnectorLists(Count)%ConnectorType(NumConnectors))
ALLOCATE(ConnectorLists(Count)%ConnectorName(NumConnectors))
ALLOCATE(ConnectorLists(Count)%ConnectorMatchNo(NumConnectors))
ConnectorLists(Count)%ConnectorType='UNKNOWN'
ConnectorLists(Count)%ConnectorName='UNKNOWN'
ConnectorLists(Count)%ConnectorMatchNo=0
ConnectorLists(Count)%NumOfSplitters=0
ConnectorLists(Count)%NumOfMixers=0
CCount=0
DO Arg=2,NumAlphas,2
CCount=CCount+1
IF (SameString(Alphas(Arg) , cSPLITTER)) THEN
ConnectorLists(Count)%ConnectorType(CCount)=Alphas(Arg)(1:30)
ConnectorLists(Count)%NumOfSplitters=ConnectorLists(Count)%NumOfSplitters+1
ELSEIF (SameString(Alphas(Arg) , cMIXER)) THEN
ConnectorLists(Count)%ConnectorType(CCount)=Alphas(Arg)(1:30)
ConnectorLists(Count)%NumOfMixers=ConnectorLists(Count)%NumOfMixers+1
ELSE
CALL ShowWarningError('GetConnectorListInput: Invalid '//TRIM(cAlphaFields(Arg))//'='// &
TRIM(Alphas(Arg))//' in '//TRIM(CurrentModuleObject)//'='//TRIM(Alphas(1)))
ENDIF
ConnectorLists(Count)%ConnectorName(CCount)=Alphas(Arg+1)
ENDDO
ENDDO
GetConnectorListInputFlag=.false.
DEALLOCATE(Alphas)
DEALLOCATE(Numbers)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
! Validity checks on Connector Lists
IF (GetSplitterInputFlag) THEN
CALL GetSplitterInput
GetSplitterInputFlag=.false.
ENDIF
IF (GetMixerInputFlag) THEN
CALL GetMixerInput
GetMixerInputFlag=.false.
ENDIF
SplitNum=0
MixerNum=0
DO Count=1,NumOfConnectorLists
IF (ConnectorLists(Count)%NumOfConnectors <= 1) CYCLE ! Air Loop only has one.
IF (ConnectorLists(Count)%NumOfConnectors > 2) CYCLE ! Rules not clear for this case
DO Loop=1,ConnectorLists(Count)%NumOfConnectors
IF (ConnectorLists(Count)%ConnectorMatchNo(Loop) /= 0) CYCLE
IF (SameString(ConnectorLists(Count)%ConnectorType(Loop) , cSPLITTER)) THEN
CurSplitter=.true.
CurMixer=.false.
SplitNum=FindItemInList(ConnectorLists(Count)%ConnectorName(Loop),Splitters%Name,NumSplitters)
! Following code sets up branch names to be matched from Splitter/Mixer data structure
IF (SplitNum == 0) THEN
CALL ShowSevereError('Invalid Connector:Splitter(none)='//TRIM(ConnectorLists(Count)%ConnectorName(Loop)// &
', referenced by '//TRIM(CurrentModuleObject)//'='//TRIM(ConnectorLists(Count)%Name)))
ErrorsFound=.true.
CYCLE
ENDIF
NumBranchNames=Splitters(SplitNum)%NumOutletBranches
ALLOCATE(BranchNames(NumBranchNames))
BranchNames=Splitters(SplitNum)%OutletBranchNames
ELSEIF (SameString(ConnectorLists(Count)%ConnectorType(Loop) , cMIXER)) THEN
CurSplitter=.true.
CurMixer=.false.
MixerNum=FindItemInList(ConnectorLists(Count)%ConnectorName(Loop),Mixers%Name,NumMixers)
IF (MixerNum == 0) THEN
CALL ShowSevereError('Invalid Connector:Mixer(none)='//TRIM(ConnectorLists(Count)%ConnectorName(Loop))// &
', referenced by '//TRIM(CurrentModuleObject)//'='//TRIM(ConnectorLists(Count)%Name))
ErrorsFound=.true.
CYCLE
ENDIF
NumBranchNames=Mixers(MixerNum)%NumInletBranches
ALLOCATE(BranchNames(NumBranchNames))
BranchNames=Mixers(MixerNum)%InletBranchNames
ELSE
CYCLE
ENDIF
! Try to match mixer to splitter
DO Loop1=Loop+1,ConnectorLists(Count)%NumOfConnectors
IF (CurMixer .and. .NOT. SameString(ConnectorLists(Count)%ConnectorType(Loop1) , cSPLITTER)) CYCLE
IF (CurSplitter .and. .NOT. SameString(ConnectorLists(Count)%ConnectorType(Loop1) , cMIXER)) CYCLE
IF (ConnectorLists(Count)%ConnectorMatchNo(Loop1) /= 0) CYCLE
SELECT CASE (CurSplitter)
CASE(.true.)
! Current "item" is a splitter, candidate is a mixer.
MixerNum=FindItemInList(ConnectorLists(Count)%ConnectorName(Loop1),Mixers%Name,NumMixers)
IF (MixerNum == 0) CYCLE
IF (Mixers(MixerNum)%NumInletBranches /= NumBranchNames) CYCLE
MatchFound=.true.
DO Loop2=1,Mixers(MixerNum)%NumInletBranches
TestNum=FindItemInList(Mixers(MixerNum)%InletBranchNames(Loop2),BranchNames,NumBranchNames)
IF (TestNum == 0) THEN
MatchFound=.false.
EXIT
ENDIF
ENDDO
IF (MatchFound) THEN
ConnectorLists(Count)%ConnectorMatchNo(Loop1)=MixerNum
ConnectorLists(Count)%ConnectorMatchNo(Loop)=SplitNum
ENDIF
CASE(.false.)
! Current "item" is a splitter, candidate is a mixer.
SplitNum=FindItemInList(ConnectorLists(Count)%ConnectorName(Loop1),Splitters%Name,NumSplitters)
IF (SplitNum == 0) CYCLE
IF (Splitters(SplitNum)%NumOutletBranches /= NumBranchNames) CYCLE
MatchFound=.true.
DO Loop2=1,Splitters(SplitNum)%NumOutletBranches
TestNum=FindItemInList(Splitters(SplitNum)%OutletBranchNames(Loop2),BranchNames,NumBranchNames)
IF (TestNum == 0) THEN
MatchFound=.false.
EXIT
ENDIF
ENDDO
IF (MatchFound) THEN
ConnectorLists(Count)%ConnectorMatchNo(Loop1)=SplitNum
ConnectorLists(Count)%ConnectorMatchNo(Loop)=MixerNum
ENDIF
END SELECT
ENDDO
DEALLOCATE(BranchNames)
ENDDO
ENDDO
DO Count=1,NumOfConnectorLists
IF (ConnectorLists(Count)%NumOfConnectors <= 1) CYCLE ! Air Loop only has one.
IF (ConnectorLists(Count)%NumOfConnectors > 2) CYCLE ! Rules not clear
DO Loop=1,ConnectorLists(Count)%NumOfConnectors
IF (ConnectorLists(Count)%ConnectorMatchNo(Loop) /= 0) CYCLE
! = 0, not matched.
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//'='//TRIM(ConnectorLists(Count)%Name))
CALL ShowContinueError('...Item='//TRIM(ConnectorLists(Count)%ConnectorName(Loop))//', Type='// &
TRIM(ConnectorLists(Count)%ConnectorType(Loop))//' was not matched.')
IF (SameString(ConnectorLists(Count)%ConnectorType(Loop),'Connector:Splitter')) THEN
CALL ShowContinueError('The BranchList for this Connector:Splitter does not match the BranchList'// &
' for its corresponding Connector:Mixer.')
ELSE
CALL ShowContinueError('The BranchList for this Connector:Mixer does not match the BranchList'// &
' for its corresponding Connector:Splitter.')
ENDIF
ErrorsFound=.true.
ENDDO
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError('GetConnectorListInput: Program terminates for preceding conditions.')
ENDIF
RETURN
END SUBROUTINE GetConnectorListInput