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) | :: | SysNum | |||
| logical, | intent(in) | :: | FirstHVACIteration | |||
| integer, | intent(in) | :: | ZoneNum | |||
| integer, | intent(in) | :: | ZoneNodeNum | 
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 SimConstVol(SysNum,FirstHVACIteration, ZoneNum, ZoneNodeNum)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard J. Liesen
          !       DATE WRITTEN   February 2000
          !       MODIFIED       FB/KHL/TH 2/2011: added maximum supply air temperature leaving reheat coil
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine simulates the simple single duct constant volume systems.
          ! METHODOLOGY EMPLOYED:
          ! There is method to this madness.
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
   USE DataZoneEnergyDemands
!unused   USE DataHeatBalFanSys, ONLY: Mat
   USE WaterCoils,   ONLY:SimulateWaterCoilComponents
   USE HeatingCoils, ONLY:SimulateHeatingCoilComponents
   USE SteamCoils,   ONLY:SimulateSteamCoilComponents
   USE PlantUtilities, ONLY: SetActuatedBranchFlowRate
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
   INTEGER, INTENT(IN) :: SysNum
   INTEGER, INTENT(IN) :: ZoneNum
   INTEGER, INTENT (IN):: ZoneNodeNum
   LOGICAL, INTENT (IN):: FirstHVACIteration
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
   REAL(r64) :: MassFlow          ! [kg/sec]   Total Mass Flow Rate from Hot & Cold Inlets
   REAL(r64) :: QZnReq            ! [Watts]
   REAL(r64) :: QToHeatSetPt      ! [W]  remaining load to heating setpoint
   REAL(r64) :: CpAir
   INTEGER   :: WaterControlNode  !This is the Actuated Reheat Control Node
   REAL(r64) :: MaxFlowWater      !This is the value passed to the Controller depending if FirstHVACIteration or not
   REAL(r64) :: MinFlowWater      !This is the value passed to the Controller depending if FirstHVACIteration or not
   REAL(r64) :: QActualHeating    ! the heating load seen by the reheat coil
   REAL(r64) :: TAirMax = 0.0D0   ! Maximum zone supply air temperature [C]
   REAL(r64) :: QMax    = 0.0D0   ! Maximum heat addition rate imposed by the max zone supply air temperature [W]
   REAL(r64) :: ZoneTemp   = 0.0D0   ! Zone temperature [C]
   REAL(r64) :: QMax2    = 0.0D0
   REAL(r64) :: DummyMdot  ! local fluid mass flow rate
   QToHeatSetPt=ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP ! The calculated load from the Heat Balance
   MassFlow = SysInlet(SysNum)%AirMassFlowRateMaxAvail ! System massflow is set to the Available
   QMax2 = QToHeatSetPt
   ZoneTemp = Node(ZoneNodeNum)%Temp
   CpAir = PsyCpAirFnWTdb(Node(ZoneNodeNum)%HumRat,ZoneTemp) ! zone air specific heat
   IF (Sys(SysNum)%MaxReheatTempSetByUser) THEN
       TAirMax = Sys(Sysnum)%MaxReheatTemp
       QMax = CpAir*MassFlow*(TAirMax-ZoneTemp)
       QMax2 = MIN(QToHeatSetPt,QMax)
   END IF     ! IF (Sys(SysNum)%MaxReheatTempSetByUser) THEN
   If(((SysInlet(SysNum)%AirMassFlowRateMaxAvail == 0.0D0) .and.  &
            (SysInlet(SysNum)%AirMassFlowRateMinAvail == 0.0D0)) .or.  &
            (SysInlet(SysNum)%AirMassFlowRate == 0.0D0)) Then
   ! System is Off set massflow to 0.0
     MassFlow = 0.0D0
   End If
   ! Calculate the Damper Position when there is a Max air flow specified.
   If(Sys(Sysnum)%AirMassFlowRateMax == 0.0D0) Then
     Sys(Sysnum)%DamperPosition = 0.0D0
   Else
     Sys(Sysnum)%DamperPosition = MassFlow/Sys(Sysnum)%AirMassFlowRateMax
   End If
   ! make sure the inlet node flow rate is updated if the mass flow has been limited
   SysOutlet(SysNum)%AirMassFlowRate = MassFlow
   SysOutlet(SysNum)%AirMassFlowRateMaxAvail = SysInlet(SysNum)%AirMassFlowRateMaxAvail
   SysOutlet(SysNum)%AirMassFlowRateMinAvail = SysInlet(SysNum)%AirMassFlowRateMinAvail
   Call UpdateSys(SysNum)
   QActualHeating = QToHeatSetPt - Massflow * CpAir * (SysInlet(SysNum)%AirTemp-ZoneTemp) ! reheat needed
   !Now the massflow for reheating has been determined. If it is zero, or in SetBack, or the
   ! system scheduled OFF then not operational and shut the system down.
   If((MassFlow > SmallMassFlow) .AND. (QActualHeating > 0.0D0) .AND. &
      (TempControlType(ZoneNum) .NE. SingleCoolingSetPoint)) Then
     SELECT CASE(Sys(SysNum)%ReheatComp_Num)
       CASE(HCoilType_SimpleHeating) ! COIL:WATER:SIMPLEHEATING
         ! Determine the load required to pass to the Component controller
         QZnReq = QMax2 + Massflow * CpAir * ZoneTemp
         !Before Iterating through the Reheat Coil and Controller set the flags for the
         ! Do Loop to initialized conditions.
        ! Node(Sys(SysNum)%ReheatControlNode)%MassFlowRate = 0.0D0
         ! Initialize hot water flow rate to zero.
         DummyMdot = 0.0D0
         CALL SetActuatedBranchFlowRate(DummyMdot,Sys(SysNum)%ReheatControlNode,  &
              Sys(SysNum)%HWLoopNum,Sys(SysNum)%HWLoopSide, Sys(SysNum)%HWBranchIndex, .TRUE.)
         !On the first HVAC iteration the system values are given to the controller, but after that
         ! the demand limits are in place and there needs to be feedback to the Zone Equipment
         If(FirstHVACIteration)Then
            MaxFlowWater = Sys(SysNum)%MaxReheatWaterFlow
            MinFlowWater = Sys(SysNum)%MinReheatWaterFlow
         Else
            WaterControlNode = Sys(SysNum)%ReheatControlNode
            MaxFlowWater = Node(WaterControlNode)%MassFlowRateMaxAvail
            MinFlowWater = Node(WaterControlNode)%MassFlowRateMinAvail
         EndIf
         ! Simulate reheat coil for the Const Volume system
         ! Set Converged to True & when controller is not converged it will set to False.
         CALL ControlCompOutput(CompName=Sys(SysNum)%ReheatName,         &
                            CompType=Sys(SysNum)%ReheatComp,             &
                            CompNum=Sys(SysNum)%ReheatComp_Index,        &
                            FirstHVACIteration=FirstHVACIteration,       &
                            QZnReq=QZnReq,                               &
                            ActuatedNode=Sys(SysNum)%ReheatControlNode,  &
                            MaxFlow=MaxFlowWater,                        &
                            MinFlow=MinFlowWater,                        &
                            TempOutNode=Sys(SysNum)%ReheatAirOutletNode, &
                            ControlOffSet=Sys(SysNum)%ControllerOffset,  &
                            AirMassFlow=Massflow,                        &
                            ControlCompTypeNum=Sys(SysNum)%ControlCompTypeNum, &
                            CompErrIndex=Sys(SysNum)%CompErrIndex, &
                            LoopNum     = Sys(SysNum)%HWLoopNum,              &
                            LoopSide    = Sys(SysNum)%HWLoopSide,             &
                            BranchIndex = Sys(SysNum)%HWBranchIndex)
       CASE(HCoilType_SteamAirHeating) ! COIL:STEAM:STEAMAIRHEATING
         ! Determine the load required to pass to the Component controller
         QZnReq = QMax2 - Massflow * CpAir * (SysInlet(SysNum)%AirTemp-ZoneTemp)
         ! Simulate reheat coil for the VAV system
         CALL SimulateSteamCoilComponents(CompName=Sys(SysNum)%ReheatName,       &
                                          FirstHVACIteration=FirstHVACIteration, &
                                          QCoilReq=QZnReq,                       &
                                          CompIndex=Sys(SysNum)%ReheatComp_Index)
       CASE(HCoilType_Electric) ! COIL:ELECTRIC:HEATING
         ! Determine the load required to pass to the Component controller
         QZnReq = QMax2 - Massflow * CpAir * (SysInlet(SysNum)%AirTemp-ZoneTemp)
         ! Simulate reheat coil for the VAV system
         CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName,       &
                                            FirstHVACIteration=FirstHVACIteration, &
                                            QCoilReq=QZnReq,                       &
                                            CompIndex=Sys(SysNum)%ReheatComp_Index)
       CASE(HCoilType_Gas) ! COIL:GAS:HEATING
         ! Determine the load required to pass to the Component controller
         QZnReq = QMax2 - Massflow * CpAir * (SysInlet(SysNum)%AirTemp-ZoneTemp)
         ! Simulate reheat coil for the VAV system
         CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName,       &
                                            FirstHVACIteration=FirstHVACIteration, &
                                            QCoilReq=QZnReq,                       &
                                            CompIndex=Sys(SysNum)%ReheatComp_Index)
       CASE DEFAULT
         CALL ShowFatalError('Invalid Reheat Component='//TRIM(Sys(SysNum)%ReheatComp))
     END SELECT
   !the COIL is OFF the properties are calculated for this special case.
   Else
     SELECT CASE(Sys(SysNum)%ReheatComp_Num)
       CASE(HCoilType_SimpleHeating) ! COIL:WATER:SIMPLEHEATING
         ! Simulate reheat coil for the Const Volume system
         !Node(Sys(SysNum)%ReheatControlNode)%MassFlowRate = 0.0D0
         ! Initialize hot water flow rate to zero.
         DummyMdot = 0.0D0
         CALL SetActuatedBranchFlowRate(DummyMdot,Sys(SysNum)%ReheatControlNode,  &
              Sys(SysNum)%HWLoopNum,Sys(SysNum)%HWLoopSide, Sys(SysNum)%HWBranchIndex, .TRUE.)
         !call the reheat coil with the NO FLOW condition to make sure that the Node values
         ! are passed through to the coil outlet correctly
         CALL SimulateWaterCoilComponents(Sys(SysNum)%ReheatName,FirstHVACIteration,  &
                                            CompIndex=Sys(SysNum)%ReheatComp_Index)
       CASE(HCoilType_SteamAirHeating) ! COIL:STEAM:AIRHEATING
         ! Simulate reheat coil for the Const Volume system
         CALL SimulateSteamCoilComponents(CompName=Sys(SysNum)%ReheatName,       &
                                          FirstHVACIteration=FirstHVACIteration, &
                                          QCoilReq=0.0d0,       &
                                          CompIndex=Sys(SysNum)%ReheatComp_Index)
       CASE(HCoilType_Electric) ! COIL:ELECTRIC:HEATING
         ! Simulate reheat coil for the Const Volume system
         CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName,       &
                                            FirstHVACIteration=FirstHVACIteration, &
                                            QCoilReq=0.0d0,       &
                                            CompIndex=Sys(SysNum)%ReheatComp_Index)
       CASE(HCoilType_Gas) ! COIL:GAS:HEATING
         ! Simulate reheat coil for the Const Volume system
         CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName,       &
                                            FirstHVACIteration=FirstHVACIteration, &
                                            QCoilReq=0.0d0,       &
                                            CompIndex=Sys(SysNum)%ReheatComp_Index)
       CASE DEFAULT
         CALL ShowFatalError('Invalid Reheat Component='//TRIM(Sys(SysNum)%ReheatComp))
     END SELECT
   End IF
!Debugging output for model
!If((HourofDay .ge. 8) .and. (hourofDay .lt. 15)) Then
!      Write(OutputFileDebug,*)  'Day of Sim     Hour of Day    Time'
!      Write(OutputFileDebug,*)  DayofSim, HourOfDay, TimeStep*TimeStepZone
!      Write(OutputFileDebug,10)
!
!      Write(OutputFileDebug,20)ZoneNum, SysInlet(SysNum)%AirMassFlowRate, &
!                             SysInlet(SysNum)%AirMassFlowRate, &
!                              Temperature, Mat(ZoneNum), Node(ZoneNodeNum)%Temp, QTotLoad, &
!                             Enthalpy
!End If
!10 Format('ZoneNum    SysHot    SysCold   Temp  &
!      &    MAT        NodeZoneTemp    QTotLoad  Enthalpy')
!
!20 Format(1x,I3,3x, 5(2x, F9.4), 2(2x, F9.2))
 RETURN
END SUBROUTINE SimConstVol