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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | GetInputOK |
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 GetPlantOperationInput(GetInputOK)
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN October 1998
! MODIFIED July 2010, Dan Fisher, restructure input data
! RE-ENGINEERED na
! 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:
! PlantEquipmentOperationSchemes
! CondenserEquipmentOperationSchemes
! REFERENCES:
! na
! USE STATEMENTS:
USE ScheduleManager, ONLY: GetScheduleIndex
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, GetObjectItemNum, FindItemInList, VerifyName
USE DataIPShortCuts ! Data for field names, blank numerics
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: GetInputOK
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetPlantOperationInput: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: LoopNum ! Loop counter (Plant or Cond)
INTEGER :: OpNum ! Scheme counter
INTEGER :: Num ! Item counter
INTEGER :: NumPlantOpSchemes ! Total Number of PlantEquipmentOperationSchemes
INTEGER :: NumCondOpSchemes ! Total Number of CondenserEquipmentOperationSchemes
INTEGER :: NumAlphas ! Number of alpha items in the input object
INTEGER :: NumNums ! Number of numeric items in the input object
INTEGER :: IOSTAT
CHARACTER(len=MaxNameLength) :: PlantOpSchemeName ! Name of the plant or condenser operating scheme
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in renaming
CHARACTER(len=MaxNameLength) :: PlantLoopObject ! for ease in renaming
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: OpSchemeNames ! Used to verify unique op scheme names
LOGICAL :: IsNotOK
LOGICAL :: IsBlank
LOGICAL :: ErrorsFound ! Passed in from OpSchemeInput
ErrorsFound = .FALSE.
IF(.NOT. ALLOCATED(PlantLoop))THEN
GetInputOK = .FALSE.
RETURN
ELSE
GetInputOK = .TRUE.
ENDIF
! get number of operation schemes
CurrentModuleObject ='PlantEquipmentOperationSchemes'
NumPlantOpSchemes = GetNumObjectsFound(CurrentModuleObject)
IF (NumPlantOpSchemes > 0) THEN
! OpSchemeListNames is used to determine if there are any duplicate operation scheme names
ALLOCATE(OpSchemeNames(NumPlantOpSchemes))
OpSchemeNames=' '
Num=0
DO OpNum=1,NumPlantOpSchemes
CALL GetObjectItem(CurrentModuleObject,OpNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),OpSchemeNames,Num,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
CYCLE
ENDIF
Num=Num+1
OpSchemeNames(Num)=cAlphaArgs(1)
ENDDO
DEALLOCATE(OpSchemeNames)
END IF
CurrentModuleObject ='CondenserEquipmentOperationSchemes'
NumCondOpSchemes = GetNumObjectsFound(CurrentModuleObject)
IF (NumCondOpSchemes > 0) THEN
! OpSchemeListNames is used to determine if there are any duplicate operation scheme names
ALLOCATE(OpSchemeNames(NumCondOpSchemes))
OpSchemeNames=' '
Num=0
DO OpNum=1,NumCondOpSchemes
CALL GetObjectItem(CurrentModuleObject,OpNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),OpSchemeNames,Num,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
CYCLE
ENDIF
Num=Num+1
OpSchemeNames(Num)=cAlphaArgs(1)
ENDDO
DEALLOCATE(OpSchemeNames)
END IF
!Load the Plant data structure
DO LoopNum = 1, TotNumLoops
PlantOpSchemeName = PlantLoop(LoopNum)%OperationScheme
IF(LoopNum .LE. NumPlantLoops) THEN
CurrentModuleObject = 'PlantEquipmentOperationSchemes'
PlantLoopObject='PlantLoop'
ELSE
CurrentModuleObject = 'CondenserEquipmentOperationSchemes'
PlantLoopObject='CondenserLoop'
END IF
OpNum=GetObjectItemNum(TRIM(CurrentModuleObject),PlantOpSchemeName)
IF (OpNum > 0) THEN
CALL GetObjectItem(CurrentModuleObject,OpNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, NumBlank=lNumericFieldBlanks, NumericFieldNames=cNumericFieldNames, &
AlphaBlank=lAlphaFieldBlanks,AlphaFieldNames=cAlphaFieldNames)
PlantLoop(LoopNum)%NumOpSchemes = (NumAlphas - 1)/3
IF (PlantLoop(LoopNum)%NumOpSchemes .GT. 0) THEN
ALLOCATE (PlantLoop(LoopNum)%OpScheme(PlantLoop(LoopNum)%NumOpSchemes))
DO Num = 1, PlantLoop(LoopNum)%NumOpSchemes
PlantLoop(LoopNum)%OpScheme(Num)%TypeOf = cAlphaArgs(Num*3-1)
SELECT CASE(PlantLoop(LoopNum)%OpScheme(Num)%TypeOf)
CASE ('LOAD RANGE BASED OPERATION') ! Deprecated
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=LoadRBOpSchemeType ! Deprecated
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(cAlphaArgs(1))//'" deprecated field value ="'// &
TRIM(PlantLoop(LoopNum)%OpScheme(Num)%TypeOf)//'".')
CALL ShowContinueError('... should be replaced with PlantEquipmentOperation:CoolingLoad or '// &
'PlantEquipmentOperation:HeatingLoad')
CASE ('PLANTEQUIPMENTOPERATION:COOLINGLOAD')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=CoolingRBOpSchemeType
CASE ('PLANTEQUIPMENTOPERATION:HEATINGLOAD')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=HeatingRBOpSchemeType
CASE ('PLANTEQUIPMENTOPERATION:COMPONENTSETPOINT') !* Temp Based Control
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=CompSetPtBasedSchemeType
CASE ('PLANTEQUIPMENTOPERATION:USERDEFINED')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=EMSOpSchemeType
AnyEMSPlantOpSchemesInModel = .TRUE.
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORDRYBULB')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=DrybulbRBOpSchemeType
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORWETBULB')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=WetBulbRBOpSchemeType
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORDEWPOINT')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=DewpointRBOpSchemeType
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORRELATIVEHUMIDITY')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=RelHumRBOpSchemeType
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORDRYBULBDIFFERENCE')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=DrybulbTDBOpSchemeType
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORWETBULBDIFFERENCE')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=WetBulbTDBOpSchemeType
CASE ('PLANTEQUIPMENTOPERATION:OUTDOORDEWPOINTDIFFERENCE')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=DewpointTDBOpSchemeType
CASE ('PLANTEQUIPMENTOPERATION:UNCONTROLLED')
PlantLoop(LoopNum)%OpScheme(Num)%OpSchemeType=UncontrolledOpSchemeType
CASE DEFAULT ! invalid op scheme type for plant loop
CALL ShowSevereError(RoutineName//'Invalid '//TRIM(cAlphaFieldNames(Num*3-1))//'='//TRIM(cAlphaArgs(Num*3-1))// &
', entered in '//TRIM(CurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END SELECT
PlantLoop(LoopNum)%OpScheme(Num)%Name = cAlphaArgs(Num*3)
PlantLoop(LoopNum)%OpScheme(Num)%Sched = cAlphaArgs(Num*3+1)
PlantLoop(LoopNum)%OpScheme(Num)%SchedPtr = GetScheduleIndex(PlantLoop(LoopNum)%OpScheme(Num)%Sched)
IF (PlantLoop(LoopNum)%OpScheme(Num)%SchedPtr == 0) THEN
CALL ShowSevereError(RoutineName//'Invalid '//TRIM(cAlphaFieldNames(Num*3+1))//' = "'//TRIM(cAlphaArgs(Num*3+1))// &
'", entered in '//TRIM(CurrentModuleObject)//'= "'//TRIM(cAlphaArgs(1))//'".')
Errorsfound=.true.
ENDIF
END DO
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(cAlphaArgs(1))// &
'", requires at least '//TRIM(cAlphaFieldNames(2))//', '//TRIM(cAlphaFieldNames(3))//&
' and '//TRIM(cAlphaFieldNames(4))//' to be specified.')
Errorsfound = .true.
ENDIF
ELSE
CALL ShowSevereError(RoutineName//TRIM(PlantLoopObject)//'='//TRIM(PlantLoop(LoopNum)%Name)//' is expecting')
CALL ShowContinueError(TRIM(CurrentModuleObject)//'='//TRIM(PlantOpSchemeName)//', but not found.')
Errorsfound = .true.
ENDIF
END DO
IF (Errorsfound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting input for PlantEquipmentOperationSchemes or '//&
'CondenserEquipmentOperationSchemes')
ENDIF
RETURN
END SUBROUTINE GetPlantOperationInput