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 | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | UnitarySystemName | |||
| logical, | intent(in) | :: | FirstHVACIteration | |||
| integer, | intent(in) | :: | AirLoopNum | |||
| integer, | intent(inout) | :: | CompIndex | |||
| logical, | intent(out), | optional | :: | HeatActive | ||
| logical, | intent(out), | optional | :: | CoolActive | ||
| integer, | intent(in), | optional | :: | OAUnitNum | ||
| real(kind=r64), | intent(in), | optional | :: | OAUCoilOutTemp | ||
| logical, | intent(in), | optional | :: | ZoneEquipment | 
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 SimUnitarySystem(UnitarySystemName,FirstHVACIteration,AirLoopNum,CompIndex, &
                            HeatActive,CoolActive,OAUnitNum,OAUCoilOutTemp,ZoneEquipment)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard Raustad, FSEC
          !       DATE WRITTEN   February 2013
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine manages unitary system component simulation.
          ! METHODOLOGY EMPLOYED:
          ! na
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE General,          ONLY: TrimSigDigits
  USE DataAirLoop,      ONLY: AirLoopControlInfo
  USE InputProcessor,   ONLY: FindItemInList
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  CHARACTER(len=*), INTENT(IN)       :: UnitarySystemName  ! Name of Unitary System object
  LOGICAL,   INTENT(IN)              :: FirstHVACIteration ! True when first HVAC iteration
  INTEGER,   INTENT(IN)              :: AirLoopNum         ! Primary air loop number
  INTEGER,   INTENT(INOUT)           :: CompIndex          ! Index to Unitary System object
  LOGICAL,   INTENT(OUT),   OPTIONAL :: HeatActive         ! True if heat coil active
  LOGICAL,   INTENT(OUT),   OPTIONAL :: CoolActive         ! True if cool coil active
  INTEGER,   INTENT(IN),    OPTIONAL :: OAUnitNum          ! If the system is an equipment of OutdoorAirUnit
  REAL(r64), INTENT(IN),    OPTIONAL :: OAUCoilOutTemp     ! the coil inlet temperature of OutdoorAirUnit
  LOGICAL,   INTENT(IN),    OPTIONAL :: ZoneEquipment      ! TRUE if called as zone equipment
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER       :: UnitarySysNum         ! Index to AirloopHVAC:UnitarySystem object
  LOGICAL       :: HXUnitOn              ! Flag to control HX for HXAssisted Cooling Coil
  INTEGER       :: CompOn                ! Determines if compressor is on or off
  ! Obtains and Allocates unitary system related parameters from input file
  IF (GetInputFlag) THEN
    ! Get the unitary system input
    CALL GetUnitarySystemInput
    GetInputFlag=.false.
  END IF
  ! Find the correct unitary system Number
  IF (CompIndex == 0) THEN
    UnitarySysNum = FindItemInList(UnitarySystemName,UnitarySystem%Name,NumUnitarySystem)
    IF (UnitarySysNum == 0) THEN
      CALL ShowFatalError('SimDXCoolingSystem: DXUnit not found='//TRIM(UnitarySystemName))
    END IF
    CompIndex=UnitarySysNum
  ELSE
    UnitarySysNum=CompIndex
    IF (UnitarySysNum > NumUnitarySystem .or. UnitarySysNum < 1) THEN
      CALL ShowFatalError('SimUnitarySystem:  Invalid CompIndex passed='//  &
                          TRIM(TrimSigDigits(UnitarySysNum))// &
                          ', Number of Unit Systems='//TRIM(TrimSigDigits(NumUnitarySystem))//  &
                          ', Unitary System name='//TRIM(UnitarySystemName))
    END IF
    IF (CheckEquipName(UnitarySysNum)) THEN
      IF (UnitarySystemName /= UnitarySystem(UnitarySysNum)%Name) THEN
        CALL ShowFatalError('SimUnitarySystem: Invalid CompIndex passed='//  &
                            TRIM(TrimSigDigits(UnitarySysNum))// &
                            ', Unitary System name='//TRIM(UnitarySystemName)//', stored Unit Name for that index='//  &
                            TRIM(UnitarySystem(UnitarySysNum)%Name))
      END IF
      CheckEquipName(UnitarySysNum)=.false.
    END IF
  END IF
  IF(PRESENT(HeatActive))HeatActive = .FALSE.
  IF(PRESENT(CoolActive))CoolActive = .FALSE.
  FanSpeedRatio = 1.0d0
  IF(PRESENT(ZoneEquipment))THEN
    CALL InitUnitarySystems(UnitarySysNum,0,OAUnitNUm,OAUCoilOutTemp, FirstHVACIteration)
  ELSE
    CALL InitUnitarySystems(UnitarySysNum,AirLoopNum,OAUnitNUm,OAUCoilOutTemp, FirstHVACIteration)
  END IF
  HXUnitOn = .FALSE.
  SELECT CASE(UnitarySystem(UnitarySysNum)%ControlType)
    CASE(SetPointBased)
      CompOn = 1
      IF(PRESENT(ZoneEquipment))THEN
        CALL ControlUnitarySystemtoSP(UnitarySysNum,FirstHVACIteration,0,OAUCoilOutTemp,HXUnitOn)
      ELSE
        CALL ControlUnitarySystemtoSP(UnitarySysNum,FirstHVACIteration,AirLoopNum,OAUCoilOutTemp,HXUnitOn)
      END IF
    CASE(LoadBased)
      IF(PRESENT(ZoneEquipment))THEN
        CALL ControlUnitarySystemtoLoad(UnitarySysNum,FirstHVACIteration,0,CompOn,OAUCoilOutTemp,HXUnitOn)
      ELSE
        CALL ControlUnitarySystemtoLoad(UnitarySysNum,FirstHVACIteration,AirLoopNum,CompOn,OAUCoilOutTemp,HXUnitOn)
      END IF
  END SELECT
  ! Report the current output
  IF(PRESENT(ZoneEquipment))THEN
    CALL ReportUnitarySystem(UnitarySysNum, 0)
  ELSE
    CALL ReportUnitarySystem(UnitarySysNum, AirLoopNum)
  END IF
  IF(PRESENT(CoolActive))THEN
    IF(UnitarySystem(UnitarySysNum)%CoolingPartLoadFrac*REAL(CompOn,r64) > 0.0d0)CoolActive = .TRUE.
  END IF
  IF(PRESENT(HeatActive))THEN
    IF(UnitarySystem(UnitarySysNum)%HeatingPartLoadFrac*REAL(CompOn,r64) > 0.0d0 .OR. &
     UnitarySystem(UnitarySysNum)%SuppHeatPartLoadFrac*REAL(CompOn,r64) > 0.0d0)HeatActive = .TRUE.
  END IF
  ! set econo lockout flag
  ! If the sysem is not an equipment of Outdoor air unit
!  IF (AirLoopNum /=-1 .AND. ALLOCATED(AirLoopControlInfo) .AND. UnitarySystem(UnitarySysNum)%AirLoopEquipment) THEN
  IF (AirLoopNum > 0 .AND. ALLOCATED(AirLoopControlInfo) .AND. UnitarySystem(UnitarySysNum)%AirLoopEquipment) THEN
    IF ( (UnitarySystem(UnitarySysNum)%HeatCompPartLoadRatio > 0.0d0 .OR. &
          UnitarySystem(UnitarySysNum)%SpeedRatio > 0.0d0 .OR. &
          UnitarySystem(UnitarySysNum)%CycRatio > 0.0d0) .AND. &
          AirLoopControlInfo(AirLoopNum)%CanLockoutEconoWithCompressor) THEN
            AirLoopControlInfo(AirLoopNum)%ReqstEconoLockoutWithCompressor = .TRUE.
    ELSE
      AirLoopControlInfo(AirLoopNum)%ReqstEconoLockoutWithCompressor = .FALSE.
    END IF
    IF ((HeatActive) .AND. &
       (AirLoopControlInfo(AirLoopNum)%CanLockoutEconoWithCompressor .OR. &
        AirLoopControlInfo(AirLoopNum)%CanLockoutEconoWithHeating)) THEN
      AirLoopControlInfo(AirLoopNum)%ReqstEconoLockoutWithHeating = .TRUE.
    ELSE
      AirLoopControlInfo(AirLoopNum)%ReqstEconoLockoutWithHeating = .FALSE.
    END IF
  END IF
  ! Calculate heat recovery
  IF (UnitarySystem(UnitarySysNum)%HeatRecActive) THEN
    CALL UnitarySystemHeatRecovery(UnitarySysNum)
  END IF
  ! Coils should have been sized by now. Set this flag to false in case other equipment is downstream of Unitary System.
! can't do this since there are other checks that need this flag (e.g., HVACManager, line 3577)
!  AirLoopControlInfo(AirLoopNum)%UnitarySys = .FALSE.
  RETURN
END SUBROUTINE SimUnitarySystem