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