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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | BoilerType | |||
character(len=*), | intent(in) | :: | BoilerName | |||
integer, | intent(in) | :: | EquipFlowCtrl | |||
integer, | intent(inout) | :: | CompIndex | |||
logical, | intent(in) | :: | RunFlag | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
logical, | intent(inout) | :: | InitLoopEquip | |||
real(kind=r64), | intent(inout) | :: | MyLoad | |||
real(kind=r64) | :: | MaxCap | ||||
real(kind=r64) | :: | MinCap | ||||
real(kind=r64) | :: | OptCap | ||||
logical, | intent(in) | :: | GetSizingFactor | |||
real(kind=r64), | intent(out) | :: | SizingFactor |
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 SimSteamBoiler(BoilerType,BoilerName,EquipFlowCtrl, CompIndex, RunFlag,FirstHVACIteration, &
InitLoopEquip,MyLoad,MaxCap,MinCap,OptCap,GetSizingFactor,SizingFactor)
! SUBROUTINE INFORMATION:
! AUTHOR Rahul Chillar
! DATE WRITTEN
! MODIFIED
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subrountine controls the boiler component simulation
! METHODOLOGY EMPLOYED: na
! REFERENCES: na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList
USE FluidProperties
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: BoilerType ! boiler type (used in CASE statement)
CHARACTER(len=*), INTENT(IN) :: BoilerName ! boiler identifier
INTEGER, INTENT(IN) :: EquipFlowCtrl ! Flow control mode for the equipment
INTEGER, INTENT(INOUT) :: CompIndex ! boiler counter/identifier
LOGICAL, INTENT(IN) :: RunFlag ! if TRUE run boiler simulation--boiler is ON
LOGICAL , INTENT(IN) :: FirstHVACIteration ! TRUE if First iteration of simulation
LOGICAL, INTENT(INOUT) :: InitLoopEquip ! If not zero, calculate the max load for operating conditions
REAL(r64), INTENT(INOUT) :: MyLoad ! W - Actual demand boiler must satisfy--calculated by load dist. routine
REAL(r64) :: MinCap ! W - minimum boiler operating capacity
REAL(r64) :: MaxCap ! W - maximum boiler operating capacity
REAL(r64) :: OptCap ! W - optimal boiler operating capacity
LOGICAL, INTENT(IN) :: GetSizingFactor ! TRUE when just the sizing factor is requested
REAL(r64), INTENT(OUT) :: SizingFactor ! sizing factor
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: GetInput = .TRUE. ! if TRUE read user input
INTEGER :: BoilerNum ! boiler counter/identifier
!Get Input
IF (GetInput) THEN
CALL GetBoilerInput
GetInput=.false.
END IF
! Find the correct Equipment
IF (CompIndex == 0) THEN
BoilerNum = FindItemInList(BoilerName,Boiler%Name,NumBoilers)
IF (BoilerNum == 0) THEN
CALL ShowFatalError('SimBoiler: Unit not found='//TRIM(BoilerName))
ENDIF
CompIndex=BoilerNum
ELSE
BoilerNum=CompIndex
IF (BoilerNum > NumBoilers .or. BoilerNum < 1) THEN
CALL ShowFatalError('SimBoiler: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(BoilerNum))// &
', Number of Units='//TRIM(TrimSigDigits(NumBoilers))// &
', Entered Unit name='//TRIM(BoilerName))
ENDIF
IF (CheckEquipName(BoilerNum)) THEN
IF (BoilerName /= Boiler(BoilerNum)%Name) THEN
CALL ShowFatalError('SimBoiler: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(BoilerNum))// &
', Unit name='//TRIM(BoilerName)//', stored Unit Name for that index='// &
TRIM(Boiler(BoilerNum)%Name))
ENDIF
CheckEquipName(BoilerNum)=.false.
ENDIF
ENDIF
! Initialize Loop Equipment
IF (InitLoopEquip) THEN
CALL InitBoiler(BoilerNum)
CALL SizeBoiler(BoilerNum)
MinCap = Boiler(BoilerNum)%NomCap*Boiler(BoilerNum)%MinPartLoadRat
MaxCap = Boiler(BoilerNum)%NomCap*Boiler(BoilerNum)%MaxPartLoadRat
OptCap = Boiler(BoilerNum)%NomCap*Boiler(BoilerNum)%OptPartLoadRat
IF (GetSizingFactor) THEN
SizingFactor = Boiler(BoilerNum)%SizFac
ENDIF
RETURN
END IF
!Calculate Load
!Select boiler type and call boiler model
CALL InitBoiler(BoilerNum)
CALL CalcBoilerModel(BoilerNum,MyLoad,Runflag,EquipFlowCtrl)
CALL UpdateBoilerRecords(MyLoad,RunFlag,BoilerNum,FirstHVACIteration)
RETURN
END SUBROUTINE SimSteamBoiler