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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | LoopNum | |||
integer, | intent(in) | :: | LoopSideNum | |||
integer, | intent(in) | :: | BranchNum | |||
integer, | intent(in) | :: | CompNum | |||
integer, | intent(in) | :: | CurCompLevelOpNum | |||
integer, | intent(in) | :: | CurSchemePtr | |||
real(kind=r64), | intent(in) | :: | LoopDemand | |||
real(kind=r64), | intent(inout) | :: | RemLoopDemand |
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 DistributeUserDefinedPlantLoad(LoopNum, LoopSideNum,BranchNum,CompNum,CurCompLevelOpNum,CurSchemePtr, &
LoopDemand,RemLoopDemand )
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN August 2013
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: emsCallFromUserDefinedComponentModel
USE EMSManager, ONLY: ManageEMS
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum
INTEGER, INTENT(IN) :: LoopSideNum
INTEGER, INTENT(IN) :: BranchNum
INTEGER, INTENT(IN) :: CompNum
INTEGER, INTENT(IN) :: CurCompLevelOpNum !index for Plant()%loopside()%branch()%comp()%opscheme()
INTEGER, INTENT(IN) :: CurSchemePtr
REAL(r64), INTENT(IN) :: LoopDemand
REAL(r64), INTENT(INOUT) :: RemLoopDemand
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: CompPtr
INTEGER :: ListPtr
! ListPtr = PlantLoop(LoopNum)%loopside(LoopSideNum)%branch(BranchNum)%comp(CompNum)%opscheme(CurCompLevelOpNum)%EquipList(1)%ListPtr
CompPtr = PlantLoop(LoopNum)%loopside(LoopSideNum)%branch(BranchNum)%comp(CompNum) &
%opscheme(CurCompLevelOpNum)%EquipList(1)%CompPtr
! fill internal variable
PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%EquipList(1)%Comp(CompPtr)%EMSIntVarRemainingLoadValue = LoopDemand
! Call EMS program(s)
IF ( PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%ErlSimProgramMngr > 0) THEN
CALL ManageEMS(emsCallFromUserDefinedComponentModel, &
ProgramManagerToRun = PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%ErlSimProgramMngr)
ENDIF
! move actuated value to MyLoad
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%MyLoad = &
PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%EquipList(1)%Comp(CompPtr)%EMSActuatorDispatchedLoadValue
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%EquipDemand = &
PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%EquipList(1)%Comp(CompPtr)%EMSActuatorDispatchedLoadValue
IF (ABS(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%MyLoad) > LoopDemandTol) THEN
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%ON = .TRUE.
ELSE
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%ON = .FALSE.
ENDIF
RETURN
END SUBROUTINE DistributeUserDefinedPlantLoad