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 |
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 InitEMS (iCalledFrom)
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith
! DATE WRITTEN May 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! collect routines needed to initialize EMS
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: WarmupFlag, DoingSizing, KickOffSimulation, BeginEnvrnFlag, &
emsCallFromZoneSizing, emsCallFromSystemSizing, emsCallFromUserDefinedComponentModel
USE DataInterfaces, ONLY: ShowFatalError
USE RuntimeLanguageProcessor, ONLY: InitializeRuntimeLanguage, SetErlValueNumber
USE ScheduleManager, ONLY : GetCurrentScheduleValue
USE DataZoneControls, ONLY: GetZoneAirStatsInputFlag
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.
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InternalVarUsedNum ! local index and loop
INTEGER :: InternVarAvailNum ! local index
INTEGER :: SensorNum ! local loop and index
INTEGER :: ErlVariableNum ! local index
REAL(r64) :: tmpReal ! temporary local integer
IF (GetEMSUserInput) THEN
CALL SetupZoneInfoAsInternalDataAvail
CALL SetupWindowShadingControlActuators
CALL SetupSurfaceConvectionActuators
CALL SetupSurfaceConstructionActuators
CALL SetupSurfaceOutdoorBoundaryConditionActuators
CALL GetEMSInput
GetEMSUserInput = .FALSE.
ENDIF
IF (.NOT. GetZoneAirStatsInputFlag .AND. .NOT. ZoneThermostatActuatorsHaveBeenSetup) THEN
CALL SetupThermostatActuators
ZoneThermostatActuatorsHaveBeenSetup = .TRUE.
ENDIF
! need to delay setup of HVAC actuator until after the systems input has been processed (if present)
IF (FinishProcessingUserInput .AND. .NOT. DoingSizing .AND. .NOT. KickOffSimulation) THEN !
CALL SetupNodeSetpointsAsActuators
CALL SetupPrimaryAirSystemAvailMgrAsActuators
! CALL SetupWindowShadingControlActuators !this is too late for including in sizing, moved to GetEMSUserInput
! CALL SetupThermostatActuators !this is too late for including in sizing, moved to GetEMSUserInput
! CALL SetupSurfaceConvectionActuators !this is too late for including in sizing, moved to GetEMSUserInput
FinishProcessingUserInput = .FALSE.
END IF
CALL InitializeRuntimeLanguage
IF ((BeginEnvrnFlag) .OR. (iCalledFrom == emsCallFromZoneSizing) .OR. (iCalledFrom == emsCallFromSystemSizing) &
.OR. (iCalledFrom == emsCallFromUserDefinedComponentModel) ) THEN
! another pass at trying to setup input data.
IF (FinishProcessingUserInput) CALL ProcessEMSInput(.FALSE.)
! update internal data variables being used by Erl
DO InternalVarUsedNum = 1, NumInternalVariablesUsed
ErlVariableNum = EMSInternalVarsUsed(InternalVarUsedNum)%ErlVariableNum
InternVarAvailNum = EMSInternalVarsUsed(InternalVarUsedNum)%InternVarNum
IF (.NOT. (InternVarAvailNum > 0 )) CYCLE ! sometimes executes before completely finished setting up.
IF (.NOT. (ErlVariableNum > 0 )) CYCLE
SELECT CASE (EMSInternalVarsAvailable(InternVarAvailNum)%PntrVarTypeUsed)
CASE (PntrReal)
ErlVariable(ErlVariableNum)%Value = SetErlValueNumber(EMSInternalVarsAvailable(InternVarAvailNum)%RealValue)
CASE (PntrInteger)
tmpReal = REAL(EMSInternalVarsAvailable(InternVarAvailNum)%IntValue, r64 )
ErlVariable(ErlVariableNum)%Value = SetErlValueNumber(tmpReal)
END SELECT
ENDDO
ENDIF
! Update sensors with current data
DO SensorNum = 1, NumSensors
ErlVariableNum = Sensor(SensorNum)%VariableNum
IF ((ErlVariableNum > 0) .AND. (Sensor(SensorNum)%Index > 0)) THEN
IF (Sensor(SensorNum)%SchedNum == 0) THEN ! not a schedule so get from output processor
ErlVariable(ErlVariableNum)%Value = &
SetErlValueNumber(GetInternalVariableValue(Sensor(SensorNum)%Type, Sensor(SensorNum)%Index) , &
OrigValue = ErlVariable(ErlVariableNum)%Value )
ELSE ! schedule so use schedule service
ErlVariable(ErlVariableNum)%Value = &
SetErlValueNumber(GetCurrentScheduleValue(Sensor(SensorNum)%SchedNum), &
OrigValue = ErlVariable(ErlVariableNum)%Value )
ENDIF
ENDIF
END DO
RETURN
END SUBROUTINE InitEMS