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