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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | LoopNum | |||
logical, | intent(in) | :: | OkayToFinish |
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 SizePlantLoop(LoopNum, OkayToFinish)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN December 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing the supply side of Plant Loops for which loop flow rates
! have not been specified in the input.
! METHODOLOGY EMPLOYED:
! Obtains volumetric flow rate data from the PlantSizData array..
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE InputProcessor, ONLY: FindItemInList
USE General, ONLY: RoundSigDigits
USE PlantLoopEquip, ONLY : SimPlantEquip
USE FluidProperties, ONLY: GetDensityGlycol
USE ReportSizingManager, ONLY: ReportSizingOutput
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum ! Supply side loop being simulated
LOGICAL, INTENT(IN) :: OkayToFinish
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PlantSizNum ! index of Plant Sizing data for this loop
INTEGER :: BranchNum ! DO loop counter for cycling through branches on a demand side loop
INTEGER :: CompNum ! DO loop counter for cycling through components on a demand side loop
INTEGER :: SupNodeNum ! component inlet water node number
INTEGER :: WaterCompNum ! DO loop counter for cycling through all the components that demand water
LOGICAL :: ErrorsFound ! If errors detected in input
LOGICAL :: InitLoopEquip
LOGICAL :: SimNestedLoop
LOGICAL :: ReSize
LOGICAL :: AllSizFac
REAL(r64) :: LoopSizFac
REAL(r64) :: AvLoopSizFac
REAL(r64) :: PlantSizFac
REAL(r64) :: MaxSizFac
REAL(r64) :: BranchSizFac
REAL(r64) :: NumBrSizFac
REAL(r64) :: FluidDensity ! local value from glycol routine
LOGICAL :: Finalize
Finalize = OkayToFinish
PlantSizNum = 0
ErrorsFound = .FALSE.
LoopSizFac = 0.0d0
! InitLoopEquip = .FALSE.
InitLoopEquip = .TRUE.
SimNestedLoop = .FALSE.
AllSizFac = .TRUE.
GetCompSizFac = .TRUE.
MaxSizFac = 0.0d0
PlantSizFac = 1.0d0
NumBrSizFac = 0.0d0
ReSize = .FALSE.
IF (PlantLoop(LoopNum)%PlantSizNum > 0) THEN
ReSize = .TRUE.
PlantSizNum = PlantLoop(LoopNum)%PlantSizNum
! PlantSizData(PlantSizNum)%DesVolFlowRate = 0.0D0 ! DSU2
ELSE
IF (NumPltSizInput > 0) THEN
PlantSizNum = FindItemInList(PlantLoop(LoopNum)%Name,PlantSizData%PlantLoopName,NumPltSizInput)
END IF
END IF
PlantLoop(LoopNum)%PlantSizNum = PlantSizNum
! calculate a loop sizing factor and a branch sizing factor. Note that components without a sizing factor
! are assigned sizing factors of zero in this calculation
IF (PlantSizNum > 0) THEN
DO BranchNum= 1, PlantLoop(LoopNum)%LoopSide(SupplySide)%TotalBranches
BranchSizFac = 0.0d0
PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%PumpSizFac = 1.0d0
IF (PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumIn == &
PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%NodeNumIn) CYCLE
IF (PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumOut == &
PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%NodeNumOut) CYCLE
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%TotalComponents
CALL SimPlantEquip(LoopNum,SupplySide,BranchNum,CompNum,.TRUE.,InitLoopEquip, GetCompSizFac)
BranchSizFac = MAX(BranchSizFac , PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%Comp(CompNum)%SizFac)
END DO
LoopSizFac = LoopSizFac + BranchSizFac
MaxSizFac = MAX(MaxSizFac, BranchSizFac)
IF (BranchSizFac > 0.0d0) THEN
PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%PumpSizFac = BranchSizFac
NumBrSizFac = NumBrSizFac + 1.0d0
ELSE
AllSizFac = .FALSE.
END IF
END DO
AvLoopSizFac = LoopSizFac / MAX(1.0d0, NumBrSizFac)
! sum up contributions from CompDesWaterFlow
PlantSizData(PlantSizNum)%DesVolFlowRate = 0.d0 ! init for summation
DO BranchNum = 1, PlantLoop(LoopNum)%LoopSide(DemandSide)%TotalBranches
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(DemandSide)%Branch(BranchNum)%TotalComponents
SupNodeNum = PlantLoop(LoopNum)%LoopSide(DemandSide)%Branch(BranchNum)%Comp(CompNum)%NodeNumIn
DO WaterCompNum=1,SaveNumPlantComps
IF (SupNodeNum == CompDesWaterFlow(WaterCompNum)%SupNode) THEN
PlantSizData(PlantSizNum)%DesVolFlowRate = PlantSizData(PlantSizNum)%DesVolFlowRate + &
CompDesWaterFlow(WaterCompNum)%DesVolFlowRate
END IF
END DO
END DO
END DO
IF (PlantLoop(LoopNum)%MaxVolFlowRate .NE. AutoSize .AND. .NOT. ReSize) THEN
PlantSizData(PlantSizNum)%DesVolFlowRate = PlantLoop(LoopNum)%MaxVolFlowRate
ELSE IF (AvLoopSizFac > 0.0d0 .AND. AvLoopSizFac < 1.0d0) THEN
PlantSizFac = LoopSizFac
ELSE IF (AvLoopSizFac > 1.0d0) THEN
PlantSizFac = MaxSizFac
ELSE
PlantSizFac = 1.0d0
END IF
DO BranchNum= 1, PlantLoop(LoopNum)%LoopSide(SupplySide)%TotalBranches
IF (PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumIn == &
PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%NodeNumIn) THEN
PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%PumpSizFac = PlantSizFac
END IF
IF (PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumOut == &
PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%NodeNumOut) THEN
PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%PumpSizFac = PlantSizFac
END IF
END DO
END IF
IF (PlantLoop(LoopNum)%MaxVolFlowRate == AutoSize) THEN
IF ((PlantSizNum > 0) ) THEN
IF (PlantSizData(PlantSizNum)%VolFlowSizingDone) THEN
IF (PlantSizData(PlantSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
PlantLoop(LoopNum)%MaxVolFlowRate = PlantSizData(PlantSizNum)%DesVolFlowRate * PlantSizFac
ELSE
PlantLoop(LoopNum)%MaxVolFlowRate = 0.0d0
CALL ShowWarningError('SizePlantLoop: Calculated Plant Sizing Design Volume Flow Rate=['// &
TRIM(RoundSigDigits(PlantSizData(PlantSizNum)%DesVolFlowRate, 2))//'] is too small. Set to 0.0')
CALL ShowContinueError('..occurs for PlantLoop='//TRIM(PlantLoop(LoopNum)%Name))
END IF
IF (Finalize) THEN
IF (PlantLoop(LoopNum)%TypeOfLoop == LoopType_Plant) THEN
CALL ReportSizingOutput('PlantLoop',PlantLoop(LoopNum)%Name,&
'Maximum Loop Flow Rate [m3/s]',PlantLoop(LoopNum)%MaxVolFlowRate)
ELSEIF (PlantLoop(LoopNum)%TypeOfLoop == LoopType_Condenser) Then
CALL ReportSizingOutput('CondenserLoop',PlantLoop(LoopNum)%Name,&
'Maximum Loop Flow Rate [m3/s]',PlantLoop(LoopNum)%MaxVolFlowRate)
ENDIF
ENDIF
ENDIF
ELSE
CALL ShowFatalError('Autosizing of plant loop requires a loop Sizing:Plant object')
CALL ShowContinueError('Occurs in PlantLoop object='//TRIM(PlantLoop(LoopNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
IF (.NOT. Finalize) THEN
GetCompSizFac = .FALSE.
RETURN
ENDIF
! Small loop mass no longer introduces instability. Checks and warnings removed by SJR 20 July 2007.
IF (PlantLoop(LoopNum)%Volume == AutoCalculate) THEN
! Although there is no longer a stability requirement (mass can be zero), autosizing is formulated the same way.
PlantLoop(LoopNum)%Volume = PlantLoop(LoopNum)%MaxVolFlowRate*TimeStepZone*SecInHour/0.8d0
IF (PlantLoop(LoopNum)%TypeOfLoop == LoopType_Plant) THEN
! condenser loop vs plant loop breakout needed.
CALL ReportSizingOutput('PlantLoop', PlantLoop(LoopNum)%Name,'Plant Loop Volume [m3]', PlantLoop(LoopNum)%Volume)
ELSEIF (PlantLoop(LoopNum)%TypeOfLoop == LoopType_Condenser) THEN
CALL ReportSizingOutput('CondenserLoop', PlantLoop(LoopNum)%Name,'Condenser Loop Volume [m3]', PlantLoop(LoopNum)%Volume)
ENDIF
END IF
!should now have plant volume, calculate plant volume's mass for fluid type
IF (PlantLoop(LoopNum)%FluidType==NodeType_Water) THEN
FluidDensity = GetDensityGlycol(PlantLoop(LoopNum)%FluidName, InitConvTemp,PlantLoop(LoopNum)%FluidIndex,'SizePlantLoop')
ELSEIF (PlantLoop(LoopNum)%FluidType==NodeType_Steam) THEN
FluidDensity = GetSatDensityRefrig('STEAM',100.0d0,1.0d0,PlantLoop(LoopNum)%FluidIndex,'SizePlantLoop')
END IF
PlantLoop(LoopNum)%Mass = PlantLoop(LoopNum)%Volume * FluidDensity
PlantLoop(LoopNum)%MaxMassFlowRate = PlantLoop(LoopNum)%MaxVolFlowRate * FluidDensity
PlantLoop(LoopNum)%MinMassFlowRate = PlantLoop(LoopNum)%MinVolFlowRate * FluidDensity
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding sizing errors cause program termination')
END IF
GetCompSizFac = .FALSE.
RETURN
END SUBROUTINE SizePlantLoop