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.
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 GetInputTabularPredefined
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN November 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine flags if any of the predefined reports
! are requested by the user
! METHODOLOGY EMPLOYED:
! Uses get input structure similar to other objects
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE OutputProcessor, ONLY: EndUseCategory, MaxNumSubcategories
USE DataStringGlobals, ONLY: CharComma, CharTab, CharSpace
USE OutputReportPredefined, ONLY: reportName, numReportName
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='Output:Table:SummaryReports'
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER, EXTERNAL :: GetMeterIndex !an external subroutine
INTEGER :: NumTabularPredefined
INTEGER :: NumParams
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: AlphArray
REAL(r64),ALLOCATABLE, DIMENSION(:) :: NumArray
INTEGER :: IOStat ! IO Status when calling get input subroutine
INTEGER :: iReport
CHARACTER(len=MaxNameLength) :: meterName
INTEGER :: meterNumber
INTEGER :: iResource
INTEGER :: jEndUse
INTEGER :: kEndUseSub
INTEGER :: jReport
INTEGER :: lenAlpha
INTEGER :: lenReport
LOGICAL :: nameFound
LOGICAL :: ErrorsFound
ErrorsFound=.false.
NumTabularPredefined = GetNumObjectsFound(CurrentModuleObject)
IF (NumTabularPredefined .EQ. 1) THEN
! find out how many fields since the object is extensible
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumParams,NumAlphas,NumNums)
! allocate the temporary arrays for the call to get the filed
ALLOCATE(AlphArray(NumAlphas))
AlphArray = ''
! don't really need the NumArray since not expecting any numbers but the call requires it
ALLOCATE(NumArray(NumNums))
NumArray = 0.0d0
! get the object
CALL GetObjectItem(CurrentModuleObject,1,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT)
! default all report flags to false (do not get produced)
displayTabularBEPS = .FALSE.
! initialize the names of the predefined monthly report titles
CALL InitializePredefinedMonthlyTitles
! loop through the fields looking for matching report titles
DO iReport = 1, NumAlphas
nameFound=.false.
IF (SameString(AlphArray(iReport),'ABUPS')) THEN
displayTabularBEPS = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'AnnualBuildingUtilityPerformanceSummary')) THEN
displayTabularBEPS = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'BEPS')) THEN
displayTabularBEPS = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'ComponentCostEconomicsSummary')) then
displayTabularCompCosts = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'InputVerificationandResultsSummary')) then
displayTabularVeriSum = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'IVRS')) then
displayTabularVeriSum = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'ComponentSizingSummary')) then
displayComponentSizing = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'CSS')) then
displayComponentSizing = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'SurfaceShadowingSummary')) then
displaySurfaceShadowing = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'SHAD')) then
displaySurfaceShadowing = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'DemandEndUseComponentsSummary')) then
displayDemandEndUse = .true.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'AdaptiveComfortSummary')) then
displayAdaptiveComfort = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'SourceEnergyEndUseComponentsSummary')) then
displaySourceEnergyEndUseSummary = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'ZoneComponentLoadSummary')) then
displayZoneComponentLoadSummary = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'LEEDSummary')) then
displayLEEDSummary = .TRUE.
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'EnergyMeters')) then
WriteTabularFiles=.true.
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'AllSummary')) then
WriteTabularFiles=.true.
displayTabularBEPS = .TRUE.
displayTabularVeriSum = .TRUE.
displayTabularCompCosts = .TRUE.
displaySurfaceShadowing = .TRUE.
displayComponentSizing = .TRUE.
displayDemandEndUse = .true.
displayAdaptiveComfort = .TRUE.
displaySourceEnergyEndUseSummary = .TRUE.
nameFound=.true.
DO jReport = 1, numReportName
reportName(jReport)%show = .TRUE.
END DO
ELSEIF (SameString(AlphArray(iReport),'AllSummaryAndSizingPeriod')) then
WriteTabularFiles=.true.
displayTabularBEPS = .TRUE.
displayTabularVeriSum = .TRUE.
displayTabularCompCosts = .TRUE.
displaySurfaceShadowing = .TRUE.
displayComponentSizing = .TRUE.
displayDemandEndUse = .true.
displayAdaptiveComfort = .TRUE.
displaySourceEnergyEndUseSummary = .TRUE.
nameFound=.true.
DO jReport = 1, numReportName
reportName(jReport)%show = .TRUE.
END DO
!the sizing period reports
displayZoneComponentLoadSummary = .TRUE.
ELSEIF (SameString(AlphArray(iReport),'AllMonthly')) then
WriteTabularFiles=.true.
DO jReport = 1, numNamedMonthly
namedMonthly(jReport)%show = .TRUE.
END DO
nameFound=.true.
ELSEIF (SameString(AlphArray(iReport),'AllSummaryAndMonthly')) then
WriteTabularFiles=.true.
displayTabularBEPS = .TRUE.
displayTabularVeriSum = .TRUE.
displayTabularCompCosts = .TRUE.
displaySurfaceShadowing = .TRUE.
displayComponentSizing = .TRUE.
displayDemandEndUse = .true.
displayAdaptiveComfort = .TRUE.
displaySourceEnergyEndUseSummary = .TRUE.
nameFound=.true.
DO jReport = 1, numReportName
reportName(jReport)%show = .TRUE.
END DO
DO jReport = 1, numNamedMonthly
namedMonthly(jReport)%show = .TRUE.
END DO
ELSEIF (SameString(AlphArray(iReport),'AllSummaryMonthlyAndSizingPeriod')) then
WriteTabularFiles=.true.
displayTabularBEPS = .TRUE.
displayTabularVeriSum = .TRUE.
displayTabularCompCosts = .TRUE.
displaySurfaceShadowing = .TRUE.
displayComponentSizing = .TRUE.
displayDemandEndUse = .true.
displayAdaptiveComfort = .TRUE.
displaySourceEnergyEndUseSummary = .TRUE.
nameFound=.true.
DO jReport = 1, numReportName
reportName(jReport)%show = .TRUE.
END DO
DO jReport = 1, numNamedMonthly
namedMonthly(jReport)%show = .TRUE.
END DO
!the sizing period reports
displayZoneComponentLoadSummary = .TRUE.
ENDIF
!check the reports that are predefined and are created by outputreportpredefined.f90
DO jReport = 1, numReportName
lenAlpha = LEN_TRIM(AlphArray(iReport))
lenReport = LEN_TRIM(reportName(jReport)%name)
IF (SameString(AlphArray(iReport),reportName(jReport)%name)) THEN
WriteTabularFiles=.true.
reportName(jReport)%show = .TRUE.
nameFound=.true.
END IF
IF (SameString(AlphArray(iReport),reportName(jReport)%abrev)) THEN
WriteTabularFiles=.true.
reportName(jReport)%show = .TRUE.
nameFound=.true.
END IF
END DO
! check if the predefined monthly reports are used
DO jReport = 1, numNamedMonthly
IF (SameString(AlphArray(iReport),namedMonthly(jReport)%title)) THEN
namedMonthly(jReport)%show = .TRUE.
WriteTabularFiles=.TRUE.
nameFound=.true.
END IF
END DO
IF (.not. nameFound) THEN
CALL ShowSevereError(CurrentModuleObject//' Field['//trim(RoundSigDigits(iReport))//']="'// &
trim(AlphArray(iReport))//'", invalid report name -- will not be reported.')
! ErrorsFound=.true.
ENDIF
END DO
CALL CreatePredefinedMonthlyReports
DEALLOCATE(AlphArray)
DEALLOCATE(NumArray)
ELSEIF (NumTabularPredefined > 1) THEN
CALL ShowSevereError(CurrentModuleObject//': Only one instance of this object is allowed.')
ErrorsFound=.true.
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError(CurrentModuleObject//': Preceding errors cause termination.')
ENDIF
! if the BEPS report has been called for than initialize its arrays
IF (displayTabularBEPS .OR. displayDemandEndUse .OR. displaySourceEnergyEndUseSummary .or. displayLEEDSummary) THEN
! initialize the resource type names
resourceTypeNames(1) = 'Electricity'
resourceTypeNames(2) = 'Gas'
resourceTypeNames(3) = 'DistrictCooling'
resourceTypeNames(4) = 'DistrictHeating'
resourceTypeNames(5) = 'Steam'
resourceTypeNames(6) = 'Gasoline'
resourceTypeNames(7) = 'Water'
resourceTypeNames(8) = 'Diesel'
resourceTypeNames(9) = 'Coal'
resourceTypeNames(10) = 'FuelOil#1'
resourceTypeNames(11) = 'FuelOil#2'
resourceTypeNames(12) = 'Propane'
resourceTypeNames(13) = 'OtherFuel1'
resourceTypeNames(14) = 'OtherFuel2'
sourceTypeNames(1)='Electric'
sourceTypeNames(2)='NaturalGas'
sourceTypeNames(3)='Gasoline'
sourceTypeNames(4)='Diesel'
sourceTypeNames(5)='Coal'
sourceTypeNames(6)='FuelOil#1'
sourceTypeNames(7)='FuelOil#2'
sourceTypeNames(8)='Propane'
sourceTypeNames(9)='PurchasedElectric'
sourceTypeNames(10)='SoldElectric'
sourceTypeNames(11)='OtherFuel1'
sourceTypeNames(12)='OtherFuel2'
! initialize the end use names
endUseNames(endUseHeating) = 'Heating'
endUseNames(endUseCooling) = 'Cooling'
endUseNames(endUseInteriorLights) = 'InteriorLights'
endUseNames(endUseExteriorLights) = 'ExteriorLights'
endUseNames(endUseInteriorEquipment) = 'InteriorEquipment'
endUseNames(endUseExteriorEquipment) = 'ExteriorEquipment'
endUseNames(endUseFans) = 'Fans'
endUseNames(endUsePumps) = 'Pumps'
endUseNames(endUseHeatRejection) = 'HeatRejection'
endUseNames(endUseHumidification) = 'Humidifier'
endUseNames(endUseHeatRecovery) = 'HeatRecovery'
endUseNames(endUseWaterSystem) = 'WaterSystems'
endUseNames(endUseRefrigeration) = 'Refrigeration'
endUseNames(endUseCogeneration) = 'Cogeneration'
! End use subs must be dynamically allocated to accomodate the end use with the most subcategories
ALLOCATE(meterNumEndUseSubBEPS(numResourceTypes,numEndUses,MaxNumSubcategories))
meterNumEndUseSubBEPS = 0
! loop through all of the resources and end uses and sub end uses for the entire facility
DO iResource = 1, numResourceTypes
meterName = TRIM(resourceTypeNames(iResource)) // ':FACILITY'
meterNumber = GetMeterIndex(meterName)
meterNumTotalsBEPS(iResource) = meterNumber
DO jEndUse = 1, numEndUses
meterName = TRIM(endUseNames(jEndUse)) // ':' // TRIM(resourceTypeNames(iResource)) !// ':FACILITY'
meterNumber = GetMeterIndex(meterName)
meterNumEndUseBEPS(jEndUse,iResource) = meterNumber
DO kEndUseSub = 1, EndUseCategory(jEndUse)%NumSubcategories
meterName = TRIM(EndUseCategory(jEndUse)%SubcategoryName(kEndUseSub)) &
//':'//TRIM(endUseNames(jEndUse))//':'//TRIM(resourceTypeNames(iResource))
meterNumber = GetMeterIndex(meterName)
meterNumEndUseSubBEPS(iResource,jEndUse,kEndUseSub) = meterNumber
END DO
END DO
END DO
DO iResource = 1, numSourceTypes
meterNumber = GetMeterIndex(trim(sourceTypeNames(iResource))//'Emissions:Source')
meterNumTotalsSource(iResource) = meterNumber
END DO
! initialize the gathering arrays to zero
gatherTotalsBEPS = 0.0d0
gatherTotalsBySourceBEPS = 0.0d0
gatherTotalsSource = 0.0d0
gatherTotalsBySource = 0.0d0
gatherEndUseBEPS = 0.0d0
gatherEndUseBySourceBEPS = 0.0d0
! End use subs must be dynamically allocated to accomodate the end use with the most subcategories
ALLOCATE(gatherEndUseSubBEPS(numResourceTypes,numEndUses,MaxNumSubcategories))
gatherEndUseSubBEPS = 0.0d0
ALLOCATE(gatherDemandEndUseSub(numResourceTypes,numEndUses,MaxNumSubcategories))
gatherDemandEndUseSub = 0.0d0
! get meter numbers for other meters relating to electric load components
meterNumPowerFuelFireGen = GetMeterIndex('Cogeneration:ElectricityProduced')
meterNumPowerPV = GetMeterIndex('Photovoltaic:ElectricityProduced')
meterNumPowerWind = GetMeterIndex('WindTurbine:ElectricityProduced')
meterNumPowerHTGeothermal = GetMeterIndex('HTGeothermal:ElectricityProduced')
meterNumElecProduced = GetMeterIndex('ElectricityProduced:Facility')
meterNumElecPurchased = GetMeterIndex('ElectricityPurchased:Facility')
meterNumElecSurplusSold = GetMeterIndex('ElectricitySurplusSold:Facility')
! if no ElectricityPurchased:Facility meter is defined then no electric load center
! was created by the user and no power generation will occur in the plant. The amount
! purchased would be the total end use.
IF (meterNumElecPurchased .EQ. 0) THEN
meterNumElecPurchased = GetMeterIndex('Electricity:Facility')
END IF
! initialize the gathering variables for the electric load components
gatherPowerFuelFireGen = 0.0d0
gatherPowerPV = 0.0d0
gatherPowerWind = 0.0d0
gatherPowerHTGeothermal = 0.0d0
gatherElecProduced = 0.0d0
gatherElecPurchased = 0.0d0
gatherElecSurplusSold = 0.0d0
! get meter numbers for onsite thermal components on BEPS report
meterNumWaterHeatRecovery = GetMeterIndex('HeatRecovery:EnergyTransfer')
meterNumAirHeatRecoveryCool = GetMeterIndex('HeatRecoveryForCooling:EnergyTransfer')
meterNumAirHeatRecoveryHeat = GetMeterIndex('HeatRecoveryForHeating:EnergyTransfer')
meterNumHeatHTGeothermal = GetMeterIndex('HTGeothermal:HeatProduced')
meterNumHeatSolarWater = GetMeterIndex('SolarWater:Facility')
meterNumHeatSolarAir = GetMeterIndex('HeatProduced:SolarAir')
! initialize the gathering variables for onsite thermal components on BEPS report
gatherWaterHeatRecovery = 0.0d0
gatherAirHeatRecoveryCool = 0.0d0
gatherAirHeatRecoveryHeat = 0.0d0
gatherHeatHTGeothermal = 0.0d0
gatherHeatSolarWater = 0.0d0
gatherHeatSolarAir = 0.0d0
! get meter numbers for water components on BEPS report
meterNumRainWater = GetMeterIndex('Rainwater:OnSiteWater')
meterNumCondensate = GetMeterIndex('Condensate:OnSiteWater')
meterNumGroundwater = GetMeterIndex('Wellwater:OnSiteWater')
meterNumMains = GetMeterIndex('MainsWater:Facility')
meterNumWaterEndUseTotal = GetMeterIndex('Water:Facility')
! initialize the gathering variables for water components on BEPS report
gatherRainWater = 0.0d0
gatherCondensate = 0.0d0
gatherWellwater = 0.0d0
gatherMains = 0.0d0
gatherWaterEndUseTotal = 0.0d0
END IF
END SUBROUTINE GetInputTabularPredefined