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.
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 ReportMaxVentilationLoads
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Dan Fisher (with minor assistance from RKS)
          !       DATE WRITTEN   July 2004
          !       MODIFIED       Dec. 2006, BG. reengineered to add zone forced air units to vent rates and loads
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! calculate and report zone ventilation loads
          ! METHODOLOGY EMPLOYED:
          ! calculate energy contribution of outside air through mixing box and pro-rate to
          ! zones according to zone mass flow rates.
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE  Psychrometrics, ONLY: PsyHFnTdbW, PsyRhoAirFnPbTdbW
  USE  DataZoneEnergyDemands
  USE  DataGlobalConstants
  USE  DataHeatBalance, ONLY: Zone, ZnAirRpt, ZonePreDefRep
  USE  DataHeatBalFanSys, ONLY: MAT, ZoneAirHumRatAvg
  USE  DataEnvironment, ONLY: StdBaroPress, StdRhoAir, OutAirDensity, OutBaroPress
  USE WindowAC,                  Only : GetWindowACOutAirNode, GetWindowACMixedAirNode, &
                                        GetWindowACZoneInletAirNode, GetWindowACReturnAirNode
  USE PackagedTerminalHeatPump,  Only : GetPTUnitOutAirNode, GetPTUnitMixedAirNode, &
                                        GetPTUnitZoneInletAirNode, GetPTUnitReturnAirNode
  USE FanCoilUnits,              Only : GetFanCoilOutAirNode, GetFanCoilMixedAirNode, &
                                        GetFanCoilZoneInletAirNode, GetFanCoilReturnAirNode
  USE UnitVentilator ,           Only : GetUnitVentilatorOutAirNode, GetUnitVentilatorMixedAirNode, &
                                        GetUnitVentilatorZoneInletAirNode, GetUnitVentilatorReturnAirNode
  USE PurchasedAirManager,       Only : GetPurchasedAirOutAirMassFlow, GetPurchasedAirZoneInletAirNode, &
                                        GetPurchasedAirMixedAirTemp, GetPurchasedAirMixedAirHumRat, GetPurchasedAirReturnAirNode
  USE HVACStandAloneERV ,        Only : GetStandAloneERVOutAirNode, GetStandAloneERVReturnAirNode, &
                                        GetStandAloneERVZoneInletAirNode
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
          ! na
          ! SUBROUTINE PARAMETER DEFINITIONS:
    REAL(r64), PARAMETER :: SmallLoad = 0.1d0  !(W)
    REAL(r64), PARAMETER :: KJperJ = 0.001d0   !kilojoules per joules
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
    INTEGER     ::  CtrlZoneNum         !ZONE counter
    INTEGER     ::  ZoneInNum           !counter for zone air distribution inlets
    INTEGER     ::  ReturnAirNode       !node number for return node on primary air loop
    INTEGER     ::  MixedAirNode        !mixed air node number (right after the mixing box) on primary air loop
    INTEGER     ::  AirLoopNum
    INTEGER     ::  AirDistCoolInletNodeNum
    INTEGER     ::  AirDistHeatInletNodeNum
    REAL(r64)   ::  AirSysEnthReturnAir      !enthalpy of the return air (mixing box inlet node, return side)
    REAL(r64)   ::  AirSysEnthMixedAir       !enthalpy of the mixed air (mixing box outlet node, mixed air side)
    REAL(r64)   ::  AirSysZoneVentLoad       !ventilation load attributed to a particular zone from primary air system
    REAL(r64)   ::  ADUCoolFlowrate
    REAL(r64)   ::  ADUHeatFlowrate
    REAL(r64)   ::  AirSysTotalMixFlowRate   !Mixed air flow
    REAL(r64)   ::  AirSysOutAirFlow         ! outside air flow rate for zone from primary air system
    REAL(r64)   ::  ZFAUEnthReturnAir !Zone forced Air unit enthalpy of the return air
    REAL(r64)   ::  ZFAUTempMixedAir  !Zone forced Air unit dry-bulb temperature of the mixed air
    REAL(r64)   ::  ZFAUHumRatMixedAir  !Zone forced Air unit humidity ratio of the mixed air
    REAL(r64)   ::  ZFAUEnthMixedAir  !Zone forced Air unit enthalpy of the mixed air
    REAL(r64)   ::  ZFAUFlowRate
    REAL(r64)   ::  ZFAUZoneVentLoad !ventilation load attributed to a particular zone from zone forced air units
    REAL(r64)   ::  ZFAUOutAirFlow   !outside air flow rate for zone from zone forced air units.
    INTEGER     ::  ZoneInletAirNode
    REAL(r64)   ::  ZoneVentLoad        !ventilation load attributed to a particular zone
    REAL(r64)   ::  ZoneLoad            !ventilation load attributed to a particular zone
    REAL(r64)   ::  OutAirFlow        !Total outside air flow
    REAL(r64)   ::  ZoneFlowFrac      !fraction of mixed air flowing to a zone
    REAL(r64)   ::  ZoneVolume        !Volume of zone
    REAL(r64)   ::  currentZoneAirDensity ! current zone air density (outside barometric pressure)
    INTEGER     ::  ActualZoneNum
    INTEGER     ::  OutAirNode
    INTEGER     ::  thisZoneEquipNum  ! loop counter
