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) | :: | BaseboardNum | |||
integer, | intent(in) | :: | ControlledZoneNumSub | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 InitSteamBaseboard(BaseboardNum, ControlledZoneNumSub, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! Rick Strand
! DATE WRITTEN Nov 1997
! Feb 2001
! MODIFIED Sep 2009 Daeho Kang (Add Radiant Component)
! Sept 2010 Chandan Sharma, FSEC (plant interactions)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes the baseboard units.
! METHODOLOGY EMPLOYED:
! The initialization subrotines both in high temperature radiant radiator
! and convective only baseboard radiator are combined and modified.
! The heater is assumed to be crossflow with both fluids unmixed.
! REFERENCES:
! USE STATEMENTS:
USE DataEnvironment, ONLY: StdBaroPress
USE FluidProperties, ONLY: GetSatEnthalpyRefrig, GetSatDensityRefrig
USE PlantUtilities, ONLY: InitComponentNodes
USE DataPlant, ONLY: ScanPlantLoopsForObject
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN) :: FirstHVACIteration
INTEGER, INTENT(IN) :: BaseboardNum
INTEGER, INTENT(IN) :: ControlledZoneNumSub
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: MyOneTimeFlag = .true.
LOGICAL, SAVE :: ZoneEquipmentListChecked = .false.
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
INTEGER :: Loop
INTEGER :: SteamInletNode
INTEGER :: ZoneNode
INTEGER :: ZoneNum
REAL(r64) :: StartEnthSteam
REAL(r64) :: SteamDensity
LOGICAL :: errFlag
! Do the one time initializations
IF (MyOneTimeFlag) THEN
! initialize the environment and sizing flags
ALLOCATE(MyEnvrnFlag(NumSteamBaseboards))
ALLOCATE(MySizeFlag(NumSteamBaseboards))
ALLOCATE(ZeroSourceSumHATsurf(NumofZones))
ZeroSourceSumHATsurf = 0.0D0
ALLOCATE(QBBSteamRadSource(NumSteamBaseboards))
QBBSteamRadSource = 0.0D0
ALLOCATE(QBBSteamRadSrcAvg(NumSteamBaseboards))
QBBSteamRadSrcAvg = 0.0D0
ALLOCATE(LastQBBSteamRadSrc(NumSteamBaseboards))
LastQBBSteamRadSrc = 0.0D0
ALLOCATE(LastSysTimeElapsed(NumSteamBaseboards))
LastSysTimeElapsed = 0.0D0
ALLOCATE(LastTimeStepSys(NumSteamBaseboards))
LastTimeStepSys = 0.0D0
ALLOCATE(SetLoopIndexFlag(NumSteamBaseboards))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
MyOneTimeFlag = .false.
SetLoopIndexFlag = .TRUE.
END IF
IF (SteamBaseboard(BaseboardNum)%ZonePtr <= 0) &
SteamBaseboard(BaseboardNum)%ZonePtr = ZoneEquipConfig(ControlledZoneNumSub)%ActualZoneNum
! Need to check all units to see if they are on ZoneHVAC:EquipmentList or issue warning
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.true.
DO Loop=1,NumSteamBaseboards
IF (CheckZoneEquipmentList(cCMO_BBRadiator_Steam,SteamBaseboard(Loop)%EquipID)) CYCLE
CALL ShowSevereError('InitBaseboard: Unit=['//TRIM(cCMO_BBRadiator_Steam)//','// &
TRIM(SteamBaseboard(Loop)%EquipID)//'] is not on any ZoneHVAC:EquipmentList. It will not be simulated.')
END DO
ENDIF
IF(SetLoopIndexFlag(BaseboardNum))THEN
IF(ALLOCATED(PlantLoop))THEN
errFlag=.false.
CALL ScanPlantLoopsForObject(SteamBaseboard(BaseboardNum)%EquipID, &
SteamBaseboard(BaseboardNum)%EquipType, &
SteamBaseboard(BaseboardNum)%LoopNum, &
SteamBaseboard(BaseboardNum)%LoopSideNum, &
SteamBaseboard(BaseboardNum)%BranchNum, &
SteamBaseboard(BaseboardNum)%CompNum, &
errFlag=errFlag)
SetLoopIndexFlag(BaseboardNum) = .FALSE.
IF (errFlag) THEN
CALL ShowFatalError('InitSteamBaseboard: Program terminated for previous conditions.')
ENDIF
ENDIF
ENDIF
IF (.NOT. SysSizingCalc .AND. MySizeFlag(BaseboardNum) .AND. (.NOT. SetLoopIndexFlag(BaseboardNum))) THEN
! For each coil, do the sizing once
CALL SizeSteamBaseboard(BaseboardNum)
MySizeFlag(BaseboardNum) = .FALSE.
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(BaseboardNum)) THEN
! Initialize
SteamInletNode = SteamBaseboard(BaseboardNum)%SteamInletNode
Node(SteamInletNode)%Temp = 100.0d0
Node(SteamInletNode)%Press = 101325.0d0
SteamDensity = GetSatDensityRefrig ('STEAM',Node(SteamInletNode)%Temp,1.0d0,Node(SteamInletNode)%FluidIndex, &
'InitSteamCoil')
StartEnthSteam = GetSatEnthalpyRefrig('STEAM',Node(SteamInletNode)%Temp,1.0d0,Node(SteamInletNode)%FluidIndex, &
'InitSteamCoil')
SteamBaseboard(BaseboardNum)%SteamMassFlowRateMax = SteamDensity * SteamBaseboard(BaseboardNum)%SteamVolFlowRateMax
CALL InitComponentNodes(0.d0,SteamBaseboard(BaseboardNum)%SteamMassFlowRateMax, &
SteamBaseboard(BaseboardNum)%SteamInletNode, &
SteamBaseboard(BaseboardNum)%SteamOutletNode, &
SteamBaseboard(BaseboardNum)%LoopNum, &
SteamBaseboard(BaseboardNum)%LoopSideNum, &
SteamBaseboard(BaseboardNum)%BranchNum, &
SteamBaseboard(BaseboardNum)%CompNum)
Node(SteamInletNode)%Enthalpy = StartEnthSteam
Node(SteamInletNode)%Quality = 1.0d0
Node(SteamInletNode)%HumRat = 0.0d0
! Initializes radiant sources
ZeroSourceSumHATsurf =0.0D0
QBBSteamRadSource =0.0D0
QBBSteamRadSrcAvg =0.0D0
LastQBBSteamRadSrc =0.0D0
LastSysTimeElapsed =0.0D0
LastTimeStepSys =0.0D0
MyEnvrnFlag(BaseboardNum) = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(BaseboardNum) = .true.
ENDIF
IF (BeginTimeStepFlag .AND. FirstHVACIteration) THEN
ZoneNum = SteamBaseboard(BaseboardNum)%ZonePtr
ZeroSourceSumHATsurf(ZoneNum) = SumHATsurf(ZoneNum)
QBBSteamRadSrcAvg(BaseboardNum) = 0.0D0
LastQBBSteamRadSrc(BaseboardNum) = 0.0D0
LastSysTimeElapsed(BaseboardNum) = 0.0D0
LastTimeStepSys(BaseboardNum) = 0.0D0
END IF
! Do the every time step initializations
SteamInletNode = SteamBaseboard(BaseboardNum)%SteamInletNode
ZoneNode = ZoneEquipConfig(ControlledZoneNumSub)%ZoneNode
SteamBaseboard(BaseboardNum)%SteamMassFlowRate = Node(SteamInletNode)%MassFlowRate
SteamBaseboard(BaseboardNum)%SteamInletTemp = Node(SteamInletNode)%Temp
SteamBaseboard(BaseboardNum)%SteamInletEnthalpy = Node(SteamInletNode)%Enthalpy
SteamBaseboard(BaseboardNum)%SteamInletPress = Node(SteamInletNode)%Press
SteamBaseboard(BaseboardNum)%SteamInletQuality = Node(SteamInletNode)%Quality
SteamBaseboard(BaseboardNum)%TotPower = 0.0d0
SteamBaseboard(BaseboardNum)%Power = 0.0d0
SteamBaseboard(BaseboardNum)%ConvPower = 0.0d0
SteamBaseboard(BaseboardNum)%RadPower = 0.0d0
SteamBaseboard(BaseboardNum)%TotEnergy = 0.0d0
SteamBaseboard(BaseboardNum)%Energy = 0.0d0
SteamBaseboard(BaseboardNum)%ConvEnergy = 0.0d0
SteamBaseboard(BaseboardNum)%RadEnergy = 0.0d0
RETURN
END SUBROUTINE InitSteamBaseboard