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 WriteCompCostTable
! SUBROUTINE INFORMATION:
! AUTHOR BGriffith
! DATE WRITTEN April/May 2004
! MODIFIED January 2010, Kyle Benne
! Added SQLite output
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! produce a results table from Cost Estimate Calculations
! METHODOLOGY EMPLOYED:
! USE data from CostEstimateManager, call JGlazer's subroutines
! REFERENCES:
! na
! USE STATEMENTS:
USE DataCostEstimate
USE SQLiteProcedures, ONLY: CreateSQLiteTabularDataRecords
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:
REAL(r64), DIMENSION(10,3):: TableBodyData
REAL(r64) :: RefBldgConstCost ! holds interim value for construction component costs: reference bldg.
REAL(r64) :: CurntBldgConstCost ! holds interim value for construction component costs: current bldg.
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: columnHead
INTEGER,ALLOCATABLE,DIMENSION(:) :: columnWidth
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: rowHead
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:,:) :: tableBody
INTEGER :: Item ! do-loop counter for line items
INTEGER :: NumRows ! number of rows in report table excluding table header
INTEGER :: NumCols ! number of columns in report table
CHARACTER(len=MaxNameLength) :: SIunit = ''
CHARACTER(len=MaxNameLength) :: m2_unitName = ''
REAL(r64) :: m2_unitConv = 0.0d0
INTEGER :: unitConvIndex = 0
CHARACTER(len=MaxNameLength) :: IPunitName = ''
REAL(r64) :: IPqty
REAL(r64) :: IPsingleValue
REAL(r64) :: IPvaluePer
If (.not. DoCostEstimate) RETURN
CALL WriteReportHeaders('Component Cost Economics Summary','Entire Facility',isAverage)
! compute floor area if no ABUPS
IF (buildingConditionedFloorArea == 0.0d0) THEN
CALL DetermineBuildingFloorArea
ENDIF
! 1st sub-table with total Costs and normalized with area
ALLOCATE(rowHead(10))
ALLOCATE(columnHead(3))
ALLOCATE(columnWidth(3))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(10,3))
columnHead(1) = 'Reference Bldg.'
columnHead(2) = 'Current Bldg. Model'
columnHead(3) = 'Difference'
rowHead(1) = 'Line Item SubTotal (~~$~~)'
rowHead(2) = 'Misc. Costs (~~$~~)'
rowHead(3) = 'Regional Adjustment (~~$~~)'
rowHead(4) = 'Design Fee (~~$~~)'
rowHead(5) = 'Contractor Fee (~~$~~)'
rowHead(6) = 'Contingency (~~$~~)'
rowHead(7) = 'Permits, Bonds, Insurance (~~$~~)'
rowHead(8) = 'Commissioning (~~$~~)'
rowHead(9) = 'Cost Estimate Total (~~$~~)'
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
SIunit = '[m2]'
CALL LookupSItoIP(SIunit, unitConvIndex, m2_unitName)
m2_unitConv = convertIP(unitConvIndex,1.0d0)
rowHead(10) = 'Cost Per Conditioned Building Area (~~$~~/ft2)'
ELSE
rowHead(10) = 'Cost Per Conditioned Building Area (~~$~~/m2)'
m2_unitConv = 1.0d0
END IF
TableBodyData = 0.0d0
TableBody = ''
TableBodyData(1,1) = RefrncBldg%LineItemTot
TableBody(1,1) = TRIM(RealToStr(TableBodyData(1,1),2))
TableBodyData(2,1) = RefrncBldg%MiscCostperSqMeter * buildingConditionedFloorArea
TableBody(2,1) = TRIM(RealToStr(TableBodyData(2,1),2))
IF (RefrncBldg%RegionalModifier /= 1.0d0) THEN
TableBodyData(3,1) = (RefrncBldg%LineItemTot + RefrncBldg%MiscCostperSqMeter * buildingConditionedFloorArea) &
*(RefrncBldg%RegionalModifier - 1.0d0)
ELSE
TableBodyData(3,1) = 0.0d0
ENDIF
RefBldgConstCost = SUM(TableBodyData(1:3,1))
TableBody(3,1) = TRIM(RealToStr(TableBodyData(3,1),2))
TableBodyData(4,1) = RefBldgConstCost * RefrncBldg%DesignFeeFrac
TableBody(4,1) = TRIM(RealToStr(TableBodyData(4,1),2))
TableBodyData(5,1) = RefBldgConstCost * RefrncBldg%ContractorFeeFrac
TableBody(5,1) = TRIM(RealToStr(TableBodyData(5,1),2))
TableBodyData(6,1) = RefBldgConstCost * RefrncBldg%ContingencyFrac
TableBody(6,1) = TRIM(RealToStr(TableBodyData(6,1),2))
TableBodyData(7,1) = RefBldgConstCost * RefrncBldg%BondCostFrac
TableBody(7,1) = TRIM(RealToStr(TableBodyData(7,1),2))
TableBodyData(8,1) = RefBldgConstCost * RefrncBldg%CommissioningFrac
TableBody(8,1) = TRIM(RealToStr(TableBodyData(8,1),2))
RefrncBldg%GrandTotal = SUM(TableBodyData(1:8,1))
TableBodyData(9,1) = RefrncBldg%GrandTotal
TableBody(9,1) = TRIM(RealToStr(TableBodyData(9,1),2))
IF (buildingConditionedFloorArea .GT. 0.0d0) THEN
TableBodyData(10,1) = TableBodyData(9,1) / (buildingConditionedFloorArea * m2_unitConv)
endif
TableBody(10,1) = TRIM(RealToStr(TableBodyData(10,1),2))
TableBodyData(1,2) = CurntBldg%LineItemTot
TableBody(1,2) = trim(RealToStr(TableBodyData(1,2),2))
TableBodyData(2,2) = CurntBldg%MiscCostperSqMeter * buildingConditionedFloorArea
TableBody(2,2) = trim(RealToStr(TableBodyData(2,2),2))
IF (CurntBldg%RegionalModifier /= 1.0d0) THEN
TableBodyData(3,2) = (CurntBldg%LineItemTot + CurntBldg%MiscCostperSqMeter * buildingConditionedFloorArea) &
*(CurntBldg%RegionalModifier - 1.0d0)
ELSE
TableBodyData(3,2) = 0.0d0
ENDIF
TableBody(3,2) = trim(RealToStr(TableBodyData(3,2),2))
CurntBldgConstCost = SUM(TableBodyData(1:3,2))
TableBodyData(4,2) = CurntBldgConstCost * CurntBldg%DesignFeeFrac
TableBody(4,2) = TRIM(RealToStr(TableBodyData(4,2),2))
TableBodyData(5,2) = CurntBldgConstCost * CurntBldg%ContractorFeeFrac
TableBody(5,2) = trim(RealToStr(TableBodyData(5,2),2))
TableBodyData(6,2) = CurntBldgConstCost * CurntBldg%ContingencyFrac
TableBody(6,2) = trim(RealToStr(TableBodyData(6,2),2))
TableBodyData(7,2) = CurntBldgConstCost * CurntBldg%BondCostFrac
TableBody(7,2) = trim(RealToStr(TableBodyData(7,2),2))
TableBodyData(8,2) = CurntBldgConstCost * CurntBldg%CommissioningFrac
TableBody(8,2) = TRIM(RealToStr(TableBodyData(8,2),2))
CurntBldg%GrandTotal = sum(TableBodyData(1:8,2))
TableBodyData(9,2) = CurntBldg%GrandTotal
TableBody(9,2) = trim(RealToStr(TableBodyData(9,2),2))
IF (buildingConditionedFloorArea .GT. 0) THEN
TableBodyData(10,2) = TableBodyData(9,2) / (buildingConditionedFloorArea * m2_unitConv)
endif
TableBody(10,2) = trim(RealToStr(TableBodyData(10,2),2))
TableBodyData(1:10,3) = TableBodyData(1:10,2) - TableBodyData(1:10,1)
TableBody(1,3) = trim(RealToStr(TableBodyData(1,3),2))
TableBody(2,3) = trim(RealToStr(TableBodyData(2,3),2))
TableBody(3,3) = trim(RealToStr(TableBodyData(3,3),2))
TableBody(4,3) = trim(RealToStr(TableBodyData(4,3),2))
TableBody(5,3) = trim(RealToStr(TableBodyData(5,3),2))
TableBody(6,3) = trim(RealToStr(TableBodyData(6,3),2))
TableBody(7,3) = trim(RealToStr(TableBodyData(7,3),2))
TableBody(8,3) = trim(RealToStr(TableBodyData(8,3),2))
TableBody(9,3) = trim(RealToStr(TableBodyData(9,3),2))
TableBody(10,3) = trim(RealToStr(TableBodyData(10,3),2))
CALL writeSubtitle('Construction Cost Estimate Summary' )
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'Construction Cost Estimate Summary',&
'Entire Facility',&
'Construction Cost Estimate Summary')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
NumRows = NumLineItems +1 !body will have the total and line items
NumCols = 6 ! Line no., Line name, Qty, Units, ValperQty, Subtotal
ALLOCATE(rowHead(NumRows))
ALLOCATE(columnHead(NumCols))
ALLOCATE(columnWidth(NumCols))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(NumRows,NumCols))
tableBody = '--' ! array init
rowHead = '--' ! array init
rowHead(NumRows) = 'Line Item SubTotal' !last line in table will be a total
! setup up column headers
columnHead(1) = 'Line No.'
columnHead(2) = 'Item Name'
columnHead(3) = 'Quantity.'
ColumnHead(4) = 'Units'
columnHead(5) = '~~$~~ per Qty.'
columnHead(6) = 'SubTotal ~~$~~'
columnWidth = (/7,30,16,10,16,16/) !array assignment - for all columns
DO Item=1,NumLineItems
tableBody(item, 1) = trim(IntToStr(CostLineItem(item)%LineNumber))
tableBody(item, 2) = trim(CostLineItem(item)%LineName)
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
CALL LookupSItoIP(CostLineItem(item)%Units, unitConvIndex, IPunitName)
IF (unitConvIndex .NE. 0) THEN
IPqty = convertIP(unitConvIndex,CostLineItem(item)%Qty)
tableBody(item, 3) = trim(RealToStr(IPqty, 2))
tableBody(item, 4) = trim(IPunitName)
IPsingleValue = convertIP(unitConvIndex,1.0d0)
IF (IPsingleValue .NE. 0.0d0) THEN
IPvaluePer = CostLineItem(item)%ValuePer / IPsingleValue
tableBody(item, 5) = trim(RealToStr(IPvaluePer, 2))
END IF
ELSE
tableBody(item, 3) = trim(RealToStr(CostLineItem(item)%Qty, 2))
tableBody(item, 4) = trim(CostLineItem(item)%Units)
tableBody(item, 5) = trim(RealToStr(CostLineItem(item)%ValuePer, 2))
END IF
ELSE
tableBody(item, 3) = trim(RealToStr(CostLineItem(item)%Qty, 2))
tableBody(item, 4) = trim(CostLineItem(item)%Units)
tableBody(item, 5) = trim(RealToStr(CostLineItem(item)%ValuePer, 2))
END IF
tableBody(item, 6) = trim(RealToStr(CostLineItem(item)%LineSubTotal, 2))
ENDDO
tableBody(NumRows, 6) = trim(RealToStr(CurntBldg%LineItemTot, 2))
CALL writeSubtitle('Cost Line Item Details') !: '//trim(RealToStr(CostEstimateTotal, 2)))
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'Construction Cost Estimate Summary',&
'Entire Facility',&
'Cost Line Item Details')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
RETURN
END SUBROUTINE WriteCompCostTable