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) | :: | UnitarySysNum | |||
| logical, | intent(in) | :: | FirstHVACIteration | 
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 ControlSuppHeatSystem(UnitarySysNum, FirstHVACIteration )
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard Raustad, FSEC
          !       DATE WRITTEN   February 2013
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          !  This subroutine updates the System outlet nodes.
          ! METHODOLOGY EMPLOYED:
          !  Data is moved from the System data structure to the System outlet nodes.
          ! REFERENCES:
          !  na
          ! USE STATEMENTS:
  USE DataAirLoop,     ONLY: LoopHeatingCoilMaxRTF, LoopDXCoilRTF
  USE Psychrometrics,  ONLY: PsyHFnTdbW, PsyTdpFnWPb
  USE General,         ONLY: SolveRegulaFalsi, RoundSigDigits
  USE HeatingCoils,    ONLY: SimulateHeatingCoilComponents
  USE WaterCoils,      ONLY: SimulateWaterCoilComponents
  USE SteamCoils,      ONLY: SimulateSteamCoilComponents
  USE PlantUtilities,  ONLY: SetComponentFlowRate
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER,  INTENT(In)    :: UnitarySysNum           ! index to Unitary System
  LOGICAL,  INTENT(In)    :: FirstHVACIteration      ! First HVAC iteration flag
          ! SUBROUTINE PARAMETER DEFINITIONS:
  INTEGER, PARAMETER   :: MaxIte    = 500     ! Maximum number of iterations for solver
  REAL(r64), PARAMETER :: Acc       = 1.0d-3  ! Accuracy of solver result
  REAL(r64), PARAMETER :: HumRatAcc = 1.0d-6  ! Accuracy of solver result
  INTEGER, PARAMETER   :: SolveMaxIter=50
          ! INTERFACE BLOCK SPECIFICATIONS
          !  na
          ! DERIVED TYPE DEFINITIONS
          !  na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  CHARACTER(len=MaxNameLength)  :: CompName  ! Name of the heating coil
  INTEGER             :: CompIndex           ! Index to the heating coil
