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 GetOperationSchemeInput
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN October 1998
! MODIFIED August 2001, LKL -- Validations
! RE-ENGINEERED July 2010, Dan Fisher, restructure input data
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reads the primary plant loop
! operation schemes from the input file
! METHODOLOGY EMPLOYED:
! calls the Input Processor to retrieve data from input file.
! The format of the Energy+.idd (the EnergyPlus input data dictionary) for the
! following keywords is reflected exactly in this subroutine:
! PlantEquipmentOperation:*
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString, FindItemInList
USE NodeInputManager, ONLY: GetOnlySingleNode
USE DataLoopNode
USE DataSizing
USE DataIPShortCuts
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetOperationSchemeInput: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: SchemeNum
INTEGER :: Num
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: IOSTAT
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: ErrorsFound ! May be set here and passed on
INTEGER :: CLRBO ! Number ofCooling Load Range Based Operation Inputs
INTEGER :: HLRBO ! Number ofHeating Load Range Based Operation Inputs
INTEGER :: DBRBO ! Number ofDry Bulb Temperature Range Based Operation Inputs
INTEGER :: WBRBO ! Number ofWet Bulb Temperature Range Based Operation Inputs
INTEGER :: DPRBO ! Number ofDewPoint Temperature Range Based Operation Inputs
INTEGER :: RHRBO ! Number ofRelative Humidity Range Based Operation Inputs
INTEGER :: CSPBO ! Number of Component SetPoint Based Operation Inputs
INTEGER :: DBTDBO ! Number ofDry Bulb Temperature Range Based Operation Inputs
INTEGER :: WBTDBO ! Number ofWet Bulb Temperature Range Based Operation Inputs
INTEGER :: DPTDBO ! Number ofDewPoint Temperature Range Based Operation Inputs
INTEGER :: NumSchemes ! Number of Condenser equipment lists
INTEGER :: NumUncontrolledSchemes ! Number of Condenser equipment lists
INTEGER :: NumUserDefOpSchemes ! number of user defined EMS op schemes
INTEGER :: CELists ! Number of Condenser equipment lists
INTEGER :: PELists ! Number of Plant equipment lists
INTEGER :: Count ! Loop counter
INTEGER :: NumSchemeLists
INTEGER :: LoopNum
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in renaming.
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: TempVerifyNames
ErrorsFound = .FALSE. !DSU CS
!**********VERIFY THE 'PLANTEQUIPMENTOPERATION:...' KEYWORDS**********
CLRBO = GetNumObjectsFound('PlantEquipmentOperation:CoolingLoad')
HLRBO = GetNumObjectsFound('PlantEquipmentOperation:HeatingLoad')
DBRBO = GetNumObjectsFound('PlantEquipmentOperation:OutdoorDryBulb')
WBRBO = GetNumObjectsFound('PlantEquipmentOperation:OutdoorWetBulb')
DPRBO = GetNumObjectsFound('PlantEquipmentOperation:OutdoorDewpoint')
RHRBO = GetNumObjectsFound('PlantEquipmentOperation:OutdoorRelativeHumidity')
CSPBO = GetNumObjectsFound('PlantEquipmentOperation:ComponentSetpoint') !* Temp Based Control
NumUserDefOpSchemes = GetNumObjectsFound('PlantEquipmentOperation:UserDefined' )
DBTDBO = GetNumObjectsFound('PlantEquipmentOperation:OutdoorDryBulbDifference')
WBTDBO = GetNumObjectsFound('PlantEquipmentOperation:OutdoorWetBulbDifference')
DPTDBO = GetNumObjectsFound('PlantEquipmentOperation:OutdoorDewpointDifference')
NumSchemes = CLRBO+HLRBO+DBRBO+WBRBO+DPRBO+RHRBO+CSPBO+DBTDBO+WBTDBO+DPTDBO+NumUserDefOpSchemes
NumUncontrolledSchemes = GetNumObjectsFound('PlantEquipmentOperation:Uncontrolled')
IF ( (NumSchemes + NumUncontrolledSchemes) .le. 0 ) THEN
CALL ShowFatalError('No PlantEquipmentOperation:* objects specified. Stop simulation.')
END IF
! test for blank or duplicates -- this section just determines if there are any duplicate operation scheme names
ALLOCATE(TempVerifyNames(NumSchemes))
TempVerifyNames=' '
!Check for existence of duplicates in keyword names
Count = 0
DO Num = 1,NumSchemes
IF (CLRBO > 0 .AND. Num <=CLRBO)THEN
CurrentModuleObject ='PlantEquipmentOperation:CoolingLoad'
Count = Num
ELSEIF(HLRBO > 0 .AND. Num <=(CLRBO+HLRBO))THEN
CurrentModuleObject ='PlantEquipmentOperation:HeatingLoad'
Count = Num-CLRBO
ELSEIF(DBRBO > 0 .AND. Num <=(CLRBO+HLRBO+DBRBO))THEN
CurrentModuleObject ='PlantEquipmentOperation:OutdoorDryBulb'
Count = Num-CLRBO-HLRBO
ELSEIF(WBRBO > 0 .AND. Num <=(CLRBO+HLRBO+DBRBO+WBRBO))THEN
CurrentModuleObject ='PlantEquipmentOperation:OutdoorWetBulb'
Count = Num-CLRBO-HLRBO-DBRBO
ELSEIF(DPRBO > 0 .AND. Num <=(CLRBO+HLRBO+DBRBO+WBRBO+DPRBO))THEN
CurrentModuleObject ='PlantEquipmentOperation:OutdoorDewpoint'
Count = Num-CLRBO-HLRBO-DBRBO-WBRBO
ELSEIF(RHRBO > 0 .AND. Num <=(CLRBO+HLRBO+DBRBO+WBRBO+DPRBO+RHRBO))THEN
CurrentModuleObject ='PlantEquipmentOperation:OutdoorRelativeHumidity'
Count = Num-CLRBO-HLRBO-DBRBO-WBRBO-DPRBO
ELSEIF(CSPBO > 0 .AND. Num <=(CLRBO+HLRBO+DBRBO+WBRBO+DPRBO+RHRBO+CSPBO))THEN
CurrentModuleObject ='PlantEquipmentOperation:ComponentSetpoint'
Count = Num-CLRBO-HLRBO-DBRBO-WBRBO-DPRBO-RHRBO
ELSEIF(DBTDBO > 0 .AND. Num <=(CLRBO+HLRBO+DBRBO+WBRBO+DPRBO+RHRBO+CSPBO+DBTDBO))THEN
CurrentModuleObject ='PlantEquipmentOperation:OutdoorDryBulbDifference'
Count = Num-CLRBO-HLRBO-DBRBO-WBRBO-DPRBO-RHRBO-CSPBO
ELSEIF(WBTDBO > 0 .AND. Num <=(CLRBO+HLRBO+DBRBO+WBRBO+DPRBO+RHRBO+CSPBO+DBTDBO+WBTDBO))THEN
CurrentModuleObject ='PlantEquipmentOperation:OutdoorWetBulbDifference'
Count = Num-CLRBO-HLRBO-DBRBO-WBRBO-DPRBO-RHRBO-CSPBO-DBTDBO
ELSEIF(DPTDBO > 0 .AND. Num <=(CLRBO+HLRBO+DBRBO+WBRBO+DPRBO+RHRBO+CSPBO+DBTDBO+WBTDBO+DPTDBO))THEN
CurrentModuleObject ='PlantEquipmentOperation:OutdoorDewpointDifference'
Count = Num-CLRBO-HLRBO-DBRBO-WBRBO-DPRBO-RHRBO-CSPBO-DBTDBO-WBTDBO
ELSEIF(NumUncontrolledSchemes > 0 .AND. &
Num <=(CLRBO+HLRBO+DBRBO+WBRBO+DPRBO+RHRBO+CSPBO+DBTDBO+WBTDBO+DPTDBO + NumUncontrolledSchemes))THEN
CurrentModuleObject ='PlantEquipmentOperation:Uncontrolled'
Count = Num-CLRBO-HLRBO-DBRBO-WBRBO-DPRBO-RHRBO-CSPBO-DBTDBO-WBTDBO-DPTDBO
ELSEIF(NumUserDefOpSchemes > 0 .AND. &
Num <=(CLRBO+HLRBO+DBRBO+WBRBO+DPRBO+RHRBO+CSPBO+DBTDBO+WBTDBO+DPTDBO + NumUncontrolledSchemes + NumUserDefOpSchemes))THEN
CurrentModuleObject ='PlantEquipmentOperation:UserDefined'
Count = Num-CLRBO-HLRBO-DBRBO-WBRBO-DPRBO-RHRBO-CSPBO-DBTDBO-WBTDBO-DPTDBO-NumUncontrolledSchemes
ELSE
CALL ShowFatalError('Error in control scheme identification')
ENDIF
CALL GetObjectItem(CurrentModuleObject,Count,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),TempVerifyNames,Num-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
CYCLE
ENDIF
TempVerifyNames(Num)=cAlphaArgs(1)
ENDDO
DEALLOCATE(TempVerifyNames)
!**********VERIFY THE 'PlantEquipmentList' AND 'CondenserEquipmentList' KEYWORDS*********
PELists = GetNumObjectsFound('PlantEquipmentList')
CELists = GetNumObjectsFound('CondenserEquipmentList')
NumSchemeLists = PELists + CELists
ALLOCATE(TempVerifyNames(NumSchemeLists))
TempVerifyNames=' '
count = 0
DO Num = 1,NumSchemeLists
IF (Num <=PELists)THEN
CurrentModuleObject ='PlantEquipmentList'
Count = Num
ELSE
CurrentModuleObject ='CondenserEquipmentList'
Count = Num-PeLists
ENDIF
CALL GetObjectItem(CurrentModuleObject,Count,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),TempVerifyNames,Num-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
CYCLE
ENDIF
TempVerifyNames(Num)=cAlphaArgs(1)
ENDDO
DEALLOCATE(TempVerifyNames)
!**********GET INPUT AND LOAD PLANT DATA STRUCTURE*********
!extend number of equipment lists to include one for each CSPBO
NumSchemeLists =NumSchemeLists+CSPBO+NumUserDefOpSchemes
DO LoopNum = 1, TotNumLoops
DO SchemeNum = 1, PlantLoop(LoopNum)%NumOpSchemes
SELECT CASE(PlantLoop(LoopNum)%OpScheme(SchemeNum)%TypeOf)
CASE ('PLANTEQUIPMENTOPERATION:COOLINGLOAD')
CurrentModuleObject = 'PlantEquipmentOperation:CoolingLoad'
CALL FindRangeBasedOrUncontrolledInput(CurrentModuleObject,CLRBO,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:HEATINGLOAD')
CurrentModuleObject = 'PlantEquipmentOperation:HeatingLoad'
CALL FindRangeBasedOrUncontrolledInput(CurrentModuleObject,HLRBO,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:COMPONENTSETPOINT') !* Temp Based Control
CurrentModuleObject = 'PlantEquipmentOperation:ComponentSetPoint'
CALL FindCompSPInput(CurrentModuleObject,CSPBO,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:USERDEFINED')
CurrentModuleObject = 'PlantEquipmentOperation:UserDefined'
CALL GetUserDefinedOpSchemeInput(CurrentModuleObject,NumUserDefOpSchemes,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORDRYBULB')
CurrentModuleObject = 'PlantEquipmentOperation:OutdoorDryBulb'
CALL FindRangeBasedOrUncontrolledInput(CurrentModuleObject,DBRBO,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORWETBULB')
CurrentModuleObject = 'PlantEquipmentOperation:OutdoorWetBulb'
CALL FindRangeBasedOrUncontrolledInput(CurrentModuleObject,WBRBO,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORDEWPOINT')
CurrentModuleObject = 'PlantEquipmentOperation:OutdoorDewPoint'
CALL FindRangeBasedOrUncontrolledInput(CurrentModuleObject,DPRBO,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORRELATIVEHUMIDITY')
CurrentModuleObject = 'PlantEquipmentOperation:OutdoorrelativeHumidity'
CALL FindRangeBasedOrUncontrolledInput(CurrentModuleObject,RHRBO,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORDRYBULBDIFFERENCE')
CurrentModuleObject = 'PlantEquipmentOperation:OutdoorDryBulbDifference'
CALL FindDeltaTempRangeInput(CurrentModuleObject,DBTDBO,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORWETBULBDIFFERENCE')
CurrentModuleObject = 'PlantEquipmentOperation:OutdoorWetBulbDifference'
CALL FindDeltaTempRangeInput(CurrentModuleObject,WBTDBO,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORDEWPOINTDIFFERENCE')
CurrentModuleObject = 'PlantEquipmentOperation:OutdoorDewPointDifference'
CALL FindDeltaTempRangeInput(CurrentModuleObject,DPTDBO,LoopNum,SchemeNum,ErrorsFound)
CASE ('PLANTEQUIPMENTOPERATION:UNCONTROLLED')
CurrentModuleObject = 'PlantEquipmentOperation:Uncontrolled'
CALL FindRangeBasedOrUncontrolledInput(CurrentModuleObject,NumUncontrolledSchemes,LoopNum,SchemeNum,ErrorsFound)
CASE DEFAULT ! invalid op scheme type for plant loop
! DSU? Seems like the alpha args below is incorrect....
CALL ShowSevereError('Invalid operation scheme type = "'//TRIM(cAlphaArgs(Num*3-1))// &
'", entered in '//TRIM(CurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END SELECT
ENDDO
ENDDO
! Validate that component names/types in each list correspond to a valid component in input file
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found getting inputs. Previous error(s) cause program termination.')
ENDIF
RETURN
END SUBROUTINE GetOperationSchemeInput