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 GetSplitterInput
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN Sept 2005 (moved from GetLoopSplitter)
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets the Splitter data that is used in Loops.
! IDD structure:
! Connector:Splitter,
! \min-fields 3
! \extensible:1 Just duplicate last field and \ comments (changing numbering, please)
! \memo Split one air/water stream into N outlet streams. Branch names cannot be duplicated
! \memo within a single Splitter list.
! A1, \field Name
! \required-field
! A2, \field Inlet Branch Name
! \required-field
! \type object-list
! \object-list Branches
! A3, \field Outlet Branch 1 Name
! \required-field
! \type object-list
! \object-list Branches
! A4, \field Outlet Branch 2 Name
! \type object-list
! \object-list Branches
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: TrimSigDigits
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 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 :: Loop
INTEGER :: Loop1
INTEGER :: Count
INTEGER :: Found
LOGICAL :: ErrorsFound=.false.
CHARACTER(len=MaxNameLength) :: TestName
CHARACTER(len=MaxNameLength) :: BranchListName
CHARACTER(len=6) :: FoundSupplyDemandAir
CHARACTER(len=6) :: SaveSupplyDemandAir
CHARACTER(len=9) :: FoundLoop
CHARACTER(len=9) :: SaveLoop
LOGICAL :: MatchedLoop
IF (.not. GetSplitterInputFlag) RETURN
CurrentModuleObject = cSPLITTER
NumSplitters=GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(Splitters(NumSplitters))
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumParams,NumAlphas,NumNumbers)
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,NumSplitters
CALL GetObjectItem(CurrentModuleObject,Count,Alphas,NumAlphas,Numbers,NumNumbers,IOStat, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
Splitters(Count)%Name=Alphas(1)
Splitters(Count)%InletBranchName=Alphas(2)
Splitters(Count)%NumOutletBranches=NumAlphas-2
ALLOCATE(Splitters(Count)%OutletBranchNames(Splitters(Count)%NumOutletBranches))
DO Loop=1,Splitters(Count)%NumOutletBranches
Splitters(Count)%OutletBranchNames(Loop)=Alphas(2+Loop)
ENDDO
ENDDO
GetSplitterInputFlag=.false.
DEALLOCATE(Alphas)
DEALLOCATE(Numbers)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
! More validity -- check splitter "names" against branches.
IF (.not. GetBranchInputFlag) THEN
CALL GetBranchInput
GetBranchInputFlag=.false.
ENDIF
DO Count=1,NumSplitters
Found=FindItemInList(Splitters(Count)%InletBranchName,Branch%Name,NumOfBranches)
IF (Found == 0) THEN
CALL ShowSevereError('GetSplitterInput: Invalid Branch='//TRIM(Splitters(Count)%InletBranchName)// &
', referenced as Inlet Branch to '//TRIM(CurrentModuleObject)//'='//TRIM(Splitters(Count)%Name))
ErrorsFound=.true.
ENDIF
DO Loop=1,Splitters(Count)%NumOutletBranches
Found=FindItemInList(Splitters(Count)%OutletBranchNames(Loop),Branch%Name,NumOfBranches)
IF (Found == 0) THEN
CALL ShowSevereError('GetSplitterInput: Invalid Branch='//TRIM(Splitters(Count)%OutletBranchNames(Loop))// &
', referenced as Outlet Branch # '//TRIM(TrimSigDigits(Loop))// &
' to '//TRIM(CurrentModuleObject)//'='//TRIM(Splitters(Count)%Name))
ErrorsFound=.true.
ENDIF
ENDDO
ENDDO
! Check for duplicate names specified in Splitters
DO Count=1,NumSplitters
TestName=Splitters(Count)%InletBranchName
DO Loop=1,Splitters(Count)%NumOutletBranches
IF (TestName /= Splitters(Count)%OutletBranchNames(Loop)) CYCLE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'='//TRIM(Splitters(Count)%Name)// &
' specifies an outlet node name the same as the inlet node.')
CALL ShowContinueError('..Inlet Node='//TRIM(TestName))
CALL ShowContinueError('..Outlet Node #'//TRIM(TrimSigDigits(Loop))// &
' is duplicate.')
ErrorsFound=.true.
ENDDO
DO Loop=1,Splitters(Count)%NumOutletBranches
DO Loop1=Loop+1,Splitters(Count)%NumOutletBranches
IF (Splitters(Count)%OutletBranchNames(Loop) /= Splitters(Count)%OutletBranchNames(Loop1)) CYCLE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'='//TRIM(Splitters(Count)%Name)// &
' specifies duplicate outlet nodes in its outlet node list.')
CALL ShowContinueError('..Outlet Node #'//TRIM(TrimSigDigits(Loop))// &
' Name='//TRIM(Splitters(Count)%OutletBranchNames(Loop)))
CALL ShowContinueError('..Outlet Node #'//TRIM(TrimSigDigits(Loop))// &
' is duplicate.')
ErrorsFound=.true.
ENDDO
ENDDO
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError('GetSplitterInput: Fatal Errors Found in '//TRIM(CurrentModuleObject)//', program terminates.')
ENDIF
! Everything supposed to be good. Now make sure all branches in Splitter on same side of loop.
SaveSupplyDemandAir=Blank
DO Count=1,NumSplitters
! 2. Find the branch name in branchlist
TestName=Splitters(Count)%InletBranchName
BranchListName=Blank
DO Loop1=1,NumOfBranchLists
IF (ANY(BranchList(Loop1)%BranchNames == TestName)) THEN
BranchListName=BranchList(Loop1)%Name
EXIT
ENDIF
ENDDO
IF (BranchListName /= Blank) THEN
FoundSupplyDemandAir=Blank
FoundLoop=Blank
MatchedLoop=.false.
! 3. Find the loop and type
CALL FindAirPlantCondenserLoopFromBranchList(BranchListName,FoundLoop,FoundSupplyDemandAir,MatchedLoop)
IF (MatchedLoop) THEN
SaveSupplyDemandAir=FoundSupplyDemandAir
SaveLoop=FoundLoop
ELSE
CALL ShowSevereError('GetSplitterInput: Inlet Splitter Branch="'//TRIM(TestName)//'" and BranchList="'// &
TRIM(BranchListName)//'" not matched to a Air/Plant/Condenser Loop')
CALL ShowContinueError('...and therefore, not a valid Loop Splitter.')
CALL ShowContinueError('...'//TRIM(CurrentModuleObject)//'='//TRIM(Splitters(Count)%Name))
ErrorsFound=.true.
ENDIF
ELSE
CALL ShowSevereError('GetSplitterInput: Inlet Splitter Branch="'//TRIM(TestName)//'" not on BranchList')
CALL ShowContinueError('...and therefore, not a valid Loop Splitter.')
CALL ShowContinueError('...'//TRIM(CurrentModuleObject)//'='//TRIM(Splitters(Count)%Name))
ErrorsFound=.true.
ENDIF
DO Loop=1,Splitters(Count)%NumOutletBranches
TestName=Splitters(Count)%OutletBranchNames(Loop)
BranchListName=Blank
DO Loop1=1,NumOfBranchLists
IF (ANY(BranchList(Loop1)%BranchNames == TestName)) THEN
BranchListName=BranchList(Loop1)%Name
EXIT
ENDIF
ENDDO
IF (BranchListName /= Blank) THEN
FoundSupplyDemandAir=Blank
FoundLoop=Blank
MatchedLoop=.false.
! 3. Find the loop and type
CALL FindAirPlantCondenserLoopFromBranchList(BranchListName,FoundLoop,FoundSupplyDemandAir,MatchedLoop)
IF (MatchedLoop) THEN
IF (SaveSupplyDemandAir /= FoundSupplyDemandAir .or. SaveLoop /= FoundLoop) THEN
CALL ShowSevereError('GetSplitterInput: Outlet Splitter Branch="'//TRIM(TestName)// &
'" does not match types of Inlet Branch.')
CALL ShowContinueError('...Inlet Branch is on "'//TRIM(SaveLoop)//'" on "'// &
TRIM(SaveSupplyDemandAir)//'" side.')
CALL ShowContinueError('...Outlet Branch is on "'//TRIM(FoundLoop)//'" on "'// &
TRIM(FoundSupplyDemandAir)//'" side.')
CALL ShowContinueError('...All branches in Loop Splitter must be on same kind of loop and supply/demand side.')
CALL ShowContinueError('...'//TRIM(CurrentModuleObject)//'='//TRIM(Splitters(Count)%Name))
ErrorsFound=.true.
ENDIF
ELSE
CALL ShowSevereError('GetSplitterInput: Outlet Splitter Branch="'//TRIM(TestName)//'" and BranchList="'// &
TRIM(BranchListName)//'" not matched to a Air/Plant/Condenser Loop')
CALL ShowContinueError('...and therefore, not a valid Loop Splitter.')
CALL ShowContinueError('...'//TRIM(CurrentModuleObject)//'='//TRIM(Splitters(Count)%Name))
ErrorsFound=.true.
ENDIF
ELSE
CALL ShowSevereError('GetSplitterInput: Outlet Splitter Branch="'//TRIM(TestName)//'" not on BranchList')
CALL ShowContinueError('...and therefore, not a valid Loop Splitter')
CALL ShowContinueError('...'//TRIM(CurrentModuleObject)//'='//TRIM(Splitters(Count)%Name))
ErrorsFound=.true.
ENDIF
ENDDO
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError('GetSplitterInput: Fatal Errors Found in '//TRIM(CurrentModuleObject)//', program terminates.')
ENDIF
RETURN
END SUBROUTINE GetSplitterInput