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) | :: | ParentType | |||
character(len=*), | intent(in) | :: | ParentName | |||
character(len=*), | intent(in) | :: | CompType | |||
character(len=*), | intent(in) | :: | CompName | |||
character(len=*), | intent(in) | :: | InletNode | |||
character(len=*), | intent(in) | :: | OutletNode | |||
character(len=*), | intent(in), | optional | :: | Description |
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 SetUpCompSets(ParentType,ParentName,CompType,CompName,InletNode,OutletNode,Description)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN November 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine sets up "Component Sets" as input in the branch
! lists. These can be used later to verify that the proper names and
! inlet/outlet nodes have been input. This routine assumes that identical
! "CompSets" cannot be used in multiple places and issues a warning if they are.
!
! This subroutine also
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: MakeUPPERCase,SameString
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: ParentType ! Parent Object Type
CHARACTER(len=*), INTENT(IN) :: ParentName ! Parent Object Name
CHARACTER(len=*), INTENT(IN) :: CompType ! Component Type
CHARACTER(len=*), INTENT(IN) :: CompName ! Component Name
CHARACTER(len=*), INTENT(IN) :: InletNode ! Inlet Node Name
CHARACTER(len=*), INTENT(IN) :: OutletNode ! Outlet Node Name
CHARACTER(len=*), INTENT(IN), OPTIONAL :: Description ! Description
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
TYPE (ComponentListData), ALLOCATABLE, DIMENSION(:) :: TempCompSets
CHARACTER(len=MaxNameLength) :: CompTypeUC ! Component type in upper case
CHARACTER(len=MaxNameLength) :: ParentTypeUC ! Parent component type in upper case
INTEGER Count, Count2
INTEGER Found, Found2
ParentTypeUC = MakeUPPERCase(ParentType)
CompTypeUC = MakeUPPERCase(CompType)
Found=0
! See if Component-Nodes set is already there - should be unique
! Try to fill in blanks (passed in as undefined
DO Count=1,NumCompSets
! IF (CompTypeUC /= CompSets(Count)%CType .or. CompName /= CompSets(Count)%CName) CYCLE
IF (CompName /= CompSets(Count)%CName) CYCLE
IF (CompTypeUC /= 'UNDEFINED') THEN
IF (CompTypeUC /= CompSets(Count)%CType) CYCLE
ENDIF
! Component name matches, component type matches or is undefined
IF (InletNode /= 'UNDEFINED') THEN
IF (Compsets(Count)%InletNodeName /= 'UNDEFINED') THEN
IF (InletNode /= CompSets(Count)%InletNodeName) CYCLE
ENDIF
ENDIF
IF (OutletNode /= 'UNDEFINED') THEN
IF (Compsets(Count)%OutletNodeName /= 'UNDEFINED') THEN
IF (OutletNode /= CompSets(Count)%OutletNodeName) CYCLE
ENDIF
ENDIF
! See if something undefined and set here
IF (CompSets(Count)%ParentCType == 'UNDEFINED' .and. CompSets(Count)%ParentCName == 'UNDEFINED') THEN
! Assume this is a further definition for this compset
CompSets(Count)%ParentCType=ParentTypeUC
CompSets(Count)%ParentCName=ParentName
IF (PRESENT(Description)) CompSets(Count)%Description=Description
Found=Count
EXIT
ENDIF
ENDDO
IF (Found == 0) THEN
DO Count=1,NumCompSets
Found=0
! Test if inlet node has been used before as an inlet node
! If the matching node name does not belong to the parent object, then error
! For example a fan may share the same inlet node as the furnace object which is its parent
IF (InletNode /= CompSets(Count)%InletNodeName) THEN
CYCLE
! If parent type is "UNDEFINED" then no error
ELSEIF ((ParentTypeUC == 'UNDEFINED') .or. (CompSets(Count)%ParentCType == 'UNDEFINED')) THEN
! If node name is "UNDEFINED" then no error
ELSEIF (InletNode /= 'UNDEFINED') THEN
! If the matching node name does not belong to the parent or child object, then error
! For example a fan may share the same inlet node as the furnace object which is its parent
IF ((TRIM(ParentTypeUC) == TRIM(CompSets(Count)%CType)) .and. (TRIM(ParentName) == TRIM(CompSets(Count)%CName))) THEN
! OK - The duplicate inlet node belongs to this component's parent
ELSEIF ((TRIM(CompTypeUC) == TRIM(CompSets(Count)%ParentCType)) .and. &
(TRIM(CompName) == TRIM(CompSets(Count)%ParentCName))) THEN
! OK - The duplicate inlet node belongs to a child of this component
ELSE
! Due to possibility of grandparents or more, if the matching node name
! belongs to a component that appears as a parent, then OK
Found2=0
DO Count2=1,NumCompSets
IF ((TRIM(CompSets(Count)%CType) == TRIM(CompSets(Count2)%ParentCType)) .and. &
(TRIM(CompSets(Count)%CName) == TRIM(CompSets(Count2)%ParentCName))) Found2=1
IF ((TRIM(CompTypeUC) == TRIM(CompSets(Count2)%ParentCType)) .and. &
(TRIM(CompName) == TRIM(CompSets(Count2)%ParentCName))) Found2=1
ENDDO
IF (Found2 == 0) THEN
CALL ShowWarningError ('Node used as an inlet more than once: '//TRIM(InletNode))
CALL ShowContinueError (' Used by : '//TRIM(CompSets(Count)%ParentCType)//', name='// &
TRIM(CompSets(Count)%ParentCName))
CALL ShowContinueError (' as inlet for: '//TRIM(CompSets(Count)%CType)//', name='//TRIM(CompSets(Count)%CName))
CALL ShowContinueError (' and by : '//TRIM(ParentTypeUC)//', name='//TRIM(ParentName))
CALL ShowContinueError (' as inlet for: '//TRIM(CompTypeUC)//', name='//TRIM(CompName))
ENDIF
ENDIF
ENDIF
! Test if outlet node has been used before as an outlet node
! If the matching node name does not belong to the parent or child object, then error
! For example a fan may share the same outlet node as the furnace object which is its parent
IF (OutletNode /= CompSets(Count)%OutletNodeName) THEN
CYCLE
! If parent type is "UNDEFINED" then no error
ELSEIF ((ParentTypeUC == 'UNDEFINED') .or. (CompSets(Count)%ParentCType == 'UNDEFINED')) THEN
! If node name is "UNDEFINED" then no error
ELSEIF (OutletNode /= 'UNDEFINED') THEN
IF ((TRIM(ParentTypeUC) == TRIM(CompSets(Count)%CType)) .and. (TRIM(ParentName) == TRIM(CompSets(Count)%CName))) THEN
! OK - The duplicate outlet node belongs to this component's parent
ELSEIF ((TRIM(CompTypeUC) == TRIM(CompSets(Count)%ParentCType)) .and. &
(TRIM(CompName) == TRIM(CompSets(Count)%ParentCName))) THEN
! OK - The duplicate outlet node belongs to a child of this component
ELSE
! Due to possibility of grandparents or more, if the matching node name
! belongs to a component that appears as a parent, then OK
Found2=0
DO Count2=1,NumCompSets
IF ((TRIM(CompSets(Count)%CType) == TRIM(CompSets(Count2)%ParentCType)) .and. &
(TRIM(CompSets(Count)%CName) == TRIM(CompSets(Count2)%ParentCName))) Found2=1
IF ((TRIM(CompTypeUC) == TRIM(CompSets(Count2)%ParentCType)) .and. &
(TRIM(CompName) == TRIM(CompSets(Count2)%ParentCName))) Found2=1
ENDDO
! This rule is violated by dual duct units, so let it pass
IF ((Found2 == 0) .AND. (.not. SameString(CompSets(Count)%CType(1:21),'AirTerminal:DualDuct:')) &
.AND. (.not. SameString(CompTypeUC(1:21),'AirTerminal:DualDuct:')) ) THEN
CALL ShowWarningError ('Node used as an outlet more than once: '//TRIM(OutletNode))
CALL ShowContinueError (' Used by : '//TRIM(CompSets(Count)%ParentCType)//', name='// &
TRIM(CompSets(Count)%ParentCName))
CALL ShowContinueError (' as outlet for: '//TRIM(CompSets(Count)%CType)//', name='//TRIM(CompSets(Count)%CName))
CALL ShowContinueError (' and by : '//TRIM(ParentTypeUC)//', name='//TRIM(ParentName))
CALL ShowContinueError (' as outlet for: '//TRIM(CompTypeUC)//', name='//TRIM(CompName))
ENDIF
ENDIF
ENDIF
IF (CompTypeUC /= CompSets(Count)%CType .and. CompTypeUC /= 'UNDEFINED') CYCLE
IF (CompName /= CompSets(Count)%CName) CYCLE
Found=Count
EXIT
ENDDO
ENDIF
IF (Found == 0) THEN
NumCompSets=NumCompSets+1
ALLOCATE(TempCompSets(NumCompSets))
IF (NumCompSets > 1) THEN
TempCompSets(1:NumCompSets-1)=CompSets
DEALLOCATE(CompSets)
ENDIF
TempCompSets(NumCompSets)%CName=Blank
TempCompSets(NumCompSets)%CType=Blank
TempCompSets(NumCompSets)%InletNodeName=Blank
TempCompSets(NumCompSets)%OutletNodeName=Blank
TempCompSets(NumCompSets)%ParentCType=Blank
TempCompSets(NumCompSets)%ParentCName=Blank
TempCompSets(NumCompSets)%Description='UNDEFINED'
ALLOCATE(CompSets(NumCompSets))
CompSets=TempCompSets
DEALLOCATE(TempCompSets)
CompSets(NumCompSets)%ParentCType=ParentTypeUC
CompSets(NumCompSets)%ParentCName=ParentName
CompSets(NumCompSets)%CType=CompTypeUC
CompSets(NumCompSets)%CName=CompName
CompSets(NumCompSets)%InletNodeName=InletNode
CompSets(NumCompSets)%OutletNodeName=OutletNode
IF (PRESENT(Description)) THEN
CompSets(NumCompSets)%Description=Description
ELSE
CompSets(NumCompSets)%Description='UNDEFINED'
ENDIF
ENDIF
RETURN
END SUBROUTINE SetUpCompSets