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 GetInputLifeCycleCostUsePriceEscalation
! 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:UsePriceEscalation" 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 :: jYear
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.
INTEGER :: escStartYear = 0
INTEGER :: escNumYears = 0
INTEGER :: escEndYear = 0
INTEGER :: earlierEndYear = 0
INTEGER :: laterStartYear = 0
INTEGER :: curEsc = 0
INTEGER :: curFld = 0
IF (.NOT. LCCparamPresent) RETURN
CurrentModuleObject = 'LifeCycleCost:UsePriceEscalation'
numUsePriceEscalation = GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(UsePriceEscalation(numUsePriceEscalation))
DO iInObj = 1 , numUsePriceEscalation
ALLOCATE(UsePriceEscalation(iInObj)%Escalation(lengthStudyYears))
END DO
IF (numUsePriceEscalation .GT. 0) THEN
DO iInObj = 1 , numUsePriceEscalation
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
UsePriceEscalation(iInObj)%Name = TRIM(AlphaArray(1))
! A2, \field Resource
! \required-field
! \type choice
! \key Electricity
! \key NaturalGas
! \key Steam
! \key Gasoline
! \key Diesel
! \key Coal
! \key FuelOil#1
! \key FuelOil#2
! \key Propane
! \key Water
! \key OtherFuel1
! \key OtherFuel2
UsePriceEscalation(iInObj)%resource = AssignResourceTypeNum(AlphaArray(2)) !use function from DataGlobalConstants
IF (NumAlphas .GT. 3) THEN
CALL ShowWarningError('In '//TRIM(CurrentModuleObject)//' contains more alpha fields than expected.')
END IF
! N1, \field Escalation Start Year
! \type integer
! \minimum 1900
! \maximum 2100
UsePriceEscalation(iInObj)%escalationStartYear = INT(NumArray(1))
IF (UsePriceEscalation(iInObj)%escalationStartYear .GT. 2100) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(1))// &
'. Value greater than 2100 yet it is representing a year. ')
END IF
IF (UsePriceEscalation(iInObj)%escalationStartYear .LT. 1900) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Invalid value in field '//TRIM(cNumericFieldNames(1))// &
'. Value less than 1900 yet it is representing a year. ')
END IF
! A3, \field Escalation Start Month
! \type choice
! \key January
! \key February
! \key March
! \key April
! \key May
! \key June
! \key July
! \key August
! \key September
! \key October
! \key November
! \key December
! \default January
UsePriceEscalation(iInObj)%escalationStartMonth = MonthToMonthNumber(AlphaArray(3),1)
! N2, \field Year 1 Escalation
! \type real
! \begin-extensible
! The array is from the baseDateYear until baseDateYear + lengthStudyYears
! Set the array to default to 1.0
DO jYear = 1,lengthStudyYears
UsePriceEscalation(iInObj)%Escalation(jYear) = 1.0d0
END DO
! Since the years in the UsePriceEscalation may not match up with the baseDateYear and
! the lenghtStudyYears, need to make adjustments when reading in the values to align
! with the baseDateYear (the first item in all yearly arrays)
escStartYear = UsePriceEscalation(iInObj)%escalationStartYear
escNumYears = NumNums - 1
escEndYear = escStartYear + escNumYears - 1
earlierEndYear = MIN(escEndYear,lastDateYear) ! pick the earlier ending date
laterStartYear = MAX(escStartYear,baseDateYear) !pick the later starting date
DO jYear = laterStartYear,earlierEndYear
curFld = 2 + jYear - escStartYear
curEsc = 1 + jYear - baseDateYear
IF ((curFld .LE. numNums) .AND. (curFld .GE. 1)) THEN
IF ((curEsc .LE. lengthStudyYears) .AND. (curEsc .GE. 1)) THEN
UsePriceEscalation(iInObj)%Escalation(curEsc) = NumArray(curFld)
END IF
END IF
END DO
END DO
END IF
END SUBROUTINE GetInputLifeCycleCostUsePriceEscalation