SUBROUTINE ManageElectricLoadCenters(FirstHVACIteration,SimElecCircuits, UpdateMetersOnly)
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN Sept. 2000
! RE-ENGINEERED Richard Liesen, Feb 2003
! RE-ENGINEERED Bereket Nigusse, Jan/Feb 2010 Generator dispatch is based on actual
! power produced by the previous generator(s)
! MODIFIED Weimin Wang, July 2010 Consider transformer
! PURPOSE OF THIS SUBROUTINE:
! This subroutine manages the electric load centers by matching demand and
! generator power output.
! METHODOLOGY EMPLOYED:
! Generators are dispatched in the sequence sepecified in the idf. The generators
! in the first electric load center are dispatched first. Generators are called
! right after dispatch and the remaining building load due for dispatch is updated
! using the actual generated power output not the requested value from the
! ElectricLoadCenter:Generators object(s).
!
! REFERENCES: na
! USE STATEMENTS:
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE General, ONLY: TrimSigDigits
USE DataGlobals, ONLY: dooutputreporting, MetersHaveBeenInitialized, warmupflag, &
doingsizing, currenttime, BeginEnvrnFlag
USE DataEnvironment, ONLY: Month, DayOfMonth
USE DataHVACGlobals, only: SysTimeElapsed
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT (IN) :: FirstHVACIteration
LOGICAL, INTENT(INOUT) :: SimElecCircuits ! simulation convergence flag
LOGICAL, INTENT (IN) :: UpdateMetersOnly ! if true then don't resimulate generators, just update meters.
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: GenNum = 0 ! Generator number counter
INTEGER :: LoadCenterNum = 0 ! Load center number counter
INTEGER :: TransfNum = 0 ! Transformer number counter
INTEGER :: MeterNum = 0 ! A transformer's meter number counter
INTEGER :: MeterIndex = 0 ! Meter index number from GetMeterIndex
INTEGER, SAVE :: ElecFacilityIndex = 0
REAL(r64) :: ElecFacilityBldg = 0.0D0
REAL(r64) :: ElecFacilityHVAC = 0.0D0
REAL(r64) :: ElecProducedPV = 0.0D0
REAL(r64) :: ElecProducedWT = 0.0D0
REAL(r64) :: RemainingLoad = 0.0D0 ! Remaining electric power load to be met by a load center
REAL(r64) :: WholeBldgRemainingLoad = 0.0D0 ! Remaining electric power load for the building
REAL(r64) :: RemainingThermalLoad = 0.0D0 ! Remaining thermal load to be met
LOGICAL,SAVE :: MyOneTimeFlag = .true.
REAL(r64) :: CustomMeterDemand = 0.0D0 ! local variable for Custom metered elec demand
INTEGER, external :: GetMeterIndex
REAL(r64), external :: GetInstantMeterValue
REAL(r64), external :: GetCurrentMeterValue
CHARACTER(len=MaxNameLength), external :: GetMeterResourceType
LOGICAL, SAVE :: MyEnvrnFlag=.true.
REAL(r64) :: ElectricProdRate = 0.0d0 ! Electric Power Production Rate of Generators
REAL(r64) :: ThermalProdRate = 0.0d0 ! Thermal Power Production Rate of Generators
REAL(r64) :: ExcessThermalPowerRequest = 0.0d0 ! Excess Thermal Power Request
REAL(r64) :: LoadCenterElectricLoad = 0.0D0 ! Load center electric load to be dispatched
REAL(r64) :: LoadCenterThermalLoad = 0.0D0 ! Load center thermal load to be dispatched
REAL(r64) :: StorageDrawnPower = 0.0D0 ! Electric Power Draw Rate from storage units
REAL(r64) :: StorageStoredPower = 0.0D0 ! Electric Power Store Rate from storage units
! Get Generator data from input file
IF (GetInput) THEN
CALL GetPowerManagerInput
GetInput = .FALSE.
END IF
! Setting up the Internal Meters and getting their indexes is done only once
IF(MetersHaveBeenInitialized .and. MyOneTimeFlag) THEN
ElecFacilityIndex = GetMeterIndex('Electricity:Facility')
ElecProducedCoGenIndex = GetMeterIndex('Cogeneration:ElectricityProduced')
ElecProducedPVIndex = GetMeterIndex('Photovoltaic:ElectricityProduced')
ElecProducedWTIndex = GetMeterIndex('WindTurbine:ElectricityProduced')
DO LoadCenterNum = 1, NumLoadCenters
ElecLoadCenter(LoadCenterNum)%DemandMeterPtr = GetMeterIndex(ElecLoadCenter(LoadCenterNum)%DemandMeterName)
ENDDO
DO TransfNum = 1, NumTransformers !NumTransformers is a module variable
IF(Transformer(TransfNum)%UsageMode == PowerInFromGrid) THEN
DO MeterNum = 1, SIZE(Transformer(TransfNum)%WiredMeterNames)
MeterIndex = GetMeterIndex(Transformer(TransfNum)%WiredMeterNames(MeterNum))
Transformer(TransfNum)%WiredMeterPtrs(MeterNum) = MeterIndex
!Check whether the meter is an electricity meter
!Index function is used here because some resource types are not Electricity but strings containing
! Electricity such as ElectricityPurchased and ElectricityProduced.
!It is not proper to have this check in GetInput routine because the meter index may have not been defined
IF( INDEX(GetMeterResourceType(MeterIndex),'Electricity') == 0) THEN
CALL ShowFatalError('Non-electricity meter used for '// Transformer(TransfNum)%Name)
END IF
END DO
ENDIF
END DO
MyOneTimeFlag = .FALSE.
END IF
IF (BeginEnvrnFlag .and. MyEnvrnFlag) THEN
WholeBldgElectSummary%ElectricityProd = 0.d0
WholeBldgElectSummary%ElectProdRate = 0.d0
WholeBldgElectSummary%ElectricityPurch = 0.d0
WholeBldgElectSummary%ElectPurchRate = 0.d0
WholeBldgElectSummary%ElectSurplusRate = 0.d0
WholeBldgElectSummary%ElectricitySurplus = 0.d0
WholeBldgElectSummary%ElectricityNetRate = 0.d0
WholeBldgElectSummary%ElectricityNet = 0.d0
WholeBldgElectSummary%TotalBldgElecDemand = 0.d0
WholeBldgElectSummary%TotalHVACElecDemand = 0.d0
WholeBldgElectSummary%TotalElectricDemand = 0.d0
WholeBldgElectSummary%ElecProducedPVRate = 0.d0
WholeBldgElectSummary%ElecProducedWTRate = 0.d0
IF (NumLoadCenters > 0) THEN
ElecLoadCenter%DCElectricityProd = 0.d0
ElecLoadCenter%DCElectProdRate = 0.d0
ElecLoadCenter%DCpowerConditionLosses = 0.d0
ElecLoadCenter%ElectricityProd = 0.d0
ElecLoadCenter%ElectProdRate = 0.d0
ElecLoadCenter%ThermalProd = 0.d0
ElecLoadCenter%ThermalProdRate = 0.d0
ElecLoadCenter%TotalPowerRequest = 0.d0
ElecLoadCenter%TotalThermalPowerRequest = 0.d0
ElecLoadCenter%ElectDemand = 0.d0
ENDIF
DO LoadCenterNum = 1, NumLoadCenters
IF (ElecLoadCenter(LoadCenterNum)%NumGenerators == 0) CYCLE
ElecLoadCenter(LoadCenterNum)%ElecGen%ONThisTimestep = .FALSE.
ElecLoadCenter(LoadCenterNum)%ElecGen%DCElectricityProd = 0.d0
ElecLoadCenter(LoadCenterNum)%ElecGen%DCElectProdRate = 0.d0
ElecLoadCenter(LoadCenterNum)%ElecGen%ElectricityProd = 0.d0
ElecLoadCenter(LoadCenterNum)%ElecGen%ElectProdRate = 0.d0
ElecLoadCenter(LoadCenterNum)%ElecGen%ThermalProd = 0.d0
ElecLoadCenter(LoadCenterNum)%ElecGen%ThermalProdRate = 0.d0
ENDDO
IF (NumInverters > 0) THEN
Inverter%AncillACuseRate = 0.d0
Inverter%AncillACuseEnergy = 0.d0
Inverter%QdotconvZone = 0.d0
Inverter%QdotRadZone = 0.d0
ENDIF
IF (NumElecStorageDevices > 0) THEN
ElecStorage%PelNeedFromStorage = 0.d0
ElecStorage%PelFromStorage = 0.d0
ElecStorage%PelIntoStorage = 0.d0
ElecStorage%QdotConvZone = 0.d0
ElecStorage%QdotRadZone = 0.d0
ElecStorage%TimeElapsed = 0.d0
ElecStorage%ElectEnergyinStorage = 0.d0
ElecStorage%StoredPower = 0.d0
ElecStorage%StoredEnergy = 0.d0
ElecStorage%DecrementedEnergyStored = 0.d0
ElecStorage%DrawnPower = 0.d0
ElecStorage%DrawnEnergy = 0.d0
ElecStorage%ThermLossRate = 0.d0
ElecStorage%ThermLossEnergy = 0.d0
ENDIF
MyEnvrnFlag=.false.
ENDIF
IF (.not. BeginEnvrnFlag) MyEnvrnFlag=.TRUE.
! Determine the demand from the simulation for Demand Limit and Track Electrical and Reporting
ElecFacilityBldg=GetInstantMeterValue(ElecFacilityIndex,1)
ElecFacilityHVAC=GetInstantMeterValue(ElecFacilityIndex,2)
! deprecate this PV stuff?
ElecProducedPV = GetInstantMeterValue(ElecProducedPVIndex,2)
ElecProducedWT = GetInstantMeterValue(ElecProducedWTIndex,2)
WholeBldgElectSummary%TotalBldgElecDemand = ElecFacilityBldg/(TimeStepZone*SecInHour)
WholeBldgElectSummary%TotalHVACElecDemand = ElecFacilityHVAC/(TimeStepSys*SecInHour)
WholeBldgElectSummary%TotalElectricDemand = WholeBldgElectSummary%TotalBldgElecDemand + &
WholeBldgElectSummary%TotalHVACElecDemand
WholeBldgElectSummary%ElecProducedPVRate = ElecProducedPV/(TimeStepSys*SecInHour)
WholeBldgElectSummary%ElecProducedWTRate = ElecProducedWT/(TimeStepSys*SecInHour)
WholeBldgRemainingLoad = WholeBldgElectSummary%TotalElectricDemand !- WholeBldgElectSummary%ElecProducedPVRate
IF (UpdateMetersOnly) THEN ! just update record keeping, don't resimulate load centers
CALL ManageTransformers()
CALL UpdateWholeBuildingRecords
RETURN
ENDIF
! dispatch across load centers and generators keeping track of remaining whole building load.
DO LoadCenterNum = 1, NumLoadCenters
IF ((ElecLoadCenter(LoadCenterNum)%DemandMeterPtr == 0 ) .AND. &
(ElecLoadCenter(LoadCenterNum)%OperationScheme == iOpSchemeTrackMeter) ) THEN ! keep trying to setup
ElecLoadCenter(LoadCenterNum)%DemandMeterPtr = GetMeterIndex(ElecLoadCenter(LoadCenterNum)%DemandMeterName)
ENDIF
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = 0.0d0
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest = 0.0d0
! Check Operation Scheme and assign power generation load
! Both the Demand Limit and Track Electrical schemes will sequentially load the available generators. All demand
! not met by available generator capacity will be met by purchased electrical.
! If a generator is needed in the simulation for a small load and it is less than the minimum part load ratio
! the generator will operate at the minimum part load ratio and the excess will either reduce demand or
! be available for storage or sell back to the power company.
TypeOfEquip: SELECT CASE (ElecLoadCenter(LoadCenterNum)%OperationScheme)
CASE (iOpSchemeBaseLoad) ! 'BASELOAD'
LoadCenterElectricLoad = WholeBldgRemainingLoad
DO GenNum = 1, ElecLoadCenter(LoadCenterNum)%NumGenerators
IF(GetCurrentScheduleValue(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%AvailSchedPtr) .gt. 0.0D0) THEN
! Set the Operation Flag
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
! Set the electric generator load request
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = 0.0D0
END IF
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
! Get generator's actual electrical and thermal power outputs
CALL GeneratorPowerOutput(LoadCenterNum,GenNum,FirstHVACIteration,ElectricProdRate,ThermalProdRate)
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep
WholeBldgRemainingLoad = WholeBldgRemainingLoad - ElectricProdRate ! Update whole building remaining load
END DO
CASE (iOpSchemeDemandLimit) ! 'DEMAND LIMIT'
! The Demand Limit scheme tries to have the generators meet all of the demand above the purchased Electric
! limit set by the user.
RemainingLoad = WholeBldgRemainingLoad - ElecLoadCenter(LoadCenterNum)%DemandLimit
LoadCenterElectricLoad = RemainingLoad
DO GenNum = 1, ElecLoadCenter(LoadCenterNum)%NumGenerators
IF(GetCurrentScheduleValue(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%AvailSchedPtr) .gt. 0.0D0 &
.and. RemainingLoad > 0.0D0) THEN
! Set the Operation Flag
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
! Set the electric generator load
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MIN(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut,RemainingLoad)
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = 0.0D0
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
END IF
! Get generator's actual electrical and thermal power outputs
CALL GeneratorPowerOutput(LoadCenterNum,GenNum,FirstHVACIteration,ElectricProdRate,ThermalProdRate)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
ELSE
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
MIN(LoadCenterElectricLoad,ElecLoadCenter(LoadCenterNum)%TotalPowerRequest)
ENDIF
ENDIF
RemainingLoad = RemainingLoad - ElectricProdRate ! Update remaining load to be met by this load center
WholeBldgRemainingLoad = WholeBldgRemainingLoad - ElectricProdRate ! Update whole building remaining load
END DO
CASE (iOpSchemeTrackElectrical) ! 'TRACK ELECTRICAL'
!The Track Electrical scheme tries to have the generators meet all of the electrical demand for the building.
RemainingLoad = WholeBldgRemainingLoad
LoadCenterElectricLoad = RemainingLoad
DO GenNum = 1, ElecLoadCenter(LoadCenterNum)%NumGenerators
IF(GetCurrentScheduleValue(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%AvailSchedPtr) .gt. 0.0D0 &
.and. RemainingLoad > 0.0D0) THEN
! Set the Operation Flag
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
! Set the electric generator load
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MIN(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut,RemainingLoad)
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = 0.0D0
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
END IF
! Get generator's actual electrical and thermal power outputs
CALL GeneratorPowerOutput(LoadCenterNum,GenNum,FirstHVACIteration,ElectricProdRate,ThermalProdRate)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
ELSE
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
MIN(LoadCenterElectricLoad,ElecLoadCenter(LoadCenterNum)%TotalPowerRequest)
ENDIF
ENDIF
RemainingLoad = RemainingLoad - ElectricProdRate ! Update remaining load to be met by this load center
WholeBldgRemainingLoad = WholeBldgRemainingLoad - ElectricProdRate ! Update whole building remaining load
END DO
CASE (iOpSchemeTrackSchedule) ! 'TRACK SCHEDULE'
! The Track Schedule scheme tries to have the generators meet the electrical demand determined from a schedule.
! Code is very similar to 'Track Electrical' except for initial RemainingLoad is replaced by SchedElecDemand
! and PV production is ignored.
RemainingLoad = GetCurrentScheduleValue(ElecLoadCenter(LoadCenterNum)%TrackSchedPtr)
LoadCenterElectricLoad = RemainingLoad
DO GenNum = 1, ElecLoadCenter(LoadCenterNum)%NumGenerators
IF(GetCurrentScheduleValue(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%AvailSchedPtr) .gt. 0.0D0 &
.and. RemainingLoad > 0.0D0) THEN
! Set the Operation Flag
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
! Set the electric generator load
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MIN(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut,RemainingLoad)
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = 0.0D0
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
END IF
! Get generator's actual electrical and thermal power outputs
CALL GeneratorPowerOutput(LoadCenterNum,GenNum,FirstHVACIteration,ElectricProdRate,ThermalProdRate)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
ELSE
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
MIN(LoadCenterElectricLoad,ElecLoadCenter(LoadCenterNum)%TotalPowerRequest)
ENDIF
ENDIF
RemainingLoad = RemainingLoad - ElectricProdRate ! Update remaining load to be met by this load center
WholeBldgRemainingLoad = WholeBldgRemainingLoad - ElectricProdRate ! Update whole building remaining load
END DO
CASE (iOpSchemeTrackMeter) ! 'TRACK METER'
! The TRACK CUSTOM METER scheme tries to have the generators meet all of the
! electrical demand from a meter, it can also be a user-defined Custom Meter
! and PV is ignored.
CustomMeterDemand = GetInstantMeterValue(ElecLoadCenter(LoadCenterNum)%DemandMeterPtr,1)/ (TimeStepZone * SecInHour) &
+ GetInstantMeterValue(ElecLoadCenter(LoadCenterNum)%DemandMeterPtr,2)/ (TimeStepSys * SecInHour)
RemainingLoad = CustomMeterDemand
LoadCenterElectricLoad = RemainingLoad
DO GenNum = 1, ElecLoadCenter(LoadCenterNum)%NumGenerators
IF(GetCurrentScheduleValue(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%AvailSchedPtr) .gt. 0.0D0 &
.and. RemainingLoad > 0.0D0) THEN
! Set the Operation Flag
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
! Set the electric generator load
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MIN(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut,RemainingLoad)
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = 0.0D0
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
END IF
! Get generator's actual electrical and thermal power outputs
CALL GeneratorPowerOutput(LoadCenterNum,GenNum,FirstHVACIteration,ElectricProdRate,ThermalProdRate)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
ELSE
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
MIN(LoadCenterElectricLoad,ElecLoadCenter(LoadCenterNum)%TotalPowerRequest)
ENDIF
ENDIF
RemainingLoad = RemainingLoad - ElectricProdRate ! Update remaining load to be met by this load center
WholeBldgRemainingLoad = WholeBldgRemainingLoad - ElectricProdRate ! Update whole building remaining load
END DO
CASE (iOpSchemeThermalFollow)
! Turn thermal load into an electrical load for cogenerators controlled to follow heat loads
RemainingThermalLoad = 0.0D0
CALL CalcLoadCenterThermalLoad(FirstHVACIteration, LoadCenterNum, RemainingThermalLoad)
LoadCenterThermalLoad = RemainingThermalLoad
DO GenNum = 1, ElecLoadCenter(LoadCenterNum)%NumGenerators
IF(GetCurrentScheduleValue(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%AvailSchedPtr) .gt. 0.0D0 &
.and. RemainingThermalLoad > 0.0D0) THEN
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio > 0.0D0) THEN
RemainingLoad = RemainingThermalLoad / ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MIN(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut,RemainingLoad)
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
ENDIF
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = 0.0D0
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
ENDIF
! Get generator's actual electrical and thermal power outputs
CALL GeneratorPowerOutput(LoadCenterNum,GenNum,FirstHVACIteration,ElectricProdRate,ThermalProdRate)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest = &
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest &
+ (MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)) &
* ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ (MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0))
ELSE
IF (ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest < LoadCenterThermalLoad .AND. &
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0d0) THEN
ExcessThermalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut &
* ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio &
- LoadCenterThermalLoad
IF ( ExcessThermalPowerRequest < 0.0d0 ) THEN
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest = &
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut &
* ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut
ELSE
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest = LoadCenterThermalLoad
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio > 0.0d0) THEN
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut &
- (ExcessThermalPowerRequest &
/ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio)
ENDIF
ENDIF
ENDIF
ENDIF
RemainingThermalLoad = RemainingThermalLoad - ThermalProdRate ! Update remaining load to be met
! by this load center
WholeBldgRemainingLoad = WholeBldgRemainingLoad - ElectricProdRate ! Update whole building remaining load
ENDDO
CASE (iOpSchemeThermalFollowLimitElectrical)
! Turn a thermal load into an electrical load for cogenerators controlled to follow heat loads.
! Add intitialization of RemainingThermalLoad as in the ThermalFollow operating scheme above.
CALL CalcLoadCenterThermalLoad(FirstHVACIteration,LoadCenterNum, RemainingThermalLoad)
! Total current electrical demand for the building is a secondary limit.
RemainingLoad = WholeBldgRemainingLoad
LoadCenterElectricLoad = WholeBldgRemainingLoad
LoadCenterThermalLoad = RemainingThermalLoad
DO GenNum = 1, ElecLoadCenter(LoadCenterNum)%NumGenerators
IF((GetCurrentScheduleValue(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%AvailSchedPtr) .gt. 0.0D0) &
.and. (RemainingThermalLoad > 0.0D0) .and. (RemainingLoad > 0.0D0) ) THEN
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio > 0.0D0) THEN
RemainingLoad = MIN(WholeBldgRemainingLoad, RemainingThermalLoad / &
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio)
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MIN(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut,RemainingLoad)
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
ENDIF
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = 0.0D0
! now handle EMS override
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep = &
MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0D0) THEN
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .TRUE.
ELSE
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%ONThisTimeStep = .FALSE.
ENDIF
ENDIF
ENDIF
! Get generator's actual electrical and thermal power outputs
CALL GeneratorPowerOutput(LoadCenterNum,GenNum,FirstHVACIteration,ElectricProdRate,ThermalProdRate)
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSRequestOn) THEN
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest = &
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest &
+ (MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0)) &
* ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ (MAX(ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%EMSPowerRequest, 0.0D0))
ELSE
IF (ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest < LoadCenterThermalLoad .AND. &
ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%PowerRequestThisTimestep > 0.0d0) THEN
ExcessThermalPowerRequest = ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut &
* ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio &
- LoadCenterThermalLoad
IF ( ExcessThermalPowerRequest < 0.0d0 ) THEN
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest = &
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut &
* ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut
ELSE
ElecLoadCenter(LoadCenterNum)%TotalThermalPowerRequest = LoadCenterThermalLoad
IF (ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio > 0.0d0) THEN
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest &
+ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%MaxPowerOut &
- (ExcessThermalPowerRequest &
/ ElecLoadCenter(LoadCenterNum)%ElecGen(GenNum)%NominalThermElectRatio)
ENDIF
ENDIF
ElecLoadCenter(LoadCenterNum)%TotalPowerRequest = &
MIN(LoadCenterElectricLoad,ElecLoadCenter(LoadCenterNum)%TotalPowerRequest)
ENDIF
ENDIF
RemainingThermalLoad = RemainingThermalLoad - ThermalProdRate ! Update remaining thermal load to
! be met by this load center
WholeBldgRemainingLoad = WholeBldgRemainingLoad - ElectricProdRate ! Update whole building remaining
! electric load
ENDDO
CASE (0) ! This case allows for the reporting to be done without generators specified.
CASE DEFAULT
CALL ShowFatalError('Invalid operation scheme type for Electric Load Center=' &
//TRIM(ElecLoadCenter(LoadCenterNum)%Name))
END SELECT TypeOfEquip
ElecLoadCenter(LoadCenterNum)%ElectDemand = LoadCenterElectricLoad !To obtain the load for transformer
IF ( (ElecLoadCenter(LoadCenterNum)%StoragePresent) .AND. &
(ElecLoadCenter(LoadCenterNum)%BussType == DCBussInverterDCStorage) ) THEN
CALL ManageElectCenterStorageInteractions(LoadCenterNum,StorageDrawnPower,StorageStoredPower)
! Adjust whole building electric demand based on storage inputs and outputs
WholeBldgRemainingLoad = WholeBldgRemainingLoad - StorageDrawnPower + StorageStoredPower
ENDIF
IF (ElecLoadCenter(LoadCenterNum)%InverterPresent) CALL ManageInverter(LoadCenterNum)
IF ( (ElecLoadCenter(LoadCenterNum)%StoragePresent) .AND. &
( (ElecLoadCenter(LoadCenterNum)%BussType == DCBussInverterACStorage) &
.OR. (ElecLoadCenter(LoadCenterNum)%BussType == ACBussStorage) ) ) THEN
CALL ManageElectCenterStorageInteractions(LoadCenterNum,StorageDrawnPower,StorageStoredPower)
WholeBldgRemainingLoad = WholeBldgRemainingLoad - StorageDrawnPower + StorageStoredPower
ENDIF
CALL UpdateLoadCenterRecords(LoadCenterNum)
ENDDO !End of Load Center Do Loop
! The transformer call should be put outside of the "Load Center" loop because
! 1) A transformer may be for utility, not for load center
! 2) A tansformer may be shared by multiple load centers
CALL ManageTransformers()
CALL UpdateWholeBuildingRecords
! Need to simulate through the Elec Manager at least twice to ensure that Heat Recovery information is included.
! recheck this, may not be needed now that load centers are called more often.
! Does the IF condition also need to check if any thermal following strategies have been specified?
! That is, if only electrical following schemes, don't need to resimulate?
IF(FirstHVACIteration)THEN
SimElecCircuits = .TRUE.
ELSE
SimElecCircuits = .FALSE.
END IF
RETURN
END SUBROUTINE ManageElectricLoadCenters