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) | :: | CBNum | |||
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 InitCoolBeam(CBNum,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN February 6, 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initialization of the cooled beam units
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList
USE DataDefineEquip, ONLY: AirDistUnit
USE InputProcessor, ONLY: SameString
USE DataPlant, ONLY: PlantLoop, ScanPlantLoopsForObject, TypeOf_CooledBeamAirTerminal
USE FluidProperties, ONLY: GetDensityGlycol
USE PlantUtilities, ONLY: InitComponentNodes, SetComponentFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: CBNum ! number of the current cooled beam unit being simulated
LOGICAL, INTENT (IN) :: FirstHVACIteration ! TRUE if first air loop solution this HVAC step
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InAirNode ! supply air inlet node number
INTEGER :: OutAirNode ! unit air outlet node
INTEGER :: InWaterNode ! unit inlet chilled water node
INTEGER :: OutWaterNode ! unit outlet chilled water node
REAL(r64) :: RhoAir ! air density at outside pressure and standard temperature and humidity
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MySizeFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: PlantLoopScanFlag
REAL(r64) :: rho ! local fluid density
LOGICAL,SAVE :: ZoneEquipmentListChecked = .false. ! True after the Zone Equipment List has been checked for items
Integer :: Loop ! Loop checking control variable
CHARACTER(len=MaxNameLength) :: CurrentModuleObject
LOGICAL :: errFlag
CurrentModuleObject = 'AirTerminal:SingleDuct:ConstantVolume:CooledBeam'
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumCB))
ALLOCATE(MySizeFlag(NumCB))
ALLOCATE(PlantLoopScanFlag(NumCB))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
PlantLoopScanFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF (PlantLoopScanFlag(CBNum) .and. ALLOCATED(PlantLoop)) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject(CoolBeam(CBNum)%Name, &
TypeOf_CooledBeamAirTerminal, &
CoolBeam(CBNum)%CWLoopNum, &
CoolBeam(CBNum)%CWLoopSideNum, &
CoolBeam(CBNum)%CWBranchNum, &
CoolBeam(CBNum)%CWCompNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitCoolBeam: Program terminated for previous conditions.')
ENDIF
PlantLoopScanFlag(CBNum) = .FALSE.
ENDIF
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.true.
! Check to see if there is a Air Distribution Unit on the Zone Equipment List
DO Loop=1,NumCB
IF (CoolBeam(Loop)%ADUNum == 0) CYCLE
IF (CheckZoneEquipmentList('ZONEHVAC:AIRDISTRIBUTIONUNIT',AirDistUnit(CoolBeam(Loop)%ADUNum)%Name)) CYCLE
CALL ShowSevereError('InitCoolBeam: ADU=[Air Distribution Unit,'// &
TRIM(AirDistUnit(CoolBeam(Loop)%ADUNum)%Name)// &
'] is not on any ZoneHVAC:EquipmentList.')
CALL ShowContinueError('...Unit=['//TRIM(CurrentModuleObject)//','//TRIM(CoolBeam(Loop)%Name)// &
'] will not be simulated.')
ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(CBNum) .AND. .NOT. PlantLoopScanFlag(CBNum)) THEN
CALL SizeCoolBeam(CBNum)
InWaterNode = CoolBeam(CBNum)%CWInNode
OutWaterNode = CoolBeam(CBNum)%CWOutNode
rho = GetDensityGlycol(PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidIndex, &
'InitCoolBeam')
CoolBeam(CBNum)%MaxCoolWaterMassFlow = rho * CoolBeam(CBNum)%MaxCoolWaterVolFlow
CALL InitComponentNodes(0.d0, CoolBeam(CBNum)%MaxCoolWaterMassFlow, &
InWaterNode, OutWaterNode, &
CoolBeam(CBNum)%CWLoopNum, &
CoolBeam(CBNum)%CWLoopSideNum, &
CoolBeam(CBNum)%CWBranchNum, &
CoolBeam(CBNum)%CWCompNum)
MySizeFlag(CBNum) = .FALSE.
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(CBNum)) THEN
RhoAir = StdRhoAir
InAirNode = CoolBeam(CBNum)%AirInNode
OutAirNode = CoolBeam(CBNum)%AirOutNode
! set the mass flow rates from the input volume flow rates
CoolBeam(CBNum)%MaxAirMassFlow = RhoAir * CoolBeam(CBNum)%MaxAirVolFlow
Node(InAirNode)%MassFlowRateMax = CoolBeam(CBNum)%MaxAirMassFlow
Node(OutAirNode)%MassFlowRateMax = CoolBeam(CBNum)%MaxAirMassFlow
Node(InAirNode)%MassFlowRateMin = 0.0d0
Node(OutAirNode)%MassFlowRateMin = 0.0d0
InWaterNode = CoolBeam(CBNum)%CWInNode
OutWaterNode = CoolBeam(CBNum)%CWOutNode
Call InitComponentNodes(0.d0, CoolBeam(CBNum)%MaxCoolWaterMassFlow, &
InWaterNode, OutWaterNode, &
CoolBeam(CBNum)%CWLoopNum, &
CoolBeam(CBNum)%CWLoopSideNum, &
CoolBeam(CBNum)%CWBranchNum, &
CoolBeam(CBNum)%CWCompNum)
MyEnvrnFlag(CBNum) = .FALSE.
END IF ! end one time inits
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(CBNum) = .true.
ENDIF
InAirNode = CoolBeam(CBNum)%AirInNode
OutAirNode = CoolBeam(CBNum)%AirOutNode
! Do the start of HVAC time step initializations
IF (FirstHVACIteration) THEN
! check for upstream zero flow. If nonzero and schedule ON, set primary flow to max
IF (GetCurrentScheduleValue(CoolBeam(CBNum)%SchedPtr) .GT. 0.0d0 .AND. Node(InAirNode)%MassFlowRate .GT. 0.0d0) THEN
Node(InAirNode)%MassFlowRate = CoolBeam(CBNum)%MaxAirMassFlow
ELSE
Node(InAirNode)%MassFlowRate = 0.0d0
END IF
! reset the max and min avail flows
IF (GetCurrentScheduleValue(CoolBeam(CBNum)%SchedPtr) .GT. 0.0d0 .AND. Node(InAirNode)%MassFlowRateMaxAvail .GT. 0.0d0) THEN
Node(InAirNode)%MassFlowRateMaxAvail = CoolBeam(CBNum)%MaxAirMassFlow
Node(InAirNode)%MassFlowRateMinAvail = CoolBeam(CBNum)%MaxAirMassFlow
ELSE
Node(InAirNode)%MassFlowRateMaxAvail = 0.0d0
Node(InAirNode)%MassFlowRateMinAvail = 0.0d0
END IF
!Plant should do this InWaterNode = CoolBeam(CBNum)%CWInNode
! Node(InWaterNode)%MassFlowRateMaxAvail = CoolBeam(CBNum)%MaxCoolWaterMassFlow
! Node(InWaterNode)%MassFlowRateMinAvail = 0.0
END IF
! do these initializations every time step
InWaterNode = CoolBeam(CBNum)%CWInNode
CoolBeam(CBNum)%TWin = Node(InWaterNode)%Temp
CoolBeam(CBNum)%SupAirCoolingRate = 0.0d0
CoolBeam(CBNum)%SupAirHeatingRate = 0.0d0
! CoolBeam(CBNum)%BeamFlow = Node(InAirNode)%MassFlowRate / (StdRhoAir*CoolBeam(CBNum)%NumBeams)
RETURN
END SUBROUTINE InitCoolBeam