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) | :: | iCalledFrom | |||
integer, | intent(in), | optional | :: | ProgramManagerToRun |
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 ManageEMS(iCalledFrom, ProgramManagerToRun)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN June 2006
! MODIFIED na
! RE-ENGINEERED Brent Griffith, April 2009
! added calling point argument and logic.
! Collapsed SimulateEMS into this routine
! PURPOSE OF THIS SUBROUTINE:
!
! METHODOLOGY EMPLOYED:
! Standard EnergyPlus methodology.
! USE STATEMENTS:
USE DataGlobals, ONLY: WarmupFlag, DoingSizing, ZoneTSReporting, HVACTSReporting, &
KickOffSimulation, AnyEnergyManagementSystemInModel, BeginEnvrnFlag, &
emsCallFromSetupSimulation, emsCallFromExternalInterface, emsCallFromBeginNewEvironment, &
emsCallFromUserDefinedComponentModel
USE DataInterfaces, ONLY: ShowFatalError
USE RuntimeLanguageProcessor, ONLY: EvaluateStack, BeginEnvrnInitializeRuntimeLanguage
USE OutputProcessor, ONLY: MeterType, NumEnergyMeters, EnergyMeters, RealVariables, RealVariableType, NumOfRVariable, RVar, &
RVariableTypes
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: iCalledFrom ! indicates where subroutine was called from, parameters in DataGlobals.
INTEGER, INTENT (IN), OPTIONAL :: ProgramManagerToRun ! specific program manager to run
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ErlVariableNum ! local index
INTEGER :: ProgramManagerNum ! local index and loop
INTEGER :: ErlProgramNum ! local index
INTEGER :: ActuatorUsedLoop ! local loop
INTEGER :: EMSActuatorVariableNum
TYPE(ErlValueType) :: ReturnValue ! local Erl value structure
LOGICAL :: AnyProgramRan ! local logical
INTEGER :: tmpInteger
! INTEGER :: ProgramNum
! FLOW:
IF ( .NOT. AnyEnergyManagementSystemInModel) RETURN ! quick return if nothing to do
IF (iCalledFrom == emsCallFromBeginNewEvironment) CALL BeginEnvrnInitializeRuntimeLanguage
CALL InitEMS(iCalledFrom)
IF (iCalledFrom == emsCallFromSetupSimulation) THEN
Call ProcessEMSInput(.TRUE.)
RETURN
ENDIF
! Run the Erl programs depending on calling point.
AnyProgramRan = .FALSE.
IF (iCalledFrom /= emsCallFromUserDefinedComponentModel) THEN
DO ProgramManagerNum = 1, NumProgramCallManagers
IF (EMSProgramCallManager(ProgramManagerNum)%CallingPoint == iCalledFrom) THEN
DO ErlProgramNum = 1, EMSProgramCallManager(ProgramManagerNum)%NumErlPrograms
ReturnValue = EvaluateStack(EMSProgramCallManager(ProgramManagerNum)%ErlProgramARR(ErlProgramNum))
AnyProgramRan = .TRUE.
ENDDO
ENDIF
ENDDO
ELSE ! call specific program manager
IF (PRESENT(ProgramManagerToRun)) THEN
DO ErlProgramNum = 1, EMSProgramCallManager(ProgramManagerToRun)%NumErlPrograms
ReturnValue = EvaluateStack(EMSProgramCallManager(ProgramManagerToRun)%ErlProgramARR(ErlProgramNum))
AnyProgramRan = .TRUE.
ENDDO
ENDIF
ENDIF
IF (iCalledFrom == emsCallFromExternalInterface) THEN
AnyProgramRan = .TRUE.
ENDIF
IF (.NOT. AnyProgramRan) RETURN
! Set actuated variables with new values
DO ActuatorUsedLoop = 1, numActuatorsUsed + NumExternalInterfaceActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitExportActuatorsUsed
ErlVariableNum = EMSActuatorUsed(ActuatorUsedLoop)%ErlVariableNum
IF (.NOT. (ErlVariableNum >0)) CYCLE ! this can happen for good reason during sizing
EMSActuatorVariableNum = EMSActuatorUsed(ActuatorUsedLoop)%ActuatorVariableNum
IF (.NOT. (EMSActuatorVariableNum >0)) CYCLE ! this can happen for good reason during sizing
IF (ErlVariable(ErlVariableNum)%Value%Type == ValueNull) THEN
EMSActuatorAvailable(EMSActuatorVariableNum)%Actuated = .FALSE.
ELSE
! Set the value and the actuated flag remotely on the actuated object via the pointer
SELECT CASE (EMSActuatorAvailable(EMSActuatorVariableNum)%PntrVarTypeUsed)
CASE (PntrReal)
EMSActuatorAvailable(EMSActuatorVariableNum)%Actuated = .TRUE.
EMSActuatorAvailable(EMSActuatorVariableNum)%RealValue = ErlVariable(ErlVariableNum)%Value%Number
CASE (PntrInteger)
EMSActuatorAvailable(EMSActuatorVariableNum)%Actuated = .TRUE.
tmpInteger = FLOOR(ErlVariable(ErlVariableNum)%Value%Number)
EMSActuatorAvailable(EMSActuatorVariableNum)%IntValue = tmpInteger
CASE (PntrLogical)
EMSActuatorAvailable(EMSActuatorVariableNum)%Actuated = .TRUE.
IF (ErlVariable(ErlVariableNum)%Value%Number == 0.0D0) THEN
EMSActuatorAvailable(EMSActuatorVariableNum)%LogValue = .FALSE.
ELSEIF (ErlVariable(ErlVariableNum)%Value%Number == 1.0D0) THEN
EMSActuatorAvailable(EMSActuatorVariableNum)%LogValue = .TRUE.
ELSE
EMSActuatorAvailable(EMSActuatorVariableNum)%LogValue = .FALSE.
ENDIF
CASE DEFAULT
END SELECT
END IF
END DO
CALL ReportEMS
RETURN
END SUBROUTINE ManageEMS