SUBROUTINE GetPowerManagerInput
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN September 2000
! MODIFIED B. Griffith, 2008 multiple load centers, inverter, storage
! W. Wang, 2010 transformer
! Y. KyungTae & W. Wang July-August, 2011 Add a battery model
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reads the load center data
! attributes from the input file
! METHODOLOGY EMPLOYED:
! calls the Input Processor to retrieve data from input file.
! The format of the Energy+.idd (the EnergyPlus input data dictionary) for the
! following keywords is reflected exactly in this subroutine:
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, FindItemInList, &
SameString, MakeUPPERCase, GetObjectDefMaxArgs
USE DataIPShortCuts
USE ScheduleManager, ONLY: GetScheduleIndex
USE CurveManager, ONLY: GetCurveIndex, GetCurveType
Use DataHeatBalance, ONLY: Zone, IntGainTypeOf_ElectricLoadCenterInverterSimple, &
IntGainTypeOf_ElectricLoadCenterInverterFunctionOfPower, &
IntGainTypeOf_ElectricLoadCenterInverterLookUpTable, &
IntGainTypeOf_ElectricLoadCenterStorageSimple, &
IntGainTypeOf_ElectricLoadCenterStorageBattery, &
IntGainTypeOf_ElectricLoadCenterTransformer
USE DataGlobals , ONLY: NumOfZones, AnyEnergyManagementSystemInModel, ScheduleAlwaysOn
USE DataInterfaces
USE General, ONLY: RoundSigDigits
USE OutputReportPredefined
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank=' '
CHARACTER(len=*), PARAMETER :: RoutineName='GetPowerManagerInput: '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER, external :: GetMeterIndex
INTEGER :: NumGenLists ! Number of generator lists
INTEGER :: AlphaCount ! alpha input index
INTEGER :: GenCount ! generator counter index
INTEGER :: Count ! loop index
INTEGER :: ListNum ! List number index
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
!CHARACTER(len=MaxNameLength),DIMENSION(:), ALLOCATABLE :: Alpha !dimension to num of alpha fields in input
!REAL(r64), DIMENSION(:), ALLOCATABLE :: Num !dimension to num of numeric data fields in input
LOGICAL :: ErrorsFound=.false. ! error in input
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: ListName
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: InverterNames
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: StorageNames
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: TransformerNames
INTEGER :: AnyElectricityPresent ! local test for presence of Electricty in Facility
INTEGER :: NumGenerators ! local number of generators per electric load center
LOGICAL :: SetupWholeBldgReports
!unused1208 INTEGER :: MaxNumAlphas
!unused1208 INTEGER :: MaxNumArgs
!unused1208 INTEGER :: MaxNumNumbers
INTEGER :: NumofCECinverters
INTEGER :: NumofCurveInverters
INTEGER :: NumofSimpleInverters
INTEGER :: NumofSimpleElecStorage
INTEGER :: NumofKiBaMElecStorage
INTEGER :: InvertNum
INTEGER :: StorNum
INTEGER :: TransfNum
INTEGER :: Found
INTEGER :: NumAlphaBeforeMeter !Number of Alpha fields before the extensible meters
!Used to derive the number of meters wired to a transformer
INTEGER :: NumWiredMeters !Number of electric meters wired to a transformer
INTEGER :: LCofTransformer !Index of load center served by a transformer
INTEGER :: LoopCount !loop counter
REAL(r64) :: pvTotalCapacity = 0.0d0 ! for LEED report
REAL(r64) :: windTotalCapacity = 0.0d0 ! for LEED report
NumAlphaBeforeMeter = 7 !Hard coded. Changes might be needed if the transformer input structure gets changed
LCofTransformer = 0
!FLOW:
SetupWholeBldgReports = .FALSE.
!first read in any inverters that might be associated with a load center
NumofCECinverters = GetNumObjectsFound('ElectricLoadCenter:Inverter:LookUpTable')
NumofCurveInverters = GetNumObjectsFound('ElectricLoadCenter:Inverter:FunctionOfPower')
NumofSimpleInverters = GetNumObjectsFound('ElectricLoadCenter:Inverter:Simple')
NumInverters = NumofCECinverters + NumofCurveInverters + NumofSimpleInverters
If (NumInverters > 0) Then
Allocate(Inverter(NumInverters))
Allocate(InverterNames(NumInverters))
If (NumofCECinverters > 0) Then
cCurrentModuleObject = 'ElectricLoadCenter:Inverter:LookUpTable'
Do InvertNum = 1, NumofCECinverters
CALL GetObjectItem(cCurrentModuleObject,InvertNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),InverterNames,InvertNum-1,IsNotOK,IsBlank,trim(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
InverterNames(InvertNum) =TRIM(cAlphaArgs(1))
Inverter(InvertNum)%name = cAlphaArgs(1)
Inverter(InvertNum)%ModelType = CECLookUpTableModel
IF (lAlphaFieldBlanks(2)) THEN
Inverter(InvertNum)%AvailSchedPtr = ScheduleAlwaysOn
ELSE
Inverter(InvertNum)%AvailSchedPtr = GetScheduleIndex(cAlphaArgs(2))
If ( Inverter(InvertNum)%AvailSchedPtr == 0 ) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
ErrorsFound=.true.
ENDIF
ENDIF
Inverter(InvertNum)%ZoneNum = FindItemInList(cAlphaArgs(3), Zone%Name, NumOfZones)
IF (Inverter(InvertNum)%ZoneNum > 0) Inverter(InvertNum)%HeatLossesDestination = ZoneGains
IF (Inverter(InvertNum)%ZoneNum == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
Inverter(InvertNum)%HeatLossesDestination = LostToOutside
ELSE
Inverter(InvertNum)%HeatLossesDestination = LostToOutside
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CAll ShowContinueError('Zone name not found. Inverter heat losses will not be added to a zone' )
! continue with simulation but inverter losses not sent to a zone.
ENDIF
ENDIF
Inverter(InvertNum)%ZoneRadFract = rNumericArgs(1)
Inverter(InvertNum)%RatedPower = rNumericArgs(2)
Inverter(InvertNum)%StandbyPower = rNumericArgs(3)
Inverter(InvertNum)%LUtable%NightTareLossPower = rNumericArgs(3)
Inverter(InvertNum)%LUtable%NominalVoltage = rNumericArgs(4)
Inverter(InvertNum)%LUtable%NomVoltEfficiencyARR(1) = rNumericArgs(5)
Inverter(InvertNum)%LUtable%NomVoltEfficiencyARR(2) = rNumericArgs(6)
Inverter(InvertNum)%LUtable%NomVoltEfficiencyARR(3) = rNumericArgs(7)
Inverter(InvertNum)%LUtable%NomVoltEfficiencyARR(4) = rNumericArgs(8)
Inverter(InvertNum)%LUtable%NomVoltEfficiencyARR(5) = rNumericArgs(9)
Inverter(InvertNum)%LUtable%NomVoltEfficiencyARR(6) = rNumericArgs(10)
ENDDO
ENDIF
IF (NumofCurveInverters >0) THEN
cCurrentModuleObject = 'ElectricLoadCenter:Inverter:FunctionOfPower'
Do InvertNum = NumofCECinverters + 1, NumofCECinverters + NumofCurveInverters
CALL GetObjectItem(cCurrentModuleObject,InvertNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),InverterNames,InvertNum-1,IsNotOK,IsBlank,trim(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
InverterNames(InvertNum) =TRIM(cAlphaArgs(1))
Inverter(InvertNum)%ModelType = CurveFuncOfPower
Inverter(InvertNum)%Name = cAlphaArgs(1)
IF (lAlphaFieldBlanks(2)) THEN
Inverter(InvertNum)%AvailSchedPtr = ScheduleAlwaysOn
ELSE
Inverter(InvertNum)%AvailSchedPtr = GetScheduleIndex(cAlphaArgs(2))
If ( Inverter(InvertNum)%AvailSchedPtr == 0 ) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
ErrorsFound=.true.
ENDIF
ENDIF
Inverter(InvertNum)%ZoneNum = FindItemInList(cAlphaArgs(3), Zone%Name, NumOfZones)
IF (Inverter(InvertNum)%ZoneNum > 0) Inverter(InvertNum)%HeatLossesDestination = ZoneGains
IF (Inverter(InvertNum)%ZoneNum == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
Inverter(InvertNum)%HeatLossesDestination = LostToOutside
ELSE
Inverter(InvertNum)%HeatLossesDestination = LostToOutside
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
! continue with simulation but inverter losses not sent to a zone.
CAll ShowContinueError('Zone name not found. Inverter heat losses will not be added to a zone' )
ENDIF
ENDIF
Inverter(InvertNum)%CurveNum = GetCurveIndex(cAlphaArgs(4))
If (Inverter(InvertNum)%CurveNum == 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//' = '//TRIM(cAlphaArgs(4)) )
CAll ShowContinueError('Curve was not found')
ErrorsFound=.true.
ENDIF
Inverter(InvertNum)%ZoneRadFract = rNumericArgs(1)
Inverter(InvertNum)%RatedPower = rNumericArgs(2)
Inverter(InvertNum)%MinEfficiency = rNumericArgs(3)
Inverter(InvertNum)%MaxEfficiency = rNumericArgs(4)
Inverter(InvertNum)%MinPower = rNumericArgs(5)
Inverter(InvertNum)%MaxPower = rNumericArgs(6)
Inverter(InvertNum)%StandbyPower = rNumericArgs(7)
ENDDO
ENDIF
IF (NumofSimpleInverters > 0) THEN
cCurrentModuleObject = 'ElectricLoadCenter:Inverter:Simple'
DO InvertNum = NumofCECinverters + NumofCurveInverters +1, NumInverters
CALL GetObjectItem(cCurrentModuleObject,InvertNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .false.
IsBlank = .false.
CALL VerifyName(cAlphaArgs(1),InverterNames,InvertNum-1,IsNotOK,IsBlank,trim(cCurrentModuleObject)//' Name')
IF (IsNotOK) Then
errorsFound = .true.
If (IsBlank) cAlphaArgs(1)='xxxx'
ENDIF
InverterNames(InvertNum) = Trim(cAlphaArgs(1))
Inverter(InvertNum)%Name = Trim(cAlphaArgs(1))
Inverter(InvertNum)%ModelType = SimpleConstantEff
IF (lAlphaFieldBlanks(2)) THEN
Inverter(InvertNum)%AvailSchedPtr = ScheduleAlwaysOn
ELSE
Inverter(InvertNum)%AvailSchedPtr = GetScheduleIndex(cAlphaArgs(2))
If ( Inverter(InvertNum)%AvailSchedPtr == 0 ) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
ErrorsFound=.true.
ENDIF
ENDIF
Inverter(InvertNum)%ZoneNum = FindItemInList(cAlphaArgs(3), Zone%Name, NumOfZones)
IF (Inverter(InvertNum)%ZoneNum > 0) Inverter(InvertNum)%HeatLossesDestination = ZoneGains
IF (Inverter(InvertNum)%ZoneNum == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
Inverter(InvertNum)%HeatLossesDestination = LostToOutside
ELSE
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CAll ShowContinueError('Zone name not found. Inverter heat losses will not be added to a zone' )
! continue with simulation but inverter losses not sent to a zone.
ENDIF
ENDIF
Inverter(InvertNum)%ZoneRadFract = rNumericArgs(1)
Inverter(InvertNum)%Efficiency = rNumericArgs(2)
ENDDO
ENDIF
!setup reports for all inverters
Do InvertNum = 1, NumInverters
Call SetupOutputVariable('Inverter DC to AC Efficiency []', &
Inverter(InvertNum)%Efficiency, 'System', 'Average', Inverter(InvertNum)%Name )
Call SetupOutputVariable('Inverter DC Input Electric Power [W]', &
Inverter(InvertNum)%DCPowerIn, 'System', 'Average', Inverter(InvertNum)%Name )
Call SetupOutputVariable('Inverter DC Input Electric Energy [J]', &
Inverter(InvertNum)%DCEnergyIn, 'System', 'Sum', Inverter(InvertNum)%Name )
Call SetupOutputVariable('Inverter AC Output Electric Power [W]', &
Inverter(InvertNum)%ACPowerOut, 'System', 'Average', Inverter(InvertNum)%Name )
Call SetupOutputVariable('Inverter AC Output Electric Energy [J]', &
Inverter(InvertNum)%ACEnergyOut, 'System', 'Sum', Inverter(InvertNum)%Name , &
ResourceTypeKey='ElectricityProduced',EndUseKey='Photovoltaics',GroupKey='Plant') ! right now PV is the only DC source
Call SetupOutputVariable('Inverter Thermal Loss Rate [W]', &
Inverter(InvertNum)%ThermLossRate, 'System', 'Average', Inverter(InvertNum)%Name )
Call SetupOutputVariable('Inverter Thermal Loss Energy [J]', &
Inverter(InvertNum)%ThermLossEnergy, 'System', 'Sum', Inverter(InvertNum)%Name )
Call SetupOutputVariable('Inverter Ancillary AC Electric Power [W]', &
Inverter(InvertNum)%AncillACuseRate , 'System', 'Average', Inverter(InvertNum)%Name )
Call SetupOutputVariable('Inverter Ancillary AC Electric Energy [J]', &
Inverter(InvertNum)%AncillACuseEnergy , 'System', 'Sum', Inverter(InvertNum)%Name , &
ResourceTypeKey='Electricity',EndUseKey='Cogeneration',GroupKey='Plant') ! called cogeneration for end use table
IF (Inverter(InvertNum)%ZoneNum > 0) THEN
SELECT CASE (Inverter(InvertNum)%ModelType)
CASE (SimpleConstantEff)
CALL SetupZoneInternalGain(Inverter(InvertNum)%ZoneNum, &
'ElectricLoadCenter:Inverter:Simple', &
Inverter(InvertNum)%Name , &
IntGainTypeOf_ElectricLoadCenterInverterSimple, &
ConvectionGainRate = Inverter(InvertNum)%QdotconvZone, &
ThermalRadiationGainRate = Inverter(InvertNum)%QdotRadZone )
CASE (CurveFuncOfPower)
CALL SetupZoneInternalGain(Inverter(InvertNum)%ZoneNum, &
'ElectricLoadCenter:Inverter:FunctionOfPower', &
Inverter(InvertNum)%Name , &
IntGainTypeOf_ElectricLoadCenterInverterFunctionOfPower, &
ConvectionGainRate = Inverter(InvertNum)%QdotconvZone, &
ThermalRadiationGainRate = Inverter(InvertNum)%QdotRadZone )
CASE (CECLookUpTableModel)
CALL SetupZoneInternalGain(Inverter(InvertNum)%ZoneNum, &
'ElectricLoadCenter:Inverter:LookUpTable', &
Inverter(InvertNum)%Name , &
IntGainTypeOf_ElectricLoadCenterInverterLookUpTable, &
ConvectionGainRate = Inverter(InvertNum)%QdotconvZone, &
ThermalRadiationGainRate = Inverter(InvertNum)%QdotRadZone)
END SELECT
ENDIF
ENDDO
ENDIF !any inverters
!read in any electrical storage devices that may be associated with load centers.
NumofSimpleElecStorage = GetNumObjectsFound('ElectricLoadCenter:Storage:Simple')
NumofKiBaMElecStorage = GetNumObjectsFound('ElectricLoadCenter:Storage:Battery')
NumElecStorageDevices = NumofSimpleElecStorage + NumofKiBaMElecStorage
IF (NumElecStorageDevices > 0) THEN
ALLOCATE(ElecStorage(NumElecStorageDevices))
ALLOCATE(StorageNames(NumElecStorageDevices))
IF (NumofSimpleElecStorage > 0) THEN
cCurrentModuleObject = 'ElectricLoadCenter:Storage:Simple'
DO StorNum = 1, NumofSimpleElecStorage
CALL GetObjectItem(cCurrentModuleObject, StorNum, cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1), StorageNames, StorNum-1, IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
If (IsNotOK) Then
ErrorsFound = .true.
If (IsBlank) cAlphaArgs(1) = 'xxxx'
endif
StorageNames(StorNum)=trim(cAlphaArgs(1))
ElecStorage(StorNum)%Name = cAlphaArgs(1)
IF (lAlphaFieldBlanks(2)) THEN
ElecStorage(StorNum)%AvailSchedPtr = ScheduleAlwaysOn
ELSE
ElecStorage(StorNum)%AvailSchedPtr = GetScheduleIndex(cAlphaArgs(2))
If ( ElecStorage(StorNum)%AvailSchedPtr == 0 ) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
ErrorsFound=.true.
ENDIF
ENDIF
ElecStorage(StorNum)%ZoneNum = FindItemInList(cAlphaArgs(3), Zone%Name, NumOfZones)
IF (ElecStorage(StorNum)%ZoneNum > 0) ElecStorage(StorNum)%HeatLossesDestination = ZoneGains
IF (ElecStorage(StorNum)%ZoneNum == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
ElecStorage(StorNum)%HeatLossesDestination = LostToOutside
ELSE
ElecStorage(StorNum)%HeatLossesDestination = LostToOutside
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CAll ShowContinueError('Zone name not found. Electrical storage heat losses will not be added to a zone' )
!continue with simulation but storage losses not sent to a zone.
ENDIF
ENDIF
ElecStorage(StorNum)%StorageModelMode = SimpleBucketStorage
ElecStorage(StorNum)%ZoneRadFract = rNumericArgs(1)
ElecStorage(StorNum)%EnergeticEfficCharge = rNumericArgs(2)
ElecStorage(StorNum)%EnergeticEfficDischarge = rNumericArgs(3)
ElecStorage(StorNum)%MaxEnergyCapacity = rNumericArgs(4)
ElecStorage(StorNum)%MaxPowerDraw = rNumericArgs(5)
ElecStorage(StorNum)%MaxPowerStore = rNumericArgs(6)
ElecStorage(StorNum)%StartingEnergyStored = rNumericArgs(7)
CALL SetupOutputVariable('Electric Storage Charge State [J]', &
ElecStorage(StorNum)%ElectEnergyinStorage, 'System', 'Average', ElecStorage(StorNum)%Name ) !? 'Sum'
ENDDO
ENDIF !any simple storage
IF (NumofKiBaMElecStorage > 0) THEN
cCurrentModuleObject = 'ElectricLoadCenter:Storage:Battery'
DO StorNum = 1+NumofSimpleElecStorage, NumofKiBaMElecStorage
CALL GetObjectItem(cCurrentModuleObject, StorNum, cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1), StorageNames, StorNum-1, IsNotOK,IsBlank,trim(cCurrentModuleObject)//' Name')
If (IsNotOK) Then
ErrorsFound = .true.
If (IsBlank) cAlphaArgs(1) = 'xxxx'
endif
StorageNames(StorNum)=trim(cAlphaArgs(1))
ElecStorage(StorNum)%Name = cAlphaArgs(1)
IF (lAlphaFieldBlanks(2)) THEN
ElecStorage(StorNum)%AvailSchedPtr = ScheduleAlwaysOn
ELSE
ElecStorage(StorNum)%AvailSchedPtr = GetScheduleIndex(cAlphaArgs(2))
If ( ElecStorage(StorNum)%AvailSchedPtr == 0 ) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
ErrorsFound=.true.
ENDIF
ENDIF
ElecStorage(StorNum)%ZoneNum = FindItemInList(cAlphaArgs(3), Zone%Name, NumOfZones)
IF (ElecStorage(StorNum)%ZoneNum > 0) ElecStorage(StorNum)%HeatLossesDestination = ZoneGains
IF (ElecStorage(StorNum)%ZoneNum == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
ElecStorage(StorNum)%HeatLossesDestination = LostToOutside
ELSE
ElecStorage(StorNum)%HeatLossesDestination = LostToOutside
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CAll ShowContinueError('Zone name not found. Electrical storage heat losses will not be added to a zone')
!continue with simulation but storage losses not sent to a zone.
ENDIF
ENDIF
ElecStorage(StorNum)%ChargeCurveNum = GetCurveIndex(cAlphaArgs(4)) !voltage calculation for charging
IF(ElecStorage(StorNum)%ChargeCurveNum.EQ. 0 .and. .not. lAlphaFieldBlanks(4))THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
ErrorsFound=.true.
ELSEIF (lAlphaFieldBlanks(4)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//' cannot be blank. But no entry found.')
ErrorsFound=.true.
ELSEIF (.not. SameString(GetCurveType(ElecStorage(StorNum)%ChargeCurveNum),'RectangularHyperbola2')) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('Curve Type must be RectangularHyperbola2 but was '// &
trim(GetCurveType(ElecStorage(StorNum)%ChargeCurveNum)))
ErrorsFound=.true.
ENDIF
ElecStorage(StorNum)%DischargeCurveNum = GetCurveIndex(cAlphaArgs(5)) ! voltage calculation for discharging
IF(ElecStorage(StorNum)%DischargeCurveNum.EQ. 0 .and. .not. lAlphaFieldBlanks(5))THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(5))//'='//TRIM(cAlphaArgs(5)))
ErrorsFound=.true.
ELSEIF (lAlphaFieldBlanks(5)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(5))//' cannot be blank. But no entry found.')
ErrorsFound=.true.
ELSEIF (.not. SameString(GetCurveType(ElecStorage(StorNum)%DischargeCurveNum),'RectangularHyperbola2')) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(5))//'='//TRIM(cAlphaArgs(5)))
CALL ShowContinueError('Curve Type must be RectangularHyperbola2 but was '// &
trim(GetCurveType(ElecStorage(StorNum)%DischargeCurveNum)))
ErrorsFound=.true.
ENDIF
IF (SameString(cAlphaArgs(6),'Yes')) THEN
ElecStorage(StorNum)%LifeCalculation = Battery_LifeCalculation_Yes
ELSEIF(SameString(cAlphaArgs(6),'No')) THEN
ElecStorage(StorNum)%LifeCalculation = Battery_LifeCalculation_No
ELSE
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(6))//' = '//TRIM(cAlphaArgs(6)) )
CAll ShowContinueError('Yes or No should be selected. Default value No is used to continue simulation')
ElecStorage(StorNum)%LifeCalculation = Battery_LifeCalculation_No
ENDIF
IF(ElecStorage(StorNum)%LifeCalculation == Battery_LifeCalculation_Yes) THEN
ElecStorage(StorNum)%LifeCurveNum = GetCurveIndex(cAlphaArgs(7)) !Battery life calculation
IF(ElecStorage(StorNum)%LifeCurveNum.EQ. 0 .and. .not. lAlphaFieldBlanks(7))THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
ErrorsFound=.true.
ELSEIF (lAlphaFieldBlanks(7)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//' cannot be blank when '// &
trim(cAlphaArgs(6))//' = Yes. But no entry found.')
ErrorsFound=.true.
ELSEIF (.not. SameString(GetCurveType(ElecStorage(StorNum)%LifeCurveNum),'DoubleExponentialDecay')) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Curve Type must be DoubleExponentialDecay but was '// &
trim(GetCurveType(ElecStorage(StorNum)%LifeCurveNum)))
ErrorsFound=.true.
ENDIF
ElecStorage(StorNum)%CycleBinNum= rNumericArgs(14)
IF (.not. ErrorsFound) THEN ! life cycle calculation for this battery, allocate arrays for degradation calculation
ALLOCATE(ElecStorage(StorNum)%B10(1:MAXRainflowArrayBounds+1))
ALLOCATE(ElecStorage(StorNum)%X0(1:MAXRainflowArrayBounds+1))
ALLOCATE(ElecStorage(StorNum)%Nmb0(1:ElecStorage(StorNum)%CycleBinNum))
ALLOCATE(ElecStorage(StorNum)%OneNmb0(1:ElecStorage(StorNum)%CycleBinNum))
ElecStorage(StorNum)%B10=0.0d0
ElecStorage(StorNum)%X0=0.0d0
ElecStorage(StorNum)%Nmb0=0.0d0
ElecStorage(StorNum)%OneNmb0=0.0d0
ENDIF
ENDIF
ElecStorage(StorNum)%StorageModelMode = KiBaMBattery
ElecStorage(StorNum)%ZoneRadFract = rNumericArgs(1)
ElecStorage(StorNum)%ParallelNum = rNumericArgs(2)
ElecStorage(StorNum)%SeriesNum = rNumericArgs(3)
ElecStorage(StorNum)%MaxAhCapacity = rNumericArgs(4)
ElecStorage(StorNum)%StartingSOC = rNumericArgs(5)
ElecStorage(StorNum)%AvailableFrac = rNumericArgs(6)
ElecStorage(StorNum)%ChargeConversionRate = rNumericArgs(7)
ElecStorage(StorNum)%ChargedOCV = rNumericArgs(8)
ElecStorage(StorNum)%DischargedOCV = rNumericArgs(9)
ElecStorage(StorNum)%InternalR = rNumericArgs(10)
ElecStorage(StorNum)%MaxDischargeI = rNumericArgs(11)
ElecStorage(StorNum)%CutoffV = rNumericArgs(12)
ElecStorage(StorNum)%MaxChargeRate = rNumericArgs(13)
CALL SetupOutputVariable('Electric Storage Operating Mode Index []', &
ElecStorage(StorNum)%StorageMode, 'System', 'Average', ElecStorage(StorNum)%Name )
CALL SetupOutputVariable('Electric Storage Charge State [Ah]', &
ElecStorage(StorNum)%AbsoluteSOC, 'System', 'Average', ElecStorage(StorNum)%Name )
CALL SetupOutputVariable('Electric Storage Charge Fraction []', &
ElecStorage(StorNum)%FractionSOC, 'System', 'Average', ElecStorage(StorNum)%Name )
CALL SetupOutputVariable('Electric Storage Total Current [A]', &
ElecStorage(StorNum)%BatteryCurrent, 'System', 'Average', ElecStorage(StorNum)%Name)
CALL SetupOutputVariable('Electric Storage Total Voltage [V]', &
ElecStorage(StorNum)%BatteryVoltage, 'System', 'Average', ElecStorage(StorNum)%Name)
IF(ElecStorage(StorNum)%LifeCalculation == Battery_LifeCalculation_Yes) THEN
CALL SetupOutputVariable('Electric Storage Degradation Fraction []', &
ElecStorage(StorNum)%BatteryDamage, 'System', 'Average', ElecStorage(StorNum)%Name)
ENDIF
ENDDO
ENDIF !any kibam storage
!For any battery
DO StorNum = 1, NumofSimpleElecStorage+NumofKiBaMElecStorage
CALL SetupOutputVariable('Electric Storage Charge Power [W]', &
ElecStorage(StorNum)%StoredPower, 'System', 'Average', ElecStorage(StorNum)%Name )
CALL SetupOutputVariable('Electric Storage Charge Energy [J]', &
ElecStorage(StorNum)%StoredEnergy, 'System', 'Sum', ElecStorage(StorNum)%Name )
CALL SetupOutputVariable('Electric Storage Production Decrement Energy [J]', &
ElecStorage(StorNum)%DecrementedEnergyStored, 'System', 'Sum', ElecStorage(StorNum)%Name ,&
ResourceTypeKey='ElectricityProduced',EndUseKey='COGENERATION',GroupKey='Plant')
CALL SetupOutputVariable('Electric Storage Discharge Power [W]', &
ElecStorage(StorNum)%DrawnPower, 'System', 'Average', ElecStorage(StorNum)%Name )
CALL SetupOutputVariable('Electric Storage Discharge Energy [J]', &
ElecStorage(StorNum)%DrawnEnergy, 'System', 'Sum', ElecStorage(StorNum)%Name ,&
ResourceTypeKey='ElectricityProduced',EndUseKey='COGENERATION',GroupKey='Plant')
CALL SetupOutputVariable('Electric Storage Thermal Loss Rate [W]', &
ElecStorage(StorNum)%ThermLossRate, 'System', 'Average', ElecStorage(StorNum)%Name )
CALL SetupOutputVariable('Electric Storage Thermal Loss Energy [J]', &
ElecStorage(StorNum)%ThermLossEnergy, 'System', 'Sum', ElecStorage(StorNum)%Name )
IF ( AnyEnergyManagementSystemInModel) THEN
IF(ElecStorage(StorNum)%StorageModelMode == SimpleBucketStorage) THEN
CALL SetupEMSInternalVariable('Electrical Storage Maximum Capacity', ElecStorage(StorNum)%Name, '[J]', &
ElecStorage(StorNum)%MaxEnergyCapacity )
ELSEIF(ElecStorage(StorNum)%StorageModelMode == KiBaMBattery) THEN
CALL SetupEMSInternalVariable('Electrical Storage Maximum Capacity', ElecStorage(StorNum)%Name, '[Ah]', &
ElecStorage(StorNum)%MaxAhCapacity )
ENDIF
CALL SetupEMSActuator('Electrical Storage', ElecStorage(StorNum)%Name, 'Power Draw Rate' , '[W]', &
ElecStorage(StorNum)%EMSOverridePelFromStorage, ElecStorage(StorNum)%EMSValuePelFromStorage )
CALL SetupEMSActuator('Electrical Storage', ElecStorage(StorNum)%Name, 'Power Charge Rate' , '[W]', &
ElecStorage(StorNum)%EMSOverridePelIntoStorage, ElecStorage(StorNum)%EMSValuePelIntoStorage )
ENDIF
IF (ElecStorage(StorNum)%ZoneNum > 0) THEN
SELECT CASE (ElecStorage(StorNum)%StorageModelMode)
CASE (SimpleBucketStorage)
CALL SetupZoneInternalGain(ElecStorage(StorNum)%ZoneNum, &
'ElectricLoadCenter:Storage:Simple', &
ElecStorage(StorNum)%Name , &
IntGainTypeOf_ElectricLoadCenterStorageSimple, &
ConvectionGainRate = ElecStorage(StorNum)%QdotconvZone, &
ThermalRadiationGainRate = ElecStorage(StorNum)%QdotRadZone)
CASE (KiBaMBattery)
CALL SetupZoneInternalGain(ElecStorage(StorNum)%ZoneNum, &
'ElectricLoadCenter:Storage:Battery', &
ElecStorage(StorNum)%Name , &
IntGainTypeOf_ElectricLoadCenterStorageBattery, &
ConvectionGainRate = ElecStorage(StorNum)%QdotconvZone, &
ThermalRadiationGainRate = ElecStorage(StorNum)%QdotRadZone)
END SELECT
ENDIF
ENDDO
ENDIF !any storage at all
!read in any electrical transformers that may be associated with load centers.
NumTransformers = GetNumObjectsFound('ElectricLoadCenter:Transformer')
IF (NumTransformers > 0) THEN
ALLOCATE(Transformer(NumTransformers))
ALLOCATE(TransformerNames(NumTransformers))
cCurrentModuleObject = 'ElectricLoadCenter:Transformer'
DO TransfNum = 1, NumTransformers
CALL GetObjectItem(cCurrentModuleObject, TransfNum, cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1), TransformerNames, TransfNum-1, IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .true.
IF (IsBlank) cAlphaArgs(1) = 'xxxx' !Actually, this line is not necessary because name is a required field
ENDIF
TransformerNames(TransfNum) = TRIM(cAlphaArgs(1))
Transformer(TransfNum)%Name = cAlphaArgs(1)
IF (lAlphaFieldBlanks(2)) THEN
Transformer(TransfNum)%AvailSchedPtr = ScheduleAlwaysOn
ELSE
Transformer(TransfNum)%AvailSchedPtr = GetScheduleIndex(cAlphaArgs(2))
IF ( Transformer(TransfNum)%AvailSchedPtr == 0 ) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
ErrorsFound=.true.
ENDIF
ENDIF
IF (SameString(cAlphaArgs(3) , 'PowerInFromGrid') ) THEN
Transformer(TransfNum)%UsageMode = PowerInFromGrid
ELSEIF (SameString(cAlphaArgs(3), 'PowerOutFromOnsiteGeneration' ) ) THEN
Transformer(TransfNum)%UsageMode = PowerOutFromBldg
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
ErrorsFound=.true.
ENDIF
Transformer(TransfNum)%ZoneNum = FindItemInList(cAlphaArgs(4), Zone%Name, NumOfZones)
IF (Transformer(TransfNum)%ZoneNum > 0) Transformer(TransfNum)%HeatLossesDestination = ZoneGains
IF (Transformer(TransfNum)%ZoneNum == 0) THEN
IF (lAlphaFieldBlanks(4)) THEN
Transformer(TransfNum)%HeatLossesDestination = LostToOutside
ELSE
Transformer(TransfNum)%HeatLossesDestination = LostToOutside
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//' = '//TRIM(cAlphaArgs(4)) )
CAll ShowContinueError('Zone name not found. Transformer heat losses will not be added to a zone' )
!continue with simulation but storage losses not sent to a zone.
ENDIF
ENDIF
Transformer(TransfNum)%ZoneRadFrac = rNumericArgs(1)
Transformer(TransfNum)%RatedCapacity = rNumericArgs(2)
Transformer(TransfNum)%Phase = rNumericArgs(3)
IF (SameString(cAlphaArgs(5) , 'Copper') ) THEN
Transformer(TransfNum)%FactorTempCoeff = 234.5d0
ELSEIF (SameString(cAlphaArgs(5), 'Aluminum' ) ) THEN
Transformer(TransfNum)%FactorTempCoeff = 225.0d0
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(5))//' = '//TRIM(cAlphaArgs(5)) )
ErrorsFound=.true.
ENDIF
Transformer(TransfNum)%TempRise = rNumericArgs(4)
Transformer(TransfNum)%EddyFrac = rNumericArgs(5)
IF (SameString(cAlphaArgs(6) , 'RatedLosses') ) THEN
Transformer(TransfNum)%PerformanceInputMode = LossesMethod
ELSEIF (SameString(cAlphaArgs(6), 'NominalEfficiency' ) ) THEN
Transformer(TransfNum)%PerformanceInputMode = EfficiencyMethod
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(6))//' = '//TRIM(cAlphaArgs(6)) )
ErrorsFound=.true.
ENDIF
Transformer(TransfNum)%RatedNL = rNumericArgs(6)
Transformer(TransfNum)%RatedLL = rNumericArgs(7)
Transformer(TransfNum)%RatedEfficiency = rNumericArgs(8)
Transformer(TransfNum)%RatedPUL = rNumericArgs(9)
Transformer(TransfNum)%RatedTemp = rNumericArgs(10)
Transformer(TransfNum)%MaxPUL = rNumericArgs(11)
!Check the input for MaxPUL if the performance input method is EfficiencyMethod
!Other inputs do not need to be checked because they are handled by the IDD procedure.
IF (Transformer(TransfNum)%PerformanceInputMode == EfficiencyMethod) THEN
IF (lNumericFieldBlanks(11)) THEN
Transformer(TransfNum)%MaxPUL = Transformer(TransfNum)%RatedPUL
ELSEIF(Transformer(TransfNum)%MaxPUL <= 0 .OR. Transformer(TransfNum)%MaxPUL > 1) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cNumericFieldNames(11))//'=['//trim(RoundSigDigits(rNumericArgs(11),3))//'].')
CALL ShowContinueError('Entered value must be > 0 and <= 1.')
ErrorsFound=.true.
ENDIF
ENDIF
IF (SameString(cAlphaArgs(7) , 'Yes') ) THEN
Transformer(TransfNum)%ConsiderLosses = .TRUE.
ELSEIF (SameString(cAlphaArgs(7), 'No' ) ) THEN
Transformer(TransfNum)%ConsiderLosses = .FALSE.
ELSE
IF(Transformer(TransfNum)%UsageMode == PowerInFromGrid) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//' = '//TRIM(cAlphaArgs(7)) )
ErrorsFound=.true.
ENDIF
ENDIF
NumWiredMeters = NumAlphas - NumAlphaBeforeMeter
IF(Transformer(TransfNum)%UsageMode == PowerInFromGrid) THEN
!Provide warning if no meter is wired to a transformer used to get power from the grid
IF(NumWiredMeters <= 0) THEN
CALL ShowWarningError(RoutineName//'ElectricLoadCenter:Transformer="'//TRIM(Transformer(TransfNum)%Name)//'":')
CALL ShowContinueError('ISOLATED Transformer: No meter wired to a transformer used to input power from grid' )
END IF
ALLOCATE(Transformer(TransfNum)%WiredMeterNames(NumWiredMeters))
ALLOCATE(Transformer(TransfNum)%WiredMeterPtrs(NumWiredMeters))
ALLOCATE(Transformer(TransfNum)%SpecialMeter(NumWiredMeters))
!Meter check deferred because they may have not been "loaded" yet,
DO LoopCount = 1, NumWiredMeters
Transformer(TransfNum)%WiredMeterNames(LoopCount) = MakeUPPERCase(cAlphaArgs(LoopCount+NumAlphaBeforeMeter))
!Assign SpecialMeter as TRUE if the meter name is Electricity:Facility or Electricity:HVAC
IF(SameString(Transformer(TransfNum)%WiredMeterNames(LoopCount), 'Electricity:Facility') .OR. &
SameString(Transformer(TransfNum)%WiredMeterNames(LoopCount), 'Electricity:HVAC') ) THEN
Transformer(TransfNum)%SpecialMeter(LoopCount) = .TRUE.
ELSE
Transformer(TransfNum)%SpecialMeter(LoopCount) = .FALSE.
ENDIF
END DO
ENDIF
CALL SetupOutputVariable('Transformer Efficiency []', &
Transformer(TransfNum)%Efficiency, 'System', 'Average', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer Input Electric Power [W]', &
Transformer(TransfNum)%PowerIn, 'System', 'Average', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer Input Electric Energy [J]', &
Transformer(TransfNum)%EnergyIn, 'System', 'Sum', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer Output Electric Power [W]', &
Transformer(TransfNum)%PowerOut, 'System', 'Average', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer Output Electric Energy [J]', &
Transformer(TransfNum)%EnergyOut, 'System', 'Sum', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer No Load Loss Rate [W]', &
Transformer(TransfNum)%NoLoadLossRate, 'System', 'Average', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer No Load Loss Energy [J]', &
Transformer(TransfNum)%NoLoadLossEnergy, 'System', 'Sum', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer Load Loss Rate [W]', &
Transformer(TransfNum)%LoadLossRate, 'System', 'Average', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer Load Loss Energy [J]', &
Transformer(TransfNum)%LoadLossEnergy, 'System', 'Sum', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer Thermal Loss Rate [W]', &
Transformer(TransfNum)%ThermalLossRate, 'System', 'Average', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer Thermal Loss Energy [J]', &
Transformer(TransfNum)%ThermalLossEnergy, 'System', 'Sum', Transformer(TransfNum)%Name )
CALL SetupOutputVariable('Transformer Distribution Electric Loss Energy [J]', &
Transformer(TransfNum)%ElecUseUtility, 'System', 'Sum', Transformer(TransfNum)%Name, &
ResourceTypeKey='Electricity', GroupKey='System')
CALL SetupOutputVariable('Transformer Cogeneration Electric Loss Energy [J]', &
Transformer(TransfNum)%ElecProducedCoGen, 'System', 'Sum', Transformer(TransfNum)%Name ,&
ResourceTypeKey='ElectricityProduced',EndUseKey='COGENERATION',GroupKey='System')
IF (Transformer(TransfNum)%ZoneNum > 0) THEN
CALL SetupZoneInternalGain(Transformer(TransfNum)%ZoneNum, &
'ElectricLoadCenter:Transformer', &
Transformer(TransfNum)%Name , &
IntGainTypeOf_ElectricLoadCenterTransformer, &
ConvectionGainRate = Transformer(TransfNum)%QdotconvZone, &
ThermalRadiationGainRate = Transformer(TransfNum)%QdotRadZone)
ENDIF
ENDDO ! End loop for get transformer inputs
ENDIF
!Get the number of electric load centers (now allowing more than 1 per simulation)
NumLoadCenters = GetNumObjectsFound('ElectricLoadCenter:Distribution')
IF (NumLoadCenters > 0 )THEN
IF(.NOT. ALLOCATED(ElecLoadCenter) ) &
ALLOCATE(ElecLoadCenter(NumLoadCenters))
DO LoopCount = 1, NumTransformers
IF(.NOT. ALLOCATED(Transformer(LoopCount)%LoadCenterIndexes) ) THEN
ALLOCATE(Transformer(LoopCount)%LoadCenterIndexes(NumLoadCenters))
ENDIF
END DO
ELSE
! set up one load center anyway for consistent access to report variables.
IF(.NOT. ALLOCATED(ElecLoadCenter) ) &
ALLOCATE (ElecLoadCenter(1))
ENDIF
!First get the number of electric load center generator and make a list of names
cCurrentModuleObject = 'ElectricLoadCenter:Generators'
NumGenLists = GetNumObjectsFound(cCurrentModuleObject)
ALLOCATE(ListName(NumGenLists))
DO Count = 1, NumGenLists
CALL GetObjectItem(cCurrentModuleObject,Count,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),ListName,Count-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
ENDIF
ListName(Count) =TRIM(cAlphaArgs(1))
END DO
DO Count = 1, NumLoadCenters
!Get the data for electric load centers
cCurrentModuleObject = 'ElectricLoadCenter:Distribution'
CALL GetObjectItem(cCurrentModuleObject,Count,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),ElecLoadCenter%Name,Count-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
!Load the Power Center Name.
ElecLoadCenter(Count)%Name = cAlphaArgs(1)
!Load the Power Center Generator List .
ElecLoadCenter(Count)%GeneratorList = cAlphaArgs(2)
!Load the Power Center Operation Scheme
IF (SameString(cAlphaArgs(3) , 'Baseload') ) THEN
ElecLoadCenter(Count)%OperationScheme = iOpSchemeBaseload
ELSEIF (SameString(cAlphaArgs(3), 'DemandLimit' ) ) THEN
ElecLoadCenter(Count)%OperationScheme = iOpSchemeDemandLimit
ELSEIF (SameString(cAlphaArgs(3), 'TrackElectrical' ) ) THEN
ElecLoadCenter(Count)%OperationScheme = iOpSchemeTrackElectrical
ELSEIF (SameString(cAlphaArgs(3), 'TrackSchedule' ) ) THEN
ElecLoadCenter(Count)%OperationScheme = iOpSchemeTrackSchedule
ELSEIF (SameString(cAlphaArgs(3), 'TrackMeter' ) ) THEN
ElecLoadCenter(Count)%OperationScheme = iOpSchemeTrackMeter
ELSEIF (SameString(cAlphaArgs(3), 'FollowThermal' ) ) THEN
ElecLoadCenter(Count)%OperationScheme = iOpSchemeThermalFollow
ELSEIF (SameString(cAlphaArgs(3), 'FollowThermalLimitElectrical' ) ) THEN
ElecLoadCenter(Count)%OperationScheme = iOpSchemeThermalFollowLimitElectrical
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
ErrorsFound=.true.
ENDIF
!Load the Purchaed Electric Demand Limit for the Demand Limit scheme only. Is not used for other schemes.
ElecLoadCenter(Count)%DemandLimit = rNumericArgs(1)
ElecLoadCenter(Count)%TrackSchedPtr = GetScheduleIndex(cAlphaArgs(4))
! test if schedule valid and 'TRACK SCHEDULE'
IF ((ElecLoadCenter(Count)%TrackSchedPtr == 0 ) .and. &
(ElecLoadCenter(Count)%OperationScheme == iOpSchemeTrackSchedule) ) THEN ! throw error
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//' = '//TRIM(cAlphaArgs(4)) )
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//' = blank field.')
ENDIF
CAll ShowContinueError('Schedule not found; Must be entered and valid when Operation Scheme=TrackSchedule')
errorsFound = .TRUE.
ENDIF
ElecLoadCenter(Count)%DemandMeterName = MakeUPPERCase(cAlphaArgs(5))
! meters may not be "loaded" yet, defered check to later subroutine
IF (SameString(cAlphaArgs(6) , 'AlternatingCurrent')) THEN
ElecLoadCenter(Count)%BussType = ACBuss
cAlphaArgs(6)='AlternatingCurrent'
ELSEIF (SameString(cAlphaArgs(6) , 'DirectCurrentWithInverter')) THEN
ElecLoadCenter(Count)%BussType = DCBussInverter
ElecLoadCenter(Count)%InverterPresent = .TRUE.
cAlphaArgs(6)='DirectCurrentWithInverter'
ELSEIF (SameString(cAlphaArgs(6) , 'AlternatingCurrentWithStorage') ) THEN
ElecLoadCenter(Count)%BussType = ACBussStorage
ElecLoadCenter(Count)%StoragePresent = .TRUE.
cAlphaArgs(6)='AlternatingCurrentWithStorage'
ELSEIF (SameString(cAlphaArgs(6) , 'DirectCurrentWithInverterDCStorage') ) THEN
ElecLoadCenter(Count)%BussType = DCBussInverterDCStorage
ElecLoadCenter(Count)%InverterPresent = .TRUE.
ElecLoadCenter(Count)%StoragePresent = .TRUE.
cAlphaArgs(6)='DirectCurrentWithInverterDCStorage'
ELSEIF (SameString(cAlphaArgs(6) , 'DirectCurrentWithInverterACStorage') ) THEN
ElecLoadCenter(Count)%BussType = DCBussInverterACStorage
ElecLoadCenter(Count)%InverterPresent = .TRUE.
ElecLoadCenter(Count)%StoragePresent = .TRUE.
cAlphaArgs(6)='DirectCurrentWithInverterACStorage'
ELSEIF (SameString(cAlphaArgs(6), Blank )) Then
ElecLoadCenter(Count)%BussType = ACBuss
cAlphaArgs(6)='AlternatingCurrent (field was blank)'
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(6))//' = '//TRIM(cAlphaArgs(6)) )
errorsFound = .TRUE.
ENDIF
If (ElecLoadCenter(Count)%InverterPresent) Then
ElecLoadCenter(Count)%InverterModelNum = FindItemInList(cAlphaArgs(7), InverterNames, NumInverters)
If (ElecLoadCenter(Count)%InverterModelNum <= 0) Then
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//' = '//TRIM(cAlphaArgs(7)) )
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//' = blank field.')
ENDIF
CAll ShowContinueError('Inverter object was not found; Must have and be valid when Buss Type="'// &
trim(cAlphaArgs(6))//'".')
errorsFound = .TRUE.
ELSE
! check if previous elec load center already uses this inverter.
IF (Count-1 > 0) THEN
Found=FindItemInList(cAlphaArgs(7),ElecLoadCenter%InverterName,Count-1)
IF (Found /= 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//' = '//TRIM(cAlphaArgs(7)) )
CALL ShowContinueError('Inverter object has already been used by another '//TRIM(cCurrentModuleObject))
errorsFound = .TRUE.
ENDIF
ENDIF
ENDIF
ElecLoadCenter(Count)%InverterName = Trim(cAlphaArgs(7))
ENDIF
IF (ElecLoadCenter(Count)%StoragePresent) THEN
ElecLoadCenter(Count)%StorageModelNum = FindItemInList(cAlphaArgs(8), StorageNames, NumElecStorageDevices)
IF (ElecLoadCenter(Count)%StorageModelNum <= 0) THEN
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(8))//' = '//TRIM(cAlphaArgs(8)) )
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(8))//' = blank field.')
ENDIF
CALL ShowContinueError('Electrical storage object was not found; Must have and be valid when Buss Type="'// &
trim(cAlphaArgs(6))//'".')
errorsFound = .TRUE.
ELSE
! check if previous elec load center already uses this storage.
IF (Count-1 > 0) THEN
Found=FindItemInList(cAlphaArgs(8),ElecLoadCenter%StorageName,Count-1)
IF (Found /= 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(8))//' = '//TRIM(cAlphaArgs(8)) )
CALL ShowContinueError('Storage object has already been used by another '//TRIM(cCurrentModuleObject))
errorsFound = .TRUE.
ENDIF
ENDIF
ENDIF
ElecLoadCenter(Count)%StorageName = Trim(cAlphaArgs(8))
ENDIF
! If a transformer is used in an electric load center, the program needs to 1) update the number of
! electric load centers connected to that transformer; 2) bookkeep the load center index in the transformer
! data structure so that the transformer knows which load center is connected.
IF(NumAlphas >= 9 .AND. (.not. lAlphaFieldBlanks(9)) ) THEN
ElecLoadCenter(Count)%TransformerModelNum = FindItemInList(cAlphaArgs(9), TransformerNames, NumTransformers)
IF (ElecLoadCenter(Count)%TransformerModelNum <= 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(9))//' = '//TRIM(cAlphaArgs(9)) )
ErrorsFound = .TRUE.
ELSE
! It is allowed that a transformer can serve multiple load centers.
! This differs from inverters and batteries (electrical storage) implemented previously
ElecLoadCenter(Count)%TransformerName = TRIM(cAlphaArgs(9))
LCofTransformer = Transformer(ElecLoadCenter(Count)%TransformerModelNum)%LoadCenterNum + 1
Transformer(ElecLoadCenter(Count)%TransformerModelNum)%LoadCenterNum = LCofTransformer
Transformer(ElecLoadCenter(Count)%TransformerModelNum)%LoadCenterIndexes(LCofTransformer) = Count
ENDIF
ENDIF
!Setup general output variables for reporting in the electric load center
SetupWholeBldgReports = .TRUE.
CALL SetupOutputVariable('Electric Load Center Produced Electric Power [W]', &
ElecLoadCenter(Count)%ElectProdRate,'System','Average',ElecLoadCenter(Count)%Name)
CALL SetupOutputVariable('Electric Load Center Produced Electric Energy [J]', &
ElecLoadCenter(Count)%ElectricityProd,'System','Sum',ElecLoadCenter(Count)%Name)
CALL SetupOutputVariable('Electric Load Center Produced Thermal Rate [W]', &
ElecLoadCenter(Count)%ThermalProdRate,'System','Average',ElecLoadCenter(Count)%Name)
CALL SetupOutputVariable('Electric Load Center Produced Thermal Energy [J]', &
ElecLoadCenter(Count)%ThermalProd,'System','Sum',ElecLoadCenter(Count)%Name)
If(Trim(ElecLoadCenter(Count)%GeneratorList) .ne. '')Then
ListNum=FindItemInList(ElecLoadCenter(Count)%GeneratorList,ListName,NumGenLists)
IF (ListNum == 0) THEN
CALL ShowSevereError('Requested Generator List='//TRIM(ElecLoadCenter(Count)%GeneratorList)// &
', not found. Load Center='//TRIM(ElecLoadCenter(Count)%Name))
ErrorsFound=.true.
CYCLE
ENDIF
cCurrentModuleObject = 'ElectricLoadCenter:Generators'
CALL GetObjectItem(cCurrentModuleObject,ListNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
!Calculate the number of generators in list
NumGenerators = NumNums / 2 ! note IDD needs Min Fields = 6 can this be more robust?
IF (MOD((NumAlphas-1+NumNums),5) /= 0) NumGenerators=NumGenerators+1
alphacount =2
!Allocate the pointer array
ALLOCATE(ElecLoadCenter(Count)%ElecGen(NumGenerators))
ElecLoadCenter(Count)%NumGenerators = NumGenerators
pvTotalCapacity = 0.0d0 ! for LEED report
windTotalCapacity = 0.0d0 ! for LEED report
DO GenCount = 1, ElecLoadCenter(Count)%NumGenerators
!Load the Power Center Generator List Name
ElecLoadCenter(Count)%ElecGen(GenCount)%Name = cAlphaArgs(alphacount)
alphacount =alphacount+1
!Load the Type of Generator
ElecLoadCenter(Count)%ElecGen(GenCount)%TypeOf = cAlphaArgs(alphacount)
IF (SameString( cAlphaArgs(alphacount) , 'Generator:InternalCombustionEngine') ) THEN
ElecLoadCenter(Count)%ElecGen(GenCount)%CompType_Num = iGeneratorICEngine
ELSEIF (SameString(cAlphaArgs(alphacount) , 'Generator:CombustionTurbine') ) THEN
ElecLoadCenter(Count)%ElecGen(GenCount)%CompType_Num = iGeneratorCombTurbine
ELSEIF (SameString(cAlphaArgs(alphacount) , 'Generator:MicroTurbine') ) THEN
ElecLoadCenter(Count)%ElecGen(GenCount)%CompType_Num = iGeneratorMicroturbine
ELSEIF (SameString(cAlphaArgs(alphacount) , 'Generator:Photovoltaic') ) THEN
ElecLoadCenter(Count)%ElecGen(GenCount)%CompType_Num = iGeneratorPV
ELSEIF (SameString(cAlphaArgs(alphacount) , 'Generator:FuelCell') ) THEN
ElecLoadCenter(Count)%ElecGen(GenCount)%CompType_Num = iGeneratorFuelCell
ELSEIF (SameString(cAlphaArgs(alphacount) , 'Generator:MicroCHP') ) THEN
ElecLoadCenter(Count)%ElecGen(GenCount)%CompType_Num = iGeneratorMicroCHP
ELSEIF (SameString(cAlphaArgs(alphacount) , 'Generator:WindTurbine') ) THEN
ElecLoadCenter(Count)%ElecGen(GenCount)%CompType_Num = iGeneratorWindTurbine
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(alphacount))//' = '//TRIM(cAlphaArgs(alphacount)) )
ErrorsFound=.true.
ENDIF
CALL ValidateComponent(ElecLoadCenter(Count)%ElecGen(GenCount)%TypeOf,ElecLoadCenter(Count)%ElecGen(GenCount)%Name, &
IsNotOK,'Generator')
IF (IsNotOK) THEN
CALL ShowContinueError('In '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ENDIF
alphacount =alphacount+1
ElecLoadCenter(Count)%ElecGen(GenCount)%MaxPowerOut = rNumericArgs(2*GenCount-1)
ElecLoadCenter(Count)%ElecGen(GenCount)%NominalThermElectRatio = rNumericArgs(2*GenCount)
IF (AnyEnergyManagementSystemInModel) Then
CALL SetupEMSInternalVariable('Generator Nominal Maximum Power', ElecLoadCenter(Count)%ElecGen(GenCount)%Name , &
'[W]', ElecLoadCenter(Count)%ElecGen(GenCount)%MaxPowerOut )
CALL SetupEMSInternalVariable('Generator Nominal Thermal To Electric Ratio', &
ElecLoadCenter(Count)%ElecGen(GenCount)%Name , &
'[ratio]', ElecLoadCenter(Count)%ElecGen(GenCount)%NominalThermElectRatio )
ENDIF
!Load the Power CenterElectric Generation Meter Name
ElecLoadCenter(Count)%ElecGen(GenCount)%AvailSched = cAlphaArgs(alphacount)
IF (lAlphaFieldBlanks(alphacount)) THEN
ElecLoadCenter(Count)%ElecGen(GenCount)%AvailSchedPtr = ScheduleAlwaysOn
ELSE
ElecLoadCenter(Count)%ElecGen(GenCount)%AvailSchedPtr = GetScheduleIndex(cAlphaArgs(alphacount))
IF (ElecLoadCenter(Count)%ElecGen(GenCount)%AvailSchedPtr <= 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(alphacount))//' = '//TRIM(cAlphaArgs(alphacount)) )
CAll ShowContinueError('Schedule was not found ')
errorsFound = .true.
ENDIF
ENDIF
alphacount =alphacount+1
CALL SetupOutputVariable('Generator Requested Electric Power [W]', &
ElecLoadCenter(Count)%ElecGen(GenCount)%PowerRequestThisTimestep, &
'System','Average',ElecLoadCenter(Count)%ElecGen(GenCount)%Name)
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSActuator('On-Site Generator Control', ElecLoadCenter(Count)%ElecGen(GenCount)%Name, &
'Requested Power', '[W]', &
ElecLoadCenter(Count)%ElecGen(GenCount)%EMSRequestOn , &
ElecLoadCenter(Count)%ElecGen(GenCount)%EMSPowerRequest )
ENDIF
ENDDO !End of the NumGenerators Loop
End If
CALL SetupOutputVariable('Electric Load Center Requested Electric Power [W]', &
ElecLoadCenter(Count)%TotalPowerRequest,'System','Average', &
ElecLoadCenter(Count)%Name)
ENDDO ! loop over number of load centers
! LEED report
pvTotalCapacity = 0.0d0
windTotalCapacity = 0.0d0
DO Count = 1, NumLoadCenters
IF(Trim(ElecLoadCenter(Count)%GeneratorList) .NE. '')Then
DO GenCount = 1, ElecLoadCenter(Count)%NumGenerators
IF (ElecLoadCenter(Count)%ElecGen(GenCount)%CompType_Num .EQ. iGeneratorPV) THEN
pvTotalCapacity = pvTotalCapacity + ElecLoadCenter(Count)%ElecGen(GenCount)%MaxPowerOut
ENDIF
IF (ElecLoadCenter(Count)%ElecGen(GenCount)%CompType_Num .EQ. iGeneratorWindTurbine) THEN
windTotalCapacity = windTotalCapacity + ElecLoadCenter(Count)%ElecGen(GenCount)%MaxPowerOut
ENDIF
END DO
END IF
END DO
!put in total capacity for PV and Wind for LEED report
CALL PreDefTableEntry(pdchLeedRenRatCap,'Photovoltaic',pvTotalCapacity/1000,2)
CALL PreDefTableEntry(pdchLeedRenRatCap,'Wind',windTotalCapacity/1000,2)
IF (NumLoadCenters == 0) THEN
! if user input did not include an Electric Load center, create a simple default one here for reporting purposes
! but only if there are any other electricity components set up (yet) for metering
AnyElectricityPresent = GetMeterIndex('ELECTRICITY:FACILITY')
If (AnyElectricityPresent > 0) Then
NumLoadCenters = 1
ElecLoadCenter(1)%Name = 'Electrical Service'
ElecLoadCenter(1)%OperationScheme = iOpSchemeTrackElectrical
SetupWholeBldgReports = .TRUE.
ENDIF ! any electricity metered
ENDIF ! no user electric load center
If (SetupWholeBldgReports) then
CALL SetupOutputVariable('Facility Total Purchased Electric Power [W]', &
WholeBldgElectSummary%ElectPurchRate,'System','Average',WholeBldgElectSummary%Name)
CALL SetupOutputVariable('Facility Total Purchased Electric Energy [J]', &
WholeBldgElectSummary%ElectricityPurch,'System','Sum',WholeBldgElectSummary%Name, &
ResourceTypeKey='ElectricityPurchased',EndUseKey='COGENERATION',GroupKey='Plant')
CALL SetupOutputVariable('Facility Total Surplus Electric Energy [J]', &
WholeBldgElectSummary%ElectricitySurplus,'System','Sum',WholeBldgElectSummary%Name , &
ResourceTypeKey='ElectricitySurplusSold',EndUseKey='COGENERATION',GroupKey='Plant')
CALL SetupOutputVariable('Facility Net Purchased Electric Power [W]', &
WholeBldgElectSummary%ElectricityNetRate,'System','Average',WholeBldgElectSummary%Name)
CALL SetupOutputVariable('Facility Net Purchased Electric Energy [J]', &
WholeBldgElectSummary%ElectricityNet,'System','Sum',WholeBldgElectSummary%Name, &
ResourceTypeKey='ElectricityNet',EndUseKey='COGENERATION',GroupKey='Plant')
CALL SetupOutputVariable('Facility Total Building Electric Demand Power [W]', &
WholeBldgElectSummary%TotalBldgElecDemand,'System','Average',WholeBldgElectSummary%Name)
CALL SetupOutputVariable('Facility Total HVAC Electric Demand Power [W]', &
WholeBldgElectSummary%TotalHVACElecDemand,'System','Average',WholeBldgElectSummary%Name)
CALL SetupOutputVariable('Facility Total Electric Demand Power [W]', &
WholeBldgElectSummary%TotalElectricDemand,'System','Average',WholeBldgElectSummary%Name)
CALL SetupOutputVariable('Facility Total Produced Electric Power [W]', &
WholeBldgElectSummary%ElectProdRate,'System','Average',WholeBldgElectSummary%Name)
CALL SetupOutputVariable('Facility Total Produced Electric Energy [J]', &
WholeBldgElectSummary%ElectricityProd,'System','Sum',WholeBldgElectSummary%Name)
ENDIF
!Check whether a transformer connects to a load center if it is used to output power to the grid
!Issue warning if no load center is connected to that transformer
!This has to be done after reading in all load centers
DO TransfNum = 1, NumTransformers
IF(Transformer(TransfNum)%UsageMode == PowerOutFromBldg .AND. Transformer(TransfNum)%LoadCenterNum == 0) THEN
CALL ShowSevereError(RoutineName//'ElectricLoadCenter:Transformer="'//TRIM(Transformer(TransfNum)%Name)//'", invalid entry.')
CALL ShowContinueError('ISOLATED Transformer: No load center connects to a transformer used to output power' )
END IF
END DO
DEALLOCATE(ListName)
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Preceding errors terminate program.')
ENDIF
RETURN
END SUBROUTINE GetPowerManagerInput