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) | :: | Action | |||
integer, | intent(in) | :: | MgrNum | |||
integer, | intent(in) | :: | LoadPtr | |||
logical, | intent(out) | :: | CanReduceDemand |
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 LoadInterface(Action, MgrNum, LoadPtr, CanReduceDemand)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN August 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Provides a universal interface to handle all communication with the various load objects.
! Demand managers for new types of loads can be easily added with a new CASE statement in this subroutine
! and new GetInput code.
! METHODOLOGY EMPLOYED:
!
! USE STATEMENTS:
USE ExteriorEnergyUse, ONLY: ExteriorLights
USE DataHeatBalance, ONLY: Lights, ZoneElectric
USE DataZoneControls, ONLY: TempControlledZone,ComfortControlledZone,NumComfortControlledZones
USE DataHeatBalFanSys, ONLY: ZoneThermostatSetPointHi, ZoneThermostatSetPointLo,ComfortControlType
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: Action
INTEGER, INTENT(IN) :: MgrNum
INTEGER, INTENT(IN) :: LoadPtr
LOGICAL, INTENT(OUT) :: CanReduceDemand
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: LowestPower
! FLOW:
CanReduceDemand = .FALSE.
SELECT CASE (DemandMgr(MgrNum)%Type)
CASE (ManagerTypeExtLights)
LowestPower = ExteriorLights(LoadPtr)%DesignLevel * DemandMgr(MgrNum)%LowerLimit
IF (Action == CheckCanReduce) THEN
IF (ExteriorLights(LoadPtr)%Power > LowestPower) CanReduceDemand = .TRUE.
ELSE IF (Action == SetLimit) THEN
ExteriorLights(LoadPtr)%ManageDemand = .TRUE.
ExteriorLights(LoadPtr)%DemandLimit = LowestPower
ELSE IF (Action == ClearLimit) THEN
ExteriorLights(LoadPtr)%ManageDemand = .FALSE.
END IF
CASE (ManagerTypeLights)
LowestPower = Lights(LoadPtr)%DesignLevel * DemandMgr(MgrNum)%LowerLimit
IF (Action == CheckCanReduce) THEN
IF (Lights(LoadPtr)%Power > LowestPower) CanReduceDemand = .TRUE.
ELSE IF (Action == SetLimit) THEN
Lights(LoadPtr)%ManageDemand = .TRUE.
Lights(LoadPtr)%DemandLimit = LowestPower
ELSE IF (Action == ClearLimit) THEN
Lights(LoadPtr)%ManageDemand = .FALSE.
END IF
CASE (ManagerTypeElecEquip)
LowestPower = ZoneElectric(LoadPtr)%DesignLevel * DemandMgr(MgrNum)%LowerLimit
IF (Action == CheckCanReduce) THEN
IF (ZoneElectric(LoadPtr)%Power > LowestPower) CanReduceDemand = .TRUE.
ELSE IF (Action == SetLimit) THEN
ZoneElectric(LoadPtr)%ManageDemand = .TRUE.
ZoneElectric(LoadPtr)%DemandLimit = LowestPower
ELSE IF (Action == ClearLimit) THEN
ZoneElectric(LoadPtr)%ManageDemand = .FALSE.
END IF
CASE (ManagerTypeThermostats)
IF (Action == CheckCanReduce) THEN
IF (ZoneThermostatSetPointLo(TempControlledZone(LoadPtr)%ActualZoneNum) > DemandMgr(MgrNum)%LowerLimit & ! Heating
.OR. ZoneThermostatSetPointHi(TempControlledZone(LoadPtr)%ActualZoneNum) < DemandMgr(MgrNum)%UpperLimit) & ! Cooling
CanReduceDemand = .TRUE.
ELSE IF (Action == SetLimit) THEN
TempControlledZone(LoadPtr)%ManageDemand = .TRUE.
TempControlledZone(LoadPtr)%HeatingResetLimit = DemandMgr(MgrNum)%LowerLimit
TempControlledZone(LoadPtr)%CoolingResetLimit = DemandMgr(MgrNum)%UpperLimit
ELSE IF (Action == ClearLimit) THEN
TempControlledZone(LoadPtr)%ManageDemand = .FALSE.
END IF
IF (NumComfortControlledZones > 0) THEN
IF (ComfortControlType(TempControlledZone(LoadPtr)%ActualZoneNum)>0) then
IF (Action == CheckCanReduce) THEN
IF (ZoneThermostatSetPointLo(ComfortControlledZone(LoadPtr)%ActualZoneNum) > DemandMgr(MgrNum)%LowerLimit & !Heating
.OR. ZoneThermostatSetPointHi(ComfortControlledZone(LoadPtr)%ActualZoneNum) < DemandMgr(MgrNum)%UpperLimit) &
CanReduceDemand = .TRUE.
ELSE IF (Action == SetLimit) THEN
ComfortControlledZone(LoadPtr)%ManageDemand = .TRUE.
ComfortControlledZone(LoadPtr)%HeatingResetLimit = DemandMgr(MgrNum)%LowerLimit
ComfortControlledZone(LoadPtr)%CoolingResetLimit = DemandMgr(MgrNum)%UpperLimit
ELSE IF (Action == ClearLimit) THEN
ComfortControlledZone(LoadPtr)%ManageDemand = .FALSE.
END IF
END IF
END IF
END SELECT
RETURN
END SUBROUTINE LoadInterface