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 GetInputLifeCycleCostRecurringCosts
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer of GARD Analytics, Inc.
! DATE WRITTEN May 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Read the input file for "LifeCycleCost:RecurringCosts" object.
! METHODOLOGY EMPLOYED:
! REFERENCES:
! na
! USE STATEMENTS:
! na
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 :: iInObj ! loop index variable for reading in objects
INTEGER :: jFld
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
CHARACTER(len=MaxNameLength),DIMENSION(100) :: AlphaArray !character string data
REAL(r64), DIMENSION(100) :: NumArray !numeric data
INTEGER :: IOStat ! IO Status when calling get input subroutine
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in renaming.
IF (.NOT. LCCparamPresent) RETURN
CurrentModuleObject = 'LifeCycleCost:RecurringCosts'
numRecurringCosts = GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(RecurringCosts(numRecurringCosts))
DO iInObj = 1 , numRecurringCosts
CALL GetObjectItem(CurrentModuleObject,iInObj,AlphaArray,NumAlphas,NumArray,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
!check to make sure none of the values are another life cycle cost object
DO jFld = 1, NumAlphas
IF (INDEX(MakeUpperCase(AlphaArray(jFld)),'LifeCycleCost:') .GT. 0) THEN
CALL ShowWarningError('In '//TRIM(CurrentModuleObject)//' named ' // TRIM(AlphaArray(1)) // &
' a field was found containing LifeCycleCost: which may indicate a missing comma.')
END IF
END DO
! start to extract values from input array into appropriate fields
! A1, \field Name
! \required-field
! \type alpha
RecurringCosts(iInObj)%Name = AlphaArray(1)
! A2, \field Category
! \type choice
! \key Maintenance
! \key Repair
! \key Operation
! \key Replacement
! \key MinorOverhaul
! \key MajorOverhaul
! \key OtherOperational
! \default Maintenance
IF (SameString(AlphaArray(2),'Maintenance')) THEN
RecurringCosts(iInObj)%category = costCatMaintenance
ELSEIF (SameString(AlphaArray(2),'Repair')) THEN
RecurringCosts(iInObj)%category = costCatRepair
ELSEIF (SameString(AlphaArray(2),'Operation')) THEN
RecurringCosts(iInObj)%category = costCatOperation
ELSEIF (SameString(AlphaArray(2),'Replacement')) THEN
RecurringCosts(iInObj)%category = costCatReplacement
ELSEIF (SameString(AlphaArray(2),'MinorOverhaul')) THEN
RecurringCosts(iInObj)%category = costCatMinorOverhaul
ELSEIF (SameString(AlphaArray(2),'MajorOverhaul')) THEN
RecurringCosts(iInObj)%category = costCatMajorOverhaul
ELSEIF (SameString(AlphaArray(2),'OtherOperational')) THEN
RecurringCosts(iInObj)%category = costCatOtherOperational
ELSE
RecurringCosts(iInObj)%category = costCatMaintenance
CALL ShowWarningError(TRIM(CurrentModuleObject) //': Invalid '//TRIM(cAlphaFieldNames(2))//'="'// &
TRIM(AlphaArray(2))//'". The category of Maintenance will be used.')
END IF
! N1, \field Cost
! \type real
RecurringCosts(iInObj)%cost = NumArray(1)
! A3, \field Start of Costs
! \type choice
! \key ServicePeriod
! \key BasePeriod
! \default ServicePeriod
IF (SameString(AlphaArray(3),'ServicePeriod')) THEN
RecurringCosts(iInObj)%startOfCosts = startServicePeriod
ELSEIF (SameString(AlphaArray(3),'BasePeriod')) THEN
RecurringCosts(iInObj)%startOfCosts = startBasePeriod
ELSE
RecurringCosts(iInObj)%startOfCosts = startServicePeriod
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid '//TRIM(cAlphaFieldNames(3))//'="'// &
TRIM(AlphaArray(3))//'". The start of the service period will be used.')
END IF
! N2, \field Years from Start
! \type integer
! \minimum 0
! \maximum 100
RecurringCosts(iInObj)%yearsFromStart = INT(NumArray(2))
IF (RecurringCosts(iInObj)%yearsFromStart .GT. 100) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(2))// &
'. This value is the number of years from the start so a value greater than 100 '// &
'is not reasonable for an economic evaluation. ')
END IF
IF (RecurringCosts(iInObj)%yearsFromStart .LT. 0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(2))// &
'. This value is the number of years from the start so a value less than 0 '// &
'is not reasonable for an economic evaluation. ')
END IF
! N3, \field Months from Start
! \type integer
! \minimum 0
! \maximum 1200
RecurringCosts(iInObj)%monthsFromStart = INT(NumArray(3))
IF (RecurringCosts(iInObj)%monthsFromStart .GT. 1200) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(3))// &
'. This value is the number of months from the start so a value greater than 1200 '// &
'is not reasonable for an economic evaluation. ')
END IF
IF (RecurringCosts(iInObj)%monthsFromStart .LT. 0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(3))// &
'. This value is the number of months from the start so a value less than 0 '// &
'is not reasonable for an economic evaluation. ')
END IF
! N4, \field Repeat Period Years
! \type integer
! \minimum 1
! \maximum 100
RecurringCosts(iInObj)%repeatPeriodYears = INT(NumArray(4))
IF (RecurringCosts(iInObj)%repeatPeriodYears .GT. 100) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(4))// &
'. This value is the number of years between occurances of the cost so a value greater than 100 '// &
'is not reasonable for an economic evaluation. ')
END IF
IF (RecurringCosts(iInObj)%repeatPeriodYears .LT. 1) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(4))// &
'. This value is the number of years between occurances of the cost so a value less than 1 '// &
'is not reasonable for an economic evaluation. ')
END IF
! N5, \field Repeat Period Months
! \type integer
! \minimum 0
! \maximum 1200
RecurringCosts(iInObj)%repeatPeriodMonths = INT(NumArray(5))
IF (RecurringCosts(iInObj)%repeatPeriodMonths .GT. 1200) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(5))// &
'. This value is the number of months between occurances of the cost so a value greater than 1200 '// &
'is not reasonable for an economic evaluation. ')
END IF
IF (RecurringCosts(iInObj)%repeatPeriodMonths .LT. 0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(5))// &
'. This value is the number of months between occurances of the cost so a value less than 0 '// &
'is not reasonable for an economic evaluation. ')
END IF
IF ((RecurringCosts(iInObj)%repeatPeriodMonths .EQ. 0) .AND. (RecurringCosts(iInObj)%repeatPeriodYears .EQ. 0)) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in fields '//TRIM(cNumericFieldNames(5))// &
' and '// TRIM(cNumericFieldNames(4))//'. The repeat period must not be zero months and zero years. ')
END IF
! N6; \field Annual escalation rate
! \type real
RecurringCosts(iInObj)%annualEscalationRate = INT(NumArray(6))
IF (RecurringCosts(iInObj)%annualEscalationRate .GT. 0.30d0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(6))// &
'. This value is the decimal value for the annual escalation so most values are between 0.02 and 0.15. ')
END IF
IF (RecurringCosts(iInObj)%annualEscalationRate .LT. -0.30d0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(6))// &
'. This value is the decimal value for the annual escalation so most values are between 0.02 and 0.15. ')
END IF
! express the years and months fields in total months
RecurringCosts(iInObj)%totalMonthsFromStart = RecurringCosts(iInObj)%yearsFromStart * 12 + &
RecurringCosts(iInObj)%monthsFromStart
RecurringCosts(iInObj)%totalRepeatPeriodMonths = RecurringCosts(iInObj)%repeatPeriodYears * 12 + &
RecurringCosts(iInObj)%repeatPeriodMonths
END DO
END SUBROUTINE GetInputLifeCycleCostRecurringCosts