Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | ErrorsFound |
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 CheckCostEstimateInput(ErrorsFound)
! 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:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! Set to true if errors in input, fatal at end of routine
! 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')
Case ('CONSTRUCTION')
!test input for problems
! is PerSquareMeter non-zero? if it is are other cost per values set?
! issue warning that 'Cost Estimate requested for Constructions with zero cost per unit area
!
IF (CostLineItem(item)%PerSquareMeter == 0) then
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(item)%LineName)// &
'" Construction object needs non-zero construction costs per square meter')
ErrorsFound = .TRUE.
ENDIF
ThisConstructStr = CostLineItem(Item)%ParentObjName
ThisConstructID = FindItem(ThisConstructStr, Construct%Name, TotConstructs)
IF (ThisConstructID == 0) THEN ! do any surfaces have the specified construction? If not issue warning.
CALL ShowWarningError('ComponentCost:LineItem: "'//trim(CostLineItem(item)%LineName)// &
'" Construction="'//trim(CostLineItem(Item)%ParentObjName)// &
'", no surfaces have the Construction specified')
CALL ShowContinueError('No costs will be calculated for this Construction.')
! ErrorsFound = .TRUE.
CYCLE
ENDIF
CASE ('COIL:DX','COIL:COOLING:DX:SINGLESPEED')
WildcardObjNames = .FALSE.
thisCoil = 0
! test if too many pricing methods are set in user input
IF ((CostLineItem(Item)%PerKiloWattCap > 0.0d0) .and. (CostLineItem(Item)%perEach > 0.0d0)) then
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Coil:DX, too many pricing methods specified')
ErrorsFound = .TRUE.
ENDIF
IF ((CostLineItem(Item)%PerKiloWattCap > 0.0d0) .and. (CostLineItem(Item)%PerKWCapPerCOP > 0.0d0)) then
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Coil:DX, too many pricing methods specified')
ErrorsFound = .TRUE.
ENDIF
IF ((CostLineItem(Item)%perEach > 0.0d0) .and. (CostLineItem(Item)%PerKWCapPerCOP > 0.0d0)) then
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Coil:DX, too many pricing methods specified')
ErrorsFound = .TRUE.
ENDIF
! 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
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Coil:DX: need to specify a Reference Object Name ')
ErrorsFound = .TRUE.
ELSE ! assume name is probably useful
thisCoil = FindItem(CostLineItem(Item)%ParentObjName, DXCoil%Name, NumDXCoils)
IF (thisCoil == 0) THEN
CALL ShowWarningError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Coil:DX, invalid coil specified')
CALL ShowContinueError('Coil Specified="'//trim(CostLineItem(Item)%ParentObjName)// &
'", calculations will not be completed for this item.')
ENDIF
ENDIF
CASE ('COIL:HEATING:GAS')
WildcardObjNames = .FALSE.
thisCoil = 0
! test if too many pricing methods are set in user input
IF ((CostLineItem(Item)%PerKiloWattCap > 0.0d0) .and. (CostLineItem(Item)%perEach > 0.0d0)) then
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Coil:Heating:Gas, too many pricing methods specified')
ErrorsFound = .TRUE.
ENDIF
IF ((CostLineItem(Item)%PerKiloWattCap > 0.0d0) .and. (CostLineItem(Item)%PerKWCapPerCOP > 0.0d0)) then
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Coil:Heating:Gas, too many pricing methods specified')
ErrorsFound = .TRUE.
ENDIF
IF ((CostLineItem(Item)%perEach > 0.0d0) .and. (CostLineItem(Item)%PerKWCapPerCOP > 0.0d0)) then
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Coil:Heating:Gas, too many pricing methods specified')
ErrorsFound = .TRUE.
ENDIF
! 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
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Coil:Heating:Gas, need to specify a Reference Object Name')
ErrorsFound = .TRUE.
ELSE ! assume name is probably useful
thisCoil = FindItem(CostLineItem(Item)%ParentObjName, HeatingCoil%Name, NumHeatingCoils)
IF (thisCoil == 0) THEN
CALL ShowWarningError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Coil:Heating:Gas, invalid coil specified')
CALL ShowContinueError('Coil Specified="'//trim(CostLineItem(Item)%ParentObjName)// &
'", calculations will not be completed for this item.')
ENDIF
ENDIF
CASE ('CHILLER:ELECTRIC')
!
IF (CostLineItem(Item)%ParentObjName == '') then
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Chiller:Electric, need to specify a Reference Object Name')
ErrorsFound = .TRUE.
endif
thisChil = FindItem(CostLineItem(Item)%ParentObjName, ElectricChiller%Base%Name, NumElectricChillers )
IF (thisChil == 0) THEN
CALL ShowWarningError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Chiller:Electric, invalid chiller specified.')
CALL ShowContinueError('Chiller Specified="'//trim(CostLineItem(Item)%ParentObjName)// &
'", calculations will not be completed for this item.')
ENDIF
CASE ('DAYLIGHTING:CONTROLS')
WildcardObjNames = .FALSE.
IF (TRIM(CostLineItem(Item)%ParentObjName) == '*') THEN ! wildcard, apply to all such components
WildcardObjNames = .TRUE.
ELSEIF (CostLineItem(Item)%ParentObjName == '') then
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Daylighting:Controls, need to specify a Reference Object Name')
ErrorsFound = .TRUE.
ELSE
thisZoneID = FindItem(CostLineItem(Item)%ParentObjName, zone%name, NumOfZones)
IF (thisZoneID > 0) THEN
CostLineItem(item)%Qty = ZoneDaylight(thisZoneID)%TotalDaylRefPoints
ELSE
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Daylighting:Controls, need to specify a valid zone name')
CALL ShowContinueError('Zone specified="'//trim(CostLineItem(Item)%ParentObjName)//'".')
ErrorsFound = .TRUE.
ENDIF
ENDIF
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
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Shading:Zone:Detailed, need to specify a valid zone name')
CALL ShowContinueError('Zone specified="'//trim(Surface(ThisSurfID)%ZoneName)//'".')
ErrorsFound = .TRUE.
ENDIF
ELSE
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Shading:Zone:Detailed, need to specify a valid surface name')
CALL ShowContinueError('Surface specified="'//trim(CostLineItem(item)%ParentObjName)//'".')
ErrorsFound = .TRUE.
ENDIF
ELSE
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Shading:Zone:Detailed, specify a Reference Object Name')
ErrorsFound = .TRUE.
ENDIF
CASE ('LIGHTS')
IF ((CostLineItem(Item)%PerKiloWattCap > 0.0d0) .and. (CostLineItem(Item)%perEach > 0.0d0)) then
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Lights, too many pricing methods specified')
ErrorsFound = .TRUE.
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
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Lights, need to specify a valid zone name')
CALL ShowContinueError('Zone specified="'//trim(CostLineItem(item)%ParentObjName)//'".')
ErrorsFound = .TRUE.
ENDIF
ELSE
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Lights, need to specify a Reference Object Name')
ErrorsFound = .TRUE.
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
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Generator:Photovoltaic, only available for model type PhotovoltaicPerformance:Simple')
ErrorsFound = .TRUE.
ENDIF
ELSE
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Generator:Photovoltaic, need to specify a valid PV array')
CALL ShowContinueError('PV Array specified="'//trim(CostLineItem(item)%ParentObjName)//'".')
ErrorsFound = .TRUE.
ENDIF
ELSE
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Generator:Photovoltaic, need to specify a Reference Object Name')
ErrorsFound = .TRUE.
ENDIF
ELSE
CALL ShowSevereError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", Generator:Photovoltaic, need to specify a per-kilowatt cost ')
ErrorsFound = .TRUE.
ENDIF
CASE DEFAULT
CALL ShowWarningError('ComponentCost:LineItem: "'//trim(CostLineItem(Item)%LineName)// &
'", invalid cost item -- not included in cost estimate.')
CALL ShowContinueError('... invalid object type='//trim(CostLineItem(Item)%ParentObjType))
END SELECT
ENDDO
RETURN
END SUBROUTINE CheckCostEstimateInput