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 GetPlantProfileInput
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN January 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets the plant load profile input from the input file and sets up the objects.
! METHODOLOGY EMPLOYED:
! Standard EnergyPlus methodology.
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString
USE ScheduleManager, ONLY: GetScheduleIndex
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
USE DataInterfaces, ONLY: SetupEMSActuator
USE DataLoopNode
USE DataIPShortCuts ! Data for field names, blank numerics
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: ErrorsFound = .FALSE. ! Set to true if errors in input, fatal at end of routine
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: IsBlank ! TRUE if the name is blank
LOGICAL :: IsNotOk ! TRUE if there was a problem with a list name
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: ProfileNum ! PLANT LOAD PROFILE (PlantProfile) object number
! CHARACTER(len=MaxNameLength) :: FoundBranchName
! INTEGER :: BranchControlType
! FLOW:
cCurrentModuleObject = 'LoadProfile:Plant'
NumOfPlantProfile = GetNumObjectsFound(cCurrentModuleObject)
IF (NumOfPlantProfile > 0) THEN
ALLOCATE(PlantProfile(NumOfPlantProfile))
DO ProfileNum = 1, NumOfPlantProfile
CALL GetObjectItem(cCurrentModuleObject,ProfileNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
NumBlank=lNumericFieldBlanks,AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! PlantProfile name
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1),PlantProfile%Name,ProfileNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject))
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
PlantProfile(ProfileNum)%Name = cAlphaArgs(1)
PlantProfile(ProfileNum)%TypeNum = TypeOf_PlantLoadProfile ! parameter assigned in DataPlant !DSU
PlantProfile(ProfileNum)%InletNode = GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
PlantProfile(ProfileNum)%OutletNode = GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
PlantProfile(ProfileNum)%LoadSchedule = GetScheduleIndex(cAlphaArgs(4))
IF (PlantProfile(ProfileNum)%LoadSchedule == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" The Schedule for '//Trim(cAlphaFieldNames(4))//' called '//Trim(cAlphaArgs(4))//' was not found.')
ErrorsFound = .TRUE.
END IF
PlantProfile(ProfileNum)%PeakVolFlowRate = rNumericArgs(1)
PlantProfile(ProfileNum)%FlowRateFracSchedule = GetScheduleIndex(cAlphaArgs(5))
IF (PlantProfile(ProfileNum)%FlowRateFracSchedule == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" The Schedule for '//Trim(cAlphaFieldNames(5))//' called '//Trim(cAlphaArgs(5))//' was not found.')
ErrorsFound = .TRUE.
END IF
! Check plant connections
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3),TRIM(cCurrentModuleObject)//' Nodes')
! Setup report variables
CALL SetupOutputVariable('Plant Load Profile Mass Flow Rate [kg/s]', PlantProfile(ProfileNum)%MassFlowRate, &
'System','Average',PlantProfile(ProfileNum)%Name)
CALL SetupOutputVariable('Plant Load Profile Heat Transfer Rate [W]', PlantProfile(ProfileNum)%Power, &
'System','Average',PlantProfile(ProfileNum)%Name)
CALL SetupOutputVariable('Plant Load Profile Heat Transfer Energy [J]', PlantProfile(ProfileNum)%Energy, &
'System','Sum',PlantProfile(ProfileNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='Heating',GroupKey='Plant') ! is EndUseKey right?
CALL SetupOutputVariable('Plant Load Profile Heating Energy [J]', PlantProfile(ProfileNum)%HeatingEnergy, &
'System','Sum',PlantProfile(ProfileNum)%Name, &
ResourceTypeKey='PLANTLOOPHEATINGDEMAND',EndUseKey='Heating',GroupKey='Plant')
CALL SetupOutputVariable('Plant Load Profile Cooling Energy [J]', PlantProfile(ProfileNum)%CoolingEnergy, &
'System','Sum',PlantProfile(ProfileNum)%Name, &
ResourceTypeKey='PLANTLOOPCOOLINGDEMAND',EndUseKey='Cooling',GroupKey='Plant')
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSActuator('Plant Load Profile', PlantProfile(ProfileNum)%Name, 'Mass Flow Rate' , '[kg/s]', &
PlantProfile(ProfileNum)%EMSOverrideMassFlow, PlantProfile(ProfileNum)%EMSMassFlowValue )
CALL SetupEMSActuator('Plant Load Profile', PlantProfile(ProfileNum)%Name, 'Power' , '[W]', &
PlantProfile(ProfileNum)%EMSOverridePower, PlantProfile(ProfileNum)%EMSPowerValue )
ENDIF
IF (ErrorsFound) CALL ShowFatalError('Errors in '//TRIM(cCurrentModuleObject)//' input.')
END DO ! ProfileNum
END IF
RETURN
END SUBROUTINE GetPlantProfileInput