SUBROUTINE CalcVentilatedSlabRadComps(Item, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Young Tae Chae, Rick Strand
! DATE WRITTEN June 2008
! MODIFIED Sep 2011 LKL/BG - resimulate only zones needing it for Radiant systems
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine launches the individual component simulations.
! This is called either when the system is off to carry null conditions
! through the system or during control iterations to continue updating
! what is going on within the system.
! METHODOLOGY EMPLOYED:
! Simply calls the different components in order. Only slight wrinkles
! here are that the Ventilated Slab has it's own outside air mixed and
! that a cooling coil must be present in order to call a cooling coil
! simulation. Other than that, the subroutine is very straightforward.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataEnvironment, ONLY : OutBaroPress
USE General, ONLY : RoundSigDigits
USE Fans, ONLY : SimulateFanComponents
USE HeatingCoils, ONLY : SimulateHeatingCoilComponents
USE WaterCoils, ONLY : SimulateWaterCoilComponents
USE HVACHXAssistedCoolingCoil, ONLY :SimHXAssistedCoolingCoil
Use SteamCoils, ONLY: SimulateSteamCoilComponents
USE DataHeatBalance, ONLY : Construct, Zone
USE DataHeatBalFanSys, ONLY : RadSysTiHBConstCoef, &
RadSysTiHBToutCoef,RadSysTiHBQsrcCoef, &
RadSysToHBConstCoef,RadSysToHBTinCoef, &
RadSysToHBQsrcCoef,CTFTsrcConstPart, &
ZoneAirHumRat, &
MAT
USE DataHeatBalSurface, ONLY : TH
USE DataSurfaces, ONLY : Surface
USE NodeInputManager, ONLY : GetOnlySingleNode
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: Item ! System index in ventilated slab array
LOGICAL, INTENT(IN) :: FirstHVACIteration ! flag for 1st HVAV iteration in the time step !unused1208
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: CondDeltaTemp = 0.001d0 ! How close the surface temperatures can get to the dewpoint temperature
! of a space before the radiant cooling system shuts off the flow.
REAL(r64), PARAMETER :: ZeroSystemResp = 0.1d0 ! Response below which the system response is really zero
REAL(r64), PARAMETER :: TempCheckLimit = 0.1d0 ! Maximum allowed temperature difference between outlet temperature calculations
REAL(r64), PARAMETER :: VentSlabAirTempToler = 0.001d0 !Maximum allowed temperature difference between the zone and return air
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='ZoneHVAC:VentilatedSlab'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ConstrNum ! Index for construction number in Construct derived type
REAL(r64):: CpAirZn ! Intermediate calculational variable for specific heat of air
REAL(r64):: DewPointTemp ! Dew-point temperature based on the zone air conditions
REAL(r64):: EpsMdotCpAirzn ! Epsilon (heat exchanger terminology) times water mass flow rate times water specific heat
REAL(r64):: Mdot ! Intermediate calculation variable for mass flow rate in a surface within the radiant system
INTEGER :: RadSurfNum ! DO loop counter for the surfaces that comprise a particular radiant system
INTEGER :: RadSurfNum2 ! DO loop counter for the surfaces that comprise a particular radiant system
INTEGER :: RadSurfNum3 ! DO loop counter for the surfaces that comprise a particular radiant system
!unused0309 INTEGER :: RadSurfNum4 ! DO loop counter for the surfaces that comprise a particular radiant system
INTEGER :: SurfNum ! Index for radiant surface in Surface derived type
INTEGER :: SurfNum2 ! Index for radiant surface in Surface derived type
!unused0309 INTEGER :: RadSurfNumNum
REAL(r64):: TotalVentSlabRadPower ! Total heat source/sink to radiant system
REAL(r64):: AirMassFlow ! air mass flow rate in the radiant system, kg/s
INTEGER :: SlabInNode ! Node number of the air entering the radiant system
REAL(r64):: AirOutletTempCheck ! Radiant system air outlet temperature (calculated from mixing all outlet streams together)
REAL(r64):: AirTempIn ! Temperature of the air entering the radiant system, in C
INTEGER :: ZoneNum ! number of zone being served
REAL(r64):: ZoneMult ! Zone multiplier for this system
REAL(r64):: Ca,Cb,Cc,Cd,Ce,Cf,Cg,Ch,Ci,Cj,Ck,Cl ! Coefficients to relate the inlet air temperature to the heat source
! For more info on Ca through Cl, refer Constant Flow Radiant System
!unused0309 REAL(r64):: CoreNumber
REAL(r64), SAVE :: Ckj, Cmj ! Coefficients for individual surfaces within a radiant system
REAL(r64), SAVE, DIMENSION(:), ALLOCATABLE :: AirTempOut ! Array of outlet air temperatures for each surface in the radiant system
INTEGER :: FanOutletNode ! unit air outlet node
INTEGER :: OAInletNode ! unit air outlet node
INTEGER :: MixoutNode ! unit air outlet node
INTEGER :: Returnairnode ! discription
INTEGER :: ZoneAirInNode !supply air node
!For Phase 3
REAL(r64) :: CNumDS
REAL(r64) :: CLengDS
REAL(r64) :: CDiaDS
REAL(r64) :: FlowFrac
!unused0309 REAL(r64) :: SlabAirOutTemp
REAL(r64) :: MSlabAirInTemp
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
CHARACTER(len=MaxNameLength) ::MSlabIn
CHARACTER(len=MaxNameLength) ::MSlabOut
CHARACTER(len=MaxNameLength) ::SlabName
INTEGER :: MSlabInletNode
INTEGER :: MSlabOutletNode
INTEGER, SAVE :: CondensationErrorCount = 0 ! Counts for # times the radiant systems are shutdown due to condensation
INTEGER, SAVE :: EnergyImbalanceErrorCount = 0 ! Counts for # times a temperature mismatch is found in the energy balance check
LOGICAL, SAVE :: FirstTimeFlag=.true. ! for setting size of Ckj, Cmj, AirTempOut arrays
! FLOW:
IF (FirstTimeFlag) THEN
ALLOCATE (AirTempOut(MaxCloNumOfSurfaces))
FirstTimeFlag=.false.
ENDIF
Ckj = 0.0d0
Cmj = 0.0d0
SlabInNode = VentSlab(Item)%RadInNode
FanOutletNode = VentSlab(Item)%FanOutletNode
OAInletNode = VentSlab(Item)%OutsideAirNode
MixoutNode = VentSlab(Item)%OAMixerOutNode
Returnairnode = VentSlab(Item)%ReturnAirNode
ZoneAirInnode = VentSlab(Item)%ZoneAirInNode
! Set the conditions on the air side inlet
ZoneNum = VentSlab(Item)%ZonePtr
ZoneMult = REAL(Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier,r64)
AirMassFlow = Node(VentSlab(Item)%RadInNode)%MassFlowRate / ZoneMult
IF (OperatingMode==HeatingMode) THEN
IF ((.NOT.VentSlab(Item)%HCoilPresent) .OR. &
(VentSlab(Item)%HCoilSchedValue <= 0.0d0)) THEN
AirTempIn = Node(FanOutletNode)%Temp
Node(SlabInNode)%Temp = Node(FanOutletNode)%Temp ! If coil not available or running, then coil in and out temps same
ELSE
AirTempIn = Node(SlabInNode)%Temp
END IF
END IF
IF (OperatingMode==CoolingMode) THEN
IF ((.NOT.VentSlab(Item)%CCoilPresent) .OR. &
(VentSlab(Item)%CCoilSchedValue <= 0.0d0)) THEN
AirTempIn = Node(FanOutletNode)%Temp
Node(SlabInNode)%Temp = Node(FanOutletNode)%Temp ! If coil not available or running, then coil in and out temps same
ELSE
AirTempIn = Node(SlabInNode)%Temp
END IF
END IF
IF (AirMassFlow <= 0.0d0) THEN
! No flow or below minimum allowed so there is no heat source/sink
! This is possible with a mismatch between system and plant operation
! or a slight mismatch between zone and system controls. This is not
! necessarily a "problem" so this exception is necessary in the code.
DO RadSurfNum = 1, VentSlab(Item)%NumOfSurfaces
SurfNum= VentSlab(Item)%SurfacePtr(RadSurfNum)
QRadSysSource(SurfNum)= 0.0D0
IF (Surface(SurfNum)%ExtBoundCond > 0 .AND. Surface(SurfNum)%ExtBoundCond /= SurfNum) &
QRadSysSource(Surface(SurfNum)%ExtBoundCond) = 0.0D0 ! Also zero the other side of an interzone
END DO
VentSlab(Item)%SlabOutTemp = VentSlab(Item)%SlabInTemp
! zero out node flows
Node(SlabInNode)%MassFlowRate = 0.0d0
Node(FanOutletNode)%MassFlowRate = 0.0d0
Node(OAInletNode)%MassFlowRate = 0.0d0
Node(MixoutNode)%MassFlowRate = 0.0d0
Node(Returnairnode)%MassFlowRate = 0.0d0
Node(FanOutletNode)%Temp = Node(SlabInNode)%Temp
AirMassFlow = 0.0d0
END IF
IF (AirMassFlow > 0.0d0) THEN
IF ((VentSlab(Item)%SysConfg == SlabOnly).OR.(VentSlab(Item)%SysConfg == SlabAndZone)) THEN
DO RadSurfNum = 1, VentSlab(Item)%NumOfSurfaces
SurfNum = VentSlab(Item)%SurfacePtr(RadSurfNum)
! Determine the heat exchanger "effectiveness" term
EpsMdotCpAirZn = CalcVentSlabHXEffectTerm(Item,AirTempIn,AirMassFlow, &
VentSlab(Item)%SurfaceFlowFrac(RadSurfNum) , &
VentSlab(Item)%CoreLength, &
VentSlab(Item)%CoreDiameter, VentSlab(Item)%CoreNumbers)
! Obtain the heat balance coefficients and calculate the intermediate coefficients
! linking the inlet air temperature to the heat source/sink to the radiant system.
! The coefficients are based on the Constant Flow Radiation System.
ConstrNum = Surface(SurfNum)%Construction
Ca = RadSysTiHBConstCoef(SurfNum)
Cb = RadSysTiHBToutCoef(SurfNum)
Cc = RadSysTiHBQsrcCoef(SurfNum)
Cd = RadSysToHBConstCoef(SurfNum)
Ce = RadSysToHBTinCoef(SurfNum)
Cf = RadSysToHBQsrcCoef(SurfNum)
Cg = CTFTsrcConstPart(SurfNum)
Ch = REAL(Construct(ConstrNum)%CTFTSourceQ(0),r64)
Ci = REAL(Construct(ConstrNum)%CTFTSourceIn(0),r64)
Cj = REAL(Construct(ConstrNum)%CTFTSourceOut(0),r64)
Ck = Cg + ( ( Ci*(Ca+Cb*Cd) + Cj*(Cd+Ce*Ca) ) / ( 1.0d0 - Ce*Cb ) )
Cl = Ch + ( ( Ci*(Cc+Cb*Cf) + Cj*(Cf+Ce*Cc) ) / ( 1.0d0 - Ce*Cb ) )
Mdot = AirMassFlow * VentSlab(Item)%SurfaceFlowFrac(RadSurfNum)
CpAirZn = PsyCpAirFnWTdb(Node(VentSlab(Item)%RadInNode)%HumRat,Node(VentSlab(Item)%RadInNode)%Temp)
QRadSysSource(SurfNum) = VentSlab(Item)%CoreNumbers * EpsMdotCpAirZn * (AirTempIn - Ck) &
/(1.0d0 + (EpsMdotCpAirZn*Cl/Surface(SurfNum)%Area) )
IF (Surface(SurfNum)%ExtBoundCond > 0 .AND. Surface(SurfNum)%ExtBoundCond /= SurfNum) &
QRadSysSource(Surface(SurfNum)%ExtBoundCond) = QRadSysSource (SurfNum)
! Also set the other side of an interzone!
AirTempOut(RadSurfNum) = AirTempIn - (QRadSysSource(SurfNum)/(Mdot*CpAirZn))
! "Temperature Comparison" Cut-off:
! Check to see whether or not the system should really be running. If
! QRadSysSource is negative when we are in heating mode or QRadSysSource
! is positive when we are in cooling mode, then the radiant system will
! be doing the opposite of its intention. In this case, the flow rate
! is set to zero to avoid heating in cooling mode or cooling in heating
! mode.
IF (((OperatingMode == HeatingMode).AND.(QRadSysSource(SurfNum) <= 0.0d0)) .OR. &
((OperatingMode == CoolingMode).AND.(QRadSysSource(SurfNum) >= 0.0d0)) ) THEN
! IF (.not. WarmupFlag) THEN
! TempComparisonErrorCount = TempComparisonErrorCount + 1
! IF (TempComparisonErrorCount <= NumOfVentSlabs) THEN
! CALL ShowWarningError('Radaint Heat exchange is negative in Heating Mode or posive in Cooling Mode')
! CALL ShowContinueError('Flow to the following ventilated slab will be shut-off to avoid heating in cooling mode or cooling &
! in heating mode')
! CALL ShowContinueError('Ventilated Slab Name = '//TRIM(VentSlab(Item)%Name))
! CALL ShowContinueError('All node temperature are reseted at the ventilated slab surface temperature = '// &
! RoundSigDigits(TH(VentSlab(Item)%SurfacePtr(RadSurfNum),1,2),2))
! CALL ShowContinueErrorTimeStamp(' ')
! ELSE
! CALL ShowRecurringWarningErrorAtEnd('Ventilated Slab ['//TRIM(VentSlab(Item)%Name)// &
! '] Temperature Comparison Error shut-off occurrence continues.', &
! VentSlab(Item)%CondErrCount)
! END IF
! END IF
Node(SlabInNode)%MassFlowRate = 0.0d0
Node(FanOutletNode)%MassFlowRate = 0.0d0
Node(OAInletNode)%MassFlowRate = 0.0d0
Node(MixoutNode)%MassFlowRate = 0.0d0
Node(Returnairnode)%MassFlowRate = 0.0d0
AirMassFlow = 0.0d0
DO RadSurfNum2 = 1, VentSlab(Item)%NumOfSurfaces
SurfNum2 = VentSlab(Item)%SurfacePtr(RadSurfNum2)
QRadSysSource(SurfNum2) = 0.0D0
IF (Surface(SurfNum2)%ExtBoundCond > 0 .AND. Surface(SurfNum2)%ExtBoundCond /= SurfNum2) &
QRadSysSource(Surface(SurfNum2)%ExtBoundCond) = 0.0D0 ! Also zero the other side of an interzone
IF (VentSlab(Item)%SysConfg == SlabOnly) THEN
! Node(Returnairnode)%Temp = MAT(Zonenum)
Node(Returnairnode)%Temp = TH(VentSlab(Item)%SurfacePtr(RadSurfNum),1,2)
Node(FanOutletNode)%Temp = Node(Returnairnode)%Temp
Node(SlabInNode)%Temp = Node(FanOutletNode)%Temp
ELSE IF (VentSlab(Item)%SysConfg == SlabandZone) THEN
Node(ReturnAirNode)%Temp = MAT(Zonenum)
Node(SlabInNode)%Temp = Node(ReturnAirNode)%Temp
Node(FanOutletNode)%Temp = Node(SlabInNode)%Temp
Node(ZoneAirInNode)%Temp = Node(SlabInNode)%Temp
END IF
END DO
EXIT ! outer do loop
END IF
! Condensation Cut-off:
! Check to see whether there are any surface temperatures within the radiant system that have
! dropped below the dew-point temperature. If so, we need to shut off this radiant system.
! A safety parameter is added (hardwired parameter) to avoid getting too close to condensation
! conditions.
IF (OperatingMode == CoolingMode) THEN
DewPointTemp = PsyTdpFnWPb(ZoneAirHumRat(VentSlab(Item)%ZonePtr),OutBaroPress)
DO RadSurfNum2 = 1, VentSlab(Item)%NumOfSurfaces
IF (TH(VentSlab(Item)%SurfacePtr(RadSurfNum2),1,2) < (DewPointTemp+CondDeltaTemp) ) THEN
! Condensation warning--must shut off radiant system
Node(SlabInNode)%MassFlowRate = 0.0d0
Node(FanOutletNode)%MassFlowRate = 0.0d0
Node(OAInletNode)%MassFlowRate = 0.0d0
Node(MixoutNode)%MassFlowRate = 0.0d0
Node(Returnairnode)%MassFlowRate = 0.0d0
Node(FanOutletNode)%Temp = Node(SlabInNode)%Temp
AirMassFlow = 0.0d0
DO RadSurfNum3 = 1, VentSlab(Item)%NumOfSurfaces
SurfNum2 = VentSlab(Item)%SurfacePtr(RadSurfNum3)
QRadSysSource(SurfNum2) = 0.0D0
IF (Surface(SurfNum2)%ExtBoundCond > 0 .AND. Surface(SurfNum2)%ExtBoundCond /= SurfNum2) &
QRadSysSource(Surface(SurfNum2)%ExtBoundCond) = 0.0D0 ! Also zero the other side of an interzone
END DO
! Produce a warning message so that user knows the system was shut-off due to potential for condensation
IF (.not. WarmupFlag) THEN
CondensationErrorCount = CondensationErrorCount + 1
IF (VentSlab(Item)%CondErrIndex == 0) THEN
CALL ShowWarningMessage(cMO_VentilatedSlab//' ['//TRIM(TRIM(VentSlab(Item)%Name))//']')
CALL ShowContinueError('Surface ['//trim(Surface(VentSlab(Item)%SurfacePtr(RadSurfNum2))%Name)// &
'] temperature below dew-point temperature--potential for condensation exists')
CALL ShowContinueError('Flow to the ventilated slab system will be shut-off to avoid condensation')
CALL ShowContinueError('Predicted radiant system surface temperature = '// &
trim(RoundSigDigits(TH(VentSlab(Item)%SurfacePtr(RadSurfNum2),1,2),2)))
CALL ShowContinueError('Zone dew-point temperature + safety factor delta= '// &
trim(RoundSigDigits(DewPointTemp+CondDeltaTemp,2)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
IF (CondensationErrorCount == 1) THEN
CALL ShowContinueError('Note that there is a '//TRIM(RoundSigDigits(CondDeltaTemp,4))// &
' C safety built-in to the shut-off criteria')
CALL ShowContinueError('Note also that this affects all surfaces that are part of this system')
END IF
CALL ShowRecurringWarningErrorAtEnd(cMO_VentilatedSlab//' ['//TRIM(TRIM(VentSlab(Item)%Name))// &
'] condensation shut-off occurrence continues.', &
VentSlab(Item)%CondErrIndex,ReportMinOf=DewPointTemp,ReportMaxOf=DewPointTemp, &
ReportMaxUnits='C',ReportMinUnits='C')
END IF
EXIT ! outer do loop
END IF
END DO
END IF
END DO
! Total Radiant Power
AirOutletTempCheck = 0.0d0
TotalVentSlabRadPower = 0.0d0
DO RadSurfNum = 1, VentSlab(Item)%NumOfSurfaces
SurfNum = VentSlab(Item)%SurfacePtr(RadSurfNum)
TotalVentSlabRadPower = TotalVentSlabRadPower + QRadSysSource(SurfNum)
AirOutletTempCheck = AirOutletTempCheck+(VentSlab(Item)%SurfaceFlowFrac(RadSurfNum)*AirTempOut(RadSurfNum))
END DO
TotalVentSlabRadPower = ZoneMult * TotalVentSlabRadPower
! Return Air temp Check
IF (VentSlab(Item)%SysConfg == SlabOnly) THEN
IF (AirMassFlow> 0.0d0) THEN
CpAirZn = PsyCpAirFnWTdb(Node(VentSlab(Item)%RadInNode)%HumRat,Node(VentSlab(Item)%RadInNode)%Temp)!
Node(ReturnAirNode)%Temp = Node(SlabInNode)%Temp &
-(TotalVentSlabRadPower/(AirMassFlow*CpAirZn))
IF ((ABS(Node(ReturnAirNode)%Temp-AirOutletTempCheck) > TempCheckLimit) .AND. &
(ABS(TotalVentSlabRadPower) > ZeroSystemResp) ) THEN
IF (.not. WarmupFlag) THEN
EnergyImbalanceErrorCount = EnergyImbalanceErrorCount + 1
IF (VentSlab(Item)%EnrgyImbalErrIndex == 0) THEN
CALL ShowWarningMessage(cMO_VentilatedSlab//' ['//TRIM(TRIM(VentSlab(Item)%Name))//']')
CALL ShowContinueError('Ventilated Slab (slab only type) air outlet temperature calculation mismatch.')
CALL ShowContinueError('This should not happen as it indicates a potential energy imbalance in the calculations.')
CALL ShowContinueError('However, it could also result from improper input for the ventilated slab or')
CALL ShowContinueError('illogical control temperatures. Check your input for this ventilated slab and')
CALL ShowContinueError('also look at the internal data shown below.')
CALL ShowContinueError('Predicted return air temperature [C] from the overall energy balance = '// &
trim(RoundSigDigits(Node(ReturnAirNode)%Temp,4)))
CALL ShowContinueError('Predicted return air temperature [C] from the slab section energy balances = '// &
trim(RoundSigDigits(AirOutletTempCheck,4)))
CALL ShowContinueError('Total energy rate (power) [W] added to the slab = '// &
trim(RoundSigDigits(TotalVentSlabRadPower,4)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd(cMO_VentilatedSlab//' ['//TRIM(TRIM(VentSlab(Item)%Name))// &
'] temperature calculation mismatch occurrence continues.', &
VentSlab(Item)%EnrgyImbalErrIndex)
END IF
END IF
ELSE
Node(ReturnAirNode)%Temp = Node(SlabInNode)%Temp
END IF
END IF
IF (VentSlab(Item)%SysConfg == SlabandZone) THEN
IF (AirMassFlow> 0.0d0) THEN
Node(ZoneAirInNode)%Temp = Node(SlabInNode)%Temp &
-(TotalVentSlabRadPower/(AirMassFlow*CpAirZn))
IF ( (ABS(Node(ZoneAirInNode)%Temp-AirOutletTempCheck) > TempCheckLimit) .AND. &
(ABS(TotalVentSlabRadPower) > ZeroSystemResp) ) THEN
IF (.not. WarmupFlag) THEN
EnergyImbalanceErrorCount = EnergyImbalanceErrorCount + 1
IF (VentSlab(Item)%EnrgyImbalErrIndex == 0) THEN
CALL ShowWarningMessage(cMO_VentilatedSlab//' ['//TRIM(TRIM(VentSlab(Item)%Name))//']')
CALL ShowContinueError('Ventilated Slab (slab only type) air outlet temperature calculation mismatch.')
CALL ShowContinueError('This should not happen as it indicates a potential energy imbalance in the calculations.')
CALL ShowContinueError('However, it could also result from improper input for the ventilated slab or')
CALL ShowContinueError('illogical control temperatures. Check your input for this ventilated slab and')
CALL ShowContinueError('also look at the internal data shown below.')
CALL ShowContinueError('Predicted return air temperature [C] from the overall energy balance = '// &
trim(RoundSigDigits(Node(ReturnAirNode)%Temp,4)))
CALL ShowContinueError('Predicted return air temperature [C] from the slab section energy balances = '// &
trim(RoundSigDigits(AirOutletTempCheck,4)))
CALL ShowContinueError('Total energy rate (power) [W] added to the slab = '// &
trim(RoundSigDigits(TotalVentSlabRadPower,4)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd(cMO_VentilatedSlab//' ['//TRIM(TRIM(VentSlab(Item)%Name))// &
'] temperature calculation mismatch occurrence continues.', &
VentSlab(Item)%EnrgyImbalErrIndex)
END IF
END IF
! IF ((.NOT. FirstHVACIteration) .AND. &
! (ABS(Node(ReturnAirNode)%Temp-MAT(Zonenum)) > VentSlabAirTempToler))THEN
! NeedtoIterate = .TRUE.
! END IF
! Node(ReturnAirNode)%Temp = MAT(Zonenum)
ELSE
Node(ZoneAirInNode)%Temp = Node(SlabInNode)%Temp
Node(ReturnAirNode)%Temp= MAT(Zonenum)
ENDIF
END IF
! Now that we have the source/sink term, we must redo the heat balances to obtain
! the new SumHATsurf value for the zone. Note that the difference between the new
! SumHATsurf and the value originally calculated by the heat balance with a zero
! source for all radiant systems in the zone is the load met by the system (approximately).
CALL CalcHeatBalanceOutsideSurf(ZoneNum)
CALL CalcHeatBalanceInsideSurf(ZoneNum)
END IF !SYSCONFIG. SLABONLY&SLABANDZONE
IF (VentSlab(Item)%SysConfg == SeriesSlabs) THEN
DO RadSurfNum = 1, VentSlab(Item)%NumOfSurfaces
CNumDS=VentSlab(Item)%CNumbers(RadSurfNum)
CLengDS=VentSlab(Item)%CLength(RadSurfNum)! for check
CDiaDS=VentSlab(Item)%CDiameter(RadSurfNum)! for check
FlowFrac=1.0d0
SurfNum = VentSlab(Item)%SurfacePtr(RadSurfNum)
! Determine the heat exchanger "effectiveness" term
EpsMdotCpAirZn = CalcVentSlabHXEffectTerm(Item,AirTempIn,AirMassFlow, &
FlowFrac , &
CLengDS, &
CDiaDS, CNumDS)
! Obtain the heat balance coefficients and calculate the intermediate coefficients
! linking the inlet air temperature to the heat source/sink to the radiant system.
! The coefficients are based on the Constant Flow Radiation System.
ConstrNum = Surface(SurfNum)%Construction
Ca = RadSysTiHBConstCoef(SurfNum)
Cb = RadSysTiHBToutCoef(SurfNum)
Cc = RadSysTiHBQsrcCoef(SurfNum)
Cd = RadSysToHBConstCoef(SurfNum)
Ce = RadSysToHBTinCoef(SurfNum)
Cf = RadSysToHBQsrcCoef(SurfNum)
Cg = CTFTsrcConstPart(SurfNum)
Ch = REAL(Construct(ConstrNum)%CTFTSourceQ(0),r64)
Ci = REAL(Construct(ConstrNum)%CTFTSourceIn(0),r64)
Cj = REAL(Construct(ConstrNum)%CTFTSourceOut(0),r64)
Ck = Cg + ( ( Ci*(Ca+Cb*Cd) + Cj*(Cd+Ce*Ca) ) / ( 1.0d0 - Ce*Cb ) )
Cl = Ch + ( ( Ci*(Cc+Cb*Cf) + Cj*(Cf+Ce*Cc) ) / ( 1.0d0 - Ce*Cb ) )
Mdot = AirMassFlow * FlowFrac
CpAirZn = PsyCpAirFnWTdb(Node(VentSlab(Item)%RadInNode)%HumRat,Node(VentSlab(Item)%RadInNode)%Temp)
QRadSysSource(SurfNum) = CNumDS * EpsMdotCpAirZn * (AirTempIn - Ck) &
/(1.0d0 + (EpsMdotCpAirZn*Cl/Surface(SurfNum)%Area) )
IF (Surface(SurfNum)%ExtBoundCond > 0 .AND. Surface(SurfNum)%ExtBoundCond /= SurfNum) &
QRadSysSource(Surface(SurfNum)%ExtBoundCond) = QRadSysSource (SurfNum)
! Also set the other side of an interzone!
AirTempOut(RadSurfNum) = AirTempIn - (QRadSysSource(SurfNum)/(Mdot*CpAirZn))
AirTempIn = AirTempOut(RadSurfNum)
! "Temperature Comparison" Cut-off:
! Check to see whether or not the system should really be running. If
! QRadSysSource is negative when we are in heating mode or QRadSysSource
! is positive when we are in cooling mode, then the radiant system will
! be doing the opposite of its intention. In this case, the flow rate
! is set to zero to avoid heating in cooling mode or cooling in heating
! mode.
IF (RadSurfNum.eq.1) THEN
IF (((OperatingMode == HeatingMode).AND.(QRadSysSource(SurfNum) <= 0.0d0)) .OR. &
((OperatingMode == CoolingMode).AND.(QRadSysSource(SurfNum) >= 0.0d0)) ) THEN
!IF (.not. WarmupFlag) THEN
! TempComparisonErrorCount = TempComparisonErrorCount + 1
! IF (TempComparisonErrorCount <= NumOfVentSlabs) THEN
! CALL ShowWarningError('Radaint Heat exchange is negative in Heating Mode or posive in Cooling Mode')
! CALL ShowContinueError('Flow to the following ventilated slab will be shut-off to avoid heating in cooling mode or cooling &
! in heating mode')
! CALL ShowContinueError('Ventilated Slab Name = '//TRIM(VentSlab(Item)%Name))
! CALL ShowContinueError('Surface Name = '//TRIM(VentSlab(Item)%SurfaceName(RadSurfNum)))
! CALL ShowContinueError('All node temperature are reseted at the surface temperature of control zone = '// &
! RoundSigDigits(TH(VentSlab(Item)%SurfacePtr(1),1,2),2))
! CALL ShowContinueErrorTimeStamp(' ')
! ELSE
! CALL ShowRecurringWarningErrorAtEnd('Ventilated Slab ['//TRIM(VentSlab(Item)%Name)// &
! '] shut-off occurrence continues due to temperature comparison error.', &
! VentSlab(Item)%CondErrCount)
! END IF
!END IF
Node(SlabInNode)%MassFlowRate = 0.0d0
Node(FanOutletNode)%MassFlowRate = 0.0d0
Node(OAInletNode)%MassFlowRate = 0.0d0
Node(MixoutNode)%MassFlowRate = 0.0d0
Node(Returnairnode)%MassFlowRate = 0.0d0
AirMassFlow = 0.0d0
DO RadSurfNum2 = 1, VentSlab(Item)%NumOfSurfaces
SurfNum2 = VentSlab(Item)%SurfacePtr(RadSurfNum2)
QRadSysSource(SurfNum2) = 0.0D0
IF (Surface(SurfNum2)%ExtBoundCond > 0 .AND. Surface(SurfNum2)%ExtBoundCond /= SurfNum2) &
QRadSysSource(Surface(SurfNum2)%ExtBoundCond) = 0.0D0 ! Also zero the other side of an interzone
END DO
Node(Returnairnode)%Temp = TH(VentSlab(Item)%SurfacePtr(1),1,2)
Node(FanOutletNode)%Temp = Node(Returnairnode)%Temp
Node(SlabInNode)%Temp = Node(FanOutletNode)%Temp
! Each Internal node is reseted at the surface temperature
EXIT ! outer do loop
END IF
END IF
! Condensation Cut-off:
! Check to see whether there are any surface temperatures within the radiant system that have
! dropped below the dew-point temperature. If so, we need to shut off this radiant system.
! A safety parameter is added (hardwired parameter) to avoid getting too close to condensation
! conditions.
IF (OperatingMode == CoolingMode) THEN
DewPointTemp = PsyTdpFnWPb(ZoneAirHumRat(VentSlab(Item)%ZPtr(RadSurfNum)),OutBaroPress)
DO RadSurfNum2 = 1, VentSlab(Item)%NumOfSurfaces
IF (TH(VentSlab(Item)%SurfacePtr(RadSurfNum2),1,2) < (DewPointTemp+CondDeltaTemp) ) THEN
! Condensation warning--must shut off radiant system
Node(SlabInNode)%MassFlowRate = 0.0d0
Node(FanOutletNode)%MassFlowRate = 0.0d0
Node(OAInletNode)%MassFlowRate = 0.0d0
Node(MixoutNode)%MassFlowRate = 0.0d0
Node(Returnairnode)%MassFlowRate = 0.0d0
Node(FanOutletNode)%Temp = Node(SlabInNode)%Temp
AirMassFlow = 0.0d0
DO RadSurfNum3 = 1, VentSlab(Item)%NumOfSurfaces
SurfNum2 = VentSlab(Item)%SurfacePtr(RadSurfNum3)
QRadSysSource(SurfNum2) = 0.0D0
IF (Surface(SurfNum2)%ExtBoundCond > 0 .AND. Surface(SurfNum2)%ExtBoundCond /= SurfNum2) &
QRadSysSource(Surface(SurfNum2)%ExtBoundCond) = 0.0D0 ! Also zero the other side of an interzone
END DO
! Produce a warning message so that user knows the system was shut-off due to potential for condensation
IF (.not. WarmupFlag) THEN
CondensationErrorCount = CondensationErrorCount + 1
IF (VentSlab(Item)%CondErrIndex == 0) THEN
CALL ShowWarningMessage(cMO_VentilatedSlab//' ['//TRIM(TRIM(VentSlab(Item)%Name))//']')
CALL ShowContinueError('Surface ['//trim(Surface(VentSlab(Item)%SurfacePtr(RadSurfNum2))%Name)// &
'] temperature below dew-point temperature--potential for condensation exists')
CALL ShowContinueError('Flow to the ventilated slab system will be shut-off to avoid condensation')
CALL ShowContinueError('Predicted radiant system surface temperature = '// &
trim(RoundSigDigits(TH(VentSlab(Item)%SurfacePtr(RadSurfNum2),1,2),2)))
CALL ShowContinueError('Zone dew-point temperature + safety factor delta= '// &
trim(RoundSigDigits(DewPointTemp+CondDeltaTemp,2)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
IF (CondensationErrorCount == 1) THEN
CALL ShowContinueError('Note that there is a '//TRIM(RoundSigDigits(CondDeltaTemp,4))// &
' C safety built-in to the shut-off criteria')
CALL ShowContinueError('Note also that this affects all surfaces that are part of this system')
END IF
CALL ShowRecurringWarningErrorAtEnd(cMO_VentilatedSlab//' ['//TRIM(TRIM(VentSlab(Item)%Name))// &
'] condensation shut-off occurrence continues.', &
VentSlab(Item)%CondErrIndex,ReportMinOf=DewPointTemp,ReportMaxOf=DewPointTemp, &
ReportMaxUnits='C',ReportMinUnits='C')
END IF
EXIT ! outer do loop
END IF
END DO
END IF
END DO
! Total Radiant Power
AirOutletTempCheck = 0.0d0
TotalVentSlabRadPower = 0.0d0
DO RadSurfNum = 1, VentSlab(Item)%NumOfSurfaces
SurfNum = VentSlab(Item)%SurfacePtr(RadSurfNum)
TotalVentSlabRadPower = TotalVentSlabRadPower + QRadSysSource(SurfNum)
AirOutletTempCheck = AirTempOut(RadSurfNum)
END DO
TotalVentSlabRadPower = ZoneMult * TotalVentSlabRadPower
! Intenal Node Temperature Check
MSlabAirInTemp = Node(SlabInNode)%Temp
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
SurfNum = VentSlab(Item)%SurfacePtr(RadSurfNum)
IF (AirMassFlow> 0.0d0) THEN
CpAirZn = PsyCpAirFnWTdb(Node(VentSlab(Item)%RadInNode)%HumRat,Node(VentSlab(Item)%RadInNode)%Temp)!
Node(MSlabInletNode)%Temp = MSlabAirInTemp
Node(MSlabOutletNode)%Temp = Node(MSlabInletNode)%Temp &
-(QRadSysSource(SurfNum)/(AirMassFlow*CpAirZn))
MSlabAirInTemp = Node(MSlabOutletNode)%Temp
ELSE
Node(MSlabInletNode)%Temp = Node(Returnairnode)%Temp
Node(MSlabOutletNode)%Temp = Node(MSlabInletNode)%Temp
END IF
END DO
! Return Air temp Check
IF (AirMassFlow> 0.0d0) THEN
CpAirZn = PsyCpAirFnWTdb(Node(VentSlab(Item)%RadInNode)%HumRat,Node(VentSlab(Item)%RadInNode)%Temp)
Node(ReturnAirNode)%Temp = Node(SlabInNode)%Temp - (TotalVentSlabRadPower/(AirMassFlow*CpAirZn))
IF ((ABS(Node(ReturnAirNode)%Temp-AirOutletTempCheck) > TempCheckLimit) .AND. &
(ABS(TotalVentSlabRadPower) > ZeroSystemResp) ) THEN ! Return air temperature check did not match calculated temp
IF (.not. WarmupFlag) THEN
EnergyImbalanceErrorCount = EnergyImbalanceErrorCount + 1
IF (VentSlab(Item)%EnrgyImbalErrIndex == 0) THEN
CALL ShowWarningMessage(cMO_VentilatedSlab//' ['//TRIM(TRIM(VentSlab(Item)%Name))//']')
CALL ShowContinueError('Ventilated Slab (slab only type) air outlet temperature calculation mismatch.')
CALL ShowContinueError('This should not happen as it indicates a potential energy imbalance in the calculations.')
CALL ShowContinueError('However, it could also result from improper input for the ventilated slab or')
CALL ShowContinueError('illogical control temperatures. Check your input for this ventilated slab and')
CALL ShowContinueError('also look at the internal data shown below.')
CALL ShowContinueError('Predicted return air temperature [C] from the overall energy balance = '// &
trim(RoundSigDigits(Node(ReturnAirNode)%Temp,4)))
CALL ShowContinueError('Predicted return air temperature [C] from the slab section energy balances = '// &
trim(RoundSigDigits(AirOutletTempCheck,4)))
CALL ShowContinueError('Total energy rate (power) [W] added to the slab = '// &
trim(RoundSigDigits(TotalVentSlabRadPower,4)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd(cMO_VentilatedSlab//' ['//TRIM(TRIM(VentSlab(Item)%Name))// &
'] temperature calculation mismatch occurrence continues.', &
VentSlab(Item)%EnrgyImbalErrIndex)
END IF
END IF
ELSE
Node(ReturnAirNode)%Temp = Node(SlabInNode)%Temp
END IF
! Now that we have the source/sink term, we must redo the heat balances to obtain
! the new SumHATsurf value for the zone. Note that the difference between the new
! SumHATsurf and the value originally calculated by the heat balance with a zero
! source for all radiant systems in the zone is the load met by the system (approximately).
CALL CalcHeatBalanceOutsideSurf
CALL CalcHeatBalanceInsideSurf
END IF ! SeriesSlabs
END IF !(AirMassFlow > 0.0d0)
RETURN
END SUBROUTINE CalcVentilatedSlabRadComps