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 CalcCostEstimate
! SUBROUTINE INFORMATION:
! AUTHOR BGriffith
! DATE WRITTEN April 2004
! MODIFIED February 2005, M. J. Witte
! Add subscript to DX coil variables due to new multimode DX coil
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates the Cost Estimate based on inputs.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSurfaces, ONLY: Surface , TotSurfaces
USE DataGlobals , ONLY: NumOfZones
USE DataHeatBalance, ONLY: Construct, TotConstructs, Lights, zone ,totLights
USE InputProcessor, ONLY: FindItem
USE DXCoils , ONLY: DXCoil, NumDXCoils
USE PlantChillers , ONLY: ElectricChiller, numElectricChillers
USE DataPhotovoltaics, ONLY: PVarray, NumPVs, NumSimplePVModuleTypes, iSimplePVModel
USE DataDaylighting
USE HeatingCoils, ONLY: HeatingCoil, NumHeatingCoils
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Item ! do-loop counter for line items
INTEGER :: ThisConstructID ! hold result of FindItem searching for Construct name
INTEGER :: ThisSurfID ! hold result from findItem
INTEGER :: ThisZoneID ! hold result from findItem
CHARACTER(len=MaxNameLength) ::ThisConstructStr
LOGICAL,ALLOCATABLE, DIMENSION(:) :: uniqueSurfMask !
REAL(r64), ALLOCATABLE, DIMENSION(:) :: SurfMultipleARR
INTEGER :: surf ! do-loop counter for checking for surfaces for uniqueness
INTEGER :: thisCoil ! index of named coil in its derived type
LOGICAL :: WildcardObjNames
INTEGER :: thisChil
INTEGER :: ThisPV
REAL(r64) :: Multipliers
!Setup working data structure for line items
DO Item=1,NumLineItems !Loop thru cost line items
CostLineItem(item)%LineNumber = item
SELECT CASE (CostLineItem(Item)%ParentObjType)
Case ('GENERAL')
CostLineItem(item)%units = 'Ea.'
CostLineItem(item)%ValuePer = CostLineItem(item)%PerEach
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
Case ('CONSTRUCTION')
ThisConstructStr = CostLineItem(Item)%ParentObjName
ThisConstructID = FindItem(ThisConstructStr, Construct%Name, TotConstructs)
! need to determine unique surfacs... some surfaces are shared by zones and hence doubled
ALLOCATE(uniqueSurfMask(TotSurfaces))
uniqueSurfMask = .true. !init to true and change duplicates to false
AllOCATE(SurfMultipleARR(TotSurfaces))
SurfMultipleARR = 1.0d0
DO surf=1, TotSurfaces
IF (surface(surf)%ExtBoundCond >= 1) THEN
IF (surface(surf)%ExtBoundCond < surf) THEN !already cycled through
uniqueSurfMask(surf) = .false.
ENDIF
ENDIF
IF ( surface(surf)%Construction == 0) THEN !throw out others for now
uniqueSurfMask(surf) = .false.
ENDIF
IF (surface(surf)%Zone > 0 ) THEN
SurfMultipleARR(surf) = zone(surface(surf)%Zone)%Multiplier * &
zone(surface(surf)%Zone)%ListMultiplier
ENDIF
ENDDO
!determine which surfaces have the construction type and if any are duplicates..
CostLineItem(item)%Qty = sum(Surface%area*SurfMultipleARR, &
mask=(uniqueSurfMask .AND. (surface%construction == ThisConstructID) ))
CostLineItem(item)%units = 'm2'
CostLineItem(item)%ValuePer = CostLineItem(item)%PerSquareMeter
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
deallocate(uniqueSurfMask)
deallocate(SurfMultipleARR)
CASE ('COIL:DX','COIL:COOLING:DX:SINGLESPEED')
WildcardObjNames = .FALSE.
thisCoil = 0
! check for wildcard * in object name..
If (TRIM(CostLineItem(Item)%ParentObjName) == '*') then ! wildcard, apply to all such components
WildcardObjNames = .TRUE.
ELSEIF (CostLineItem(Item)%ParentObjName /= '') then
thisCoil = FindItem(CostLineItem(Item)%ParentObjName, DXCoil%Name, NumDXCoils)
ENDIF
If (CostLineItem(Item)%PerKiloWattCap > 0.0d0) then !
If (WildCardObjNames) then
CostLineItem(item)%Qty = sum(DXCoil%RatedTotCap(1))/1000.0d0
CostLineItem(item)%units = 'kW (tot cool cap.)'
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKiloWattCap
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
endif
If (thisCoil > 0) then
CostLineItem(item)%Qty = DXCoil(thisCoil)%RatedTotCap(1)/1000.0d0
CostLineItem(item)%units = 'kW (tot cool cap.)'
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKiloWattCap
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
endif
endif
If (CostLineItem(Item)%perEach > 0.0d0) then
If (WildCardObjNames) CostLineItem(item)%Qty = REAL(NumDXCoils,r64)
If (thisCoil > 0) CostLineItem(item)%Qty = 1.0d0
CostLineItem(item)%ValuePer = CostLineItem(Item)%perEach
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
CostLineItem(item)%units = 'Ea.'
endif
IF (CostLineItem(Item)%PerKWCapPerCOP > 0.0d0) then
If (WildCardObjNames) then
CostLineItem(item)%Qty = sum(DXCoil%RatedCOP(1)*DXCoil%RatedTotCap(1))/1000.0d0
CostLineItem(item)%units = 'kW*COP (total, rated) '
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKWCapPerCOP
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
If (thisCoil > 0) then
CostLineItem(item)%Qty = DXCoil(thisCoil)%RatedCOP(1) * DXCoil(thisCoil)%RatedTotCap(1)/1000.0d0
CostLineItem(item)%units = 'kW*COP (total, rated) '
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKWCapPerCOP
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
ENDIF
CASE ('COIL:HEATING:GAS')
WildcardObjNames = .FALSE.
thisCoil = 0
! check for wildcard * in object name..
If (TRIM(CostLineItem(Item)%ParentObjName) == '*') then ! wildcard, apply to all such components
WildcardObjNames = .TRUE.
ELSEIF (CostLineItem(Item)%ParentObjName /= '') then
thisCoil = FindItem(CostLineItem(Item)%ParentObjName, HeatingCoil%Name, NumHeatingCoils)
ENDIF
If (CostLineItem(Item)%PerKiloWattCap > 0.0d0) then !
If (WildCardObjNames) then
CostLineItem(item)%Qty = sum(HeatingCoil%NominalCapacity, &
mask=(HeatingCoil%HCoilType_Num == 1) )/1000.0d0
CostLineItem(item)%units = 'kW (tot heat cap.)'
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKiloWattCap
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
endif
If (thisCoil > 0) then
CostLineItem(item)%Qty = HeatingCoil(thisCoil)%NominalCapacity/1000.0d0
CostLineItem(item)%units = 'kW (tot heat cap.)'
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKiloWattCap
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
endif
endif
If (CostLineItem(Item)%perEach > 0.0d0) then
If (WildCardObjNames) CostLineItem(item)%Qty = NumHeatingCoils
If (thisCoil > 0) CostLineItem(item)%Qty = 1.0d0
CostLineItem(item)%ValuePer = CostLineItem(Item)%perEach
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
CostLineItem(item)%units = 'Ea.'
endif
IF (CostLineItem(Item)%PerKWCapPerCOP > 0.0d0) then
If (WildCardObjNames) then
CostLineItem(item)%Qty = sum(HeatingCoil%Efficiency*HeatingCoil%NominalCapacity ,&
mask=(HeatingCoil%HCoilType_Num == 1) )/1000.0d0
CostLineItem(item)%units = 'kW*Eff (total, rated) '
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKWCapPerCOP
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
If (thisCoil > 0) then
CostLineItem(item)%Qty = HeatingCoil(thisCoil)%Efficiency*HeatingCoil(thisCoil)%NominalCapacity/1000.0d0
CostLineItem(item)%units = 'kW*Eff (total, rated) '
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKWCapPerCOP
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
ENDIF
CASE ('CHILLER:ELECTRIC')
!
thisChil = FindItem(CostLineItem(Item)%ParentObjName, ElectricChiller%Base%Name, NumElectricChillers )
If ((thisChil > 0) .AND. (CostLineItem(Item)%PerKiloWattCap > 0.0d0)) then
CostLineItem(item)%Qty = ElectricChiller(thisChil)%Base%NomCap/1000.0d0
CostLineItem(item)%units = 'kW (tot cool cap.)'
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKiloWattCap
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
If ((thisChil > 0) .AND. (CostLineItem(Item)%PerKWCapPerCOP > 0.0d0)) then
CostLineItem(item)%Qty = ElectricChiller(thisChil)%Base%COP * ElectricChiller(thisChil)%Base%NomCap/1000.0d0
CostLineItem(item)%units = 'kW*COP (total, rated) '
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKWCapPerCOP
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
IF ((thisChil > 0) .AND. (CostLineItem(Item)%PerEach > 0.0d0)) then
CostLineItem(item)%Qty = 1.0d0
CostLineItem(item)%units = 'Ea.'
CostLineItem(item)%ValuePer = CostLineItem(Item)%perEach
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
CASE ('DAYLIGHTING:CONTROLS')
WildcardObjNames = .FALSE.
IF (TRIM(CostLineItem(Item)%ParentObjName) == '*') THEN ! wildcard, apply to all such components
WildcardObjNames = .TRUE.
CostLineItem(item)%Qty = SUM(ZoneDaylight%TotalDaylRefPoints)
ELSEIF (CostLineItem(Item)%ParentObjName /= '') then
thisZoneID = FindItem(CostLineItem(Item)%ParentObjName, zone%name, NumOfZones)
IF (thisZoneID > 0) THEN
CostLineItem(item)%Qty = ZoneDaylight(thisZoneID)%TotalDaylRefPoints
ENDIF
ENDIF
CostLineItem(item)%units = 'Ea.'
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerEach
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
CASE ('SHADING:ZONE:DETAILED')
IF (CostLineItem(Item)%ParentObjName /= '') then
ThisSurfID = FindItem(CostLineItem(Item)%ParentObjName, Surface%Name, TotSurfaces)
IF (ThisSurfID > 0) THEN
ThisZoneID = FindItem(Surface(ThisSurfID)%ZoneName,Zone%name,NumOfZones)
IF (ThisZoneID > 0) THEN
CostLineItem(item)%Qty = Surface(ThisSurfID)%area &
* zone(ThisZoneID)%Multiplier &
* zone(ThisZoneID)%ListMultiplier
CostLineItem(item)%units = 'm2'
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerSquareMeter
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
ENDIF
ENDIF
CASE ('LIGHTS')
IF (CostLineItem(item)%PerEach /= 0.0d0) THEN
CostLineItem(item)%Qty = 1.0d0
CostLineItem(item)%units = 'Ea.'
CostLineItem(item)%ValuePer = CostLineItem(item)%PerEach
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
IF (CostLineItem(item)%PerKiloWattCap /= 0.0d0) THEN
IF (CostLineItem(Item)%ParentObjName /= '') THEN
ThisZoneID = FindItem(CostLineItem(item)%ParentObjName, Zone%Name, NumOfZones)
IF (ThisZoneID > 0) THEN
CostLineItem(item)%Qty = SUM( zone(ThisZoneID)%Multiplier &
* zone(ThisZoneID)%ListMultiplier &
* Lights%DesignLevel/1000.0, &
mask=Lights%zonePtr == ThisZoneID) !this handles more than one light object per zone.
CostLineItem(item)%units = 'kW'
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKiloWattCap
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
ENDIF
ENDIF
CASE ('GENERATOR:PHOTOVOLTAIC')
IF (CostLineItem(item)%PerKiloWattCap /= 0.0d0) THEN
IF (CostLineItem(Item)%ParentObjName /= '') THEN
ThisPV = FindItem(CostLineItem(Item)%ParentObjName, PVArray%Name, NumPVs)
IF (ThisPV > 0) THEN
ThisZoneID = FindItem(Surface(PVArray(thisPV)%SurfacePtr)%ZoneName,Zone%name,NumOfZones)
IF (ThisZoneID == 0) THEN
Multipliers=1.0d0
ELSE
Multipliers=Zone(ThisZoneID)%Multiplier * Zone(ThisZoneID)%ListMultiplier
ENDIF
IF (PVArray(thisPV)%PVModelType == iSimplePVModel) THen
CostLineItem(item)%Qty = 1000.0d0 * PVArray(thisPV)%SimplePVModule%AreaCol &
* PVArray(thisPV)%SimplePVModule%PVEfficiency &
* Multipliers / 1000.0d0
ENDIF
CostLineItem(item)%units = 'kW (rated)'
CostLineItem(item)%ValuePer = CostLineItem(Item)%PerKiloWattCap
CostLineItem(item)%LineSubTotal = CostLineItem(item)%Qty * CostLineItem(item)%ValuePer
ENDIF
ENDIF
ENDIF
END SELECT
ENDDO
!now sum up the line items, result for the current building
CurntBldg%LineItemTot = sum(CostLineItem%LineSubTotal)
RETURN
END SUBROUTINE CalcCostEstimate