Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | usingVariable |
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 evaluateQualify(usingVariable)
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer of GARD Analytics, Inc.
! DATE WRITTEN July 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! METHODOLOGY EMPLOYED:
! REFERENCES:
! na
! USE STATEMENTS:
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: usingVariable
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: curTariff
INTEGER :: indexInQual
REAL(r64), DIMENSION(MaxNumMonths) :: sourceVals
REAL(r64), DIMENSION(MaxNumMonths) :: thresholdVals
INTEGER, DIMENSION(MaxNumMonths) :: monthsQualify
REAL(r64), DIMENSION(MaxNumMonths) :: seasonMask
LOGICAL :: curIsMaximum
LOGICAL :: curIsConsecutive
INTEGER :: curNumberOfMonths
INTEGER :: adjNumberOfMonths
INTEGER :: iMonth
LOGICAL :: isQualified
INTEGER :: monthsInSeason
INTEGER :: cntAllQualMonths
INTEGER :: cntConsecQualMonths
INTEGER :: maxConsecQualMonths
curTariff = econVar(usingVariable)%tariffIndx
indexInQual = econVar(usingVariable)%index
!check the tariff - make sure they match
IF (qualify(indexInQual)%namePt .NE. usingVariable) THEN
CALL ShowWarningError('UtilityCost:Tariff Debugging issue. Qualify index does not match variable pointer.')
CALL ShowContinueError(' Between: ' // TRIM(econVar(usingVariable)%name))
CALL ShowContinueError(' And: ' // TRIM(econVar(qualify(indexInQual)%namePt)%name))
END IF
IF (qualify(indexInQual)%tariffIndx .NE. curTariff) THEN
CALL ShowWarningError('UtilityCost:Tariff Debugging issue. Qualify index does not match tariff index.')
CALL ShowContinueError(' Between: ' // TRIM(tariff(curTariff)%tariffName))
CALL ShowContinueError(' And: ' // TRIM(tariff(qualify(indexInQual)%tariffIndx)%tariffName))
END IF
! data from the Qualify
sourceVals = econVar(qualify(indexInQual)%sourcePt)%values
curIsMaximum = qualify(indexInQual)%isMaximum
curIsConsecutive = qualify(indexInQual)%isConsecutive
curNumberOfMonths = qualify(indexInQual)%numberOfMonths
! determine if threshold should be based on variable or value
IF (qualify(indexInQual)%thresholdPt .NE. 0) THEN
thresholdVals = econVar(qualify(indexInQual)%thresholdPt)%values
ELSE
thresholdVals = qualify(indexInQual)%thresholdVal
END IF
! find proper season mask
SELECT CASE (qualify(indexInQual)%season)
CASE (seasonSummer)
seasonMask = econVar(tariff(curTariff)%nativeIsSummer)%values
CASE (seasonWinter)
seasonMask = econVar(tariff(curTariff)%nativeIsWinter)%values
CASE (seasonSpring)
seasonMask = econVar(tariff(curTariff)%nativeIsSpring)%values
CASE (seasonFall)
seasonMask = econVar(tariff(curTariff)%nativeIsAutumn)%values
CASE (seasonAnnual)
seasonMask = 1.0d0 !all months are 1
END SELECT
!any months with no energy use are excluded from the qualification process
DO iMonth = 1, MaxNumMonths
IF (econVar(tariff(curTariff)%nativeTotalEnergy)%values(iMonth) .EQ. 0) THEN
seasonMask(iMonth) = 0.0d0
END IF
END DO
! finally perform calculations
!loop through the months
monthsInSeason = 0
DO iMonth = 1, MaxNumMonths
IF (seasonMask(iMonth) .EQ. 1) THEN
monthsInSeason = monthsInSeason + 1
!use threshold as maximum or minimum
IF (curIsMaximum) THEN
IF (sourceVals(iMonth) .GT. thresholdVals(iMonth)) THEN
monthsQualify(iMonth) = 0 !greater than maximum threshold so it is not qualified
ELSE
monthsQualify(iMonth) = 1 !less than maximum threshold so it is qualified
END IF
ELSE
IF (sourceVals(iMonth) .LT. thresholdVals(iMonth)) THEN
monthsQualify(iMonth) = 0 !less than minimum threshold so it is not qualified
ELSE
monthsQualify(iMonth) = 1 !greater than minimum threshold so it is qualified
END IF
END IF
ELSE
monthsQualify(iMonth) = -1 !flag that indicates not part of the season
END IF
END DO
!see if the number of months is longer then the number of months and adjust
IF (curNumberOfMonths .GT. monthsInSeason) THEN
adjNumberOfMonths = monthsInSeason
ELSE
adjNumberOfMonths = curNumberOfMonths
END IF
!now that each month is qualified or not, depending on the type of test see if the entire qualify passe or not
cntAllQualMonths = 0
cntConsecQualMonths = 0
maxConsecQualMonths = 0
DO iMonth = 1,MaxNumMonths
SELECT CASE (monthsQualify(iMonth))
CASE (1) !qualified
cntAllQualMonths = cntAllQualMonths + 1
cntConsecQualMonths = cntConsecQualMonths + 1
!see if the count is greater then the previous count and if it is make it the new count
IF (cntConsecQualMonths .GT. maxConsecQualMonths) THEN
maxConsecQualMonths = cntConsecQualMonths
END IF
CASE (0) !not qualified
!reset the counter on consecutive months
cntConsecQualMonths = 0
END SELECT
END DO
!if test is for consecutive months
IF (curIsConsecutive) THEN
IF (maxConsecQualMonths .GE. adjNumberOfMonths) THEN
isQualified = .TRUE.
ELSE
isQualified = .FALSE.
END IF
ELSE !count not consecutive
IF (cntAllQualMonths .GE. adjNumberOfMonths) THEN
isQualified = .TRUE.
ELSE
isQualified = .FALSE.
END IF
END IF
!now update the tariff level qualifier - only update if the tariff is still qualified
!and the current qualifer fails.
IF (tariff(curTariff)%isQualified) THEN
IF (.NOT. isQualified) THEN
tariff(curTariff)%isQualified = .FALSE.
tariff(curTariff)%ptDisqualifier = usingVariable
END IF
END IF
!store the cost in the name of the variable
econVar(usingVariable)%values = REAL(monthsQualify,r64)
!set the flag that it has been evaluated so it won't be evaluated multiple times
econVar(usingVariable)%isEvaluated = .TRUE.
END SUBROUTINE evaluateQualify