!  REAL(r64)           :: NoOutput            ! Sensible capacity (outlet - inlet) when the compressor is off
  REAL(r64)           :: FullOutput          ! Sensible capacity (outlet - inlet) when the compressor is on
  REAL(r64)           :: ReqOutput           ! Sensible capacity (outlet - inlet) required to meet load or set point temperature
  Integer             :: InletNode           ! Inlet node number of the DX cooling coil
  Integer             :: OutletNode          ! Outlet node number of the DX cooling coil
  Integer             :: ControlNode         ! The node number where a set point is placed to control the DX cooling coil
  REAL(r64)           :: PartLoadFrac        ! The part-load fraction of the compressor
  REAL(r64)           :: DesOutTemp          ! Desired outlet temperature of the DX cooling coil
  REAL(r64)           :: QCoilActual         ! Heating coil operating capacity [W]
  INTEGER             :: SolFla              ! Flag of solver, num iterations if >0, else error index
  REAL(r64), DIMENSION(5)  :: Par            ! Parameter array passed to solver
  LOGICAL             :: SensibleLoad        ! True if there is a sensible cooling load on this system
  INTEGER             :: FanOpMode           ! Supply air fan operating mode
  REAL(R64)           :: LoopHeatingCoilMaxRTFSave ! Used to find RTF of heating coils without overwriting globabl variable
  REAL(R64)           :: LoopDXCoilMaxRTFSave ! Used to find RTF of DX heating coils without overwriting globabl variable
  LOGICAL             :: SuppHeatingCoilFlag = .TRUE.
  REAL(r64)           :: NoLoadTempOut       ! save outlet temp when coil is off (C)
      ! Set local variables
      ! Retrieve the load on the controlled zone
  OutletNode   = UnitarySystem(UnitarySysNum)%SuppCoilAirOutletNode
  InletNode    = UnitarySystem(UnitarySysNum)%SuppCoilAirInletNode
  ControlNode  = UnitarySystem(UnitarySysNum)%SuppCoilAirOutletNode
  DesOutTemp   = UnitarySystem(UnitarySysNum)%DesiredOutletTemp
  CompName     = UnitarySystem(UnitarySysNum)%SuppHeatCoilName
  CompIndex    = UnitarySystem(UnitarySysNum)%SuppHeatCoilIndex
  FanOpMode    = UnitarySystem(UnitarySysNum)%FanOpMode
  SolFla       = 0.0d0
  PartLoadFrac = 0.0d0
  SensibleLoad = .FALSE.
  LoopHeatingCoilMaxRTFSave=LoopHeatingCoilMaxRTF
  LoopHeatingCoilMaxRTF = 0.0d0
  LoopDXCoilMaxRTFSave=LoopDXCoilRTF
  LoopDXCoilRTF=0.0d0
  IF((GetCurrentScheduleValue(UnitarySystem(UnitarySysNum)%SysAvailSchedPtr) > 0.0d0) .AND. &
     (Node(InletNode)%MassFlowRate .gt. MinAirMassFlow)) THEN
    ! Determine if there is a sensible load on this system
    IF((Node(InletNode)%Temp < DesOutTemp) .AND. &
       (ABS(Node(InletNode)%Temp - DesOutTemp) .gt. TempControlTol) ) SensibleLoad = .TRUE.
    IF (SensibleLoad ) THEN
      ReqOutput = Node(InletNode)%MassFlowRate *  &
                       (PsyHFnTdbW(UnitarySystem(UnitarySysNum)%DesiredOutletTemp,Node(InletNode)%HumRat) - &
                        PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
      ! Get no load result
      PartLoadFrac = 0.0d0
      SELECT CASE(UnitarySystem(UnitarySysNum)%SuppHeatCoilType_Num)
        CASE (Coil_HeatingGas,Coil_HeatingElectric,Coil_HeatingDesuperheater )
          CALL SimulateHeatingCoilComponents(CompName,FirstHVACIteration, &
                                CompIndex=CompIndex, PartLoadRatio = PartLoadFrac, & ! QCoilReq= 0.0d0,  &
                                SuppHeat=SuppHeatingCoilFlag,FanOpMode=FanOpMode,QCoilActual=QCoilActual)
          PartLoadFrac=QCoilActual/UnitarySystem(UnitarySysNum)%DesignSuppHeatingCapacity
        CASE (Coil_HeatingWater)
          CALL SimWaterCoils(UnitarySysNum, FirstHVACIteration, PartLoadFrac, SuppHeatCoil)
        CASE (Coil_HeatingSteam)
          CALL SimSteamCoils(UnitarySysNum, FirstHVACIteration, PartLoadFrac, SuppHeatCoil)
        CASE DEFAULT
      END SELECT
      NoLoadTempOut = Node(OutletNode)%Temp
!      NoOutput = Node(InletNode)%MassFlowRate *  &
!                       (PsyHFnTdbW(NoLoadTempOut,Node(OutletNode)%HumRat)  &
!                        - PsyHFnTdbW(Node(InletNode)%Temp,Node(OutletNode)%HumRat))
!     If OutletTemp is within ACC of set point, either coil operated or is not needed
      IF(ABS(Node(OutletNode)%Temp-DesOutTemp) < Acc)THEN
        ! do nothing, coil is at set point (i.e., gas/elec/steam coil will try to hit set point
      ELSE IF(PartLoadFrac .GT. 0.0d0)THEN
        ! do nothing, coil tried to hit set point (i.e., gas/elec/steam coil tried to hit set point but missed
      ELSE IF (NoLoadTempOut .GT. (DesOutTemp - Acc)) THEN
        PartLoadFrac = 0.0d0 ! outlet temp > set point, coil is not needed
      ELSE ! outlet temp too low, turn on coil
        ! Get full load result
        PartLoadFrac = 1.0d0
        SELECT CASE(UnitarySystem(UnitarySysNum)%SuppHeatCoilType_Num)
          CASE (Coil_HeatingGas,Coil_HeatingElectric)
            CALL SimulateHeatingCoilComponents(CompName,FirstHVACIteration, &
!                                  CompIndex=CompIndex, QCoilReq= UnitarySystem(UnitarySysNum)%DesignSuppHeatingCapacity,  &
                                  CompIndex=CompIndex, PartLoadRatio = PartLoadFrac, &
                                  SuppHeat=SuppHeatingCoilFlag, FanOpMode=FanOpMode,QCoilActual=QCoilActual)
            PartLoadFrac=QCoilActual/UnitarySystem(UnitarySysNum)%DesignSuppHeatingCapacity
          CASE (Coil_HeatingDesuperheater )
            CALL SimulateHeatingCoilComponents(CompName,FirstHVACIteration, &
                                  CompIndex=CompIndex, QCoilReq= ReqOutput,  &
                                  SuppHeat=SuppHeatingCoilFlag, FanOpMode=FanOpMode)
          CASE (Coil_HeatingWater)
            CALL SimWaterCoils(UnitarySysNum, FirstHVACIteration, PartLoadFrac, SuppHeatCoil)
          CASE (Coil_HeatingSteam)
            CALL SimSteamCoils(UnitarySysNum, FirstHVACIteration, PartLoadFrac, SuppHeatCoil)
          CASE DEFAULT
        END SELECT
        FullOutput = Node(InletNode)%MassFlowRate *  &
                       (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat)  &
                        - PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
!         If the FullOutput outlet temp is less than (insufficient heating) or very near set point,
!         run the coil at PartLoadFrac = 1.
        IF (Node(OutletNode)%Temp .LT. (DesOutTemp+Acc)) THEN
          PartLoadFrac = 1.0d0
        ELSE
          SELECT CASE(UnitarySystem(UnitarySysNum)%SuppHeatCoilType_Num)
            CASE (Coil_HeatingGas,Coil_HeatingElectric, Coil_HeatingDesuperheater)
              Par(1) = REAL(UnitarySysNum,r64)
              IF (FirstHVACIteration) THEN
                Par(2) = 1.0d0
              ELSE
                Par(2) = 0.0d0
              END IF
              Par(3) = DesOutTemp
              IF (SuppHeatingCoilFlag) THEN
                Par(4) = 1.0d0
              ELSE
                Par(4) = 0.0d0
              END IF
              Par(5) = FanOpMode
              CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, GasElecHeatingCoilResidual, 0.0d0,   &
                                                1.0d0, Par)
            CASE (Coil_HeatingWater)
               Par(1) = REAL(UnitarySysNum,r64)
               IF (FirstHVACIteration) THEN
                 Par(2) = 1.0d0
               ELSE
                 Par(2) = 0.0d0
               END IF
               Par(3) = DesOutTemp
               IF (SuppHeatingCoilFlag) THEN
                 Par(4) = 1.0d0
               ELSE
                 Par(4) = 0.0d0
               END IF
               Par(5)=0.0d0
               CALL SolveRegulaFalsi(Acc, SolveMaxIter, SolFla, PartLoadFrac, HotWaterHeatingCoilResidual, &
                                     0.0d0, 1.0d0, Par)
            CASE (Coil_HeatingSteam)
              Par(1) = REAL(UnitarySysNum,r64)
              IF (FirstHVACIteration) THEN
                Par(2) = 1.0d0
              ELSE
                Par(2) = 0.0d0
              END IF
              Par(3) = DesOutTemp
              IF (SuppHeatingCoilFlag) THEN
                Par(4) = 1.0d0
              ELSE
                Par(4) = 0.0d0
              END IF
              CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, SteamHeatingCoilResidual, 0.0d0,   &
                                                1.0d0, Par)
            CASE DEFAULT
          END SELECT
        END IF   ! IF ((FullOutput - ReqOutput) < Acc) THEN
      END IF     ! IF ((NoOutput-ReqOutput) > Acc) THEN
    END IF       ! IF (SensibleLoad ) THEN
  END IF         ! IF((GetCurrentScheduleValue(UnitarySystem(UnitarySysNum)%SysAvailSchedPtr) > 0.0d0) .AND. &
  IF(PartLoadFrac .GT. 1.0d0) THEN
    PartLoadFrac = 1.0d0
  ELSEIF(PartLoadFrac < 0.0d0) THEN
    PartLoadFrac = 0.0d0
  END IF
  IF (SolFla == -1) THEN
    IF(.NOT. WarmupFlag)THEN
      IF(UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRIter .LT. 1)THEN
        UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRIter = UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRIter+1
        CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)// &
                              ' - Iteration limit exceeded calculating sensible '// &
                              'part-load ratio for unit = '//TRIM(UnitarySystem(UnitarySysNum)%Name))
        CALL ShowContinueError('Estimated part-load ratio  = '//RoundSigDigits((ReqOutput/FullOutput),3))
        CALL ShowContinueError('Calculated part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
        CALL ShowContinueErrorTimeStamp('The calculated part-load ratio will be used and the simulation'// &
                                      ' continues. Occurrence info: ')
      ELSE
        CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
        //TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - Iteration limit exceeded calculating'// &
        ' sensible part-load ratio error continues. Sensible PLR statistics follow.' &
        ,UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRIterIndex,PartLoadFrac,PartLoadFrac)
      END IF
    END IF  ! IF(.NOT. WarmupFlag)THEN
  ELSEIF (SolFla == -2) THEN
    PartLoadFrac = ReqOutput/FullOutput
    IF(.NOT. WarmupFlag)THEN
      IF(UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRFail .LT. 1)THEN
        UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRFail = UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRFail+1
        CALL ShowWarningError(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' - sensible part-'// &
                              'load ratio calculation failed: part-load ratio limits exceeded, for unit = '// &
                              TRIM(UnitarySystem(UnitarySysNum)%Name))
        CALL ShowContinueError('Estimated part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
        CALL ShowContinueErrorTimeStamp('The estimated part-load ratio will be used and the simulation'// &
                                        ' continues. Occurrence info: ')
      ELSE
        CALL ShowRecurringWarningErrorAtEnd(TRIM(UnitarySystem(UnitarySysNum)%UnitarySystemType)//' "'&
             //TRIM(UnitarySystem(UnitarySysNum)%Name)//'" - sensible part-load ratio calculation'// &
             ' failed error continues. Sensible PLR statistics follow.' &
             ,UnitarySystem(UnitarySysNum)%SuppHeatCoilSensPLRFailIndex,PartLoadFrac,PartLoadFrac)
      END IF
    END IF  ! IF(.NOT. WarmupFlag)THEN
  END IF  ! IF (SolFla == -1) THEN
  UnitarySystem(UnitarySysNum)%SuppHeatPartLoadFrac = PartLoadFrac
  LoopHeatingCoilMaxRTF = MAX(LoopHeatingCoilMaxRTF, LoopHeatingCoilMaxRTFSave)
  LoopDXCoilRTF      = MAX(LoopDXCoilRTF, LoopDXCoilMaxRTFSave)
RETURN
END SUBROUTINE ControlSuppHeatSystem