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.
SUBROUTINE GetPlantLoopData
! SUBROUTINE INFORMATION:
! AUTHOR Sankaranarayanan K P
! DATE WRITTEN April 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reads the primary plant loop
! attributes from the input file
! METHODOLOGY EMPLOYED:
! calls the Input Processor to retrieve data from input file.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, GetObjectItemNum, VerifyName,SameString, FindItemInList
USE DataIPShortCuts ! Data for field names, blank numerics
USE ScheduleManager, ONLY: GetScheduleIndex
USE SetPointManager, ONLY: IsNodeOnSetPtManager, TempSetPt=>iCtrlVarType_Temp
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchInputManager
USE DataSizing, ONLY: Autosize
USE SystemAvailabilityManager, ONLY: GetPlantAvailabilityManager
USE FluidProperties, ONLY: CheckFluidPropertyName, FindGlycol
USE General, ONLY: RoundSigDigits
USE DataConvergParams, ONLY: PlantConvergence
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetPlant/CondenserLoopData: '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: LoopNum ! DO loop counter for loops
INTEGER :: PressSimLoop !DO loop counter for pressure simulation type
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
INTEGER :: NumFluids ! number of fluids in sim
INTEGER :: PlantLoopNum
INTEGER :: CondLoopNum
CHARACTER(len=MaxNameLength),DIMENSION(18) :: Alpha !dimension to num of alpha fields in input
REAL(r64), DIMENSION(30) :: Num !dimension to num of numeric data fields in input
LOGICAL :: ErrorsFound=.false.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
CHARACTER(len=MaxNameLength) :: LoadingScheme
LOGICAL :: ErrFound
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in renaming.
LOGICAL :: MatchedPressureString
INTEGER :: PressSimAlphaIndex
! INTEGER :: OpSchemeFound
! FLOW:
CurrentModuleObject = 'PlantLoop'
NumPlantLoops = GetNumObjectsFound(CurrentModuleObject) ! Get the number of primary plant loops
CurrentModuleObject = 'CondenserLoop'
NumCondLoops = GetNumObjectsFound(CurrentModuleObject) ! Get the number of Condenser loops
TotNumLoops = NumPlantLoops + NumCondLoops
ErrFound=.false.
IF (TotNumLoops > 0) THEN
ALLOCATE(PlantLoop(TotNumLoops))
ALLOCATE(PlantConvergence(TotNumLoops))
IF (.not. ALLOCATED(PlantAvailMgr)) THEN
ALLOCATE(PlantAvailMgr(TotNumLoops))
ENDIF
ELSE
RETURN
END IF
DO LoopNum = 1, TotNumLoops
Alpha=''
Num=0.0d0
ALLOCATE(PlantLoop(LoopNum)%LoopSide(SupplySide))
IF(LoopNum .LE. NumPlantLoops) THEN
PlantLoopNum = LoopNum
PlantLoop(LoopNum)%TypeofLoop = Plant
CurrentModuleObject = 'PlantLoop'
CALL GetObjectItem(CurrentModuleObject,PlantLoopNum,Alpha,NumAlphas,Num,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks, &
NumBlank=lNumericFieldBlanks,AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ELSE
CondLoopNum = LoopNum-NumPlantLoops
PlantLoop(LoopNum)%TypeofLoop = Condenser
CurrentModuleObject = 'CondenserLoop'
CALL GetObjectItem(CurrentModuleObject,CondLoopNum,Alpha,NumAlphas,Num,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
END IF
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alpha(1),PlantLoop%Name,LoopNum-1,IsNotOK,IsBlank, TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alpha(1)='xxxxx'
END IF
PlantLoop(LoopNum)%Name = Alpha(1) ! Load the Plant Loop Name
IF (Alpha(2) == 'STEAM') THEN
PlantLoop(LoopNum)%FluidType = NodeType_Steam
PlantLoop(LoopNum)%FluidName = Alpha(2)
ELSEIF (Alpha(2) == 'WATER') THEN
PlantLoop(LoopNum)%FluidType = NodeType_Water
PlantLoop(LoopNum)%FluidName = Alpha(2)
PlantLoop(LoopNum)%FluidIndex = FindGlycol(Alpha(2))
ELSEIF (Alpha(2) == 'USERDEFINEDFLUIDTYPE') THEN
PlantLoop(LoopNum)%FluidType = NodeType_Water
PlantLoop(LoopNum)%FluidName = Alpha(3)
! check for valid fluid name
NumFluids = CheckFluidPropertyName(Alpha(3))
IF (NumFluids == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", missing fluid data for Plant loop.' )
ErrorsFound=.true.
ELSE
PlantLoop(LoopNum)%FluidIndex =FindGlycol(Alpha(3))
IF (PlantLoop(LoopNum)%FluidIndex == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", invalid glycol fluid data for Plant loop.' )
ErrorsFound=.true.
ENDIF
ENDIF
ELSE
CALL ShowWarningError('Input error: '//TRIM(cAlphaFieldNames(2))// '='//TRIM(Alpha(2))// &
'entered, in '//TRIM(CurrentModuleObject)//'='//TRIM(Alpha(1)))
CALL ShowContinueError('Will default to Water.')
PlantLoop(LoopNum)%FluidType = NodeType_Water
PlantLoop(LoopNum)%FluidName = 'WATER'
PlantLoop(LoopNum)%FluidIndex = FindGlycol('WATER')
ENDIF
PlantLoop(LoopNum)%OperationScheme = Alpha(4) ! Load the Plant Control Scheme Priority List
! Check to make sure not used previously.
! IF(LoopNum .LE. NumPlantLoops) THEN
! IF (LoopNum-1 > 0) THEN
! OpSchemeFound=FindItemInList(Alpha(4),PlantLoop(1:LoopNum-1)%OperationScheme,LoopNum-1)
! ELSE
! OpSchemeFound=0
! ENDIF
! IF (OpSchemeFound > 0) THEN
! CALL ShowSevereError(RoutineName//'PlantLoop="'//trim(PlantLoop(LoopNum)%Name)//'", OperationScheme already used.')
! CALL ShowContinueError('...'//trim(cAlphaFieldNames(4))//'="'//trim(Alpha(4))//'" used previously in PlantLoop='// &
! trim(PlantLoop(OpSchemeFound)%Name)//'".')
! ErrorsFound=.true.
! ENDIF
! ELSE ! Condenser Loop
! IF (LoopNum-1 > NumPlantLoops) THEN
! OpSchemeFound=FindItemInList(Alpha(4),PlantLoop(NumPlantLoops+1:LoopNum-1)%OperationScheme,CondLoopNum-1)
! ELSE
! OpSchemeFound=0
! ENDIF
! IF (OpSchemeFound > 0) THEN
! CALL ShowSevereError(RoutineName//'CondenserLoop="'//trim(PlantLoop(LoopNum)%Name)//'", OperationScheme already used.')
! CALL ShowContinueError('...'//trim(cAlphaFieldNames(4))//'="'//trim(Alpha(4))//'" used previously in CondenserLoop='// &
! trim(PlantLoop(OpSchemeFound)%Name)//'".')
! ErrorsFound=.true.
! ENDIF
! ENDIF
! Load the temperature and flow rate maximum and minimum limits
PlantLoop(LoopNum)%MaxTemp = Num(1)
PlantLoop(LoopNum)%MinTemp = Num(2)
PlantLoop(LoopNum)%MaxVolFlowRate = Num(3)
PlantLoop(LoopNum)%MinVolFlowRate = Num(4)
!The Plant loop volume for both halves of the loop is read in and used in this module for the
! correct loop temperature step. Loop data is read in supply side, but the volume is not used in
! a calculation there.
PlantLoop(LoopNum)%Volume = Num(5)
IF (lNumericFieldBlanks(5)) PlantLoop(LoopNum)%Volume = AutoCalculate
! Load the Loop Inlet and Outlet Nodes and Connection Info (Alpha(7-10) are related to the supply side)
PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNameIn = Alpha(6)
PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNameOut= Alpha(7)
PlantLoop(LoopNum)%LoopSide(SupplySide)%BranchList = Alpha(8)
PlantLoop(LoopNum)%LoopSide(SupplySide)%ConnectList= Alpha(9)
PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNameIn = Alpha(10)
PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNameOut= Alpha(11)
PlantLoop(LoopNum)%LoopSide(DemandSide)%BranchList = Alpha(12)
PlantLoop(LoopNum)%LoopSide(DemandSide)%ConnectList= Alpha(13)
PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumIn = &
GetOnlySingleNode(Alpha(6),ErrorsFound,TRIM(CurrentModuleObject),Alpha(1), &
PlantLoop(LoopNum)%FluidType,NodeConnectionType_Inlet, 1, ObjectIsParent)
PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumOut = &
GetOnlySingleNode(Alpha(7),ErrorsFound,TRIM(CurrentModuleObject),Alpha(1), &
PlantLoop(LoopNum)%FluidType,NodeConnectionType_Outlet, 1, ObjectIsParent)
PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumIn = &
GetOnlySingleNode(Alpha(10),ErrorsFound,TRIM(CurrentModuleObject),Alpha(1), &
PlantLoop(LoopNum)%FluidType,NodeConnectionType_Inlet, 1, ObjectIsParent)
PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumOut = &
GetOnlySingleNode(Alpha(11),ErrorsFound,TRIM(CurrentModuleObject),Alpha(1), &
PlantLoop(LoopNum)%FluidType,NodeConnectionType_Outlet, 1, ObjectIsParent)
PlantLoop(LoopNum)%Loopside(DemandSide)%InletNodeSetPt = &
IsNodeOnSetPtManager(PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumIn,TempSetPt)
PlantLoop(LoopNum)%Loopside(DemandSide)%OutletNodeSetPt = &
IsNodeOnSetPtManager(PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumOut,TempSetPt)
PlantLoop(LoopNum)%Loopside(SupplySide)%InletNodeSetPt = &
IsNodeOnSetPtManager(PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumIn,TempSetPt)
PlantLoop(LoopNum)%Loopside(SupplySide)%OutletNodeSetPt = &
IsNodeOnSetPtManager(PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumOut,TempSetPt)
PlantLoop(LoopNum)%TempSetPointNodeNum = &
GetOnlySingleNode(Alpha(5),ErrorsFound,TRIM(CurrentModuleObject),Alpha(1), &
PlantLoop(LoopNum)%FluidType,NodeConnectionType_Sensor, 1, ObjectIsParent)
! Load the load distribution scheme.
LoadingScheme = Alpha(14)
IF (SameString(LoadingScheme,'Optimal')) THEN
PlantLoop(LoopNum)%LoadDistribution = OptimalLoading
ELSE IF (Samestring(LoadingScheme,'Sequential')) THEN
PlantLoop(LoopNum)%LoadDistribution = SequentialLoading
ELSE IF (Samestring(LoadingScheme,'Uniform')) THEN
PlantLoop(LoopNum)%LoadDistribution = UniformLoading
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid choice.')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(14))// '="'//TRIM(Alpha(14))//'".')
CALL ShowContinueError('Will default to SequentialLoading.') ! TODO rename point
PlantLoop(LoopNum)%LoadDistribution = SequentialLoading
END IF
!When dual setpoint is allowed in condenser loop modify this code. Sankar 06/29/2009
IF(PlantLoop(LoopNum)%TypeOfLoop == Plant) THEN
! Get the Loop Demand Calculation Scheme
IF (SameString(Alpha(16),'SingleSetpoint')) THEN
PlantLoop(LoopNum)%LoopDemandCalcScheme = SingleSetPoint
ELSE IF (Samestring(Alpha(16),'DualSetpointDeadband')) THEN
IF (PlantLoop(LoopNum)%FluidType == NodeType_Steam) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid choice.')
CALL ShowContinueError(TRIM(cAlphaFieldNames(16))//'="'//TRIM(Alpha(16))// &
'" not valid for '//TRIM(cAlphaFieldNames(2))// '= Steam')
CALL ShowContinueError('Will reset '//TRIM(cAlphaFieldNames(16))// ' = SingleSetPoint and simulation will continue.')
PlantLoop(LoopNum)%LoopDemandCalcScheme = SingleSetPoint
ELSE
PlantLoop(LoopNum)%LoopDemandCalcScheme = DualSetPointDeadBand
END IF
ELSE IF (Samestring(Alpha(16),'')) THEN
PlantLoop(LoopNum)%LoopDemandCalcScheme = SingleSetPoint
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid choice.')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(16))//'="'//TRIM(Alpha(16))//'".')
CALL ShowContinueError('Will default to SingleSetPoint.') ! TODO rename point
PlantLoop(LoopNum)%LoopDemandCalcScheme = SingleSetPoint
END IF
ELSE IF(PlantLoop(LoopNum)%TypeOfLoop == Condenser) THEN
PlantLoop(LoopNum)%LoopDemandCalcScheme = SingleSetPoint
END IF
!When Commonpipe is allowed in condenser loop modify this code. Sankar 06/29/2009
IF(PlantLoop(LoopNum)%TypeOfLoop == Plant) THEN
IF(SameString(Alpha(17),'CommonPipe')) THEN
PlantLoop(LoopNum)%CommonPipeType = CommonPipe_Single
ELSE IF(SameString(Alpha(17),'TwoWayCommonPipe')) THEN
PlantLoop(LoopNum)%CommonPipeType = CommonPipe_TwoWay
ELSE IF(SameString(Alpha(17),'None') .OR. lAlphaFieldBlanks(17)) THEN
PlantLoop(LoopNum)%CommonPipeType = CommonPipe_No
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid choice.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(17))//'="'//TRIM(Alpha(17))//'".')
CALL ShowContinueError('Refer to I/O reference document for more details.')
ErrorsFound=.true.
END IF
ELSE IF(PlantLoop(LoopNum)%TypeOfLoop == Condenser) THEN
PlantLoop(LoopNum)%CommonPipeType = CommonPipe_No
END IF
IF(PlantLoop(LoopNum)%CommonPipeType == CommonPipe_TwoWay)THEN
IF(PlantLoop(LoopNum)%Loopside(DemandSide)%InletNodeSetPt .AND. &
PlantLoop(LoopNum)%Loopside(SupplySide)%InletNodeSetPt) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid condition.')
CALL ShowContinueError('While using a two way common pipe there can be setpoint on only one node other '// &
'than Plant Supply Outlet node.')
CALL ShowContinueError('Currently both Plant Demand inlet and plant supply inlet have setpoints.')
CALL ShowContinueError('Select one of the two nodes and rerun the simulation.')
ErrorsFound=.true.
END IF
IF(.NOT. PlantLoop(LoopNum)%Loopside(DemandSide)%InletNodeSetPt .AND. &
.NOT. PlantLoop(LoopNum)%Loopside(SupplySide)%InletNodeSetPt) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid condition.')
CALL ShowContinueError('While using a two way common pipe there must be a setpoint in addition to '// &
'the Plant Supply Outlet node.')
CALL ShowContinueError('Currently neither plant demand inlet nor plant supply inlet have setpoints.')
CALL ShowContinueError('Select one of the two nodes and rerun the simulation.')
ErrorsFound=.true.
END IF
END IF
!Pressure Simulation Type Input
!First set the alpha index in the object as it is different for plant/condenser
!When CommonPipe, etc., is allowed in condenser loop, modify this code. Edwin/Sankar 08/12/2009
IF(PlantLoop(LoopNum)%TypeOfLoop == Plant) THEN
PressSimAlphaIndex = 18
ELSE
PressSimAlphaIndex = 15
ENDIF
IF(NumAlphas .GE. PressSimAlphaIndex)THEN
MatchedPressureString = .FALSE.
!Check all types
DO PressSimLoop = 1, 4
IF (SameString(Alpha(PressSimAlphaIndex),PressureSimType(PressSimLoop))) THEN
PlantLoop(LoopNum)%PressureSimType = PressSimLoop
MatchedPressureString = .TRUE.
EXIT
ENDIF
ENDDO
!If we found a match, check to make sure it is one of the valid
! ones for this phase of pressure implementation
IF (MatchedPressureString) THEN
IF ( (PlantLoop(LoopNum)%PressureSimType == Press_NoPressure) .OR. &
(PlantLoop(LoopNum)%PressureSimType == Press_PumpPowerCorrection) .OR. &
(PlantLoop(LoopNum)%PressureSimType == Press_FlowCorrection) ) THEN
!We are OK here, move on
ELSE
!We have an erroneous input, alert user
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid choice.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(PressSimAlphaIndex))//'="'// &
TRIM(Alpha(PressSimAlphaIndex))//'".')
CALL ShowContinueError('Currently only options are: ')
CALL ShowContinueError(' - '//PressureSimType(Press_NoPressure))
CALL ShowContinueError(' - '//PressureSimType(Press_PumpPowerCorrection))
CALL ShowContinueError(' - '//PressureSimType(Press_FlowCorrection))
ErrorsFound=.TRUE.
ENDIF
ENDIF
!if we made it this far and didn't get a match, check for blank
IF (.NOT. MatchedPressureString) THEN
IF (TRIM(Alpha(PressSimAlphaIndex)) .EQ. '') THEN
PlantLoop(LoopNum)%PressureSimType = Press_NoPressure
MatchedPressureString = .TRUE.
EXIT
ENDIF
ENDIF
!if we made it this far, there was no match, and it wasn't blank
IF (.NOT. MatchedPressureString) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid condition.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(PressSimAlphaIndex))//'="'//TRIM(Alpha(PressSimAlphaIndex))//'".')
ErrorsFound=.TRUE.
ENDIF
ENDIF
ErrFound=.false.
IF(PlantLoop(LoopNum)%TypeOfLoop == Plant) THEN
CALL GetPlantAvailabilityManager(Alpha(15),LoopNum,TotNumLoops,ErrFound)
END IF
IF (ErrFound) THEN
CALL ShowContinueError('Input errors in '//TRIM(CurrentModuleObject)//'='//TRIM(Alpha(1)))
ErrorsFound=.true.
ENDIF
IF (GetFirstBranchInletNodeName(PlantLoop(LoopNum)%LoopSide(DemandSide)%BranchList) &
/= PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNameIn) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid condition.')
CALL ShowContinueError('The inlet node of the first branch in the '//TRIM(cAlphaFieldNames(12))//'='// &
TRIM(Alpha(12)) ) !"Plant Demand Side Branch List"
CALL ShowContinueError('is not the same as the '//TRIM(cAlphaFieldNames(10))//'='// &
TRIM(Alpha(10)) ) ! "Plant Demand Side Inlet Node Name"
CALL ShowContinueError('Branch List Inlet Node Name='// & ! TODO rename point
TRIM(GetFirstBranchInletNodeName(PlantLoop(LoopNum)%LoopSide(DemandSide)%BranchList)))
CALL ShowContinueError('Branches in a BRANCH LIST must be listed in flow order: '// &
'inlet branch, then parallel branches, then outlet branch.') ! TODO rename point
ErrorsFound=.true.
ENDIF
IF (GetLastBranchOutletNodeName(PlantLoop(LoopNum)%LoopSide(DemandSide)%BranchList) &
/= PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNameOut) THEN
!"Plant Demand Side Branch List"
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid condition.')
CALL ShowContinueError('The outlet node of the last branch in the '//TRIM(cAlphaFieldNames(12))//'='// &
TRIM(Alpha(12)) )
!"Plant Demand Side Outlet Node Name"
CALL ShowContinueError('is not the same as the '//TRIM(cAlphaFieldNames(11))//'='// &
TRIM(alpha(11)) )
CALL ShowContinueError('Branch List Outlet Node Name='// & ! TODO rename point
TRIM(GetLastBranchOutletNodeName(PlantLoop(LoopNum)%LoopSide(DemandSide)%BranchList)))
! TODO rename point
CALL ShowContinueError('Branches in a BRANCH LIST must be listed in flow order: inlet branch, then parallel branches, '// &
'then outlet branch.')
ErrorsFound=.true.
ENDIF
IF (GetFirstBranchInletNodeName(PlantLoop(LoopNum)%LoopSide(SupplySide)%BranchList) &
/= PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNameIn) THEN
!"Plant Supply Side Branch List"
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid condition.')
CALL ShowContinueError('The inlet node of the first branch in the '//TRIM(cAlphaFieldNames(8))//'='// &
TRIM(Alpha(8)) )
!"Plant Supply Side Inlet Node Name
CALL ShowContinueError('is not the same as the '//TRIM(cAlphaFieldNames(6))// '='// &
TRIM(Alpha(6)) )
CALL ShowContinueError('Branch List Inlet Node Name='// & ! TODO rename point
TRIM(GetFirstBranchInletNodeName(PlantLoop(LoopNum)%LoopSide(SupplySide)%BranchList)))
! TODO rename point
CALL ShowContinueError('Branches in a BRANCH LIST must be listed in flow order: inlet branch, then parallel branches, '// &
'then outlet branch.')
ErrorsFound=.true.
ENDIF
IF (GetLastBranchOutletNodeName(PlantLoop(LoopNum)%LoopSide(SupplySide)%BranchList) &
/= PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNameOut) THEN
!"Plant Supply Side Branch List"
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alpha(1))//'", Invalid condition.')
CALL ShowContinueError('The outlet node of the last branch in the '//TRIM(cAlphaFieldNames(8))//'='// &
TRIM(Alpha(8)) )
!"Plant Supply Side Outlet Node Name"
CALL ShowContinueError('is not the same as the '//TRIM(cAlphaFieldNames(7))//'='// &
TRIM(alpha(7)) )
CALL ShowContinueError('Branch List Outlet Node Name='// & ! TODO rename point
TRIM(GetLastBranchOutletNodeName(PlantLoop(LoopNum)%LoopSide(SupplySide)%BranchList)))
! TODO rename point
CALL ShowContinueError('Branches in a BRANCH LIST must be listed in flow order: inlet branch, then parallel branches, '// &
'then outlet branch.')
ErrorsFound=.true.
ENDIF
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in processing input. Preceding conditions cause termination.')
ENDIF
! set up loop status (set by system availability managers) report variables
! Condenser loop does not have availability manager yet. Once implemented, move the setup output variable to
! outside the IF statement.
DO LoopNum = 1, TotNumLoops
CALL SetupOutputVariable('Plant System Cycle On Off Status []', PlantAvailMgr(LoopNum)%AvailStatus, &
'Plant','Average', PlantLoop(LoopNum)%Name)
END DO
RETURN
END SUBROUTINE GetPlantLoopData