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) | :: | EnergySourceNum | |||
real(kind=r64), | intent(inout) | :: | MassFlowRate | |||
real(kind=r64), | intent(inout) | :: | InletTemp | |||
real(kind=r64), | intent(inout) | :: | OutletTemp | |||
real(kind=r64), | intent(in) | :: | MyLoad |
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 InitSimVars(EnergySourceNum,MassFlowRate,InletTemp,OutletTemp, MyLoad)
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: October 1998
! MODIFIED May 2010; Edwin Lee; Linda Lawrie (consolidation)
! RE-ENGINEERED Sept 2010, Brent Griffith, plant rewrite
! PURPOSE OF THIS SUBROUTINE:
! This subroutine does one-time inits and sets the operating mass flow rate of this machine
! METHODOLOGY EMPLOYED:
! One time inits include validating source type (should happen in getinput?) and locating this
! component on the PlantLoop topology.
! The mass flow rate is determined based on component load, and making use of
! the SetComponentFlowRate routine.
! The mass flow rate could be an inter-connected-loop side trigger. This is not really the type of
! interconnect that that routine was written for, but it is the clearest example of using it.
! USE STATEMENTS:
USE PlantUtilities, ONLY: SetComponentFlowRate, InitComponentNodes, RegisterPlantCompDesignFlow
USE DataGlobals, ONLY: BeginEnvrnFlag
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: EnergySourceNum ! Which item being initialized
REAL(r64), INTENT(INOUT) :: MassFlowRate
REAL(r64), INTENT(INOUT) :: InletTemp
REAL(r64), INTENT(INOUT) :: OutletTemp
REAL(r64), INTENT(IN) :: MyLoad
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: TempTypeFlag
REAL(r64) :: TempPlantMdot = 0.d0 ! local copy of plant flow
INTEGER :: LoopNum
INTEGER :: LoopSideNum
INTEGER :: BranchIndex
INTEGER :: CompIndex
INTEGER :: InletNode
INTEGER :: OutletNode
LOGICAL :: errFlag
! Init more variables
IF (EnergySource(EnergySourceNum)%OneTimeInitFlag) THEN
IF (EnergySource(EnergySourceNum)%EnergyType == EnergyType_DistrictHeating) THEN
TempTypeFlag = TypeOf_PurchHotWater
ELSEIF (EnergySource(EnergySourceNum)%EnergyType == EnergyType_DistrictCooling) THEN
TempTypeFlag = TypeOf_PurchChilledWater
ELSE
CALL ShowFatalError('InitSimVars: Invalid EnergyType for District Heating/Cooling='// &
trim(EnergySource(EnergySourceNum)%Name))
ENDIF
! Locate the unit on the plant loops for later usage
errFlag=.false.
CALL ScanPlantLoopsForObject(EnergySource(EnergySourceNum)%Name, &
TempTypeFlag, &
EnergySource(EnergySourceNum)%LoopNum, &
EnergySource(EnergySourceNum)%LoopSideNum, &
EnergySource(EnergySourceNum)%BranchNum, &
EnergySource(EnergySourceNum)%CompNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitSimVars: Program terminated due to previous condition(s).')
ENDIF
! set limits on outlet node temps to plant loop limits
PlantLoop(EnergySource(EnergySourceNum)%LoopNum)%LoopSide(EnergySource(EnergySourceNum)%LoopSideNum)%&
Branch(EnergySource(EnergySourceNum)%BranchNum)%Comp(EnergySource(EnergySourceNum)%CompNum)%&
MinOutletTemp = PlantLoop(EnergySource(EnergySourceNum)%LoopNum)%MinTemp
PlantLoop(EnergySource(EnergySourceNum)%LoopNum)%LoopSide(EnergySource(EnergySourceNum)%LoopSideNum)%&
Branch(EnergySource(EnergySourceNum)%BranchNum)%Comp(EnergySource(EnergySourceNum)%CompNum)%&
MaxOutletTemp = PlantLoop(EnergySource(EnergySourceNum)%LoopNum)%MaxTemp
! Register design flow rate for inlet node (helps to autosize comp setpoint op scheme flows
CALL RegisterPlantCompDesignFlow(EnergySource(EnergySourceNum)%InletNodeNum, &
PlantLoop(EnergySource(EnergySourceNum)%LoopNum)%MaxVolFlowRate)
EnergySource(EnergySourceNum)%OneTimeInitFlag=.FALSE.
ENDIF
!begin environment inits
IF (BeginEnvrnFlag .AND. EnergySource(EnergySourceNum)%BeginEnvrnInitFlag) THEN
! component model has not design flow rates, using data for overall plant loop
CALL InitComponentNodes( PlantLoop(EnergySource(EnergySourceNum)%LoopNum)%MinMassFlowRate, &
PlantLoop(EnergySource(EnergySourceNum)%LoopNum)%MaxMassFlowRate, &
EnergySource(EnergySourceNum)%InletNodeNum, &
EnergySource(EnergySourceNum)%OutletNodeNum, &
EnergySource(EnergySourceNum)%LoopNum, &
EnergySource(EnergySourceNum)%LoopSideNum, &
EnergySource(EnergySourceNum)%BranchNum, &
EnergySource(EnergySourceNum)%CompNum)
EnergySource(EnergySourceNum)%BeginEnvrnInitFlag = .FALSE.
ENDIF
IF (.NOT. BeginEnvrnFlag) EnergySource(EnergySourceNum)%BeginEnvrnInitFlag = .TRUE.
! now do everytime inits
InletNode = EnergySource(EnergySourceNum)%InletNodeNum
OutletNode = EnergySource(EnergySourceNum)%OutletNodeNum
InletTemp = Node(InletNode)%Temp
OutletTemp = InletTemp
LoopNum = EnergySource(EnergySourceNum)%LoopNum
LoopSideNum = EnergySource(EnergySourceNum)%LoopSideNum
BranchIndex = EnergySource(EnergySourceNum)%BranchNum
CompIndex = EnergySource(EnergySourceNum)%CompNum
IF (ABS(MyLoad) > 0.d0) THEN
TempPlantMdot = PlantLoop(LoopNum)%MaxMassFlowRate
ELSE
TempPlantMdot = 0.d0 ! expect no flow needed
ENDIF
! get actual mass flow to use, hold in MassFlowRate variable
CALL SetComponentFlowRate(TempPlantMdot,InletNode,OutletNode,LoopNum,LoopSideNum,BranchIndex,CompIndex)
MassFlowRate = TempPlantMdot
RETURN
END SUBROUTINE InitSimVars