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) | :: | CompTypeNum | |||
integer, | intent(in) | :: | CompNum |
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 InitPlantValves(CompTypeNum,CompNum)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith, NREL
! DATE WRITTEN Jan. 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! intialize data for valve modeling
! METHODOLOGY EMPLOYED:
!
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: BeginEnvrnFlag
USE DataInterfaces, ONLY: ShowSevereError, ShowWarningError, ShowContinueError, ShowContinueErrorTimeStamp
USE DataLoopNode, ONLY: Node
USE DataPlant, ONLY: TypeOf_ValveTempering, PlantLoop, ScanPlantLoopsForObject, &
GenEquipTypes_Pump, TypeOf_ValveTempering
USE DataBranchAirLoopPlant, ONLY : ControlType_Active
USE InputProcessor, ONLY: SameString
USE DataHVACGlobals, ONLY: NumPlantLoops
USE PlantUtilities, ONLY: InitComponentNodes
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CompTypeNum
INTEGER , INTENT(IN) :: CompNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InletNode ! local working variable for inlet node number
INTEGER :: OutletNode ! local working variable for outlet node number
INTEGER :: Strm2Node ! local working variable for stream 2 outlet node number
INTEGER :: SetPntNode ! local working variable for setpoint node number
INTEGER :: PumpOutNode ! local working variable for pump outlet node number
INTEGER :: i ! plant loop do loop counter
INTEGER :: j ! plant half loop do loop counter
INTEGER :: k ! plant branches do loop counter
Integer :: kk ! plant branches do loop counter, nested
INTEGER :: l ! plant components do loop counter
! INTEgER :: ll ! plant components do loop counter, nested
INTEGER :: m ! plant splitter do loop counter
INTEGER :: n ! plant mixer do loop counter
LOGICAL :: InNodeOnSplitter ! input data check
LOGICAL :: PumpOutNodeOkay ! input data check
LOGICAL :: ErrorsFound ! input data check
LOGICAL :: TwoBranchesBetwn ! input data check
LOGICAL :: SetpointNodeOkay ! input data check
LOGICAL :: Stream2NodeOkay ! input data check
LOGICAL :: IsBranchActive ! input data check
INTEGER :: numLoopSides ! set to SIZE(PlantLoop(i)%LoopSide)
LOGICAL, SAVE :: MyOneTimeFlag = .true. ! first pass log
LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: MyTwoTimeFlag ! second pass do input check
LOGICAL :: errFlag
SELECT CASE (CompTypeNum)
CASE (TypeOf_ValveTempering)
IF (MyOneTimeFlag) THEN
MyOneTimeFlag = .false.
ALLOCATE(MyTwoTimeFlag(NumTemperingValves))
MyTwoTimeFlag=.true.
ELSE
! delay checks one pass so more of plant data structure gets filled in
IF (MyTwoTimeFlag(CompNum)) THEN
! do some checks on input data
! Search thru PlantLoop Data Structure to check some things.
! Locate the component on the plant loops for later usage
errFlag=.false.
CALL ScanPlantLoopsForObject(TemperValve(CompNum)%Name, &
TypeOf_ValveTempering, &
TemperValve(CompNum)%LoopNum, &
TemperValve(CompNum)%LoopSideNum, &
TemperValve(CompNum)%BranchNum, &
TemperValve(CompNum)%CompNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitPlantValves: Program terminated due to previous condition(s).')
ENDIF
! init logical flags
ErrorsFound = .FALSE.
InNodeOnSplitter = .FALSE.
PumpOutNodeOkay = .FALSE.
TwoBranchesBetwn = .FALSE.
SetpointNodeOkay = .FALSE.
Stream2NodeOkay = .FALSE.
IsBranchActive = .FALSE.
! . A) find indexes of PlantLoop, Half loop, and Branch by searching CompData
IF (ALLOCATED(PlantLoop)) THEN
DO i = 1, NumPlantLoops
IF (.NOT.ALLOCATED(PlantLoop(i)%LoopSide)) CYCLE
numLoopSides = SIZE(PlantLoop(i)%LoopSide)
DO j = 1, numLoopSides
IF (.NOT.ALLOCATED(PlantLoop(i)%LoopSide(j)%Branch)) CYCLE
DO k = 1, PlantLoop(i)%LoopSide(j)%TotalBranches
IF (.NOT.ALLOCATED(PlantLoop(i)%LoopSide(j)%Branch(k)%Comp)) CYCLE
DO l = 1, PlantLoop(i)%LoopSide(j)%Branch(k)%TotalComponents
IF ( ( PlantLoop(i)%LoopSide(j)%Branch(k)%Comp(l)%TypeOf_Num == CompTypeNum) .AND. &
(PlantLoop(i)%LoopSide(j)%Branch(k)%Comp(l)%CompNum == CompNum)) THEN ! we found it.
IF (.not.SameString(PlantLoop(i)%LoopSide(j)%Branch(k)%Comp(l)%Name, TemperValve(CompNum)%Name)) THEN
! why not, maybe plant loop structures not completely filled with available data?
!write(*,*) 'Temper Valve names', PlantLoop(i)%LoopSide(j)%Branch(k)%Comp(l)%Name, TemperValve(CompNum)%Name
ENDIF
! is branch control type 'Active'
IF (PlantLoop(i)%LoopSide(j)%Branch(k)%ControlType == ControlType_Active) IsBranchActive = .true.
! is Valve inlet node an outlet node of a splitter
IF (ALLOCATED(PlantLoop(i)%LoopSide(j)%Splitter)) THEN
DO m = 1, PlantLoop(i)%LoopSide(j)%NumSplitters
IF (ALLOCATED(PlantLoop(i)%LoopSide(j)%Splitter(m)%NodeNumOut)) THEN
IF (ANY(PlantLoop(i)%LoopSide(j)%Splitter(m)%NodeNumOut &
== TemperValve(CompNum)%PltInletNodeNum)) THEN
InNodeOnSplitter = .true.
ENDIF
ENDIF ! allocated
! are there only 2 branches between splitter and mixer?
IF (PlantLoop(i)%LoopSide(j)%Splitter(m)%TotalOutletNodes == 2) THEN
TwoBranchesBetwn = .true.
ENDIF
ENDDO !loop over splitters
ENDIF ! allocated %splitter
! is stream 2 node an inlet to the mixer ?
IF (ALLOCATED(PlantLoop(i)%LoopSide(j)%Mixer)) THEN
DO n = 1, PlantLoop(i)%LoopSide(j)%NumMixers
IF (.NOT. ALLOCATED(PlantLoop(i)%LoopSide(j)%Mixer(n)%NodeNumIn)) CYCLE
IF (ANY(PlantLoop(i)%LoopSide(j)%Mixer(n)%NodeNumIn &
== TemperValve(CompNum)%PltStream2NodeNum)) THEN
! Check other branches component's node, current branch is k
DO kk = 1, PlantLoop(i)%LoopSide(j)%TotalBranches
IF (k == kk) CYCLE !already looped into this one
IF (.NOT. ALLOCATED(PlantLoop(i)%LoopSide(j)%Branch(KK)%Comp)) CYCLE
IF (ANY(PlantLoop(i)%LoopSide(j)%Branch(kk)%Comp%NodeNumOut &
== TemperValve(CompNum)%PltStream2NodeNum)) THEN !it is on other branch
Stream2NodeOkay = .TRUE.
ENDIF
ENDDO ! kk branch nested loop
ENDIF ! stream 2 node is inlet to mixer
ENDDO !mixer loop
ENDIF ! mixer allocated
! is pump node really the outlet of a branch with a pump?
DO kk=1, PlantLoop(i)%LoopSide(j)%TotalBranches
IF (PlantLoop(i)%LoopSide(j)%Branch(kk)%NodeNumOut == TemperValve(CompNum)%PltPumpOutletNodeNum) THEN
IF (ANY(PlantLoop(i)%LoopSide(j)%Branch(kk)%Comp%GeneralEquipType==GenEquipTypes_Pump)) THEN
!IF (PlantLoop(i)%LoopSide(j)%Branch(kk)%PumpPresent) THEN
PumpOutNodeOkay = .true.
ENDIF
ENDIF
ENDDO
! does sensor node agree with plant loop setpoint?
IF (PlantLoop(i)%TempSetPointNodeNum == TemperValve(CompNum)%PltSetPointNodeNum) THEN
SetpointNodeOkay = .TRUE.
ENDIF
ENDIF !found item
ENDDO ! comps l
ENDDO ! Branches k
ENDDO ! Loop Sides j
ENDDO ! Plant loops i
ENDIF ! plant loop allocated
IF (.NOT.IsBranchActive) THEN
CALL ShowSevereError('TemperingValve object needs to be on an ACTIVE branch')
ErrorsFound = .true.
ENDIF
IF (.NOT.InNodeOnSplitter) THEN
CALL ShowSevereError('TemperingValve object needs to be between a Splitter and Mixer')
ErrorsFound = .true.
ENDIF
IF (.NOT.PumpOutNodeOkay) THEN
CALL ShowSevereError('TemperingValve object needs to reference a node that is the outlet of a pump on its loop')
ErrorsFound = .true.
ENDIF
IF (.NOT.TwoBranchesBetwn) THEN
CALL ShowSevereError('TemperingValve object needs exactly two branches between a Splitter and Mixer')
ErrorsFound = .true.
ENDIF
IF (.NOT.SetpointNodeOkay) THEN
CALL ShowSevereError('TemperingValve object setpoint node not valid. '// &
'Check Setpoint manager for Plant Loop Temp Setpoint')
ErrorsFound = .true.
ENDIF
IF (.NOT.Stream2NodeOkay) THEN
CALL ShowSevereError('TemperingValve object stream 2 source node not valid.')
CALL ShowContinueError('Check that node is a component outlet, enters a mixer, and on the other branch')
ErrorsFound = .true.
ENDIF
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in input, TemperingValve object '// trim(TemperValve(CompNum)%Name))
ENDIF
MyTwoTimeFlag(CompNum) = .false.
ENDIF ! my two time flag for input checking
ENDIF ! my one time flag for input checking
InletNode = TemperValve(CompNum)%PltInletNodeNum
OutletNode = TemperValve(CompNum)%PltOutletNodeNum
Strm2Node = TemperValve(CompNum)%PltStream2NodeNum
SetPntNode = TemperValve(CompNum)%PltSetPointNodeNum
PumpOutNode= TemperValve(CompNum)%PltPumpOutletNodeNum
IF ((BeginEnvrnFlag) .AND. (TemperValve(CompNum)%init)) THEN
IF ((InletNode > 0) .AND. (OutletNode > 0)) THEN
! Node(InletNode)%Temp = 0.0
Call InitComponentNodes(0.d0, Node(PumpOutNode)%MassFlowRateMax, &
TemperValve(CompNum)%PltInletNodeNum, &
TemperValve(CompNum)%PltOutletNodeNum, &
TemperValve(CompNum)%LoopNum, &
TemperValve(CompNum)%LoopSideNum, &
TemperValve(CompNum)%BranchNum, &
TemperValve(CompNum)%CompNum )
ENDIF
TemperValve(CompNum)%Init = .False.
ENDIF
IF (.NOT. BeginEnvrnFlag) TemperValve(CompNum)%Init = .TRUE.
IF (InletNode > 0) THEN
TemperValve(CompNum)%InletTemp = Node(InletNode)%Temp
ENDIF
IF (Strm2Node > 0) THEN
TemperValve(CompNum)%Stream2SourceTemp = Node(Strm2Node)%Temp
ENDIF
IF (SetPntNode > 0) THEN
TemperValve(CompNum)%SetpointTemp = Node(SetPntNode)%TempSetPoint
ENDIF
IF (PumpOutNode > 0) THEN
TemperValve(CompNum)%MixedMassFlowRate = Node(PumpOutNode)%MassFlowRate
ENDIF
CASE DEFAULT
! should not come here, would have been caught already
END SELECT
RETURN
END SUBROUTINE InitPlantValves