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) | :: | CompType | |||
character(len=*), | intent(in) | :: | CompName | |||
integer, | intent(in) | :: | CompTypeNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(inout) | :: | CompIndex | |||
integer, | intent(in) | :: | AirLoopNum | |||
logical, | intent(in) | :: | Sim | |||
integer, | intent(in) | :: | OASysNum | |||
logical, | intent(out), | optional | :: | OAHeatingCoil | ||
logical, | intent(out), | optional | :: | OACoolingCoil | ||
logical, | intent(out), | optional | :: | OAHX |
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 SimOAComponent(CompType,CompName,CompTypeNum,FirstHVACIteration,CompIndex,AirLoopNum,Sim,OASysNum, &
OAHeatingCoil,OACoolingCoil,OAHX)
! SUBROUTINE INFORMATION
! AUTHOR: Russ Taylor, Dan Fisher, Fred Buhl
! DATE WRITTEN: Oct 1997
! MODIFIED: Dec 1997 Fred Buhl, D Shirey Feb/Sept 2003
! Nov 2004 M. J. Witte, GARD Analytics, Inc.
! Add DXSystem:AirLoop as valid OA system equipment
! Work supported by ASHRAE research project 1254-RP
! RE-ENGINEERED: This is new code, not reengineered
! PURPOSE OF THIS SUBROUTINE:
! Calls the individual air loop component simulation routines
! METHODOLOGY EMPLOYED: None
! REFERENCES: None
! USE Statements
Use Fans, Only:SimulateFanComponents
USE DataAirLoop, ONLY: AirLoopInputsFilled
Use WaterCoils, Only:SimulateWaterCoilComponents
Use HeatingCoils, Only:SimulateHeatingCoilComponents
Use HeatRecovery, Only: SimHeatRecovery
Use DesiccantDehumidifiers, Only:SimDesiccantDehumidifier
Use HVACHXAssistedCoolingCoil, Only:SimHXAssistedCoolingCoil
Use HVACDXSystem, Only:SimDXCoolingSystem
Use HVACDXHeatPumpSystem, ONLY: SimDXHeatPumpSystem
Use SteamCoils, Only:SimulateSteamCoilComponents
Use TranspiredCollector, Only:SimTranspiredCollector
Use EvaporativeCoolers, Only:SimEvapCooler
USE PhotovoltaicThermalCollectors, ONLY:SimPVTcollectors, CalledFromOutsideAirSystem
USE UserDefinedComponents, ONLY: SimCoilUserDefined
USE HVACUnitarySystem, ONLY: SimUnitarySystem, GetUnitarySystemOAHeatCoolCoil, CheckUnitarySysCoilInOASysExists
IMPLICIT NONE
! SUBROUTINE ARGUMENTS:
LOGICAL, INTENT (IN) :: FirstHVACIteration
CHARACTER(len=*), INTENT (IN) :: CompType ! the component type
CHARACTER(len=*), INTENT (IN) :: CompName ! the component Name
INTEGER, INTENT(IN) :: CompTypeNum ! Component Type -- Integerized for this module
INTEGER, INTENT(INOUT) :: CompIndex
INTEGER, INTENT(IN) :: AirLoopNum ! air loop index for economizer lockout coordination
LOGICAL, INTENT(IN) :: Sim ! if TRUE, simulate component; if FALSE, just set the coil exisitence flags
INTEGER, INTENT(IN) :: OASysNum ! index to outside air system
LOGICAL, INTENT(OUT), OPTIONAL :: OAHeatingCoil ! TRUE indicates a heating coil has been found
LOGICAL, INTENT(OUT), OPTIONAL :: OACoolingCoil ! TRUE indicates a cooling coil has been found
LOGICAL, INTENT(OUT), OPTIONAL :: OAHX ! TRUE indicates a heat exchanger has been found
! SUBROUTINE PARAMETER DEFINITIONS: None
! INTERFACE BLOCK DEFINITIONS: None
! DERIVED TYPE DEFINITIONS: None
! SUBROUTINE LOCAL VARIABLE DEFINITIONS
OAHeatingCoil = .FALSE.
OACoolingCoil = .FALSE.
OAHX = .FALSE.
SELECT CASE(CompTypeNum)
CASE (OAMixer_Num) ! 'OutdoorAir:Mixer'
IF (Sim) THEN
CALL SimOAMixer(CompName,FirstHVACIteration,CompIndex)
END IF
! Fan Types
CASE(Fan_Simple_CV) ! 'Fan:ConstantVolume'
IF (Sim) Then
CALL SimulateFanComponents(CompName,FirstHVACIteration,CompIndex)
END IF
CASE(Fan_Simple_VAV) ! 'Fan:VariableVolume'
IF (Sim) Then
CALL SimulateFanComponents(CompName,FirstHVACIteration,CompIndex)
END IF
!cpw22Aug2010 Add Fan:ComponentModel (new num=18)
CASE(Fan_ComponentModel) ! 'Fan:ComponentModel'
IF (Sim) Then
CALL SimulateFanComponents(CompName,FirstHVACIteration,CompIndex)
END IF
! Coil Types
CASE(WaterCoil_Cooling) ! 'Coil:Cooling:Water'
IF (Sim) Then
CALL SimulateWaterCoilComponents(CompName,FirstHVACIteration,CompIndex)
END IF
OACoolingCoil = .TRUE.
CASE(WaterCoil_SimpleHeat) ! 'Coil:Heating:Water')
IF (Sim) Then
CALL SimulateWaterCoilComponents(CompName,FirstHVACIteration,CompIndex)
END IF
OAHeatingCoil = .TRUE.
CASE(SteamCoil_AirHeat) ! 'Coil:Heating:Steam'
IF (Sim) Then
CALL SimulateSteamCoilComponents(CompName,FirstHVACIteration,0.0d0,CompIndex)
END IF
OAHeatingCoil = .TRUE.
CASE(WaterCoil_DetailedCool) ! 'Coil:Cooling:Water:DetailedGeometry'
IF (Sim) Then
CALL SimulateWaterCoilComponents(CompName,FirstHVACIteration,CompIndex)
END IF
OACoolingCoil = .TRUE.
CASE(Coil_ElectricHeat) ! 'Coil:Heating:Electric'
IF (Sim) Then
! stand-alone coils are temperature controlled (do not pass QCoilReq in argument list, QCoilReq overrides temp SP)
CALL SimulateHeatingCoilComponents(CompName=CompName,FirstHVACIteration=FirstHVACIteration,CompIndex=CompIndex)
END IF
OAHeatingCoil = .TRUE.
CASE(Coil_GasHeat) ! 'Coil:Heating:Gas'
IF (Sim) Then
! stand-alone coils are temperature controlled (do not pass QCoilReq in argument list, QCoilReq overrides temp SP)
CALL SimulateHeatingCoilComponents(CompName=CompName,FirstHVACIteration=FirstHVACIteration,CompIndex=CompIndex)
END IF
OAHeatingCoil = .TRUE.
CASE(WaterCoil_CoolingHXAsst) ! 'CoilSystem:Cooling:Water:HeatExchangerAssisted'
IF (Sim) Then
CALL SimHXAssistedCoolingCoil(CompName,FirstHVACIteration,On,0.0d0,CompIndex,ContFanCycCoil)
END IF
OACoolingCoil = .TRUE.
CASE(DXSystem) ! CoilSystem:Cooling:DX old 'AirLoopHVAC:UnitaryCoolOnly'
IF (Sim) Then
CALL SimDXCoolingSystem(CompName,FirstHVACIteration,AirLoopNum, CompIndex)
END IF
OACoolingCoil = .TRUE.
CASE(UnitarySystem) ! AirLoopHVAC:UnitarySystem
IF (Sim) Then
CALL SimUnitarySystem(CompName,FirstHVACIteration,AirLoopNum, CompIndex)
END IF
IF(AirLoopInputsFilled)CALL GetUnitarySystemOAHeatCoolCoil(CompName, OACoolingCoil, OAHeatingCoil)
IF(MyOneTimeCheckUnitarySysFlag(OASysNum))THEN
IF(AirLoopInputsFilled)THEN
CALL CheckUnitarySysCoilInOASysExists(CompName)
MyOneTimeCheckUnitarySysFlag(OASysNum) = .FALSE.
END IF
END IF
CASE (DXHeatPumpSystem)
IF (sim) Then
CALL SimDXHeatPumpSystem(CompName,FirstHVACIteration,AirLoopNum, CompIndex)
ENDIF
OAHeatingCoil = .TRUE.
CASE (Coil_UserDefined)
IF (sim) THEN
CALL SimCoilUserDefined(CompName, CompIndex, AirLoopNum, OAHeatingCoil, OACoolingCoil )
ENDIF
! Heat recovery
CASE(HeatXchngr) ! 'HeatExchanger:AirToAir:FlatPlate', 'HeatExchanger:AirToAir:SensibleAndLatent',
! 'HeatExchanger:Desiccant:BalancedFlow'
IF (Sim) Then
CALL SimHeatRecovery(CompName,FirstHVACIteration,CompIndex, ContFanCycCoil, &
EconomizerFlag=AirLoopControlInfo(AirLoopNum)%HeatRecoveryBypass, &
HighHumCtrlFlag=AirLoopControlInfo(AirLoopNum)%HighHumCtrlActive)
END IF
OAHX = .TRUE.
! Desiccant Dehumidifier
CASE(Desiccant) ! 'Dehumidifier:Desiccant:NoFans'
! 'Dehumidifier:Desiccant:System'
IF (Sim) Then
CALL SimDesiccantDehumidifier(CompName,FirstHVACIteration,CompIndex)
END IF
OAHX = .TRUE.
! Unglazed Transpired Solar Collector
CASE(Unglazed_SolarCollector) ! 'SolarCollector:UnglazedTranspired'
IF (Sim) Then
CALL SimTranspiredCollector(CompName, CompIndex )
END IF
! Air-based Photovoltaic-thermal flat plate collector
CASE(PVT_AirBased) ! 'SolarCollector:FlatPlate:PhotovoltaicThermal'
IF (Sim) Then
CALL SimPVTcollectors(CompIndex , FirstHVACIteration, CalledFromOutsideAirSystem, PVTName=CompName )
END IF
! Evaporative Cooler Types
CASE(EvapCooler) ! 'EvaporativeCooler:Direct:CelDekPad','EvaporativeCooler:Indirect:CelDekPad'
! 'EvaporativeCooler:Indirect:WetCoil','EvaporativeCooler:Indirect:ResearchSpecial'
IF (Sim) Then
CALL SimEvapCooler(CompName,CompIndex)
END IF
CASE DEFAULT
CALL ShowFatalError('Invalid Outside Air Component='//TRIM(CompType))
END SELECT
RETURN
END SUBROUTINE SimOAComponent