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) | :: | ControlledZoneNum | 
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 InitBaseboard(BaseboardNum, ControlledZoneNumSub)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Russ Taylor
          !       DATE WRITTEN   Nov 1997
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine initializes the Baseboard units during simulation.
          ! METHODOLOGY EMPLOYED:
          ! na
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE DataLoopNode, ONLY: Node
  USE DataZoneEquipment,  ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList,ZoneEquipConfig
  USE PlantUtilities,     ONLY: InitComponentNodes
  USE DataPlant,          ONLY: ScanPlantLoopsForObject
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT(IN) :: BaseboardNum
  INTEGER, INTENT(IN) :: ControlledZoneNumSub
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER        :: WaterInletNode
  INTEGER        :: ZoneNode
  LOGICAL,SAVE   :: MyOneTimeFlag = .true.
  LOGICAL,SAVE   :: ZoneEquipmentListChecked = .false.  ! True after the Zone Equipment List has been checked for items
  Integer        :: Loop
  LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
  REAL(r64)      :: RhoAirStdInit
  REAL(r64)      :: rho ! local fluid density
  REAL(r64)      :: Cp  ! local fluid specific heat
  LOGICAL        :: errFlag
  IF (Baseboard(BaseboardNum)%ZonePtr <= 0) &
      Baseboard(BaseboardNum)%ZonePtr = ZoneEquipConfig(ControlledZoneNumSub)%ActualZoneNum
  ! Do the one time initializations
  IF (MyOneTimeFlag) THEN
    ! initialize the environment and sizing flags
    ALLOCATE(MyEnvrnFlag(NumBaseboards))
    ALLOCATE(MySizeFlag(NumBaseboards))
    ALLOCATE(SetLoopIndexFlag(NumBaseboards))
    MyEnvrnFlag      = .TRUE.
    MySizeFlag       = .TRUE.
    MyOneTimeFlag    = .FALSE.
    SetLoopIndexFlag = .TRUE.
  END IF
  IF(SetLoopIndexFlag(BaseboardNum) .AND. ALLOCATED(PlantLoop))THEN
    errFlag=.false.
    CALL ScanPlantLoopsForObject(Baseboard(BaseboardNum)%EquipID,     &
                                 Baseboard(BaseboardNum)%EquipType,   &
                                 Baseboard(BaseboardNum)%LoopNum,     &
                                 Baseboard(BaseboardNum)%LoopSideNum, &
                                 Baseboard(BaseboardNum)%BranchNum,   &
                                 Baseboard(BaseboardNum)%CompNum,     &
                                 errFlag=errFlag)
    IF (errFlag) THEN
      CALL ShowFatalError('InitBaseboard: Program terminated for previous conditions.')
    ENDIF
    SetLoopIndexFlag(BaseboardNum) = .FALSE.
  ENDIF
  ! 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,NumBaseboards
      IF (CheckZoneEquipmentList(cCMO_BBRadiator_Water,Baseboard(Loop)%EquipID)) CYCLE
      CALL ShowSevereError('InitBaseboard: Unit=['//TRIM(cCMO_BBRadiator_Water)//','//  &
         TRIM(Baseboard(Loop)%EquipID)//  &
           '] is not on any ZoneHVAC:EquipmentList.  It will not be simulated.')
    ENDDO
  ENDIF
  IF ( .NOT. SysSizingCalc .AND. MySizeFlag(BaseboardNum) .AND. .NOT. SetLoopIndexFlag(BaseboardNum)) THEN
    ! for each coil, do the sizing once.
    CALL SizeBaseboard(BaseboardNum)
    MySizeFlag(BaseboardNum) = .FALSE.
  END IF
  ! Do the Begin Environment initializations
  IF (BeginEnvrnFlag .AND. MyEnvrnFlag(BaseboardNum).AND. .NOT. SetLoopIndexFlag(BaseboardNum)) THEN
    RhoAirStdInit = StdRhoAir
    WaterInletNode = Baseboard(BaseboardNum)%WaterInletNode
    rho = GetDensityGlycol(PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidName,  &
                           InitConvTemp, &
                           PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidIndex,&
                           'BaseboardRadiator:InitBaseboard')
    Baseboard(BaseboardNum)%WaterMassFlowRateMax = rho * Baseboard(BaseboardNum)%WaterVolFlowRateMax
    CALL InitComponentNodes(0.d0,Baseboard(BaseboardNum)%WaterMassFlowRateMax, &
                                 Baseboard(BaseboardNum)%WaterInletNode,       &
                                 Baseboard(BaseboardNum)%WaterOutletNode,       &
                                 Baseboard(BaseboardNum)%LoopNum,              &
                                 Baseboard(BaseboardNum)%LoopSideNum,          &
                                 Baseboard(BaseboardNum)%BranchNum,            &
                                 Baseboard(BaseboardNum)%CompNum)
    Node(WaterInletNode)%Temp          = 60.0d0
    Cp =  GetSpecificHeatGlycol(PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidName,  &
                                Node(WaterInletNode)%Temp,                      &
                                PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidIndex, &
                                'BaseboardRadiator:InitBaseboard')
    Node(WaterInletNode)%Enthalpy      = Cp*Node(WaterInletNode)%Temp
    Node(WaterInletNode)%Quality       = 0.0d0
    Node(WaterInletNode)%Press         = 0.0d0
    Node(WaterInletNode)%HumRat        = 0.0d0
    ! pick a mass flow rate that depends on the max water mass flow rate. CR 8842 changed to factor of 2.0
    IF (Baseboard(BaseboardNum)%AirMassFlowRate <= 0.0d0) THEN
      Baseboard(BaseboardNum)%AirMassFlowRate = 2.0d0*Baseboard(BaseboardNum)%WaterMassFlowRateMax
    END IF
    MyEnvrnFlag(BaseboardNum) = .FALSE.
  END IF
  IF (.not. BeginEnvrnFlag) THEN
    MyEnvrnFlag(BaseboardNum) = .true.
  ENDIF
  ! Do the every time step initializations
  WaterInletNode = Baseboard(BaseboardNum)%WaterInletNode
  ZoneNode = ZoneEquipConfig(ControlledZoneNumSub)%ZoneNode
  Baseboard(BaseboardNum)%WaterMassFlowRate = Node(WaterInletNode)%MassFlowRate
  Baseboard(BaseboardNum)%WaterInletTemp = Node(WaterInletNode)%Temp
  Baseboard(BaseboardNum)%WaterInletEnthalpy = Node(WaterInletNode)%Enthalpy
  Baseboard(BaseboardNum)%AirInletTemp = Node(ZoneNode)%Temp
  Baseboard(BaseboardNum)%AirInletHumRat = Node(ZoneNode)%HumRat
  RETURN
END SUBROUTINE InitBaseboard