!  CALL GetComponentEnergyUse
    IF (.not. VentReportStructureCreated) RETURN
    IF (.not. VentLoadsReportEnabled) RETURN
    !following inits are array assignments across all controlled zones.
    ZoneOAMassFlow               = 0.0d0
    ZoneOAMass                   = 0.0d0
    ZoneOAVolFlowStdRho          = 0.0d0
    ZoneOAVolStdRho              = 0.0d0
    ZoneOAVolFlowCrntRho         = 0.0d0
    ZoneOAVolCrntRho             = 0.0d0
    ZoneMechACH                  = 0.0d0
    MaxCoolingLoadMetByVent      = 0.0d0
    MaxCoolingLoadAddedByVent    = 0.0d0
    MaxOvercoolingByVent         = 0.0d0
    MaxHeatingLoadMetByVent      = 0.0d0
    MaxHeatingLoadAddedByVent    = 0.0d0
    MaxOverheatingByVent         = 0.0d0
    MaxNoLoadHeatingByVent       = 0.0d0
    MaxNoLoadCoolingByVent       = 0.0d0
  DO CtrlZoneNum=1,NumOfZones
    IF (.not. ZoneEquipConfig(CtrlZoneNum)%IsControlled) CYCLE
    ! first clear out working variables from previous zone.
    AirDistCoolInletNodeNum      = 0
    AirDistHeatInletNodeNum      = 0
    ADUCoolFlowrate              = 0.0d0
    ADUHeatFlowrate              = 0.0d0
    AirSysTotalMixFlowRate       = 0.0d0
    AirSysZoneVentLoad           = 0.0d0
    AirSysOutAirFlow             = 0.0d0
    ZFAUFlowRate                 = 0.0d0
    ZFAUZoneVentLoad             = 0.0d0
    ZFAUOutAirFlow               = 0.0d0
    OutAirFlow                   = 0.0d0
    ZoneFlowFrac                 = 0.0d0
    ZoneVolume                   = 0.0d0
    !retrieve the zone load for each zone
    ActualZoneNum = ZoneEquipConfig(CtrlZoneNum)%ActualZoneNum
    ZoneLoad      = ZoneSysEnergyDemand(ActualZoneNum)%TotalOutputRequired
    ZoneVolume     = Zone(ActualZoneNum)%Volume * Zone(ActualZoneNum)%Multiplier * Zone(ActualZoneNum)%ListMultiplier  !CR 7170
        !if system operating in deadband reset zone load
    IF (DeadbandOrSetback(ActualZoneNum)) ZoneLoad = 0.0d0
    IF (DeadbandOrSetback(ActualZoneNum))THEN
     DBFlag = 1
    ELSE
     DBFlag = 0
    ENDIF
  !  IF(AirLoopNum == 0 ) CYCLE   !orig line (BG 12-8-06 changed, zone forced air equipment seems to get excluded here...)
    ! first deal with any (and all) Zone Forced Air Units that might have outside air.
    DO thisZoneEquipNum = 1, ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%NumOfEquipTypes
      SELECT CASE (ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipType_Num(thisZoneEquipNum))
      ! case statement to cover all possible zone forced air units that could have outside air
      CASE (WindowAC_Num)    ! Window Air Conditioner
        OutAirNode =   &
           GetWindowACOutAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If (OutAirNode > 0)  ZFAUOutAirFlow = ZFAUOutAirFlow + Node(OutAirNode)%MassFlowRate
        ZoneInletAirNode =   &
           GetWindowACZoneInletAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If (ZoneInletAirNode > 0) ZFAUFlowRate =  MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
        MixedAirNode  =   &
           GetWindowACMixedAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        ReturnAirNode =   &
           GetWindowACReturnAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If ((MixedAirNode > 0) .AND. (ReturnAirNode > 0)) then
          ZFAUEnthMixedAir  = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
          ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
           !Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
          ZFAUZoneVentLoad = ZFAUZoneVentLoad +   &
             (ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
        ELSE
          ZFAUZoneVentLoad =  ZFAUZoneVentLoad +  0.0d0
        ENDIF
      CASE (PkgTermHPAirToAir_Num, PkgTermACAirToAir_Num, PkgTermHPWaterToAir_Num)
        OutAirNode = GetPTUnitOutAirNode(ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum), &
                                ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipType_Num(thisZoneEquipNum) )
        If (OutAirNode > 0)  ZFAUOutAirFlow = ZFAUOutAirFlow + Node(OutAirNode)%MassFlowRate
        ZoneInletAirNode =   &
           GetPTUnitZoneInletAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) , &
                                      ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipType_Num(thisZoneEquipNum))
        If (ZoneInletAirNode > 0) ZFAUFlowRate =  MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
        MixedAirNode  =   &
           GetPTUnitMixedAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum), &
                                  ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipType_Num(thisZoneEquipNum) )
        ReturnAirNode =   &
           GetPTUnitReturnAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum), &
                                   ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipType_Num(thisZoneEquipNum) )
        If ((MixedAirNode > 0) .AND. (ReturnAirNode > 0)) then
          ZFAUEnthMixedAir  = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
          ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
           !Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
          ZFAUZoneVentLoad = ZFAUZoneVentLoad +   &
             (ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
        ELSE
          ZFAUZoneVentLoad =  ZFAUZoneVentLoad +  0.0d0
        ENDIF
      CASE (FanCoil4Pipe_Num)
        OutAirNode =   &
           GetFanCoilOutAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If (OutAirNode > 0)  ZFAUOutAirFlow = ZFAUOutAirFlow + Node(OutAirNode)%MassFlowRate
        ZoneInletAirNode =   &
           GetFanCoilZoneInletAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If (ZoneInletAirNode > 0) ZFAUFlowRate =  MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
        MixedAirNode  =   &
           GetFanCoilMixedAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        ReturnAirNode =   &
           GetFanCoilReturnAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If ((MixedAirNode > 0) .AND. (ReturnAirNode > 0)) then
          ZFAUEnthMixedAir  = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
          ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
           !Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
          ZFAUZoneVentLoad = ZFAUZoneVentLoad +   &
             (ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
        ELSE
          ZFAUZoneVentLoad =  ZFAUZoneVentLoad +  0.0d0
        ENDIF
      CASE (UnitVentilator_Num)
        OutAirNode =   &
           GetUnitVentilatorOutAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If (OutAirNode > 0)  ZFAUOutAirFlow = ZFAUOutAirFlow + Node(OutAirNode)%MassFlowRate
        ZoneInletAirNode =   &
           GetUnitVentilatorZoneInletAirNode(   &
              ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If (ZoneInletAirNode > 0) ZFAUFlowRate =  MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
        MixedAirNode  =   &
           GetUnitVentilatorMixedAirNode(   &
              ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        ReturnAirNode =   &
           GetUnitVentilatorReturnAirNode(   &
              ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If ((MixedAirNode > 0) .AND. (ReturnAirNode > 0)) then
          ZFAUEnthMixedAir  = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
          ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
           !Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
          ZFAUZoneVentLoad = ZFAUZoneVentLoad +   &
             (ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
        ELSE
          ZFAUZoneVentLoad =  ZFAUZoneVentLoad +  0.0d0
        ENDIF
      CASE (PurchasedAir_Num)
        ZFAUOutAirFlow = ZFAUOutAirFlow +   &
          GetPurchasedAirOutAirMassFlow( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        ZoneInletAirNode =   &
           GetPurchasedAirZoneInletAirNode(   &
              ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If (ZoneInletAirNode > 0) ZFAUFlowRate =  MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
        ZFAUTempMixedAir  =  &
           GetPurchasedAirMixedAirTemp(   &
              ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        ZFAUHumRatMixedAir  =  &
           GetPurchasedAirMixedAirHumRat(   &
              ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        ReturnAirNode =   &
           GetPurchasedAirReturnAirNode(   &
              ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If ((ZFAUFlowRate > 0) .AND. (ReturnAirNode > 0)) then
          ZFAUEnthMixedAir  = PsyHFnTdbW(ZFAUTempMixedAir, ZFAUHumRatMixedAir)
          ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
           !Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
          ZFAUZoneVentLoad = ZFAUZoneVentLoad +   &
             (ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
        ELSE
          ZFAUZoneVentLoad =  ZFAUZoneVentLoad +  0.0d0
        ENDIF
      CASE (ERVStandAlone_Num)
        OutAirNode =   &
           GetStandAloneERVOutAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If (OutAirNode > 0)  ZFAUOutAirFlow = ZFAUOutAirFlow + Node(OutAirNode)%MassFlowRate
        ZoneInletAirNode =   &
           GetStandAloneERVZoneInletAirNode(   &
              ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If (ZoneInletAirNode > 0) ZFAUFlowRate =  MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
        MixedAirNode  = ZoneInletAirNode
        ReturnAirNode =   &
           GetStandAloneERVReturnAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
        If ((MixedAirNode > 0) .AND. (ReturnAirNode > 0)) then
          ZFAUEnthMixedAir  = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
          ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
           !Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
          ZFAUZoneVentLoad = ZFAUZoneVentLoad +   &
             (ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
        ELSE
          ZFAUZoneVentLoad =  ZFAUZoneVentLoad +  0.0d0
        ENDIF
      END SELECT
    ENDDO
        ! retrieve air loop indexes
    AirLoopNum = ZoneEquipConfig(CtrlZoneNum)%AirLoopNum
    If (AirLoopNum /= 0 ) then  ! deal with primary air system
        !loop over the zone supply air path inlet nodes
      DO ZoneInNum=1,ZoneEquipConfig(CtrlZoneNum)%NumInletNodes
        AirDistCoolInletNodeNum  = MAX(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode,0)
        AirDistHeatInletNodeNum  = MAX(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%InNode,0)
         ! Set for cooling or heating path
        IF(AirDistCoolInletNodeNum > 0 .AND. AirDistHeatInletNodeNum == 0)THEN
          ADUCoolFlowrate = ADUCoolFlowrate & ! CR7244 need to accumulate flow across multiple inlets
                            + MAX(Node(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode)%MassFlowRate,0.0d0)
        ELSEIF(AirDistHeatInletNodeNum > 0 .AND. AirDistCoolInletNodeNum == 0)THEN
          ADUHeatFlowrate = ADUHeatFlowrate & ! CR7244 need to accumulate flow across multiple inlets
                            + MAX(Node(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%InNode)%MassFlowRate,0.0d0)
        ELSEIF(AirDistCoolInletNodeNum > 0 .AND. AirDistHeatInletNodeNum > 0 .AND. &
               AirDistCoolInletNodeNum /= AirDistHeatInletNodeNum) THEN
           ! dual ducts! CR7244 need to accumulate flow across multiple inlets (don't count same inlet twice)
          ADUHeatFlowrate = ADUHeatFlowrate & ! CR7244 need to accumulate flow across multiple inlets
                            + MAX(Node(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%InNode)%MassFlowRate,0.0d0)
          ADUCoolFlowrate = ADUCoolFlowrate & ! CR7244 need to accumulate flow across multiple inlets
                            + MAX(Node(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode)%MassFlowRate,0.0d0)
        ELSEIF(AirDistCoolInletNodeNum > 0 .AND. AirDistHeatInletNodeNum > 0) THEN
           ! dual ducts! CR7244 need to accumulate flow across multiple inlets (don't count same inlet twice)
          ADUCoolFlowrate = ADUCoolFlowrate & ! CR7244 need to accumulate flow across multiple inlets
                            + MAX(Node(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode)%MassFlowRate,0.0d0)
        ELSE
          ! do nothing (already inits)
        END IF
      END DO
        !Find the mixed air node and return air node of the system that supplies the zone
      MixedAirNode     = PrimaryAirSystem(AirLoopNum)%OASysOutletNodeNum
      ReturnAirNode    = PrimaryAirSystem(AirLoopNum)%OASysInletNodeNum
      IF(MixedAirNode == 0 .OR. ReturnAirNode == 0)  then
        AirSysZoneVentLoad = 0.0d0
        AirSysOutAirFlow   = 0.0d0
      ELSE
        !Calculate return and mixed air ethalpies
        AirSysEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
        AirSysEnthMixedAir  = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
        IF(PrimaryAirSystem(AirLoopNum)%OASysExists) THEN
          OutAirNode = PrimaryAirSystem(AirLoopNum)%OAMixOAInNodeNum
          AirSysOutAirFlow = Node(OutAirNode)%MassFlowRate
        ELSE
          AirSysOutAirFlow = 0.0d0
        END IF
        AirSysTotalMixFlowRate = Node(MixedAirNode)%MassFlowRate
        IF(AirSysTotalMixFlowRate .NE. 0.0d0) THEN
          ZoneFlowFrac = (ADUCoolFlowrate+ADUHeatFlowrate)/AirSysTotalMixFlowRate
          AirSysOutAirFlow  = ZoneFlowFrac * AirSysOutAirFlow
        ELSE
          ZoneFlowfrac = 0.0d0
          AirSysOutAirFlow  = 0.0d0
        END IF
        !Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
        AirSysZoneVentLoad =   &
           (ADUCoolFlowrate+ADUHeatFlowrate)*(AirSysEnthMixedAir-AirSysEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
      ENDIF
    END IF ! primary air system present
    !now combine OA flow from zone forced air units with primary air system
    OutAirFlow  = AirSysOutAirFlow + ZFAUOutAirFlow
      ! assign report variables
    ZoneOAMassFlow(CtrlZoneNum) = OutAirFlow
    ZoneOAMass(CtrlZoneNum)     = ZoneOAMassFlow(CtrlZoneNum)* TimeStepSys* SecInHour
    ! determine volumetric values from mass flow using standard density (adjusted for elevation)
    ZoneOAVolFlowStdRho(CtrlZoneNum)  = ZoneOAMassFlow(CtrlZoneNum) / StdRhoAir
    ZoneOAVolStdRho(CtrlZoneNum)      = ZoneOAVolFlowStdRho(CtrlZoneNum) * TimeStepSys* SecInHour
    ! determine volumetric values from mass flow using current air density for zone (adjusted for elevation)
    currentZoneAirDensity =   PsyRhoAirFnPbTdbW(OutBaroPress, MAT(ActualZoneNum), ZoneAirHumRatAvg(ActualZoneNum))
    IF (currentZoneAirDensity > 0.0D0) ZoneOAVolFlowCrntRho(CtrlZoneNum)  = ZoneOAMassFlow(CtrlZoneNum) / currentZoneAirDensity
    ZoneOAVolCrntRho(CtrlZoneNum)  = ZoneOAVolFlowCrntRho(CtrlZoneNum) * TimeStepSys* SecInHour
    if (ZoneVolume > 0.0d0)  ZoneMechACH(CtrlZoneNum)    = (ZoneOAVolCrntRho(CtrlZoneNum) / TimeStepSys)/ZoneVolume
    !store data for predefined tabular report on outside air
    IF (ZonePreDefRep(ActualZoneNum)%isOccupied) THEN
      !accumulate the occupied time
      ZonePreDefRep(ActualZoneNum)%TotTimeOcc = ZonePreDefRep(ActualZoneNum)%TotTimeOcc + TimeStepSys
      !mechnical ventilation
      ZonePreDefRep(ActualZoneNum)%MechVentVolTotal = ZonePreDefRep(ActualZoneNum)%MechVentVolTotal + &
        ZoneOAVolCrntRho(CtrlZoneNum)
      IF ((ZoneOAVolCrntRho(CtrlZoneNum) / TimeStepSys) .LT. ZonePreDefRep(ActualZoneNum)%MechVentVolMin) THEN
        ZonePreDefRep(ActualZoneNum)%MechVentVolMin = ZoneOAVolCrntRho(CtrlZoneNum) / TimeStepSys
      END IF
      !infiltration
      ZonePreDefRep(ActualZoneNum)%InfilVolTotal = ZonePreDefRep(ActualZoneNum)%InfilVolTotal + &
        ZnAirRpt(ActualZoneNum)%InfilVolumeCurDensity
      IF (ZnAirRpt(ActualZoneNum)%InfilVolumeCurDensity .LT. ZonePreDefRep(ActualZoneNum)%InfilVolMin) THEN
        ZonePreDefRep(ActualZoneNum)%InfilVolMin = ZnAirRpt(ActualZoneNum)%InfilVolumeCurDensity
      END IF
      !'simple' mechanical ventilation
      ZonePreDefRep(ActualZoneNum)%SimpVentVolTotal = ZonePreDefRep(ActualZoneNum)%SimpVentVolTotal + &
        ZnAirRpt(ActualZoneNum)%VentilVolumeCurDensity
      IF (ZnAirRpt(ActualZoneNum)%VentilVolumeCurDensity .LT. ZonePreDefRep(ActualZoneNum)%SimpVentVolMin) THEN
        ZonePreDefRep(ActualZoneNum)%SimpVentVolMin = ZnAirRpt(ActualZoneNum)%VentilVolumeCurDensity
      END IF
    END IF
    !now combine Vent load from zone forced air units with primary air system
    ZoneVentLoad  = AirSysZoneVentLoad + ZFAUZoneVentLoad
    !cycle if ZoneVentLoad is small
    IF(ABS(ZoneVentLoad) < SmallLoad) CYCLE  ! orig. had RETURN here, BG changed to CYCLE for next controlled zone in do loop.
    !Ventilation Heating
    IF (ZoneVentLoad > SmallLoad)THEN
           !Zone cooling load
      IF(ZoneLoad < -SmallLoad)THEN
        MaxCoolingLoadAddedByVent(CtrlZoneNum) = MaxCoolingLoadAddedByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
          !Zone heating load
      ELSEIF(ZoneLoad > SmallLoad)THEN
        IF(ZoneVentLoad > ZoneLoad)THEN
            MaxHeatingLoadMetByVent(CtrlZoneNum) = MaxHeatingLoadMetByVent(CtrlZoneNum) + ABS(ZoneLoad)
            MaxOverheatingByVent(CtrlZoneNum) = MaxOverheatingByVent(CtrlZoneNum) + &
            (ZoneVentLoad - ZoneLoad )
        ELSE
            MaxHeatingLoadMetByVent(CtrlZoneNum) = MaxHeatingLoadMetByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
        ENDIF
            !No Zone Load
      ELSE
          MaxNoLoadHeatingByVent(CtrlZoneNum) = MaxNoLoadHeatingByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
      ENDIF
        !Ventilation Cooling
    ELSEIF (ZoneVentLoad < -SmallLoad)THEN
            !Zone cooling load
      IF(ZoneLoad < -SmallLoad)THEN
        IF(ZoneVentLoad < ZoneLoad)THEN
          MaxCoolingLoadMetByVent(CtrlZoneNum) = MaxCoolingLoadMetByVent(CtrlZoneNum) + ABS(ZoneLoad)
          MaxOvercoolingByVent(CtrlZoneNum) = MaxOvercoolingByVent(CtrlZoneNum) + &
            ABS(ZoneVentLoad - ZoneLoad )
        ELSE
          MaxCoolingLoadMetByVent(CtrlZoneNum) = MaxCoolingLoadMetByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
        ENDIF
             !Zone heating load
      ELSEIF(ZoneLoad > SmallLoad)THEN
        MaxHeatingLoadAddedByVent(CtrlZoneNum) = MaxHeatingLoadAddedByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
        !No Zone Load
      ELSE
        MaxNoLoadCoolingByVent(CtrlZoneNum) = MaxNoLoadCoolingByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
      ENDIF
   !Ventilation No Load
    ELSE
    ENDIF
  END DO  ! loop over controlled zones
  RETURN
END Subroutine ReportMaxVentilationLoads