SUBROUTINE CalcVentilatedSlab(Item,ZoneNum,FirstHVACIteration,PowerMet,LatOutputProvided)
! SUBROUTINE INFORMATION:
! AUTHOR Young Tae Chae, Rick Strand
! DATE WRITTEN June 2008
! MODIFIED Don Shirey, Aug 2009 (LatOutputProvided)
! July 2012, Chandan Sharma - FSEC: Added zone sys avail managers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine mainly controls the action of the Ventilated Slab
! (or more exactly, it controls the amount of outside air brought in)
! based on the user input for controls and the defined controls
! algorithms.
! METHODOLOGY EMPLOYED:
! Ventilated slab is controlled based on user input and what is happening in the
! simulation. There are various cases to consider:
! 1. OFF: Unit is schedule off or there is no load on it. All flow
! rates are set to zero and the temperatures are set to zone conditions
! (except for the outside air inlet).
! 2. HEATING/VARIABLE PERCENT: The unit is on, there is a heating load,
! and variable percent control is specified. The outside air fraction
! is set to the minimum outside air fraction (schedule based) and the
! heating coil is activated.
! 3. HEATING/FIXED TEMPERATURE: The unit is on, there is a heating load,
! and fixed temperature control is specified. The outside air fraction
! is varied in an attempt to obtain a mixed air temperature equal to
! the user specified temperature (schedule based). The heating coil
! is activated, if necessary.
! 4. COOLING/NO COIL: The unit is on, there is a cooling load, and no
! coil is present or it has been scheduled off. Set the amount of
! outside air based on the control type. Simulate the "mixing box".
! 5. COOLING/WITH COIL: The unit is on, there is a cooling load, and
! a cooling coil is present and scheduled on. Tries to use outside
! air as best as possible and then calls a cooling coil
! Note: controls are strictly temperature based and do not factor
! humidity into the equation (not an enthalpy economy cycle but rather
! a simple return air economy cycle). In addition, temperature predictions
! are not strict energy balances here in the control routine though
! in the mixing routine an energy balance is preserved.
! REFERENCES:
! ASHRAE Systems and Equipment Handbook (SI), 1996. page 31.3
! USE STATEMENTS:
USE DataZoneEnergyDemands
USE DataEnvironment, ONLY : OutDryBulbTemp, OutWetBulbTemp, EnvironmentName, CurMnDy, OutBaroPress
USE DataHeatBalance, ONLY : MRT
USE DataHeatBalFanSys, ONLY : MAT,ZoneAirHumRat
USE DataHVACGlobals, ONLY : SmallLoad, ZoneCompTurnFansOn, ZoneCompTurnFansOff
USE DataLoopNode, ONLY : Node
USE ScheduleManager, ONLY : GetCurrentScheduleValue
USE HeatingCoils, ONLY : CheckHeatingCoilSchedule
USE WaterCoils, ONLY : CheckWaterCoilSchedule
USE HVACHXAssistedCoolingCoil, ONLY : CheckHXAssistedCoolingCoilSchedule
Use SteamCoils, ONLY : CheckSteamCoilSchedule
USE General, ONLY : TrimSigDigits
USE Fans, ONLY : SimulateFanComponents !12/18
USE DataHeatBalSurface, ONLY : TH
USE NodeInputManager, ONLY : GetOnlySingleNode
USE DataInterfaces, ONLY : ControlCompOutput
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(INOUT) :: Item ! number of the current ventilated slab being simulated
INTEGER, INTENT(IN) :: ZoneNum ! number of zone being served
LOGICAL, INTENT(IN) :: FirstHVACIteration ! TRUE if 1st HVAC simulation of system timestep
REAL(r64), INTENT(OUT) :: PowerMet ! power supplied (W)
REAL(r64), INTENT(OUT) :: LatOutputProvided ! latent capacity supplied (kg/s)
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: LowTempDiff = 0.1d0 ! Smallest allowed temperature difference for comparisons
! (below this value the temperatures are assumed equal)
REAL(r64), PARAMETER :: LowOAFracDiff = 0.01d0 ! Smallest allowed outside air fraction difference for comparison
! (below this value the fractions are assumed equal)
REAL(r64), PARAMETER :: MinFlowAllowed = 0.001d0 ! lowest air flow rate allowed [kg/sec]
! INTERFACE BLOCK SPECIFICATIONS
! see use DataInterfaces
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AirMassFlow ! air mass flow rate [kg/sec]
INTEGER :: AirRelNode ! outside air relief node
INTEGER :: ControlNode ! the hot water or cold water inlet node
INTEGER :: InletNode ! system air inlet node
INTEGER :: FanOutletNode ! system fan outlet node
INTEGER :: ZoneAirInNode ! zone supply air node
REAL(r64) :: MaxOAFrac ! maximum possible outside air fraction
REAL(r64) :: MaxWaterFlow ! maximum water flow for heating or cooling [kg/sec]
REAL(r64) :: MinOAFrac ! minimum possible outside air fraction
REAL(r64) :: MinWaterFlow ! minimum water flow for heating or cooling [kg/sec]
INTEGER :: OutletNode ! air outlet node
INTEGER :: OutsideAirNode ! outside air node
REAL(r64) :: QTotUnitOut ! total unit output [watts]
REAL(r64) :: QUnitOut ! heating or sens. cooling provided by fan coil unit [watts]
REAL(r64) :: LatentOutput ! Latent (moisture) add/removal rate, negative is dehumidification [kg/s]
REAL(r64) :: SpecHumOut ! Specific humidity ratio of outlet air (kg moisture / kg moist air)
REAL(r64) :: SpecHumIn ! Specific humidity ratio of inlet air (kg moisture / kg moist air)
REAL(r64) :: Tdesired ! desired temperature after mixing inlet and outdoor air [degrees C]
REAL(r64) :: Tinlet ! temperature of air coming into the ventilated slab [degrees C]
REAL(r64) :: Toutdoor ! temperature of outdoor air being introduced into the ventilated slab [degrees C]
Real(r64) :: MaxSteamFlow
Real(r64) :: MinSteamFlow
REAL(r64) :: RadInTemp ! "Desired" radiant system air inlet temperature [Celsius]**setpoint
REAL(r64) :: SetpointTemp ! temperature that will be used to control the radiant system [Celsius]
REAL(r64) :: SetpointTempHi ! Current high point in setpoint temperature range
REAL(r64) :: SetpointTempLo ! Current low point in setpoint temperature range
REAL(r64) :: AirTempHi ! Current high point in water temperature range
REAL(r64) :: AirTempLo ! Current low point in water temperature range
REAL(r64) :: AirTempHeatHi ! Current high point in water temperature range
REAL(r64) :: AirTempCoolLo ! Current low point in water temperature range
REAL(r64) :: CpFan ! Intermediate calculational variable for specific heat of air <<NOV9 Updated
REAL(r64) :: ZoneRadNum ! number of zone being served *********************
REAL(r64) :: QZnReq
INTEGER :: RadSurfNum ! DO loop counter for the surfaces that comprise a particular radiant system
CHARACTER(len=MaxNameLength) ::MSlabIn
CHARACTER(len=MaxNameLength) ::MSlabOut
CHARACTER(len=MaxNameLength) ::SlabName
INTEGER :: MSlabInletNode
INTEGER :: MSlabOutletNode
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='ZoneHVAC:VentilatedSlab'
SELECT CASE (VentSlab(Item)%CoilOption)
CASE (BothOption)
SELECT CASE(VentSlab(Item)%HCoilType)
CASE(Heating_WaterCoilType)
CALL CheckWaterCoilSchedule('Coil:Heating:Water',VentSlab(Item)%HCoilName, &
VentSlab(Item)%HCoilSchedValue,VentSlab(Item)%HCoil_Index)
CASE(Heating_SteamCoilType)
CALL CheckSteamCoilSchedule('Coil:Heating:Steam',VentSlab(Item)%HCoilName, &
VentSlab(Item)%HCoilSchedValue,VentSlab(Item)%HCoil_Index)
CASE(Heating_ElectricCoilType)
CALL CheckHeatingCoilSchedule('Coil:Heating:Electric',VentSlab(Item)%HCoilName, &
VentSlab(Item)%HCoilSchedValue,VentSlab(Item)%HCoil_Index)
CASE(Heating_GasCoilType)
CALL CheckHeatingCoilSchedule('Coil:Heating:Gas',VentSlab(Item)%HCoilName, &
VentSlab(Item)%HCoilSchedValue,VentSlab(Item)%HCoil_Index)
CASE DEFAULT
END SELECT
SELECT CASE(VentSlab(Item)%CCoilType)
CASE(Cooling_CoilWaterCooling)
CALL CheckWaterCoilSchedule('Coil:Cooling:Water',VentSlab(Item)%CCoilName, &
VentSlab(Item)%CCoilSchedValue,VentSlab(Item)%CCoil_Index)
CASE(Cooling_CoilDetailedCooling)
CALL CheckWaterCoilSchedule('Coil:Cooling:Water:DetailedGeometry',VentSlab(Item)%CCoilName, &
VentSlab(Item)%CCoilSchedValue,VentSlab(Item)%CCoil_Index)
CASE(Cooling_CoilHXAssisted)
CALL CheckHXAssistedCoolingCoilSchedule('CoilSystem:Cooling:Water:HeatExchangerAssisted',VentSlab(Item)%CCoilName, &
VentSlab(Item)%CCoilSchedValue,VentSlab(Item)%CCoil_Index)
CASE DEFAULT
END SELECT
CASE (HeatingOption)
SELECT CASE(VentSlab(Item)%HCoilType)
CASE(Heating_WaterCoilType)
CALL CheckWaterCoilSchedule('Coil:Heating:Water',VentSlab(Item)%HCoilName, &
VentSlab(Item)%HCoilSchedValue,VentSlab(Item)%HCoil_Index)
CASE(Heating_SteamCoilType)
CALL CheckSteamCoilSchedule('Coil:Heating:Steam',VentSlab(Item)%HCoilName, &
VentSlab(Item)%HCoilSchedValue,VentSlab(Item)%HCoil_Index)
CASE(Heating_ElectricCoilType)
CALL CheckHeatingCoilSchedule('Coil:Heating:Electric',VentSlab(Item)%HCoilName, &
VentSlab(Item)%HCoilSchedValue,VentSlab(Item)%HCoil_Index)
CASE(Heating_GasCoilType)
CALL CheckHeatingCoilSchedule('Coil:Heating:Gas',VentSlab(Item)%HCoilName, &
VentSlab(Item)%HCoilSchedValue,VentSlab(Item)%HCoil_Index)
CASE DEFAULT
END SELECT
CASE (CoolingOption)
SELECT CASE(VentSlab(Item)%CCoilType)
CASE(Cooling_CoilWaterCooling)
CALL CheckWaterCoilSchedule('Coil:Cooling:Water',VentSlab(Item)%CCoilName, &
VentSlab(Item)%CCoilSchedValue,VentSlab(Item)%CCoil_Index)
CASE(Cooling_CoilDetailedCooling)
CALL CheckWaterCoilSchedule('Coil:Cooling:Water:DetailedGeometry',VentSlab(Item)%CCoilName, &
VentSlab(Item)%CCoilSchedValue,VentSlab(Item)%CCoil_Index)
CASE(Cooling_CoilHXAssisted)
CALL CheckHXAssistedCoolingCoilSchedule('CoilSystem:Cooling:Water:HeatExchangerAssisted',VentSlab(Item)%CCoilName, &
VentSlab(Item)%CCoilSchedValue,VentSlab(Item)%CCoil_Index)
CASE DEFAULT
END SELECT
CASE (NoneOption)
END SELECT
! FLOW:
FanElecPower = 0.0D0
! initialize local variables
ControlNode = 0
QUnitOut = 0.0D0
LatentOutput = 0.0D0
MaxWaterFlow = 0.0D0
MinWaterFlow = 0.0D0
InletNode = VentSlab(Item)%ReturnAirNode
OutletNode = VentSlab(Item)%RadInNode
FanOutletNode = VentSlab(Item)%FanOutletNode
ZoneAirInNode = VentSlab(Item)%ZoneAirInNode
OutsideAirNode = VentSlab(Item)%OutsideAirNode
AirRelNode = VentSlab(Item)%AirReliefNode
ZoneRadNum = VentSlab(Item)%ZonePtr
RadSurfNum = VentSlab(Item)%NumOfSurfaces
Tinlet = Node(InletNode)%Temp
Toutdoor = Node(OutsideAirNode)%Temp
! Control Type Check
SELECT CASE (VentSlab(Item)%ControlType)
CASE (MATControl)
SetpointTemp = MAT(ZoneNum)
CASE (MRTControl)
SetpointTemp = MRT(ZoneNum)
CASE (OPTControl)
SetpointTemp = 0.5d0*(MAT(ZoneNum)+MRT(ZoneNum))
CASE (ODBControl)
SetpointTemp = OutDryBulbTemp
CASE (OWBControl)
SetpointTemp = OutWetBulbTemp
CASE (SURControl)
SetpointTemp = TH(VentSlab(Item)%SurfacePtr(RadSurfNum),1,2)
CASE (DPTZControl)
SetpointTemp = PsyTdpFnWPb(ZoneAirHumRat(VentSlab(Item)%ZonePtr),OutBaroPress)
CASE DEFAULT ! Should never get here
CALL ShowSevereError('Illegal control type in low temperature radiant system: '//TRIM(VentSlab(Item)%Name))
CALL ShowFatalError('Preceding condition causes termination.')
END SELECT
! Load Check
AirTempHeatHi = GetCurrentScheduleValue(VentSlab(Item)%HotCtrlHiTempSchedPtr)
AirTempCoolLo = GetCurrentScheduleValue(VentSlab(Item)%ColdCtrlLoTempSchedPtr)
IF (((SetpointTemp >= AirTempHeatHi) .AND. (SetpointTemp <= AirTempCoolLo)) .OR. &
(GetCurrentScheduleValue(VentSlab(Item)%SchedPtr) <= 0) ) THEN
! System is off or has no load upon it; set the flow rates to zero and then
! simulate the components with the no flow conditions
Node(InletNode)%MassFlowRate = 0.0d0
Node(InletNode)%MassFlowRateMaxAvail = 0.0d0
Node(InletNode)%MassFlowRateMinAvail = 0.0d0
Node(OutletNode)%MassFlowRate = 0.0d0
Node(OutletNode)%MassFlowRateMaxAvail = 0.0d0
Node(OutletNode)%MassFlowRateMinAvail = 0.0d0
Node(OutsideAirNode)%MassFlowRate = 0.0d0
Node(OutsideAirNode)%MassFlowRateMaxAvail = 0.0d0
Node(OutsideAirNode)%MassFlowRateMinAvail = 0.0d0
Node(AirRelNode)%MassFlowRate = 0.0d0
Node(AirRelNode)%MassFlowRateMaxAvail = 0.0d0
Node(AirRelNode)%MassFlowRateMinAvail = 0.0d0
AirMassFlow = Node(FanOutletNode)%MassFlowRate
HCoilOn = .FALSE.
! Node condition
Node(InletNode)%Temp = TH(VentSlab(Item)%SurfacePtr(1),1,2)
Node(FanOutletNode)%Temp = Node(InletNode)%Temp
Node(OutletNode)%Temp = Node(FanOutletNode)%Temp
! Node condition
IF (VentSlab(Item)%SysConfg == SeriesSlabs) THEN
DO RadSurfNum = 1, VentSlab(Item)%NumOfSurfaces
SlabName=VentSlab(Item)%SurfaceName(RadSurfNum)
MSlabIn = VentSlab(Item)%SlabIn(RadSurfNum)
MSlabOut = VentSlab(Item)%SlabOut(RadSurfNum)
VentSlab(Item)%MslabInNode = &
GetOnlySingleNode(MSlabIn,ErrorsFound,CurrentModuleObject,SlabName, &
NodeType_Air,NodeConnectionType_Internal,1,ObjectIsNotParent)
VentSlab(Item)%MSlabOutNode = &
GetOnlySingleNode(MSlabOut,ErrorsFound,CurrentModuleObject,SlabName, &
NodeType_Air,NodeConnectionType_Internal,1,ObjectIsNotParent)
MSlabInletNode = VentSlab(Item)%MslabInNode
MSlabOutletNode = VentSlab(Item)%MslabOutNode
Node(MSlabInletNode)%Temp = Node(InletNode)%Temp
Node(MSlabOutletNode)%Temp = Node(MSlabInletNode)%Temp
END DO
END IF
CALL CalcVentilatedSlabComps(Item,FirstHVACIteration,QUnitOut)
Else ! System On
IF (SetpointTemp< AirTempHeatHi) THEN ! HEATING MODE
OperatingMode = HeatingMode
!Check the setpoint and temperature span
SetpointTempHi = GetCurrentScheduleValue(VentSlab(Item)%HotCtrlHiTempSchedPtr)
SetpointTempLo = GetCurrentScheduleValue(VentSlab(Item)%HotCtrlLoTempSchedPtr)
IF (SetpointTempHi < SetpointTempLo) THEN
CALL ShowSevereError('Heating setpoint temperature mismatch in'//TRIM(VentSlab(Item)%Name))
CALL ShowContinueError('High setpoint temperature is less than low setpoint temperature--check your schedule input')
CALL ShowFatalError('Preceding condition causes termination.')
END IF
AirTempHi = GetCurrentScheduleValue(VentSlab(Item)%HotAirHiTempSchedPtr)
AirTempLo = GetCurrentScheduleValue(VentSlab(Item)%HotAirLoTempSchedPtr)
IF (AirTempHi < AirTempLo) THEN
CALL ShowSevereError('Heating Air temperature mismatch in'//TRIM(VentSlab(Item)%Name))
CALL ShowContinueError('High Air temperature is less than low Air temperature--check your schedule input')
CALL ShowFatalError('Preceding condition causes termination.')
END IF
IF (SetpointTemp >= SetpointTempHi) THEN
! System is above high heating setpoint so we should be able to turn the system off
RadInTemp = AirTempLo
ELSE IF (SetpointTemp <= SetpointTempLo) THEN
! System is running with its highest inlet temperature
RadInTemp = AirTempHi
ELSE
! Interpolate to obtain the current radiant system inlet temperature
RadInTemp = AirTempHi - (AirTempHi - AirTempLo)*(SetpointTemp - SetpointTempLo)/(SetpointTempHi - SetpointTempLo)
END IF
Node(VentSlab(Item)%RadInNode)%Temp = RadInTemp
ControlNode = VentSlab(Item)%HotControlNode
MaxWaterFlow = VentSlab(Item)%MaxHotWaterFlow
MinWaterFlow = VentSlab(Item)%MinHotWaterFlow
MaxSteamFlow = VentSlab(Item)%MaxHotSteamFlow
MinSteamFlow = VentSlab(Item)%MinHotSteamFlow
! 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(.not. FirstHVACIteration .and. VentSlab(Item)%HCoilType == Heating_WaterCoilType) THEN
MaxWaterFlow = Node(ControlNode)%MassFlowRateMaxAvail
MinWaterFlow = Node(ControlNode)%MassFlowRateMinAvail
End IF
IF(.not. FirstHVACIteration .and. VentSlab(Item)%HCoilType == Heating_SteamCoilType) THEN
MaxSteamFlow = Node(ControlNode)%MassFlowRateMaxAvail
MinSteamFlow = Node(ControlNode)%MassFlowRateMinAvail
End IF
HCoilOn = .TRUE.
IF(Node(OutsideAirNode)%MassFlowRate > 0.0d0) Then
MinOAFrac = GetCurrentScheduleValue(VentSlab(Item)%MinOASchedPtr) * &
(VentSlab(Item)%MinOutAirMassFlow / Node(OutsideAirNode)%MassFlowRate)
ELSE
MinOAFrac = 0.0d0
End IF
MinOAFrac = MIN(1.0d0,MAX(0.0d0,MinOAFrac))
IF ((.NOT.VentSlab(Item)%HCoilPresent) .OR. &
(VentSlab(Item)%HCoilSchedValue <= 0.0d0) ) THEN
! In heating mode, but there is no coil to provide heating. This is handled
! differently than if there was a heating coil present. Fixed temperature
! will still try to vary the amount of outside air to meet the desired
! mixed air temperature, while variable percent will go to full ventilation
! when it is most advantageous.
! If there are no coil, Slab In Node is assumed to be Fan Outlet Node
OutletNode = FanOutletNode
SELECT CASE (VentSlab(Item)%OAControlType)
CASE (FixedOAControl)
! In this control type, the outdoor air flow rate is fixed to the maximum value
! which is equal to the minimum value, regardless of all the other conditions.
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (VariablePercent)
! This algorithm is probably a bit simplistic in that it just bounces
! back and forth between the maximum outside air and the minimum. In
! reality, a system *might* vary between the two based on the load in
! the zone. This simple flow control might cause some overcooling but
! chances are that if there is a cooling load and the zone temperature
! gets above the outside temperature that overcooling won't be significant.
Tinlet = Node(InletNode)%Temp
Toutdoor = Node(OutsideAirNode)%Temp
IF (Tinlet >= Toutdoor) THEN
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Tinlet < Toutdoor
MaxOAFrac = GetCurrentScheduleValue(VentSlab(Item)%MaxOASchedPtr)
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
CASE (FixedTemperature)
! This is basically the same algorithm as for the heating case...
Tdesired = GetCurrentScheduleValue(VentSlab(Item)%TempSchedPtr)
MaxOAFrac = 1.0d0
IF (ABS(Tinlet-Toutdoor) <= LowTempDiff) THEN ! no difference in indoor and outdoor conditions-->set OA to minimum
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF (ABS(MaxOAFrac-MinOAFrac) <= LowOAFracDiff) THEN ! no difference in outside air fractions
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF ( ( (Tdesired <= Tinlet) .AND. (Tdesired >= Toutdoor) ) .OR. &
( (Tdesired >= Tinlet) .AND. (Tdesired <= Toutdoor) ) ) THEN
! Desired temperature is between the inlet and outdoor temperatures
! so vary the flow rate between no outside air and no recirculation air
! then applying the maximum and minimum limits the user has scheduled
! to make sure too much/little outside air is being introduced
OAMassFlowRate = ((Tdesired - Tinlet)/(Toutdoor - Tinlet))*Node(InletNode)%MassFlowRate
OAMassFlowRate = MAX(OAMassFlowRate,(MinOAFrac*Node(OutsideAirNode)%MassFlowRate))
OAMassFlowRate = MIN(OAMassFlowRate,(MaxOAFrac*Node(OutsideAirNode)%MassFlowRate))
ELSE IF ( (Tdesired < Tinlet) .AND. (Tdesired < Toutdoor) ) THEN
! Desired temperature is below both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet < Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE IF ( (Tdesired > Tinlet) .AND. (Tdesired > Toutdoor) ) THEN
! Desired temperature is above both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet > Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE
! It should NEVER get to this point, but just in case...
CALL ShowFatalError('Ventilated Slab simulation control: illogical condition for '//TRIM(VentSlab(Item)%Name))
END IF
END SELECT
CALL CalcVentilatedSlabComps(Item,FirstHVACIteration,QUnitOUt)
ElSE ! Heating Coil present
SELECT CASE (VentSlab(Item)%OAControlType)
CASE (FixedOAControl)
! In this control type, the outdoor air flow rate is fixed to the maximum value
! which is equal to the minimum value, regardless of all the other conditions.
If(Node(OutsideAirNode)%MassFlowRate > 0.0d0) Then
MaxOAFrac = GetCurrentScheduleValue(VentSlab(Item)%MaxOASchedPtr)
Else
MaxOAFrac = 0.0d0
End If
MaxOAFrac = MIN(1.0d0,MAX(0.0d0,MinOAFrac))
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (VariablePercent)
! In heating mode, the ouside air for "variable percent" control
! is set to the minimum value
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (FixedTemperature)
! This is basically the same algorithm as for the heating case...
Tdesired = GetCurrentScheduleValue(VentSlab(Item)%TempSchedPtr)
MaxOAFrac = 1.0d0
IF (ABS(Tinlet-Toutdoor) <= LowTempDiff) THEN ! no difference in indoor and outdoor conditions-->set OA to minimum
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF (ABS(MaxOAFrac-MinOAFrac) <= LowOAFracDiff) THEN ! no difference in outside air fractions
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF ( ( (Tdesired <= Tinlet) .AND. (Tdesired >= Toutdoor) ) .OR. &
( (Tdesired >= Tinlet) .AND. (Tdesired <= Toutdoor) ) ) THEN
! Desired temperature is between the inlet and outdoor temperatures
! so vary the flow rate between no outside air and no recirculation air
! then applying the maximum and minimum limits the user has scheduled
! to make sure too much/little outside air is being introduced
OAMassFlowRate = ((Tdesired - Tinlet)/(Toutdoor - Tinlet))*Node(InletNode)%MassFlowRate
OAMassFlowRate = MAX(OAMassFlowRate,(MinOAFrac*Node(OutsideAirNode)%MassFlowRate))
OAMassFlowRate = MIN(OAMassFlowRate,(MaxOAFrac*Node(OutsideAirNode)%MassFlowRate))
ELSE IF ( (Tdesired < Tinlet) .AND. (Tdesired < Toutdoor) ) THEN
! Desired temperature is below both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet < Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE IF ( (Tdesired > Tinlet) .AND. (Tdesired > Toutdoor) ) THEN
! Desired temperature is above both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet > Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE
! It should NEVER get to this point, but just in case...
CALL ShowFatalError('Ventilated Slab simulation control: illogical condition for '//TRIM(VentSlab(Item)%Name))
END IF
END SELECT
CALL SimVentSlabOAMixer(Item)
CALL SimulateFanComponents(VentSlab(Item)%FanName,FirstHVACIteration,VentSlab(Item)%Fan_Index, &
ZoneCompTurnFansOn = ZoneCompTurnFansOn,ZoneCompTurnFansOff = ZoneCompTurnFansOff)
CpFan = PsyCpAirFnWTdb(Node(FanOutletNode)%HumRat,Node(FanOutletNode)%Temp)
QZnReq = (Node(OutletNode)%MassFlowRate)*CpFan*(RadInTemp-Node(FanOutletNode)%Temp)
! Setup the coil configuration
SELECT CASE (VentSlab(Item)%HCoilType)
CASE (Heating_WaterCoilType)
! control water flow to obtain output matching QZnReq
CALL ControlCompOutput(CompName=VentSlab(Item)%Name,CompType=cMO_VentilatedSlab,CompNum=Item, &
FirstHVACIteration=FirstHVACIteration,QZnReq=QZnReq, &
ActuatedNode=ControlNode,MaxFlow=MaxWaterFlow, &
MinFlow=MinWaterFlow,ControlOffSet=0.001d0, &
ControlCompTypeNum=VentSlab(Item)%ControlCompTypeNum, &
CompErrIndex=VentSlab(Item)%CompErrIndex, &
LoopNum = VentSlab(Item)%HWLoopNum, &
LoopSide = VentSlab(Item)%HWLoopSide, &
BranchIndex = VentSlab(Item)%HWBranchNum)
CASE (Heating_GasCoilType,Heating_ElectricCoilType,Heating_SteamCoilType)
CALL CalcVentilatedSlabComps(Item,FirstHVACIteration,QUnitOut)
END SELECT
END IF ! Coil/no coil block
ElSE IF (SetpointTemp>AirTempCoolLo) THEN ! Cooling Mode
OperatingMode = CoolingMode
SetpointTempHi = GetCurrentScheduleValue(VentSlab(Item)%ColdCtrlHiTempSchedPtr)
SetpointTempLo = GetCurrentScheduleValue(VentSlab(Item)%ColdCtrlLoTempSchedPtr)
IF (SetpointTempHi < SetpointTempLo) THEN
CALL ShowSevereError('Cooling setpoint temperature mismatch in'//TRIM(VentSlab(Item)%Name))
CALL ShowContinueError('High setpoint temperature is less than low setpoint temperature--check your schedule input')
CALL ShowFatalError('Preceding condition causes termination.')
END IF
AirTempHi = GetCurrentScheduleValue(VentSlab(Item)%ColdAirHiTempSchedPtr)
AirTempLo = GetCurrentScheduleValue(VentSlab(Item)%ColdAirLoTempSchedPtr)
IF (AirTempHi < AirTempLo) THEN
CALL ShowSevereError('Cooling Air temperature mismatch in'//TRIM(VentSlab(Item)%Name))
CALL ShowContinueError('High Air temperature is less than low Air temperature--check your schedule input')
CALL ShowFatalError('Preceding condition causes termination.')
END IF
IF (SetpointTemp <= SetpointTempLo) THEN
! System is below low cooling setpoint so we should be able to turn the system off
RadInTemp = AirTempHi
ELSE IF (SetpointTemp >= SetpointTempHi) THEN
! System is running with its lowest inlet temperature
RadInTemp = AirTempLo
ELSE
! Interpolate to obtain the current radiant system inlet temperature
RadInTemp = AirTempHi - (AirTempHi - AirTempLo)*(SetpointTemp - SetpointTempLo)/(SetpointTempHi - SetpointTempLo)
END IF
ControlNode = VentSlab(Item)%ColdControlNode
MaxWaterFlow = VentSlab(Item)%MaxColdWaterFlow
MinWaterFlow = VentSlab(Item)%MinColdWaterFlow
!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((.not. FirstHVACIteration) .and. (ControlNode > 0) &
.and. (VentSlab(Item)%CCoilPresent)) Then
MaxWaterFlow = Node(ControlNode)%MassFlowRateMaxAvail
MinWaterFlow = Node(ControlNode)%MassFlowRateMinAvail
End IF
HCoilOn = .FALSE.
If(Node(OutsideAirNode)%MassFlowRate > 0.0d0) Then
MinOAFrac = GetCurrentScheduleValue(VentSlab(Item)%MinOASchedPtr) * &
(VentSlab(Item)%MinOutAirMassFlow / Node(OutsideAirNode)%MassFlowRate)
Else
MinOAFrac = 0.0d0
End If
MinOAFrac = MIN(1.0d0,MAX(0.0d0,MinOAFrac))
IF ((.NOT.VentSlab(Item)%CCoilPresent) .OR. &
(VentSlab(Item)%CCoilSchedValue <= 0.0d0) ) THEN
! In cooling mode, but there is no coil to provide cooling. This is handled
! differently than if there was a cooling coil present. Fixed temperature
! will still try to vary the amount of outside air to meet the desired
! mixed air temperature, while variable percent will go to full ventilation
! when it is most advantageous.
! If there are no coil, Slab In Node is assumed to be Fan Outlet Node
OutletNode = FanOutletNode
SELECT CASE (VentSlab(Item)%OAControlType)
CASE (FixedOAControl)
! In this control type, the outdoor air flow rate is fixed to the maximum value
! which is equal to the minimum value, regardless of all the other conditions.
If(Node(OutsideAirNode)%MassFlowRate > 0.0d0) Then
MaxOAFrac = GetCurrentScheduleValue(VentSlab(Item)%MaxOASchedPtr)
Else
MaxOAFrac = 0.0d0
End If
MaxOAFrac = MIN(1.0d0,MAX(0.0d0,MinOAFrac))
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (VariablePercent)
! This algorithm is probably a bit simplistic in that it just bounces
! back and forth between the maximum outside air and the minimum. In
! reality, a system *might* vary between the two based on the load in
! the zone. This simple flow control might cause some overcooling but
! chances are that if there is a cooling load and the zone temperature
! gets above the outside temperature that overcooling won't be significant.
Tinlet = Node(InletNode)%Temp
Toutdoor = Node(OutsideAirNode)%Temp
IF (Tinlet <= Toutdoor) THEN
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Tinlet > Toutdoor
MaxOAFrac = GetCurrentScheduleValue(VentSlab(Item)%MaxOASchedPtr)
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
CASE (FixedTemperature)
! This is basically the same algorithm as for the heating case...
Tdesired = GetCurrentScheduleValue(VentSlab(Item)%TempSchedPtr)
MaxOAFrac = 1.0d0
IF (ABS(Tinlet-Toutdoor) <= LowTempDiff) THEN ! no difference in indoor and outdoor conditions-->set OA to minimum
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF (ABS(MaxOAFrac-MinOAFrac) <= LowOAFracDiff) THEN ! no difference in outside air fractions
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF ( ( (Tdesired <= Tinlet) .AND. (Tdesired >= Toutdoor) ) .OR. &
( (Tdesired >= Tinlet) .AND. (Tdesired <= Toutdoor) ) ) THEN
! Desired temperature is between the inlet and outdoor temperatures
! so vary the flow rate between no outside air and no recirculation air
! then applying the maximum and minimum limits the user has scheduled
! to make sure too much/little outside air is being introduced
OAMassFlowRate = ((Tdesired - Tinlet)/(Toutdoor - Tinlet))*Node(InletNode)%MassFlowRate
OAMassFlowRate = MAX(OAMassFlowRate,(MinOAFrac*Node(OutsideAirNode)%MassFlowRate))
OAMassFlowRate = MIN(OAMassFlowRate,(MaxOAFrac*Node(OutsideAirNode)%MassFlowRate))
ELSE IF ( (Tdesired < Tinlet) .AND. (Tdesired < Toutdoor) ) THEN
! Desired temperature is below both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet < Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE IF ( (Tdesired > Tinlet) .AND. (Tdesired > Toutdoor) ) THEN
! Desired temperature is above both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet > Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE
! It should NEVER get to this point, but just in case...
CALL ShowFatalError(cMO_VentilatedSlab//' simulation control: illogical condition for '//TRIM(VentSlab(Item)%Name))
END IF
END SELECT
CALL CalcVentilatedSlabComps(Item,FirstHVACIteration,QUnitOut)
ELSE
! There is a cooling load and there is a cooling coil present (presumably).
! Variable percent will throttle outside air back to the minimum while
! fixed temperature will still try to vary the outside air amount to meet
! the desired mixed air temperature.
SELECT CASE (VentSlab(Item)%OAControlType)
Case (FixedOAControl)
! In this control type, the outdoor air flow rate is fixed to the maximum value
! which is equal to the minimum value, regardless of all the other conditions.
If(Node(OutsideAirNode)%MassFlowRate > 0.0d0) Then
MaxOAFrac = GetCurrentScheduleValue(VentSlab(Item)%MaxOASchedPtr)
Else
MaxOAFrac = 0.0d0
End If
MaxOAFrac = MIN(1.0d0,MAX(0.0d0,MinOAFrac))
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (VariablePercent)
! A cooling coil is present so let it try to do the cooling...
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
CASE (FixedTemperature)
! This is basically the same algorithm as for the heating case...
Tdesired = GetCurrentScheduleValue(VentSlab(Item)%TempSchedPtr)
MaxOAFrac = 1.0d0
IF (ABS(Tinlet-Toutdoor) <= LowTempDiff) THEN ! no difference in indoor and outdoor conditions-->set OA to minimum
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF (ABS(MaxOAFrac-MinOAFrac) <= LowOAFracDiff) THEN ! no difference in outside air fractions
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE IF ( ( (Tdesired <= Tinlet) .AND. (Tdesired >= Toutdoor) ) .OR. &
( (Tdesired >= Tinlet) .AND. (Tdesired <= Toutdoor) ) ) THEN
! Desired temperature is between the inlet and outdoor temperatures
! so vary the flow rate between no outside air and no recirculation air
! then applying the maximum and minimum limits the user has scheduled
! to make sure too much/little outside air is being introduced
OAMassFlowRate = ((Tdesired - Tinlet)/(Toutdoor - Tinlet))*Node(InletNode)%MassFlowRate
OAMassFlowRate = MAX(OAMassFlowRate,(MinOAFrac*Node(OutsideAirNode)%MassFlowRate))
OAMassFlowRate = MIN(OAMassFlowRate,(MaxOAFrac*Node(OutsideAirNode)%MassFlowRate))
ELSE IF ( (Tdesired < Tinlet) .AND. (Tdesired < Toutdoor) ) THEN
! Desired temperature is below both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet < Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE IF ( (Tdesired > Tinlet) .AND. (Tdesired > Toutdoor) ) THEN
! Desired temperature is above both the inlet and outdoor temperatures
! so use whichever flow rate (max or min) that will get closer
IF (Tinlet > Toutdoor) THEN ! Tinlet closer to Tdesired so use minimum outside air
OAMassFlowRate = MinOAFrac*Node(OutsideAirNode)%MassFlowRate
ELSE ! Toutdoor closer to Tdesired so use maximum outside air
OAMassFlowRate = MaxOAFrac*Node(OutsideAirNode)%MassFlowRate
END IF
ELSE
! It should NEVER get to this point, but just in case...
CALL ShowFatalError(cMO_VentilatedSlab//' simulation control: illogical condition for '//TRIM(VentSlab(Item)%Name))
END IF
END SELECT
! control water flow to obtain output matching Low Setpoint Temperateure
HCoilOn = .FALSE.
CALL SimVentSlabOAMixer(Item)
CALL SimulateFanComponents(VentSlab(Item)%FanName,FirstHVACIteration,VentSlab(Item)%Fan_Index, &
ZoneCompTurnFansOn = ZoneCompTurnFansOn,ZoneCompTurnFansOff = ZoneCompTurnFansOff)
CpFan = PsyCpAirFnWTdb(Node(FanOutletNode)%HumRat,Node(FanOutletNode)%Temp)
QZnReq = (Node(OutletNode)%MassFlowRate)*CpFan*(RadInTemp-Node(FanOutletNode)%Temp)
CALL ControlCompOutput(CompName=VentSlab(Item)%Name,CompType=cMO_VentilatedSlab,CompNum=Item, &
FirstHVACIteration=FirstHVACIteration,QZnReq=QZnReq, &
ActuatedNode=ControlNode,MaxFlow=MaxWaterFlow, &
MinFlow=MinWaterFlow,ControlOffSet=0.001d0, &
ControlCompTypeNum=VentSlab(Item)%ControlCompTypeNum, &
CompErrIndex=VentSlab(Item)%CompErrIndex, &
LoopNum = VentSlab(Item)%CWLoopNum, &
LoopSide = VentSlab(Item)%CWLoopSide, &
BranchIndex = VentSlab(Item)%CWBranchNum)
END IF
END IF ! ...end of HEATING/COOLING IF-THEN block
CALL CalcVentilatedSlabRadComps(Item, FirstHVACIteration)
AirMassFlow = Node(Outletnode)%MassFlowRate
QUnitOut = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(FanOutletNode)%HumRat) &
-PsyHFnTdbW(Node(FanOutletNode)%Temp,Node(FanOutletNode)%HumRat))
END IF ! ...end of system ON/OFF IF-THEN block
! CR9155 Remove specific humidity calculations
SpecHumOut = Node(OutletNode)%HumRat
SpecHumIn = Node(FanOutletNode)%HumRat
LatentOutput = AirMassFlow * (SpecHumOut - SpecHumIn) ! Latent rate (kg/s), dehumid = negative
QTotUnitOut = AirMassFlow * (Node(FanOutletNode)%Enthalpy - Node(OutletNode)%Enthalpy)
! Report variables...
VentSlab(Item)%HeatCoilPower = MAX(0.0d0,QUnitOut)
VentSlab(Item)%SensCoolCoilPower = ABS(MIN(0.0d0,QUnitOut))
VentSlab(Item)%TotCoolCoilPower = ABS(MIN(0.0d0,QTotUnitOut))
VentSlab(Item)%LateCoolCoilPower = VentSlab(Item)%TotCoolCoilPower - VentSlab(Item)%SensCoolCoilPower
VentSlab(Item)%ElecFanPower = FanElecPower
VentSlab(Item)%AirMassFlowRate = AirMassFlow
PowerMet = QUnitOut
LatOutputProvided = LatentOutput
RETURN
END SUBROUTINE CalcVentilatedSlab