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) | :: | BoilerNum |
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 InitBoiler(BoilerNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN April 2002
! MODIFIED na
! RE-ENGINEERED Brent Griffith, rework for plant upgrade
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Boiler components
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY : BeginEnvrnFlag, AnyEnergyManagementSystemInModel
USE FluidProperties, ONLY : GetDensityGlycol
USE PlantUtilities, ONLY : InitComponentNodes
USE DataPlant, ONLY : TypeOf_Boiler_Simple, PlantSizesOkayToFinalize, &
PlantSizeNotComplete, LoopFlowStatus_NeedyIfLoopOn, &
SingleSetpoint, DualSetpointDeadband
USE EMSManager, ONLY: iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS
USE DataInterfaces, ONLY: ShowFatalError, ShowSevereError, ShowContinueError
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: BoilerNum ! number of the current boiler being simulated
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: MyOneTimeFlag = .TRUE. ! one time flag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyEnvrnFlag ! environment flag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyFlag
REAL(r64) :: rho
LOGICAL :: FatalError
LOGICAL :: errFlag
! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyFlag(NumBoilers))
ALLOCATE(MyEnvrnFlag(NumBoilers))
MyFlag = .TRUE.
MyEnvrnFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
! Init more variables
IF (MyFlag(BoilerNum)) THEN
! Locate the boilers on the plant loops for later usage
errFlag=.false.
CALL ScanPlantLoopsForObject(Boiler(BoilerNum)%Name, &
TypeOf_Boiler_Simple, &
Boiler(BoilerNum)%LoopNum, &
Boiler(BoilerNum)%LoopSideNum, &
Boiler(BoilerNum)%BranchNum, &
Boiler(BoilerNum)%CompNum, &
HighLimitTemp = Boiler(BoilerNum)%TempUpLimitBoilerOut, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitBoiler: Program terminated due to previous condition(s).')
ENDIF
IF ((Boiler(BoilerNum)%FlowMode == LeavingSetpointModulated) .OR. (Boiler(BoilerNum)%FlowMode == ConstantFlow)) THEN
! reset flow priority
PlantLoop(Boiler(BoilerNum)%LoopNum)%LoopSide(Boiler(BoilerNum)%LoopSideNum)% &
Branch(Boiler(BoilerNum)%BranchNum)%Comp(Boiler(BoilerNum)%CompNum)%FlowPriority = LoopFlowStatus_NeedyIfLoopOn
ENDIF
MyFlag(BoilerNum)=.FALSE.
ENDIF
IF(MyEnvrnFlag(BoilerNum) .and. BeginEnvrnFlag .AND. (PlantSizesOkayToFinalize))Then
IF (PlantSizeNotComplete) CALL SizeBoiler(BoilerNum)
rho = GetDensityGlycol(PlantLoop(Boiler(BoilerNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(Boiler(BoilerNum)%LoopNum)%FluidIndex, &
'InitBoiler')
Boiler(BoilerNum)%DesMassFlowRate = Boiler(BoilerNum)%VolFlowRate * rho
CALL InitComponentNodes(0.d0,Boiler(BoilerNum)%DesMassFlowRate, &
Boiler(BoilerNum)%BoilerInletNodeNum, &
Boiler(BoilerNum)%BoilerOutletNodeNum, &
Boiler(BoilerNum)%LoopNum, &
Boiler(BoilerNum)%LoopSideNum, &
Boiler(BoilerNum)%BranchNum, &
Boiler(BoilerNum)%CompNum)
IF (Boiler(BoilerNum)%FlowMode == LeavingSetpointModulated) Then ! check if setpoint on outlet node
IF ((Node(Boiler(BoilerNum)%BoilerOutletNodeNum)%TempSetPoint == SensedNodeFlagValue) .AND. &
(Node(Boiler(BoilerNum)%BoilerOutletNodeNum)%TempSetPointLo == SensedNodeFlagValue)) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
IF (.NOT. Boiler(BoilerNum)%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode Boiler named ' // &
TRIM(Boiler(BoilerNum)%Name) )
CALL ShowContinueError(' A temperature setpoint is needed at the outlet node of a boiler ' // &
'in variable flow mode, use a SetpointManager')
CALL ShowContinueError(' The overall loop setpoint will be assumed for Boiler. The simulation continues ... ')
Boiler(BoilerNum)%ModulatedFlowErrDone = .TRUE.
ENDIF
ELSE
! need call to EMS to check node
FatalError = .FALSE. ! but not really fatal yet, but should be.
CALL CheckIfNodeSetpointManagedByEMS(Boiler(BoilerNum)%BoilerOutletNodeNum,iTemperatureSetpoint, FatalError)
IF (FatalError) THEN
IF (.NOT. Boiler(BoilerNum)%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode Boiler named ' // &
TRIM(Boiler(BoilerNum)%Name) )
CALL ShowContinueError(' A temperature setpoint is needed at the outlet node of a boiler ' // &
'in variable flow mode')
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the boiler outlet node ')
CALL ShowContinueError(' or use an EMS actuator to establish a setpoint at the boiler outlet node ')
CALL ShowContinueError(' The overall loop setpoint will be assumed for Boiler. The simulation continues ... ')
Boiler(BoilerNum)%ModulatedFlowErrDone = .TRUE.
ENDIF
ENDIF
ENDIF
Boiler(BoilerNum)%ModulatedFlowSetToLoop = .TRUE. ! this is for backward compatibility and could be removed
ENDIF
ENDIF
MyEnvrnFlag(BoilerNum) = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(BoilerNum)=.TRUE.
ENDIF
! every iteration inits. (most in calc routine)
IF ((Boiler(BoilerNum)%FlowMode == LeavingSetpointModulated) .AND. Boiler(BoilerNum)%ModulatedFlowSetToLoop) THEN
! fix for clumsy old input that worked because loop setpoint was spread.
! could be removed with transition, testing , model change, period of being obsolete.
SELECT CASE (PlantLoop(Boiler(BoilerNum)%LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetPoint)
Node(Boiler(BoilerNum)%BoilerOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(Boiler(BoilerNum)%LoopNum)%TempSetPointNodeNum)%TempSetPoint
CASE (DualSetPointDeadBand)
Node(Boiler(BoilerNum)%BoilerOutletNodeNum)%TempSetPointLo = &
Node(PlantLoop(Boiler(BoilerNum)%LoopNum)%TempSetPointNodeNum)%TempSetPointLo
END SELECT
ENDIF
RETURN
END SUBROUTINE InitBoiler