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 ExpressAsCashFlows
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer of GARD Analytics, Inc.
! DATE WRITTEN July 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Convert all recurring and nonrecurring costs into cash flows
! used in calculations and reporting.
! METHODOLOGY EMPLOYED:
! REFERENCES:
! na
! USE STATEMENTS:
USE EconomicTariff, ONLY: GetMonthlyCostForResource
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 :: iCashFlow
INTEGER :: iResource
INTEGER :: jCost
INTEGER :: jMonth
INTEGER :: jAdj
INTEGER :: kYear
INTEGER :: offset
INTEGER :: month !number of months since base date
INTEGER :: firstMonth
INTEGER :: repeatMonths
INTEGER :: baseMonths1900 = 0 ! number of months since 1900 for base period
INTEGER :: serviceMonths1900 = 0 ! number of months since 1900 for service period
INTEGER :: monthsBaseToService
REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: resourceCosts
REAL(r64), DIMENSION(12) :: curResourceCosts
LOGICAL, ALLOCATABLE, DIMENSION(:) :: resourceCostNotZero
REAL(r64), ALLOCATABLE, DIMENSION(:) :: resourceCostAnnual
REAL(r64) :: annualCost
INTEGER :: cashFlowCounter
INTEGER :: found
INTEGER :: curCategory
REAL(r64),ALLOCATABLE,DIMENSION(:) :: monthlyInflationFactor
REAL(r64) :: inflationPerMonth
INTEGER :: iLoop
! compute months from 1900 for base and service period
baseMonths1900 = (baseDateYear - 1900) * 12 + baseDateMonth
serviceMonths1900 = (serviceDateYear - 1900) * 12 + serviceDateMonth
monthsBaseToService = serviceMonths1900 - baseMonths1900
! if ComponentCost:LineItem exist, the grand total of all costs are another non-recurring cost
IF (CurntBldg%GrandTotal .GT. 0.0d0) THEN !from DataCostEstimate and computed in WriteCompCostTable within OutputReportTabular
numNonrecurringCost = numNonrecurringCost + 1
NonrecurringCost(numNonrecurringCost)%Name = 'Total of ComponentCost:*'
NonrecurringCost(numNonrecurringCost)%lineItem = ''
NonrecurringCost(numNonrecurringCost)%category = costCatConstruction
NonrecurringCost(numNonrecurringCost)%cost = CurntBldg%GrandTotal
NonrecurringCost(numNonrecurringCost)%startOfCosts = startBasePeriod
NonrecurringCost(numNonrecurringCost)%yearsFromStart = 0
NonrecurringCost(numNonrecurringCost)%monthsFromStart = 0
NonrecurringCost(numNonrecurringCost)%totalMonthsFromStart = 0
END IF
! gather costs from EconomicTariff for each end use
ALLOCATE(resourceCosts(NumOfResourceTypes,12))
ALLOCATE(resourceCostNotZero(NumOfResourceTypes))
ALLOCATE(resourceCostAnnual(NumOfResourceTypes))
numResourcesUsed = 0
DO iResource = 1 , NumOfResourceTypes
CALL GetMonthlyCostForResource(iResource + ResourceTypeInitialOffset,curResourceCosts)
annualCost = 0.0d0
DO jMonth = 1, 12
resourceCosts(iResource,jMonth) = curResourceCosts(jMonth)
annualCost = annualCost + resourceCosts(iResource,jMonth)
END DO
IF (annualCost .NE. 0.0d0) THEN
numResourcesUsed = numResourcesUsed + 1
resourceCostNotZero(iResource) = .TRUE.
ELSE
resourceCostNotZero(iResource) = .FALSE.
END IF
resourceCostAnnual(iResource) = annualCost
END DO
! pre-compute the inflation factors for each year
ALLOCATE(monthlyInflationFactor(lengthStudyTotalMonths))
IF (inflationApproach .EQ. inflAppConstantDollar) THEN
monthlyInflationFactor = 1.0d0 !not really used but just in case
ELSEIF (inflationApproach .EQ. inflAppCurrentDollar) THEN
! to allocate an interest rate (in this case inflation) cannot just use 1/12
! for the monthly value since it will be slightly wrong. Instead use inverse of
! formula from Newnan (4-32) which is r = m x (ia + 1)^(1/m) - 1)
inflationPerMonth = ((inflation + 1.0d0) ** (1.0d0/12.0d0)) - 1
DO jMonth = 1, lengthStudyTotalMonths
monthlyInflationFactor(jMonth) = (1.0d0 + inflationPerMonth) ** (jMonth - 1)
END DO
END IF
numCashFlow = countOfCostCat + numRecurringCosts + numNonrecurringCost + numResourcesUsed
! Cashflow array order:
! 1 cost categories
! 2 recurring costs
! 3 nonrecurring costs
! 4 resource costs
ALLOCATE(CashFlow(numCashFlow))
DO iCashFlow = 1 , numCashFlow
ALLOCATE(CashFlow(iCashFlow)%mnAmount(lengthStudyTotalMonths))
ALLOCATE(CashFlow(iCashFlow)%yrAmount(lengthStudyYears))
ALLOCATE(CashFlow(iCashFlow)%yrPresVal(lengthStudyYears))
CashFlow(iCashFlow)%mnAmount = 0.0d0 !zero all cash flow values
CashFlow(iCashFlow)%yrAmount = 0.0d0 !zero all cash flow values
CashFlow(iCashFlow)%yrPresVal = 0.0d0 !zero all present values
END DO
! Put nonrecurring costs into cashflows
offset = countOfCostCat + numRecurringCosts
DO jCost = 1, numNonrecurringCost
CashFlow(offset + jCost)%name = NonrecurringCost(jCost)%name
CashFlow(offset + jCost)%SourceKind = skNonrecurring
CashFlow(offset + jCost)%Category = NonrecurringCost(jCost)%category
CashFlow(offset + jCost)%orginalCost = NonrecurringCost(jCost)%cost
CashFlow(offset + jCost)%mnAmount = 0.0d0
IF (NonrecurringCost(jCost)%startOfCosts .EQ. startServicePeriod) THEN
month = NonrecurringCost(jCost)%totalMonthsFromStart + monthsBaseToService + 1
ELSEIF (NonrecurringCost(jCost)%startOfCosts .EQ. startBasePeriod) THEN
month = NonrecurringCost(jCost)%totalMonthsFromStart + 1
END IF
IF ((month .GE. 1) .AND. (month .LE. lengthStudyTotalMonths)) THEN
CashFlow(offset + jCost)%mnAmount(month) = NonrecurringCost(jCost)%cost * monthlyInflationFactor(month)
ELSE
CALL ShowWarningError('For life cycle costing a nonrecurring cost named ' // TRIM(NonrecurringCost(jCost)%name) // &
' contains a cost which is not within the study period.')
END IF
END DO
! Put recurring costs into cashflows
offset = countOfCostCat
DO jCost = 1, numRecurringCosts
CashFlow(offset + jCost)%name = RecurringCosts(jCost)%name
CashFlow(offset + jCost)%SourceKind = skRecurring
CashFlow(offset + jCost)%Category = RecurringCosts(jCost)%category
CashFlow(offset + jCost)%orginalCost = RecurringCosts(jCost)%cost
IF (RecurringCosts(jCost)%startOfCosts .EQ. startServicePeriod) THEN
firstMonth = RecurringCosts(jCost)%totalMonthsFromStart + monthsBaseToService + 1
ELSEIF (RecurringCosts(jCost)%startOfCosts .EQ. startBasePeriod) THEN
firstMonth = RecurringCosts(jCost)%totalMonthsFromStart + 1
END IF
IF ((firstMonth .GE. 1) .AND. (firstMonth .LE. lengthStudyTotalMonths)) THEN
month = firstMonth
IF (RecurringCosts(jCost)%totalRepeatPeriodMonths .GE. 1) THEN
DO iLoop = 1,10000 !add a limit to the loop to prevent runaway condition
CashFlow(offset + jCost)%mnAmount(month) = RecurringCosts(jCost)%cost * monthlyInflationFactor(month)
month = month + RecurringCosts(jCost)%totalRepeatPeriodMonths
IF (month .GT. lengthStudyTotalMonths) EXIT
END DO
END IF
ELSE
CALL ShowWarningError('For life cycle costing the recurring cost named ' // TRIM(RecurringCosts(jCost)%name) // &
' has the first year of the costs that is not within the study period.')
END IF
END DO
! Put resource costs into cashflows
! the first cash flow for resources should be after the categories, recurring and nonrecurring costs
cashFlowCounter = countOfCostCat + numRecurringCosts + numNonrecurringCost
DO iResource = 1 , NumOfResourceTypes
IF (resourceCostNotZero(iResource)) THEN
cashFlowCounter = cashFlowCounter + 1
CashFlow(cashFlowCounter)%Category = costCatEnergy
CashFlow(cashFlowCounter)%Resource = iResource + ResourceTypeInitialOffset
CashFlow(cashFlowCounter)%SourceKind = skResource
CashFlow(cashFlowCounter)%name = GetResourceTypeChar(iResource + ResourceTypeInitialOffset)
IF (cashFlowCounter .LE. numCashFlow) THEN
!put the monthly energy costs into the cashflow prior to adjustments
!energy costs (a.k.a. resource costs) start at the start of service and repeat
!until the end of the study total
DO jMonth = 1, 12
CashFlow(cashFlowCounter)%mnAmount(monthsBaseToService + jMonth) = resourceCosts(iResource,jMonth)
END DO
CashFlow(cashFlowCounter)%orginalCost = resourceCostAnnual(iResource)
DO jMonth = monthsBaseToService + 13, lengthStudyTotalMonths
! use the cost from a year earlier
CashFlow(cashFlowCounter)%mnAmount(jMonth) = CashFlow(cashFlowCounter)%mnAmount(jMonth - 12)
END DO
! add in the impact of inflation
DO jMonth = 1, lengthStudyTotalMonths
CashFlow(cashFlowCounter)%mnAmount(jMonth) = CashFlow(cashFlowCounter)%mnAmount(jMonth) * monthlyInflationFactor(jMonth)
END DO
! now factor in adjustments
! need to find the correct adjustment to use for the current resource
found = 0
DO jAdj = 1,numUseAdjustment
IF (UseAdjustment(jAdj)%resource .EQ. iResource + ResourceTypeInitialOffset) THEN
found = jAdj
EXIT
END IF
END DO
! if any adjustments were found for that resource apply the multiplier
IF (found .NE. 0) THEN
DO kYear = 1,lengthStudyYears !if service period is later than base period then this will go too far
DO jMonth = 1,12
month = (kYear - 1) * 12 + jMonth
IF (month .GT. lengthStudyTotalMonths) EXIT
CashFlow(cashFlowCounter)%mnAmount(month) = CashFlow(cashFlowCounter)%mnAmount(month) * &
UseAdjustment(found)%Adjustment(kYear)
END DO
END DO
END IF
END IF
END IF
END DO
!put cashflows into categories
DO jCost = 1, countOfCostCat
CashFlow(jCost)%Category = jCost !make each category the type indicated
CashFlow(jCost)%SourceKind = skSum
END DO
!add the cashflows by category
DO jCost = countOfCostCat + 1, numCashFlow
curCategory = CashFlow(jCost)%Category
IF ((curCategory .LE. countOfCostCat) .AND. (curCategory .GE. 1)) THEN
DO jMonth = 1, lengthStudyTotalMonths
CashFlow(curCategory)%mnAmount(jMonth) = CashFlow(curCategory)%mnAmount(jMonth) + CashFlow(jCost)%mnAmount(jMonth)
END DO
END IF
END DO
!create total categories
DO jMonth = 1, lengthStudyTotalMonths
CashFlow(costCatTotEnergy)%mnAmount(jMonth) = CashFlow(costCatEnergy)%mnAmount(jMonth)
CashFlow(costCatTotOper)%mnAmount(jMonth) = CashFlow(costCatMaintenance)%mnAmount(jMonth) + &
CashFlow(costCatRepair)%mnAmount(jMonth) + &
CashFlow(costCatOperation)%mnAmount(jMonth) + &
CashFlow(costCatReplacement)%mnAmount(jMonth) + &
CashFlow(costCatMinorOverhaul)%mnAmount(jMonth) + &
CashFlow(costCatMajorOverhaul)%mnAmount(jMonth) + &
CashFlow(costCatOtherOperational)%mnAmount(jMonth) + &
CashFlow(costCatWater)%mnAmount(jMonth) + &
CashFlow(costCatEnergy)%mnAmount(jMonth)
CashFlow(costCatTotCaptl)%mnAmount(jMonth) = CashFlow(costCatConstruction)%mnAmount(jMonth) + &
CashFlow(costCatSalvage)%mnAmount(jMonth) + &
CashFlow(costCatOtherCapital)%mnAmount(jMonth)
CashFlow(costCatTotGrand)%mnAmount(jMonth) = CashFlow(costCatTotOper)%mnAmount(jMonth) + &
CashFlow(costCatTotCaptl)%mnAmount(jMonth)
END DO
!convert all monthly cashflows into yearly cashflows
DO jCost = 1,numCashFlow
DO kYear = 1,lengthStudyYears
annualCost = 0.0d0
DO jMonth = 1, 12
month = (kYear - 1) * 12 + jMonth
IF (month .LE. lengthStudyTotalMonths) THEN
annualCost = annualCost + CashFlow(jCost)%mnAmount(month)
END IF
END DO
CashFlow(jCost)%yrAmount(kYear) = annualCost
END DO
END DO
END SUBROUTINE ExpressAsCashFlows