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) | :: | CBVAVNum | 
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 SizeCBVAV(CBVAVNum)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard Raustad
          !       DATE WRITTEN   July 2006
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine is for sizing changeover-bypass VAV components.
          ! METHODOLOGY EMPLOYED:
          ! Obtains flow rates from the zone sizing arrays.
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE DataSizing
  USE InputProcessor
  USE ReportSizingManager, ONLY: ReportSizingOutput
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT(IN) :: CBVAVNum       ! Index to CBVAV system
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
          ! na
  IF (CBVAV(CBVAVNum)%MaxCoolAirVolFlow == AutoSize) THEN
    IF (CurSysNum > 0) THEN
      CALL CheckSysSizing(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name)
      CBVAV(CBVAVNum)%MaxCoolAirVolFlow   = FinalSysSizing(CurSysNum)%DesMainVolFlow
      IF(CBVAV(CBVAVNum)%FanVolFlow .LT. CBVAV(CBVAVNum)%MaxCoolAirVolFlow .AND. CBVAV(CBVAVNum)%FanVolFlow .NE. AutoSize)THEN
        CBVAV(CBVAVNum)%MaxCoolAirVolFlow = CBVAV(CBVAVNum)%FanVolFlow
        CALL ShowWarningError(TRIM(CBVAV(CBVAVNum)%UnitType)//' "'//TRIM(CBVAV(CBVAVNum)%Name)//'"')
        CALL ShowContinueError('The CBVAV system supply air fan air flow rate is less than the autosized value' &
                             //' for the maximum air flow rate in cooling mode. Consider autosizing the fan for' &
                             //' this simulation.')
        CALL ShowContinueError('The maximum air flow rate in cooling mode ' &
                             //'is reset to the supply air fan flow rate and the simulation continues.')
      END IF
      IF (CBVAV(CBVAVNum)%MaxCoolAirVolFlow < SmallAirVolFlow) THEN
        CBVAV(CBVAVNum)%MaxCoolAirVolFlow = 0.0d0
      END IF
      CALL ReportSizingOutput(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name, &
                              'maximum cooling air flow rate [m3/s]', CBVAV(CBVAVNum)%MaxCoolAirVolFlow)
    END IF
  END IF
  IF (CBVAV(CBVAVNum)%MaxHeatAirVolFlow == AutoSize) THEN
    IF (CurSysNum > 0) THEN
      CALL CheckSysSizing(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name)
      CBVAV(CBVAVNum)%MaxHeatAirVolFlow   = FinalSysSizing(CurSysNum)%DesMainVolFlow
      IF(CBVAV(CBVAVNum)%FanVolFlow .LT. CBVAV(CBVAVNum)%MaxHeatAirVolFlow .AND. CBVAV(CBVAVNum)%FanVolFlow .NE. AutoSize)THEN
        CBVAV(CBVAVNum)%MaxHeatAirVolFlow = CBVAV(CBVAVNum)%FanVolFlow
        CALL ShowWarningError(TRIM(CBVAV(CBVAVNum)%UnitType)//' "'//TRIM(CBVAV(CBVAVNum)%Name)//'"')
        CALL ShowContinueError('The CBVAV system supply air fan air flow rate is less than the autosized value' &
                             //' for the maximum air flow rate in heating mode. Consider autosizing the fan for' &
                             //' this simulation.')
        CALL ShowContinueError('The maximum air flow rate in heating mode ' &
                             //'is reset to the supply air fan flow rate and the simulation continues.')
      END IF
      IF (CBVAV(CBVAVNum)%MaxHeatAirVolFlow < SmallAirVolFlow) THEN
        CBVAV(CBVAVNum)%MaxHeatAirVolFlow = 0.0d0
      END IF
      CALL ReportSizingOutput(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name, &
                              'maximum heating air flow rate [m3/s]', CBVAV(CBVAVNum)%MaxHeatAirVolFlow)
    END IF
  END IF
  IF (CBVAV(CBVAVNum)%MaxNoCoolHeatAirVolFlow == AutoSize) THEN
    IF (CurSysNum > 0) THEN
      CALL CheckSysSizing(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name)
      CBVAV(CBVAVNum)%MaxNoCoolHeatAirVolFlow = FinalSysSizing(CurSysNum)%DesMainVolFlow
      IF(CBVAV(CBVAVNum)%FanVolFlow .LT. CBVAV(CBVAVNum)%MaxNoCoolHeatAirVolFlow .AND. &
         CBVAV(CBVAVNum)%FanVolFlow .NE. AutoSize)THEN
        CBVAV(CBVAVNum)%MaxNoCoolHeatAirVolFlow = CBVAV(CBVAVNum)%FanVolFlow
        CALL ShowWarningError(TRIM(CBVAV(CBVAVNum)%UnitType)//' "'//TRIM(CBVAV(CBVAVNum)%Name)//'"')
        CALL ShowContinueError('The CBVAV system supply air fan air flow rate is less than the autosized value' &
                             //' for the maximum air flow rate when no heating or cooling is needed. Consider' &
                             //' autosizing the fan for this simulation.')
        CALL ShowContinueError('The maximum air flow rate when no heating or cooling is needed ' &
                             //'is reset to the supply air fan flow rate and the simulation continues.')
      END IF
      IF (CBVAV(CBVAVNum)%MaxNoCoolHeatAirVolFlow < SmallAirVolFlow) THEN
        CBVAV(CBVAVNum)%MaxNoCoolHeatAirVolFlow = 0.0d0
      END IF
      CALL ReportSizingOutput(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name, &
                              'maximum air flow rate when compressor/coil is off [m3/s]', CBVAV(CBVAVNum)%MaxNoCoolHeatAirVolFlow)
    END IF
  END IF
  IF (CBVAV(CBVAVNum)%CoolOutAirVolFlow == AutoSize) THEN
    IF (CurSysNum > 0) THEN
      CALL CheckSysSizing(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name)
      CBVAV(CBVAVNum)%CoolOutAirVolFlow = FinalSysSizing(CurSysNum)%DesOutAirVolFlow
      IF(CBVAV(CBVAVNum)%FanVolFlow .LT. CBVAV(CBVAVNum)%CoolOutAirVolFlow .AND. CBVAV(CBVAVNum)%FanVolFlow .NE. AutoSize)THEN
        CBVAV(CBVAVNum)%CoolOutAirVolFlow = CBVAV(CBVAVNum)%FanVolFlow
        CALL ShowWarningError(TRIM(CBVAV(CBVAVNum)%UnitType)//' "'//TRIM(CBVAV(CBVAVNum)%Name)//'"')
        CALL ShowContinueError('The CBVAV system supply air fan air flow rate is less than the autosized value' &
                             //' for the outdoor air flow rate in cooling mode. Consider autosizing the fan for' &
                             //' this simulation.')
        CALL ShowContinueError('The outdoor air flow rate in cooling mode ' &
                             //'is reset to the supply air fan flow rate and the simulation continues.')
      END IF
      IF (CBVAV(CBVAVNum)%CoolOutAirVolFlow < SmallAirVolFlow) THEN
        CBVAV(CBVAVNum)%CoolOutAirVolFlow = 0.0d0
      END IF
      CALL ReportSizingOutput(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name, &
                              'maximum outside air flow rate in cooling [m3/s]',CBVAV(CBVAVNum)%CoolOutAirVolFlow)
    END IF
  END IF
  IF (CBVAV(CBVAVNum)%HeatOutAirVolFlow == AutoSize) THEN
    IF (CurSysNum > 0) THEN
      CALL CheckSysSizing(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name)
      CBVAV(CBVAVNum)%HeatOutAirVolFlow = FinalSysSizing(CurSysNum)%DesOutAirVolFlow
      IF(CBVAV(CBVAVNum)%FanVolFlow .LT. CBVAV(CBVAVNum)%HeatOutAirVolFlow .AND. CBVAV(CBVAVNum)%FanVolFlow .NE. AutoSize)THEN
        CBVAV(CBVAVNum)%HeatOutAirVolFlow = CBVAV(CBVAVNum)%FanVolFlow
        CALL ShowContinueError('The CBVAV system supply air fan air flow rate is less than the autosized value' &
                             //' for the outdoor air flow rate in heating mode. Consider autosizing the fan for' &
                             //' this simulation.')
        CALL ShowContinueError('The outdoor air flow rate in heating mode ' &
                             //'is reset to the supply air fan flow rate and the simulation continues.')
      END IF
      IF (CBVAV(CBVAVNum)%HeatOutAirVolFlow < SmallAirVolFlow) THEN
        CBVAV(CBVAVNum)%HeatOutAirVolFlow = 0.0d0
      END IF
      CALL ReportSizingOutput(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name, &
                              'maximum outdoor air flow rate in heating [m3/s]',CBVAV(CBVAVNum)%CoolOutAirVolFlow)
    END IF
  END IF
  IF (CBVAV(CBVAVNum)%NoCoolHeatOutAirVolFlow == AutoSize) THEN
    IF (CurSysNum > 0) THEN
      CALL CheckSysSizing(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name)
      CBVAV(CBVAVNum)%NoCoolHeatOutAirVolFlow = FinalSysSizing(CurSysNum)%DesOutAirVolFlow
      IF(CBVAV(CBVAVNum)%FanVolFlow .LT. CBVAV(CBVAVNum)%NoCoolHeatOutAirVolFlow .AND. &
         CBVAV(CBVAVNum)%FanVolFlow .NE. AutoSize)THEN
        CBVAV(CBVAVNum)%NoCoolHeatOutAirVolFlow = CBVAV(CBVAVNum)%FanVolFlow
        CALL ShowContinueError('The CBVAV system supply air fan air flow rate is less than the autosized value' &
                             //' for the outdoor air flow rate when no heating or cooling is needed. Consider' &
                             //' autosizing the fan for this simulation.')
        CALL ShowContinueError('The outdoor air flow rate when no heating or cooling is needed ' &
                             //'is reset to the supply air fan flow rate and the simulation continues.')
      END IF
      IF (CBVAV(CBVAVNum)%NoCoolHeatOutAirVolFlow < SmallAirVolFlow) THEN
        CBVAV(CBVAVNum)%NoCoolHeatOutAirVolFlow = 0.0d0
      END IF
      CALL ReportSizingOutput(CBVAV(CBVAVNum)%UnitType, CBVAV(CBVAVNum)%Name, &
                            'maximum outdoor air flow rate when compressor is off [m3/s]',CBVAV(CBVAVNum)%NoCoolHeatOutAirVolFlow)
    END IF
  END IF
  RETURN
END SUBROUTINE SizeCBVAV