Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | stringIn | |||
logical, | intent(in) | :: | flagIfNotNumeric | |||
integer, | intent(in) | :: | useOfVar | |||
integer, | intent(in) | :: | varSpecific | |||
integer, | intent(in) | :: | econObjKind | |||
integer, | intent(in) | :: | objIndex | |||
integer, | intent(in) | :: | tariffPt |
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.
INTEGER FUNCTION AssignVariablePt(stringIn,flagIfNotNumeric,useOfVar,varSpecific,econObjKind,objIndex,tariffPt)
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer of GARD Analytics, Inc.
! DATE WRITTEN May 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! If the string is not numeric, check if it is a valid string to use as
! a variable name. Check if name has been used before and if not create
! the variable using the string as its name.
! Return the index of the variable.
! METHODOLOGY EMPLOYED:
! REFERENCES:
! na
! USE STATEMENTS:
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: stringIn
LOGICAL, INTENT(IN) :: flagIfNotNumeric
INTEGER, INTENT(IN) :: useOfVar
INTEGER, INTENT(IN) :: econObjKind
INTEGER, INTENT(IN) :: varSpecific
INTEGER, INTENT(IN) :: objIndex
INTEGER, INTENT(IN) :: tariffPt
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=200) :: inNoSpaces
INTEGER :: found
INTEGER :: iVar
IF (flagIfNotNumeric .AND. (LEN_TRIM(stringIn) .GE. 1)) THEN
inNoSpaces = RemoveSpaces(stringIn)
found = 0
IF (ALLOCATED(econVar)) THEN
DO iVar = 1, numEconVar
IF (econVar(iVar)%tariffIndx .EQ. tariffPt) THEN
IF (SameString(econVar(iVar)%name,inNoSpaces)) THEN
found = iVar
EXIT
END IF
END IF
END DO
END IF
IF (found .GT. 0) THEN
AssignVariablePt = found
IF (econVar(found)%kindOfObj .EQ. 0) THEN
econVar(found)%kindOfObj = econObjKind
IF (econVar(found)%index .EQ. 0) econVar(found)%index = objIndex
END IF
ELSE
CALL incrementEconVar
econVar(numEconVar)%name = inNoSpaces
econVar(numEconVar)%kindOfObj = econObjKind
econVar(numEconVar)%index = objIndex
AssignVariablePt = numEconVar
END IF
! now set the flag for the type of usage the variable has
IF (useOfVar .EQ. varIsArgument) THEN
econVar(AssignVariablePt)%isArgument = .TRUE.
ELSE IF (useOfVar .EQ. varIsAssigned) THEN
econVar(AssignVariablePt)%isAssigned = .TRUE.
END IF
econVar(AssignVariablePt)%tariffIndx = tariffPt
! if the user defines the UtilityCost:Computation then this is called when reading the
! UtilityCost:Tariff with varNotYetDefined but they are already defined because
! the subroutine CreateCategoryNativeVariables has already been called.
IF (.NOT. ((varSpecific .EQ. varNotYetDefined) .AND. (econVar(AssignVariablePt)%specific .GE. catEnergyCharges))) THEN
econVar(AssignVariablePt)%specific = varSpecific
END IF
ELSE !if the string was numeric return a zero
AssignVariablePt = 0
END IF
END FUNCTION AssignVariablePt