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.
Type | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|
real | :: | PipeSetupFinished = .TRUE. |
SUBROUTINE SetupCommonPipes
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN Jan. 2010
! MODIFIED B. Griffith Oct. 2011
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! collect allocation, outputs, and other set up for common pipes
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPlant
USE DataInterfaces
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: CurLoopNum ! local do loop counter
ALLOCATE(PlantCommonPipe(TotNumLoops))
DO CurLoopNum = 1, TotNumLoops
SELECT CASE (PlantLoop(CurLoopNum)%CommonPipeType)
CASE (CommonPipe_No)
PlantCommonPipe(CurLoopNum)%CommonPipeType = CommonPipe_No
CASE (CommonPipe_Single)!Uncontrolled ('single') common pipe
PlantCommonPipe(CurLoopNum)%CommonPipeType = CommonPipe_Single
CALL SetupOutputVariable('Plant Common Pipe Mass Flow Rate [Kg/s]', &
PlantCommonPipe(CurLoopNum)%Flow,'System','Average',PlantLoop(CurLoopNum)%Name)
CALL SetupOutputVariable('Plant Common Pipe Temperature [C]', &
PlantCommonPipe(CurLoopNum)%Temp,'System','Average',PlantLoop(CurLoopNum)%Name)
CALL SetupOutputVariable('Plant Common Pipe Flow Direction Status []', &
PlantCommonPipe(CurLoopNum)%FlowDir,'System','Average',PlantLoop(CurLoopNum)%Name)
IF (PlantLoop(CurLoopNum)%LoopSide(SupplySide)%Branch(1)%Comp(1)%TypeOf_Num == TypeOf_PumpVariableSpeed) THEN
! If/when the model supports variable-pumping primary, this can be removed.
CALL ShowWarningError('SetupCommonPipes: detected variable speed pump on supply inlet of CommonPipe plant loop')
CALL ShowContinueError('Occurs on plant loop name = '//TRIM(PlantLoop(CurLoopNum)%Name) )
CALL ShowContinueError('The common pipe model does not support varying the flow rate on the primary/supply side')
CALL ShowContinueError('The primary/supply side will operate as if constant speed, and the simulation continues')
ENDIF
CASE (CommonPipe_TwoWay)!Controlled ('two-way') common pipe
PlantCommonPipe(CurLoopNum)%CommonPipeType = CommonPipe_TwoWay
CALL SetupOutputVariable('Plant Common Pipe Primary Mass Flow Rate [kg/s]', &
PlantCommonPipe(CurLoopNum)%PriCPLegFlow,'System','Average',PlantLoop(CurLoopNum)%Name)
CALL SetupOutputVariable('Plant Common Pipe Secondary Mass Flow Rate [kg/s]', &
PlantCommonPipe(CurLoopNum)%SecCPLegFlow,'System','Average',PlantLoop(CurLoopNum)%Name)
CALL SetupOutputVariable('Plant Common Pipe Primary to Secondary Mass Flow Rate [kg/s]', &
PlantCommonPipe(CurLoopNum)%PriToSecFlow,'System','Average',PlantLoop(CurLoopNum)%Name)
CALL SetupOutputVariable('Plant Common Pipe Secondary to Primary Mass Flow Rate [kg/s]', &
PlantCommonPipe(CurLoopNum)%SecToPriFlow,'System','Average',PlantLoop(CurLoopNum)%Name)
! check type of pump on supply side inlet
IF (PlantLoop(CurLoopNum)%LoopSide(SupplySide)%Branch(1)%Comp(1)%TypeOf_Num == TypeOf_PumpConstantSpeed) THEN
PlantCommonPipe(CurLoopNum)%SupplySideInletPumpType = ConstantFlow
ELSEIF (PlantLoop(CurLoopNum)%LoopSide(SupplySide)%Branch(1)%Comp(1)%TypeOf_Num == TypeOf_PumpVariableSpeed) THEN
PlantCommonPipe(CurLoopNum)%SupplySideInletPumpType = VariableFlow
! If/when the model supports variable-pumping primary, this can be removed.
CALL ShowWarningError('SetupCommonPipes: detected variable speed pump on supply inlet of TwoWayCommonPipe plant loop')
CALL ShowContinueError('Occurs on plant loop name = '//TRIM(PlantLoop(CurLoopNum)%Name) )
CALL ShowContinueError('The common pipe model does not support varying the flow rate on the primary/supply side')
CALL ShowContinueError('The primary/supply side will operate as if constant speed, and the simulation continues')
ENDIF
! check type of pump on demand side inlet
IF (PlantLoop(CurLoopNum)%LoopSide(DemandSide)%Branch(1)%Comp(1)%TypeOf_Num == TypeOf_PumpConstantSpeed) THEN
PlantCommonPipe(CurLoopNum)%DemandSideInletPumpType = ConstantFlow
ELSEIF (PlantLoop(CurLoopNum)%LoopSide(DemandSide)%Branch(1)%Comp(1)%TypeOf_Num == TypeOf_PumpVariableSpeed) THEN
PlantCommonPipe(CurLoopNum)%DemandSideInletPumpType = VariableFlow
ENDIF
END SELECT
END DO
CommonPipeSetupFinished = .TRUE.
RETURN
END SUBROUTINE SetupCommonPipes