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) | :: | Item | |||
integer, | intent(in) | :: | VentSlabZoneNum | |||
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 InitVentilatedSlab(Item, VentSlabZoneNum, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Young Tae Chae, Rick Strand
! DATE WRITTEN June 2008
! MODIFIED July 2012, Chandan Sharma - FSEC: Added zone sys avail managers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes all of the data elements which are necessary
! to simulate a Ventilated Slab.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataEnvironment, ONLY : OutBaroPress, OutDryBulbTemp, OutHumRat, StdBaroPress,StdRhoAir
USE DataGlobals, ONLY : NumOfZones, BeginEnvrnFlag, AnyPlantInModel
USE DataLoopNode, ONLY : Node
USE ScheduleManager, ONLY : GetCurrentScheduleValue
USE DataHeatBalFanSys, ONLY : MAT,ZoneAirHumRat
USE DataZoneEquipment, ONLY : ZoneEquipInputsFilled,CheckZoneEquipmentList, VentilatedSlab_Num
USE DataPlant, ONLY : PlantLoop, ScanPlantLoopsForObject, TypeOf_CoilWaterSimpleHeating,&
TypeOf_CoilSteamAirHeating, TypeOf_CoilWaterCooling, TypeOf_CoilWaterDetailedFlatCooling
USE FluidProperties, ONLY : GetDensityGlycol
USE PlantUtilities, ONLY : InitComponentNodes
USE DataHVACGlobals, ONLY : ZoneComp
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: Item ! index for the current ventilated slab
INTEGER, INTENT(IN) :: VentSlabZoneNum ! number of zone being served
LOGICAL, INTENT(IN) :: FirstHVACIteration ! TRUE if 1st HVAC simulation of system timestep
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! REAL :: CurrentFlowSchedule ! Schedule value for flow fraction in a ventilated slab
INTEGER :: RadNum ! Number of the radiant system (DO loop counter)
INTEGER :: RadSurfNum ! Number of the radiant system surface (DO loop counter)
INTEGER :: SurfNum ! Intermediate variable for keeping track of the surface number
INTEGER :: ZoneNum ! Intermediate variable for keeping track of the zone number
INTEGER :: AirRelNode ! relief air node number in Ventilated Slab loop
INTEGER :: ColdConNode ! cold water control node number in Ventilated Slab loop
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL,SAVE :: ZoneEquipmentListChecked = .false. ! True after the Zone Equipment List has been checked for items
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyPlantScanFlag
INTEGER :: HotConNode ! hot water control node number in Ventilated Slab loop
INTEGER :: InNode ! inlet node number in Ventilated Slab loop
INTEGER :: OutNode ! outlet node number in Ventilated Slab loop
INTEGER :: OutsideAirNode ! outside air node number in Ventilated Slab loop
REAL(r64) :: RhoAir ! air density at InNode
REAL(r64) :: TempSteamIn
REAL(r64) :: SteamDensity
INTEGER :: ZoneAirInNode
INTEGER :: MixOut
REAL(r64) :: rho
LOGICAL :: errFlag
! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumOfVentSlabs))
ALLOCATE(MySizeFlag(NumOfVentSlabs))
ALLOCATE(MyPlantScanFlag(NumOfVentSlabs))
ALLOCATE(ZeroSourceSumHATsurf(NumOfZones))
ZeroSourceSumHATsurf = 0.0D0
ALLOCATE(QRadSysSrcAvg(TotSurfaces))
QRadSysSrcAvg = 0.0D0
ALLOCATE(LastQRadSysSrc(TotSurfaces))
LastQRadSysSrc = 0.0D0
ALLOCATE(LastSysTimeElapsed(TotSurfaces))
LastSysTimeElapsed = 0.0D0
ALLOCATE(LastTimeStepSys(TotSurfaces))
LastTimeStepSys = 0.0D0
! Initialize total areas for all radiant systems
DO RadNum = 1, NumOfVentSlabs
VentSlab(Item)%TotalSurfaceArea = 0.0d0
DO SurfNum = 1, VentSlab(Item)%NumOfSurfaces
VentSlab(Item)%TotalSurfaceArea = VentSlab(Item)%TotalSurfaceArea &
+Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Area
END DO
END DO
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
MyPlantScanFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF (ALLOCATED(ZoneComp)) THEN
ZoneComp(VentilatedSlab_Num)%ZoneCompAvailMgrs(Item)%ZoneNum = VentSlabZoneNum
VentSlab(Item)%AvailStatus = ZoneComp(VentilatedSlab_Num)%ZoneCompAvailMgrs(Item)%AvailStatus
ENDIF
IF (MyPlantScanFlag(item) .AND. ALLOCATED(PlantLoop)) THEN
IF ( (VentSlab(Item)%HCoil_PlantTypeNum == TypeOf_CoilWaterSimpleHeating) .or. &
(VentSlab(Item)%HCoil_PlantTypeNum == TypeOf_CoilSteamAirHeating) ) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject( VentSlab(Item)%HCoilName, &
VentSlab(Item)%HCoil_PlantTypeNum, &
VentSlab(Item)%HWLoopNum, &
VentSlab(Item)%HWLoopSide, &
VentSlab(Item)%HWBranchNum, &
VentSlab(Item)%HWCompNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowContinueError('Reference Unit="'//trim(VentSlab(Item)%Name)//'", type=ZoneHVAC:VentilatedSlab')
CALL ShowFatalError('InitVentilatedSlab: Program terminated due to previous condition(s).')
ENDIF
VentSlab(Item)%HotCoilOutNodeNum = &
PlantLoop(VentSlab(Item)%HWLoopNum)%LoopSide(VentSlab(Item)%HWLoopSide) &
%Branch(VentSlab(Item)%HWBranchNum)%Comp(VentSlab(Item)%HWCompNum)%NodeNumOut
ENDIF
IF ( (VentSlab(Item)%CCoil_PlantTypeNum == TypeOf_CoilWaterCooling) .or. &
(VentSlab(Item)%CCoil_PlantTypeNum == TypeOf_CoilWaterDetailedFlatCooling) ) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject( VentSlab(Item)%CCoilPlantName, &
VentSlab(Item)%CCoil_PlantTypeNum, &
VentSlab(Item)%CWLoopNum, &
VentSlab(Item)%CWLoopSide, &
VentSlab(Item)%CWBranchNum, &
VentSlab(Item)%CWCompNum)
IF (errFlag) THEN
CALL ShowContinueError('Reference Unit="'//trim(VentSlab(Item)%Name)//'", type=ZoneHVAC:VentilatedSlab')
CALL ShowFatalError('InitVentilatedSlab: Program terminated due to previous condition(s).')
ENDIF
VentSlab(Item)%ColdCoilOutNodeNum = &
PlantLoop(VentSlab(Item)%CWLoopNum)%LoopSide(VentSlab(Item)%CWLoopSide) &
%Branch(VentSlab(Item)%CWBranchNum)%Comp(VentSlab(Item)%CWCompNum)%NodeNumOut
ELSE
IF (VentSlab(Item)%CCoilPresent) &
CALL ShowFatalError('InitVentilatedSlab: Unit='//trim(VentSlab(Item)%Name)// &
', invalid cooling coil type. Program terminated.')
ENDIF
MyPlantScanFlag(item) = .FALSE.
ELSEIf (MyPlantScanFlag(item) .AND. .NOT. AnyPlantInModel) THEN
MyPlantScanFlag(item) = .FALSE.
ENDIF
! need to check all Ventilated Slab units to see if they are on Zone Equipment List or issue warning
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.true.
DO RadNum=1,NumOfVentSlabs
IF (CheckZoneEquipmentList(cMO_VentilatedSlab,VentSlab(RadNum)%Name)) CYCLE
CALL ShowSevereError('InitVentilatedSlab: Ventilated Slab Unit=['//TRIM(cMO_VentilatedSlab)//','// &
TRIM(VentSlab(RadNum)%Name)// &
'] is not on any ZoneHVAC:EquipmentList. It will not be simulated.')
ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(Item) .AND. .NOT. MyPlantScanFlag(item) ) THEN
CALL SizeVentilatedSlab(Item)
MySizeFlag(Item) = .FALSE.
END IF
! Do the one time initializations
IF (BeginEnvrnFlag .AND. MyEnvrnFlag(Item) .AND. .NOT. MyPlantScanFlag(item)) THEN
! Coil Part
InNode = VentSlab(Item)%ReturnAirNode
OutNode = VentSlab(Item)%RadInNode
HotConNode = VentSlab(Item)%HotControlNode
ColdConNode = VentSlab(Item)%ColdControlNode
OutsideAirNode = VentSlab(Item)%OutsideAirNode
RhoAir = StdRhoAir
! Radiation Panel Part
ZeroSourceSumHATsurf = 0.0D0
QRadSysSrcAvg = 0.0D0
LastQRadSysSrc = 0.0D0
LastSysTimeElapsed = 0.0D0
LastTimeStepSys = 0.0D0
IF (NumOfVentSlabs > 0) THEN
VentSlab%RadHeatingPower = 0.0D0
VentSlab%RadHeatingEnergy = 0.0D0
VentSlab%RadCoolingPower = 0.0D0
VentSlab%RadCoolingEnergy = 0.0D0
ENDIF
! set the initial Temperature of Return Air
! set the mass flow rates from the input volume flow rates
VentSlab(Item)%MaxAirMassFlow = RhoAir*VentSlab(Item)%MaxAirVolFlow
VentSlab(Item)%OutAirMassFlow = RhoAir*VentSlab(Item)%OutAirVolFlow
VentSlab(Item)%MinOutAirMassFlow = RhoAir*VentSlab(Item)%MinOutAirVolFlow
IF (VentSlab(Item)%OutAirMassFlow > VentSlab(Item)%MaxAirMassFlow) THEN
VentSlab(Item)%OutAirMassFlow = VentSlab(Item)%MaxAirMassFlow
VentSlab(Item)%MinOutAirMassFlow = VentSlab(Item)%OutAirMassFlow * &
(VentSlab(Item)%MinOutAirVolFlow / VentSlab(Item)%OutAirVolFlow)
CALL ShowWarningError('Outdoor air mass flow rate higher than unit flow rate, reset to unit flow rate for ' &
//TRIM(VentSlab(Item)%Name))
END IF
! set the node max and min mass flow rates
Node(OutsideAirNode)%MassFlowRateMax = VentSlab(Item)%OutAirMassFlow
Node(OutsideAirNode)%MassFlowRateMin = 0.0d0
Node(OutNode)%MassFlowRateMax = VentSlab(Item)%MaxAirMassFlow
Node(OutNode)%MassFlowRateMin = 0.0d0
Node(InNode)%MassFlowRateMax = VentSlab(Item)%MaxAirMassFlow
Node(InNode)%MassFlowRateMin = 0.0d0
IF (VentSlab(Item)%HCoilPresent ) THEN ! Only initialize these if a heating coil is actually present
IF (VentSlab(Item)%HCoil_PlantTypeNum == TypeOf_CoilWaterSimpleHeating .AND. .NOT. MyPlantScanFlag(item)) THEN
rho = GetDensityGlycol(PlantLoop(VentSlab(Item)%HWLoopNum )%fluidName, &
60.d0, &
PlantLoop( VentSlab(Item)%HWLoopNum )%fluidIndex, &
'InitVentilatedSlab' )
VentSlab(Item)%MaxHotWaterFlow = rho * VentSlab(Item)%MaxVolHotWaterFlow
VentSlab(Item)%MinHotWaterFlow = rho * VentSlab(Item)%MinVolHotWaterFlow
CALL InitComponentNodes(VentSlab(Item)%MinHotWaterFlow, &
VentSlab(Item)%MaxHotWaterFlow, &
VentSlab(Item)%HotControlNode, &
VentSlab(Item)%HotCoilOutNodeNum, &
VentSlab(Item)%HWLoopNum, &
VentSlab(Item)%HWLoopSide, &
VentSlab(Item)%HWBranchNum, &
VentSlab(Item)%HWCompNum)
END IF
IF (VentSlab(Item)%HCoil_PlantTypeNum == TypeOf_CoilSteamAirHeating .AND. .NOT. MyPlantScanFlag(item)) THEN
TempSteamIn= 100.00d0
SteamDensity=GetSatDensityRefrig('STEAM',TempSteamIn,1.0d0,VentSlab(Item)%HCoil_FluidIndex,'InitVentilatedSlab')
VentSlab(Item)%MaxHotSteamFlow = SteamDensity*VentSlab(Item)%MaxVolHotSteamFlow
VentSlab(Item)%MinHotSteamFlow = SteamDensity*VentSlab(Item)%MinVolHotSteamFlow
CALL InitComponentNodes(VentSlab(Item)%MinHotSteamFlow, &
VentSlab(Item)%MaxHotSteamFlow, &
VentSlab(Item)%HotControlNode, &
VentSlab(Item)%HotCoilOutNodeNum, &
VentSlab(Item)%HWLoopNum, &
VentSlab(Item)%HWLoopSide, &
VentSlab(Item)%HWBranchNum, &
VentSlab(Item)%HWCompNum)
END IF
END IF !(VentSlab(Item)%HCoilPresent)
IF (VentSlab(Item)%CCoilPresent .AND. .NOT. MyPlantScanFlag(item) ) THEN
! Only initialize these if a cooling coil is actually present
IF ((VentSlab(Item)%CCoil_PlantTypeNum == TypeOf_CoilWaterCooling) .OR. &
(VentSlab(Item)%CCoil_PlantTypeNum == TypeOf_CoilWaterDetailedFlatCooling) ) THEN
rho = GetDensityGlycol(PlantLoop(VentSlab(Item)%CWLoopNum )%fluidName, &
InitConvTemp, &
PlantLoop( VentSlab(Item)%CWLoopNum )%fluidIndex, &
'InitVentilatedSlab' )
VentSlab(Item)%MaxColdWaterFlow = rho * VentSlab(Item)%MaxVolColdWaterFlow
VentSlab(Item)%MinColdWaterFlow = rho * VentSlab(Item)%MinVolColdWaterFlow
CALL InitComponentNodes(VentSlab(Item)%MinColdWaterFlow , &
VentSlab(Item)%MaxColdWaterFlow, &
VentSlab(Item)%ColdControlNode, &
VentSlab(Item)%ColdCoilOutNodeNum, &
VentSlab(Item)%CWLoopNum, &
VentSlab(Item)%CWLoopSide, &
VentSlab(Item)%CWBranchNum, &
VentSlab(Item)%CWCompNum)
ENDIF
END IF
MyEnvrnFlag(Item) = .FALSE.
END IF ! ...end start of environment inits
IF (.NOT. BeginEnvrnFlag) THEN
MyEnvrnFlag(Item) = .TRUE.
END IF
! These initializations are done every iteration...
InNode = VentSlab(Item)%ReturnAirNode
OutNode = VentSlab(Item)%RadInNode
OutsideAirNode = VentSlab(Item)%OutsideAirNode
AirRelNode = VentSlab(Item)%AirReliefNode
ZoneAirInNode = VentSlab(Item)%ZoneAirInNode
MixOut = VentSlab(Item)%OAMixerOutNode
! First, set the flow conditions up so that there is flow through the ventilated
! slab system(this will be shut down if the system is not available or there
! is no load
Node(InNode)%MassFlowRate = VentSlab(Item)%MaxAirMassFlow
Node(InNode)%MassFlowRateMaxAvail = VentSlab(Item)%MaxAirMassFlow
Node(InNode)%MassFlowRateMinAvail = VentSlab(Item)%MaxAirMassFlow
Node(OutNode)%MassFlowRate = VentSlab(Item)%MaxAirMassFlow
Node(OutNode)%MassFlowRateMaxAvail = VentSlab(Item)%MaxAirMassFlow
Node(OutNode)%MassFlowRateMinAvail = VentSlab(Item)%MaxAirMassFlow
Node(OutsideAirNode)%MassFlowRate = VentSlab(Item)%OutAirMassFlow
Node(OutsideAirNode)%MassFlowRateMaxAvail = VentSlab(Item)%OutAirMassFlow
Node(OutsideAirNode)%MassFlowRateMinAvail = VentSlab(Item)%OutAirMassFlow
Node(AirRelNode)%MassFlowRate = VentSlab(Item)%OutAirMassFlow
Node(AirRelNode)%MassFlowRateMaxAvail = VentSlab(Item)%OutAirMassFlow
Node(AirRelNode)%MassFlowRateMinAvail = VentSlab(Item)%OutAirMassFlow
! Initialize the relief air (same as inlet conditions to the Ventilated Slab ..
! Note that mass flow rates will be taken care of later.
Node(AirRelNode) = Node(InNode)
OAMassFlowRate = 0.0d0
! Just in case the system is off and conditions do not get sent through
! the system for some reason, set the outlet conditions equal to the inlet
! conditions of the ventilated slab mixer
Node(OutNode)%Temp = Node(InNode)%Temp
Node(OutNode)%Press = Node(InNode)%Press
Node(OutNode)%HumRat = Node(InNode)%HumRat
Node(OutNode)%Enthalpy = Node(InNode)%Enthalpy
! These initializations only need to be done once at the start of the iterations...
IF (BeginTimeStepFlag.AND.FirstHVACIteration) THEN
! Initialize the outside air conditions...
Node(OutsideAirNode)%Temp = Node(OutsideAirNode)%OutAirDryBulb
Node(OutsideAirNode)%HumRat = OutHumRat
Node(OutsideAirNode)%Press = OutBaroPress
! The first pass through in a particular time step
ZoneNum = VentSlab(Item)%ZonePtr
ZeroSourceSumHATsurf(ZoneNum) = SumHATsurf(ZoneNum) ! Set this to figure what part of the load the radiant system meets
DO RadSurfNum = 1, VentSlab(Item)%NumOfSurfaces
SurfNum = VentSlab(Item)%SurfacePtr(RadSurfNum)
QRadSysSrcAvg(SurfNum) = 0.0D0 ! Initialize this variable to zero (radiant system defaults to off)
LastQRadSysSrc(SurfNum) = 0.0D0 ! At the start of a time step, reset to zero so average calculation can begin again
LastSysTimeElapsed(SurfNum) = 0.0D0 ! At the start of a time step, reset to zero so average calculation can begin again
LastTimeStepSys(SurfNum) = 0.0D0 ! At the start of a time step, reset to zero so average calculation can begin again
END DO
END IF
RETURN
END SUBROUTINE InitVentilatedSlab