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 GetBranchInput
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN October 1999
! MODIFIED October 2001, Automatic Extensibility
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the input for the following IDD structure:
! Branch,
! \extensible:5 Just duplicate last 5 fields and \ comments (changing numbering, please)
! \memo List components on the branch in simulation and connection order
! \memo Note: this should NOT include splitters or mixers which define
! \memo endpoints of branches
! A1, \field Name
! \required-field
! \reference Branches
! N1, \field Maximum Flow Rate
! \default 0
! \units m3/s
! \minimum 0
! \autosizable
! A2, \field Pressure Curve Name
! \type object-list
! \reference AllCurves
! A3, \field Component 1 Object Type
! \required-field
! A4, \field Component 1 Name
! \required-field
! A5, \field Component 1 Inlet Node Name
! \required-field
! A6, \field Component 1 Outlet Node Name
! \required-field
! A7, \field Component 1 Branch Control Type
! \required-field
! \type choice
! \key Active
! \key Passive
! \key SeriesActive
! \key Bypass
! \note for ACTIVE, Component tries to set branch flow and turns off branch if the component is off
! \note for PASSIVE, Component does not try to set branch flow
! \note for SERIESACTIVE, component is active but does not turn off branch when the component is off
! \note for BYPASS, Component designates a loop bypass
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: SameString
USE CurveManager, ONLY: GetPressureCurveTypeAndIndex
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetBranchInput: '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: GetInputFlag=.true. ! Set for first time call
INTEGER :: Count ! Loop Counter
INTEGER :: BCount ! Actual Num of Branches
INTEGER :: Comp ! Loop Counter
INTEGER :: Loop ! Loop Counter
INTEGER :: NumNodes ! Number of Nodes from NodeInputManager
INTEGER, ALLOCATABLE, DIMENSION(:) :: NodeNums ! Possible Array of Node Numbers (only 1 allowed)
LOGICAL :: ErrFound ! Flag for error detection
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: NumInComps ! Number of components actually verified (no SPLITTER or MIXER allowed)
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 ConnectionType ! Used to pass variable node connection type to GetNodeNums
INTEGER PressureCurveType
INTEGER PressureCurveIndex
IF (GetInputFlag) THEN
CurrentModuleObject='Branch'
NumOfBranches=GetNumObjectsFound(CurrentModuleObject)
IF (NumOfBranches > 0) THEN
ALLOCATE(Branch(NumOfBranches))
Branch%AssignedLoopName=Blank
ErrFound=.false.
CALL GetObjectDefMaxArgs('NodeList',NumParams,NumAlphas,NumNumbers)
ALLOCATE(NodeNums(NumParams))
NodeNums=0
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.
BCount=0
DO Count=1,NumOfBranches
CALL GetObjectItem(CurrentModuleObject,Count,Alphas,NumAlphas,Numbers,NumNumbers,IOStat, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),Branch%Name,BCount,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrFound=.true.
IF (IsBlank) THEN
CYCLE
ELSE
Alphas(1)=TRIM(Alphas(1))//'--dup'
ENDIF
ENDIF
BCount=BCount+1
Branch(BCount)%Name=Alphas(1)
Branch(BCount)%MaxFlowRate=Numbers(1)
CALL GetPressureCurveTypeAndIndex(Alphas(2), PressureCurveType, PressureCurveIndex)
IF (PressureCurveType == PressureCurve_Error) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))//'", invalid data.')
CALL ShowContinueError('..Invalid '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))//'".')
CALL ShowContinueError('This curve could not be found in the input deck. Ensure that this curve has been entered')
CALL ShowContinueError(' as either a Curve:Functional:PressureDrop or one of Curve:{Linear,Quadratic,Cubic,Exponent}')
CALL ShowContinueError('This error could be caused by a misspelled curve name')
ErrFound = .TRUE.
END IF
Branch(BCount)%PressureCurveType = PressureCurveType
Branch(BCount)%PressureCurveIndex = PressureCurveIndex
Branch(BCount)%NumOfComponents=(NumAlphas-2)/5
IF (Branch(BCount)%NumOfComponents*5 /= (NumAlphas-2)) Branch(BCount)%NumOfComponents=Branch(BCount)%NumOfComponents+1
NumInComps=Branch(BCount)%NumOfComponents
ALLOCATE(Branch(BCount)%Component(Branch(BCount)%NumOfComponents))
Comp=1
DO Loop=3,NumAlphas,5
IF (SameString(Alphas(Loop),cSPLITTER) .or. SameString(Alphas(Loop),cMIXER)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))//'", invalid data.')
CALL ShowContinueError('Connector:Splitter/Connector:Mixer not allowed in object '// &
TRIM(CurrentModuleObject))
ErrFound=.true.
CYCLE
ENDIF
IF (Comp > NumInComps) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))//'", invalid data.')
CALL ShowContinueError('...Number of Arguments indicate ['//trim(RoundSigDigits(NumInComps))// &
'], but count of fields indicates ['//trim(RoundSigDigits(Comp))//']')
CALL ShowContinueError('...examine '//trim(CurrentModuleObject)//' carefully.')
CYCLE
ENDIF
Branch(BCount)%Component(Comp)%CType=Alphas(Loop)
Branch(BCount)%Component(Comp)%Name=Alphas(Loop+1)
CALL ValidateComponent(Alphas(Loop),Alphas(Loop+1),IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError('Occurs on '//TRIM(CurrentModuleObject)//'='//TRIM(Alphas(1)))
ErrFound=.true.
ENDIF
Branch(BCount)%Component(Comp)%InletNodeName=Alphas(Loop+2)
! If first component on branch, then inlet node is inlet to branch, otherwise node is internal
IF (Loop == 3) THEN
ConnectionType = NodeConnectionType_Inlet
ELSE
ConnectionType = NodeConnectionType_Internal
ENDIF
IF (.not. lAlphaBlanks(Loop+2)) THEN
CALL GetNodeNums(Branch(BCount)%Component(Comp)%InletNodeName,NumNodes,NodeNums,ErrFound,NodeType_Unknown, &
TRIM(CurrentModuleObject),Branch(BCount)%Name,ConnectionType,1,ObjectIsParent, &
InputFieldName=cAlphaFields(Loop+2))
IF (NumNodes > 1) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))//'", invalid data.')
CALL ShowContinueError('..invalid '//TRIM(cAlphaFields(Loop+2))//'="'// &
TRIM(Branch(BCount)%Component(Comp)%InletNodeName)//'" must be a single node - appears to be a list.')
CALL ShowContinueError('Occurs on '//TRIM(cAlphaFields(Loop))//'="'//TRIM(Alphas(Loop))//'", '// &
TRIM(cAlphaFields(Loop+1))//'="'//TRIM(Alphas(Loop+1))//'".')
ErrFound=.true.
ELSE
Branch(BCount)%Component(Comp)%InletNode=NodeNums(1)
ENDIF
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))//'", invalid data.')
CALL ShowContinueError('blank required field: '//TRIM(cAlphaFields(Loop+2)))
CALL ShowContinueError('Occurs on '//TRIM(cAlphaFields(Loop))//'="'//TRIM(Alphas(Loop))//'", '// &
TRIM(cAlphaFields(Loop+1))//'="'//TRIM(Alphas(Loop+1))//'".')
ErrFound=.true.
ENDIF
Branch(BCount)%Component(Comp)%OutletNodeName=Alphas(Loop+3)
! If last component on branch, then outlet node is outlet from branch, otherwise node is internal
IF (Loop == NumAlphas-4) THEN
ConnectionType = NodeConnectionType_Outlet
ELSE
ConnectionType = NodeConnectionType_Internal
ENDIF
IF (.not. lAlphaBlanks(Loop+3)) THEN
CALL GetNodeNums(Branch(BCount)%Component(Comp)%OutletNodeName,NumNodes,NodeNums,ErrFound,NodeType_Unknown, &
TRIM(CurrentModuleObject),Branch(BCount)%Name,ConnectionType,1,ObjectIsParent, &
InputFieldName=cAlphaFields(Loop+3))
IF (NumNodes > 1) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))//'", invalid data.')
CALL ShowContinueError('..invalid '//TRIM(cAlphaFields(Loop+2))//'="'// &
TRIM(Branch(BCount)%Component(Comp)%InletNodeName)//'" must be a single node - appears to be a list.')
CALL ShowContinueError('Occurs on '//TRIM(cAlphaFields(Loop))//'="'//TRIM(Alphas(Loop))//'", '// &
TRIM(cAlphaFields(Loop+1))//'="'//TRIM(Alphas(Loop+1))//'".')
ErrFound=.true.
ELSE
Branch(BCount)%Component(Comp)%OutletNode=NodeNums(1)
ENDIF
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))//'", invalid data.')
CALL ShowContinueError('blank required field: '//TRIM(cAlphaFields(Loop+3)))
CALL ShowContinueError('Occurs on '//TRIM(cAlphaFields(Loop))//'="'//TRIM(Alphas(Loop))//'", '// &
TRIM(cAlphaFields(Loop+1))//'="'//TRIM(Alphas(Loop+1))//'".')
ErrFound=.true.
ENDIF
IF (.not. lAlphaBlanks(Loop) .and. .not. lAlphaBlanks(Loop+1) .and. & !no blanks in required field set
.not. lAlphaBlanks(Loop+2) .and. .not. lAlphaBlanks(Loop+3)) &
CALL SetUpCompSets(TRIM(CurrentModuleObject),Branch(BCount)%Name, &
Alphas(Loop),Alphas(Loop+1),Alphas(Loop+2),Alphas(Loop+3))
! deprecated control type, was using (Alphas(Loop+4))
Comp=Comp+1
ENDDO
Branch(BCount)%NumOfComponents=NumInComps
ENDDO
NumOfBranches=BCount
DEALLOCATE(NodeNums)
DEALLOCATE(Alphas)
DEALLOCATE(Numbers)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
IF (ErrFound) THEN
CALL ShowSevereError(RoutineName//' Invalid '//TRIM(CurrentModuleObject)// &
' Input, preceding condition(s) will likely cause termination.')
InvalidBranchDefinitions=.true.
ENDIF
CALL TestInletOutletNodes(ErrFound)
GetInputFlag=.false.
ENDIF
ENDIF
RETURN
END SUBROUTINE GetBranchInput