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) | :: | CallerName | |||
integer, | intent(in) | :: | NodeNum | |||
integer, | intent(out) | :: | LoopNum | |||
integer, | intent(out) | :: | LoopSideNum | |||
integer, | intent(out) | :: | BranchNum | |||
integer, | intent(out), | optional | :: | CompNum |
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 ScanPlantLoopsForNodeNum(CallerName, NodeNum, LoopNum, LoopSideNum, BranchNum, CompNum)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN Feb. 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Get routine to return plant loop index and plant loop side
! based on node number. for one time init routines only.
! METHODOLOGY EMPLOYED:
! Loop thru plant data structure and find matching node.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals
USE DataInterfaces, ONLY: ShowSevereError, ShowContinueError
USE General, ONLY : RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: CallerName ! really used for error messages
INTEGER, INTENT(IN) :: NodeNum ! index in Node structure of node to be scanned
INTEGER, INTENT(OUT) :: LoopNum ! return value for plant loop
INTEGER, INTENT(OUT) :: LoopSideNum ! return value for plant loop side
INTEGER, INTENT(OUT) :: BranchNum !
INTEGER, INTENT(OUT), OPTIONAL :: CompNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: LoopCtr
INTEGER :: LoopSideCtr
INTEGER :: BranchCtr
INTEGER :: CompCtr
LOGICAL :: FoundNode
INTEGER :: inFoundCount
INTEGER :: outFoundCount
inFoundCount = 0
outFoundCount = 0
IF (PRESENT(CompNum)) THEN
CompNum = 0
ENDIF
FoundNode = .FALSE.
PlantLoops: DO LoopCtr = 1, TotNumLoops
DO LoopSideCtr = 1, 2
DO BranchCtr = 1, PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%TotalBranches
DO CompCtr = 1, PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%Branch(BranchCtr)%TotalComponents
IF (NodeNum == PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%Branch(BranchCtr)%Comp(CompCtr)%NodeNumIn) THEN
FoundNode = .TRUE.
inFoundCount = inFoundCount + 1
LoopNum = LoopCtr
LoopSideNum = LoopSideCtr
BranchNum = BranchCtr
IF (PRESENT(CompNum)) THEN
CompNum = CompCtr
ENDIF
ENDIF
IF (NodeNum == PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%Branch(BranchCtr)%Comp(CompCtr)%NodeNumOut) THEN
outFoundCount = outFoundCount + 1
LoopNum = LoopCtr
LoopSideNum = LoopSideCtr
BranchNum = BranchCtr
ENDIF
END DO
END DO
END DO
END DO PlantLoops
IF (.NOT. FoundNode) THEN
CALL ShowSevereError('ScanPlantLoopsForNodeNum: Plant Node was not found as inlet node (for component) on any plant loops')
Call ShowContinueError('Node Name="'//trim(NodeID(NodeNum))//'"' )
IF (.not. DoingSizing) THEN
Call ShowContinueError('called by '//Trim(CallerName))
ELSE
Call ShowContinueError('during sizing: called by '//Trim(CallerName))
ENDIF
IF (outFoundCount > 0) &
CALL ShowContinueError('Node was found as outlet node (for component) '//trim(RoundSigDigits(outFoundCount))//' time(s).')
CALL ShowContinueError('Possible error in Branch inputs. '// &
'For more information, look for other error messages related to this node name.')
! fatal?
END IF
RETURN
END SUBROUTINE ScanPlantLoopsForNodeNum