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 | :: | BaseboardNum | ||||
| real(kind=r64) | :: | LoadMet | 
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 SimHWConvective(BaseboardNum, LoadMet)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Russ Taylor
          !       DATE WRITTEN   Nov 1997
          !       MODIFIED       May 2000 Fred Buhl
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE: This subroutine calculates the heat exchange rate
          ! in a pure convective baseboard heater.  The heater is assumed to be crossflow
          ! with both fluids unmixed. The air flow is bouyancy driven and a constant air
          ! flow velocity of 0.5m/s is assumed. The solution is by the effectiveness-NTU
          ! method found in Icropera and DeWitt, Fundamentals of Heat and Mass Transfer,
          ! Chapter 11.4, p. 523, eq. 11.33
          ! METHODOLOGY EMPLOYED:
          ! na
          ! REFERENCES:
          ! Icropera and DeWitt, Fundamentals of Heat and Mass Transfer,
          ! Chapter 11.4, p. 523, eq. 11.33
          ! USE STATEMENTS:
    USE DataLoopNode, ONLY: Node
    USE DataSizing
    USE DataZoneEnergyDemands, ONLY: ZoneSysEnergyDemand, CurDeadbandOrSetback
    USE PlantUtilities,        ONLY: SetActuatedBranchFlowRate
    USE DataHVACGlobals, ONLY: SmallLoad
    IMPLICIT NONE
          ! SUBROUTINE ARGUMENT DEFINITIONS:
    INTEGER      :: BaseboardNum
    REAL(r64)    :: LoadMet
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
    INTEGER :: ZoneNum
    REAL(r64) :: WaterInletTemp
    REAL(r64) :: AirInletTemp
    REAL(r64) :: CpAir
    REAL(r64) :: CpWater
    REAL(r64) :: AirMassFlowRate
    REAL(r64) :: WaterMassFlowRate
    REAL(r64) :: CapacitanceAir
    REAL(r64) :: CapacitanceWater
    REAL(r64) :: CapacitanceMax
    REAL(r64) :: CapacitanceMin
    REAL(r64) :: CapacityRatio
    REAL(r64) :: NTU
    REAL(r64) :: Effectiveness
    REAL(r64) :: WaterOutletTemp
    REAL(r64) :: AirOutletTemp
    REAL(r64) :: AA
    REAL(r64) :: BB
    REAL(r64) :: CC
    REAL(r64) :: QZnReq
    ZoneNum = Baseboard(BaseboardNum)%ZonePtr
    QZnReq  = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
    IF (MySizeFlag(BaseboardNum)) & ! If in sizing, assign design condition
        QZnReq = CalcFinalZoneSizing(CurZoneEqNum)%DesHeatLoad * CalcFinalZoneSizing(CurZoneEqNum)%HeatSizingFactor
    WaterInletTemp = Baseboard(BaseboardNum)%WaterInletTemp
    WaterOutletTemp = WaterInletTemp
    AirInletTemp   = Baseboard(BaseboardNum)%AirInletTemp
    AirOutletTemp = AirInletTemp
    CpWater =  GetSpecificHeatGlycol(PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidName,  &
                           WaterInletTemp,                      &
                           PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidIndex, &
                           cCMO_BBRadiator_Water//':SimHWConvective')
    CpAir = PsyCpAirFnWTdb(Baseboard(BaseboardNum)%AirInletHumRat,AirInletTemp)
    IF (Baseboard(BaseboardNum)%DesAirMassFlowRate > 0.0d0) THEN  ! If UA is autosized, assign design condition
      AirMassFlowRate = Baseboard(BaseboardNum)%DesAirMassFlowRate
    ELSE
      AirMassFlowRate = Baseboard(BaseboardNum)%AirMassFlowRate
            ! pick a mass flow rate that depends on the max water mass flow rate. CR 8842 changed to factor of 2.0
      IF (AirMassFlowRate <= 0.0d0) &
            AirMassFlowRate = 2.0*Baseboard(BaseboardNum)%WaterMassFlowRateMax
    END IF
    WaterMassFlowRate = Node(Baseboard(BaseboardNum)%WaterInletNode)%MassFlowRate
    CapacitanceAir = CpAir * AirMassFlowRate
     IF (QZnReq > SmallLoad &
       .AND. (.NOT. CurDeadbandOrSetback(ZoneNum) .OR. MySizeFlag(BaseboardNum)) &
       .AND. (GetCurrentScheduleValue(Baseboard(BaseboardNum)%SchedPtr) > 0 .OR. MySizeFlag(BaseboardNum)) &
       .AND. (WaterMassFlowRate > 0.0d0) ) THEN
      CapacitanceWater = CpWater * WaterMassFlowRate
      CapacitanceMax = MAX(CapacitanceAir,CapacitanceWater)
      CapacitanceMin = MIN(CapacitanceAir,CapacitanceWater)
      CapacityRatio = CapacitanceMin/CapacitanceMax
      NTU = Baseboard(BaseboardNum)%UA/CapacitanceMin
      ! The effectiveness is given by the following formula:
      ! Effectiveness = 1. - EXP((1./CapacityRatio)*(NTU)**0.22*(EXP(-CapacityRatio*(NTU)**0.78)-1.))
      ! To prevent possible underflows (numbers smaller than the computer can handle) we must break
      ! the calculation up into steps and check the size of the exponential arguments.
      AA = -CapacityRatio*(NTU)**0.78d0
      IF (AA.LT.EXP_LowerLimit) THEN
        BB = 0.0d0
      ELSE
        BB = EXP(AA)
      END IF
      CC = (1.0d0/CapacityRatio)*(NTU)**0.22d0*(BB-1.0d0)
      IF (CC.LT.EXP_LowerLimit) THEN
        Effectiveness = 1.0d0
      ELSE
        Effectiveness  = 1.d0 - EXP(CC)
      END IF
      AirOutletTemp = AirInletTemp + Effectiveness*CapacitanceMin*(WaterInletTemp-AirInletTemp)/CapacitanceAir
      WaterOutletTemp = WaterInletTemp - CapacitanceAir*(AirOutletTemp-AirInletTemp)/CapacitanceWater
      LoadMet = CapacitanceWater*(WaterInletTemp-WaterOutletTemp)
       Baseboard(BaseboardNum)%WaterOutletEnthalpy = Baseboard(BaseboardNum)%WaterInletEnthalpy - &
        LoadMet/WaterMassFlowRate
    ELSE
      CapacitanceWater = 0.0d0
      CapacitanceMax = CapacitanceAir
      CapacitanceMin = 0.0d0
      NTU = 0.0d0
      Effectiveness = 0.0d0
      AirOutletTemp = AirInletTemp
      WaterOutletTemp = WaterInletTemp
      LoadMet = 0.0d0
      Baseboard(BaseboardNum)%WaterOutletEnthalpy = Baseboard(BaseboardNum)%WaterInletEnthalpy
      WaterMassFlowRate = 0.0d0
      CALL SetActuatedBranchFlowRate(WaterMassFlowRate,Baseboard(BaseboardNum)%WaterInletNode,  &
                                   Baseboard(BaseboardNum)%LoopNum,Baseboard(BaseboardNum)%LoopSideNum, &
                                   Baseboard(BaseboardNum)%BranchNum, .FALSE. )
      AirMassFlowRate = 0.0d0
    END IF
    Baseboard(BaseboardNum)%WaterOutletTemp = WaterOutletTemp
    Baseboard(BaseboardNum)%AirOutletTemp = AirOutletTemp
    Baseboard(BaseboardNum)%Power = LoadMet
    Baseboard(BaseboardNum)%WaterMassFlowRate = WaterMassFlowRate
    Baseboard(BaseboardNum)%AirMassFlowRate = AirMassFlowRate
    RETURN
  END SUBROUTINE SimHWConvective