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) | :: | LoopName | |||
character(len=*), | intent(in) | :: | BranchListName | |||
integer, | intent(inout) | :: | NumBranchNames | |||
character(len=MaxNameLength), | intent(out), | DIMENSION(:) | :: | BranchNames | ||
character(len=*), | intent(in) | :: | LoopType |
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 GetBranchList(LoopName,BranchListName,NumBranchNames,BranchNames,LoopType)
! 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 branch list specified in a Plant or Condenser loop and
! returns number and names to the outside calling routine.
! 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:
CHARACTER(len=*), INTENT(IN) :: LoopName ! Name of Loop Branch List is on
CHARACTER(len=*), INTENT(IN) :: BranchListName ! Branch List Name from Input
INTEGER, INTENT(INOUT) :: NumBranchNames ! Number of Branches for this Branch List
CHARACTER(len=MaxNameLength), INTENT(OUT), &
DIMENSION(:) :: BranchNames ! Names of Branches on this Branch List
CHARACTER(len=*), INTENT(IN) :: LoopType ! Type of Loop Branch list is on
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Found ! Points to correct Branch List/Branch
LOGICAL :: ErrFound ! True when error has occured (cannot find Branch List)
ErrFound=.false.
IF (GetBranchListInputFlag) THEN
GetBranchListInputFlag=.false.
CALL GetBranchListInput
ENDIF
! Find this BranchList in the master BranchList Names
Found=FindItemInList(BranchListName,BranchList%Name,NumOfBranchLists)
IF (Found == 0) THEN
CALL ShowFatalError('GetBranchList: BranchList Name not found='//TRIM(BranchListName))
ENDIF
! Set data
IF (BranchList(Found)%LoopName == Blank) THEN
BranchList(Found)%LoopName=LoopName
BranchList(Found)%LoopType=LoopType
ELSEIF (BranchList(Found)%LoopName /= LoopName) THEN
CALL ShowSevereError('GetBranchList: BranchList Loop Name already assigned')
CALL ShowContinueError('BranchList='//TRIM(BranchList(Found)%Name)//', already assigned to loop='// &
TRIM(BranchList(Found)%LoopName))
CALL ShowContinueError('Now requesting assignment to Loop='//TRIM(LoopName))
ErrFound=.true.
ENDIF
! Return data
NumBranchNames=BranchList(Found)%NumOfBranchNames
IF (SIZE(BranchNames) < NumBranchNames) THEN
CALL ShowSevereError('GetBranchList: Branch Names array not big enough to hold Branch Names')
CALL ShowContinueError('Input BranchListName='//TRIM(BranchListName)//', in Loop='//TRIM(LoopName))
CALL ShowContinueError('BranchName Array size='//TRIM(TrimSigDigits(SIZE(BranchNames)))// &
', but input size='//TRIM(TrimSigDigits(NumBranchNames)))
ErrFound=.true.
ELSE
BranchNames=Blank
BranchNames(1:NumBranchNames)=BranchList(Found)%BranchNames(1:NumBranchNames)
ENDIF
IF (ErrFound) THEN
CALL ShowFatalError('GetBranchList: preceding condition(s) causes program termination.')
ENDIF
RETURN
END SUBROUTINE GetBranchList