Note that the ventilated slab fan electric is NOT metered because this value is already metered through the fan component
SUBROUTINE GetVentilatedSlabInput
! SUBROUTINE INFORMATION:
! AUTHOR Young Tae Chae, Rick Strand
! DATE WRITTEN June 2008
! MODIFIED July 2012, Chandan Sharma - FSEC: Added zone sys avail managers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine obtains the input for ventilated slab and sets
! up the appropriate derived type.
! METHODOLOGY EMPLOYED:
! Standard EnergyPlus methodology.
! REFERENCES:
! Fred Buhl's fan coil module (FanCoilUnits.f90)
! Kwang Ho Lee's Unit Ventilator Module (UnitVentilator.f90)
! Rick Strand's Low temperature Radiant system (RadiantSystemLowTemp.f90)
! USE STATEMENTS:
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, VerifyName, SameString, FindItemInList, &
GetObjectDefMaxArgs
USE NodeInputManager, ONLY : GetOnlySingleNode
USE BranchNodeConnections, ONLY : SetUpCompSets
USE WaterCoils, ONLY : GetWaterCoilMaxFlowRate=>GetCoilMaxWaterFlowRate
Use SteamCoils, ONLY : GetSteamCoilMaxFlowRate=>GetCoilMaxWaterFlowRate
USE HVACHXAssistedCoolingCoil,ONLY : GetHXAssistedCoilFlowRate=>GetCoilMaxWaterFlowRate,GetHXCoilTypeAndName
USE DataGlobals, ONLY : NumOfZones, ScheduleAlwaysOn
USE DataHeatBalance, ONLY : Zone, Construct
USE DataSizing, ONLY : AutoSize
USE DataZoneEquipment, ONLY : VentilatedSlab_Num
USE ScheduleManager, ONLY : GetScheduleIndex
USE DataLoopNode
USE DataSurfaceLists
USE OutAirNodeManager, ONLY: CheckAndAddAirNodeNumber
USE FluidProperties, ONLY: FindRefrigerant
USE DataPlant, ONLY: TypeOf_CoilWaterCooling, TypeOf_CoilWaterDetailedFlatCooling, &
TypeOf_CoilWaterSimpleHeating, TypeOf_CoilSteamAirHeating
USE DataHVACGlobals, ONLY: ZoneComp
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank = ' '
CHARACTER(len=*), PARAMETER :: MeanAirTemperature = 'MeanAirTemperature'
CHARACTER(len=*), PARAMETER :: MeanRadiantTemperature = 'MeanRadiantTemperature'
CHARACTER(len=*), PARAMETER :: OperativeTemperature = 'OperativeTemperature'
CHARACTER(len=*), PARAMETER :: OutsideAirDryBulbTemperature = 'OutdoorDryBulbTemperature'
CHARACTER(len=*), PARAMETER :: OutsideAirWetBulbTemperature = 'OutdoorWetBulbTemperature'
CHARACTER(len=*), PARAMETER :: SlabSurfaceTemperature = 'SurfaceTemperature'
CHARACTER(len=*), PARAMETER :: SlabSurfaceDewPointTemperature = 'ZoneAirDewPointTemperature'
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='ZoneHVAC:VentilatedSlab'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: IsBlank ! TRUE if the name is blank
LOGICAL :: IsNotOk ! TRUE if there was a problem with a list name
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumArgs ! Unused variable that is part of a subroutine call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: Item ! Item to be "gotten"
INTEGER :: BaseNum ! Temporary number for creating RadiantSystemTypes structure
LOGICAL :: errflag ! interim error flag
INTEGER :: SurfListNum ! Index within the SurfList derived type for a surface list name
!unused0309 INTEGER :: NumOfSurfListVB ! Number of surface lists in the user input file
INTEGER :: SurfNum ! DO loop counter for surfaces
LOGICAL :: IsValid ! Set for outside air node check
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaArgs ! Alpha input items for object
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
REAL(r64), ALLOCATABLE, DIMENSION(:) :: rNumericArgs ! Numeric input items for object
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .true.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .true.
LOGICAL :: SteamMessageNeeded
! FLOW:
! Figure out how many Ventilated Slab Systems there are in the input file
SteamMessageNeeded=.true.
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumArgs,NumAlphas,NumNumbers)
ALLOCATE(cAlphaArgs(NumAlphas))
cAlphaArgs=' '
ALLOCATE(cAlphaFields(NumAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(NumNumbers))
cNumericFields=' '
ALLOCATE(rNumericArgs(NumNumbers))
rNumericArgs=0.0d0
ALLOCATE(lAlphaBlanks(NumAlphas))
lAlphaBlanks=.true.
ALLOCATE(lNumericBlanks(NumNumbers))
lNumericBlanks=.true.
! make sure data is gotten for surface lists
BaseNum=GetNumberOfSurfListVentSlab()
NumOfVentSlabs=GetNumObjectsFound(CurrentModuleObject)
! Allocate the local derived type and do one-time initializations for all parts of it
ALLOCATE(VentSlab(NumOfVentSlabs))
ALLOCATE(CheckEquipName(NumOfVentSlabs))
CheckEquipName=.true.
DO Item = 1, NumOfVentSlabs ! Begin looping over the entire ventilated slab systems found in the input file...
CALL GetObjectItem(CurrentModuleObject,Item,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1),VentSlab%Name, Item-1,IsNotOK,IsBlank,trim(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
END IF
VentSlab(Item)%Name = cAlphaArgs(1)
VentSlab(Item)%SchedName = cAlphaArgs(2)
IF (lAlphaBlanks(2)) THEN
VentSlab(Item)%SchedPtr = ScheduleAlwaysOn
ELSE
VentSlab(Item)%SchedPtr = GetScheduleIndex(cAlphaArgs(2)) ! convert schedule name to pointer
IF (VentSlab(Item)%SchedPtr== 0) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(2))//'="'//trim(cAlphaArgs(2))//'" not found.')
ErrorsFound = .TRUE.
END IF
END IF
VentSlab(Item)%ZoneName = cAlphaArgs(3)
VentSlab(Item)%ZonePtr = FindIteminList(cAlphaArgs(3),Zone%Name,NumOfZones)
IF (VentSlab(Item)%ZonePtr == 0) THEN
IF (lAlphaBlanks(3)) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(3))//' is required but input is blank.')
ELSE
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(3))//'="'//trim(cAlphaArgs(3))//'" not found.')
END IF
ErrorsFound=.true.
END IF
VentSlab(Item)%SurfListName = cAlphaArgs(4)
SurfListNum = 0
! IF (NumOfSlabLists > 0) SurfListNum = FindItemInList(VentSlab(Item)%SurfListName, SlabList%Name, NumOfSlabLists)
IF (NumOfSurfListVentSlab > 0) SurfListNum = FindItemInList(VentSlab(Item)%SurfListName,SlabList%Name,NumOfSurfListVentSlab)
IF (SurfListNum > 0) THEN ! Found a valid surface list
VentSlab(Item)%NumOfSurfaces = SlabList(SurfListNum)%NumOfSurfaces
ALLOCATE (VentSlab(Item)%ZName(VentSlab(Item)%NumOfSurfaces))
ALLOCATE (VentSlab(Item)%ZPtr(VentSlab(Item)%NumOfSurfaces))
ALLOCATE (VentSlab(Item)%SurfaceName(VentSlab(Item)%NumOfSurfaces))
ALLOCATE (VentSlab(Item)%SurfacePtr(VentSlab(Item)%NumOfSurfaces))
ALLOCATE (VentSlab(Item)%CDiameter(VentSlab(Item)%NumOfSurfaces))
ALLOCATE (VentSlab(Item)%CLength(VentSlab(Item)%NumOfSurfaces))
ALLOCATE (VentSlab(Item)%CNumbers(VentSlab(Item)%NumOfSurfaces))
ALLOCATE (VentSlab(Item)%SlabIn(VentSlab(Item)%NumOfSurfaces))
ALLOCATE (VentSlab(Item)%SlabOut(VentSlab(Item)%NumOfSurfaces))
MaxCloNumOfSurfaces=Max(MaxCloNumOfSurfaces,VentSlab(Item)%NumOfSurfaces)
DO SurfNum = 1, SlabList(SurfListNum)%NumOfSurfaces
VentSlab(Item)%ZName(SurfNum) = SlabList(SurfListNum)%ZoneName(SurfNum)
VentSlab(Item)%ZPtr(SurfNum) = SlabList(SurfListNum)%ZonePtr(SurfNum)
VentSlab(Item)%SurfaceName(SurfNum) = SlabList(SurfListNum)%SurfName(SurfNum)
VentSlab(Item)%SurfacePtr(SurfNum) = SlabList(SurfListNum)%SurfPtr(SurfNum)
VentSlab(Item)%CDiameter(SurfNum) = SlabList(SurfListNum)%CoreDiameter(SurfNum)
VentSlab(Item)%CLength(SurfNum) = SlabList(SurfListNum)%CoreLength(SurfNum)
VentSlab(Item)%CNumbers(SurfNum) = SlabList(SurfListNum)%CoreNumbers(SurfNum)
VentSlab(Item)%SlabIn(SurfNum) = SlabList(SurfListNum)%SlabInNodeName(SurfNum)
VentSlab(Item)%SlabOut(SurfNum) = SlabList(SurfListNum)%SlabOutNodeName(SurfNum)
IF (VentSlab(Item)%SurfacePtr(SurfNum) /= 0) THEN
Surface(VentSlab(Item)%SurfacePtr(SurfNum))%IntConvSurfHasActiveInIt = .TRUE.
ENDIF
END DO
ELSE ! User entered a single surface name rather than a surface list
VentSlab(Item)%NumOfSurfaces = 1
ALLOCATE (VentSlab(Item)%SurfacePtr(VentSlab(Item)%NumOfSurfaces))
ALLOCATE (VentSlab(Item)%SurfaceName(VentSlab(Item)%NumOfSurfaces))
ALLOCATE (VentSlab(Item)%SurfaceFlowFrac(VentSlab(Item)%NumOfSurfaces))
MaxCloNumOfSurfaces=Max(MaxCloNumOfSurfaces,VentSlab(Item)%NumOfSurfaces)
VentSlab(Item)%SurfaceName(1) = VentSlab(Item)%SurfListName
VentSlab(Item)%SurfacePtr(1) = FindIteminList(VentSlab(Item)%SurfaceName(1),Surface%Name,TotSurfaces)
VentSlab(Item)%SurfaceFlowFrac(1) = 1.0d0
! Error checking for single surfaces
IF (VentSlab(Item)%SurfacePtr(1) == 0) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(4))//'="'//trim(cAlphaArgs(4))//'" not found.')
ErrorsFound=.true.
ELSEIF (Surface(VentSlab(Item)%SurfacePtr(1))%PartOfVentSlabOrRadiantSurface) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid Surface')
CALL ShowContinueError(trim(cAlphaFields(4))//'="'//TRIM(cAlphaArgs(4))// &
'" has been used in another radiant system or ventilated slab.')
ErrorsFound=.true.
END IF
IF (VentSlab(Item)%SurfacePtr(1) /= 0) THEN
Surface(VentSlab(Item)%SurfacePtr(1))%IntConvSurfHasActiveInIt = .TRUE.
Surface(VentSlab(Item)%SurfacePtr(1))%PartOfVentSlabOrRadiantSurface = .true.
ENDIF
END IF
! Error checking for zones and construction information
IF (SurfListNum > 0) THEN
DO SurfNum = 1, VentSlab(Item)%NumOfSurfaces
IF (VentSlab(Item)%SurfacePtr(SurfNum) == 0) CYCLE ! invalid surface -- detected earlier
IF (VentSlab(Item)%ZPtr(SurfNum) == 0) CYCLE ! invalid zone -- detected earlier
! IF (Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Zone /= VentSlab(Item)%ZPtr(SurfNum)) THEN
! CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
! 'surface="'//TRIM(Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Name)//'".')
! CALL ShowContinueError('Surface in Zone='//TRIM(Zone(Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Zone)%Name)//' '// &
! CurrentModuleObject//' in Zone='//TRIM(cAlphaArgs(3)))
! ErrorsFound=.true.
! END IF
IF (Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Construction == 0) CYCLE ! invalid construction, detected earlier
IF (.NOT. Construct(Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Construction)%SourceSinkPresent) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
'surface="'//TRIM(Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Name)//'".')
CALL ShowContinueError('Surface Construction does not have a source/sink, Construction name= "'// &
TRIM(Construct(Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Construction)%Name)//'".')
ErrorsFound=.true.
END IF
END DO
ELSE
DO SurfNum = 1, VentSlab(Item)%NumOfSurfaces
IF (VentSlab(Item)%SurfacePtr(SurfNum) == 0) CYCLE ! invalid surface -- detected earlier
IF (VentSlab(Item)%ZonePtr == 0) CYCLE ! invalid zone -- detected earlier
IF (Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Zone /= VentSlab(Item)%ZonePtr) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
'surface="'//TRIM(Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Name)//'".')
CALL ShowContinueError('Surface in Zone='//TRIM(Zone(Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Zone)%Name)//' '// &
CurrentModuleObject//' in Zone='//TRIM(cAlphaArgs(3)))
ErrorsFound=.true.
END IF
IF (Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Construction == 0) CYCLE ! invalid construction, detected earlier
IF (.NOT. Construct(Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Construction)%SourceSinkPresent) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
'surface="'//TRIM(Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Name)//'".')
CALL ShowContinueError('Surface Construction does not have a source/sink, Construction name= "'// &
TRIM(Construct(Surface(VentSlab(Item)%SurfacePtr(SurfNum))%Construction)%Name)//'".')
ErrorsFound=.true.
END IF
END DO
END IF
VentSlab(Item)%MaxAirVolFlow = rNumericArgs(1)
! Outside air information:
VentSlab(Item)%MinOutAirVolFlow = rNumericArgs(2)
VentSlab(Item)%OutAirVolFlow = rNumericArgs(3)
SELECT CASE (cAlphaArgs(5))
CASE ('VARIABLEPERCENT')
VentSlab(Item)%OAControlType = VariablePercent
VentSlab(Item)%MaxOASchedName = cAlphaArgs(6)
VentSlab(Item)%MaxOASchedPtr = GetScheduleIndex(cAlphaArgs(7)) ! convert schedule name to pointer
IF (VentSlab(Item)%MaxOASchedPtr == 0) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(7))//'="'//trim(cAlphaArgs(7))//'" not found.')
ErrorsFound=.TRUE.
ELSEIF (.not. CheckScheduleValueMinMax(VentSlab(Item)%MaxOASchedPtr,'>=0',0.0d0,'<=',1.0d0)) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(7))//'="'//trim(cAlphaArgs(7))//'" values out of range [0,1].')
ErrorsFound=.TRUE.
END IF
CASE ('FIXEDAMOUNT')
VentSlab(Item)%OAControlType = FixedOAControl
VentSlab(Item)%MaxOASchedName = cAlphaArgs(7)
VentSlab(Item)%MaxOASchedPtr = GetScheduleIndex(cAlphaArgs(7)) ! convert schedule name to pointer
IF (VentSlab(Item)%MaxOASchedPtr == 0) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(7))//'="'//trim(cAlphaArgs(7))//'" not found.')
ErrorsFound=.TRUE.
ELSEIF (.not. CheckScheduleValueMinMax(VentSlab(Item)%MaxOASchedPtr,'>=0',0.0d0)) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(7))//'="'//trim(cAlphaArgs(7))//'" values out of range (must be >=0).')
ErrorsFound=.TRUE.
END IF
CASE ('FIXEDTEMPERATURE')
VentSlab(Item)%OAControlType = FixedTemperature
VentSlab(Item)%TempSchedName = cAlphaArgs(7)
VentSlab(Item)%TempSchedPtr = GetScheduleIndex(cAlphaArgs(7)) ! convert schedule name to pointer
IF (VentSlab(Item)%TempSchedPtr == 0) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(7))//'="'//trim(cAlphaArgs(7))//'" not found.')
ErrorsFound=.TRUE.
END IF
CASE DEFAULT
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(5))//'="'//trim(cAlphaArgs(5))//'".')
END SELECT
VentSlab(Item)%MinOASchedName = cAlphaArgs(6)
VentSlab(Item)%MinOASchedPtr = GetScheduleIndex(cAlphaArgs(6)) ! convert schedule name to pointer
IF (VentSlab(Item)%MinOASchedPtr == 0) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(6))//'="'//trim(cAlphaArgs(6))//'" not found.')
ErrorsFound=.TRUE.
END IF
! System Configuration:
IF (SameString(cAlphaArgs(8),'SlabOnly')) THEN
VentSlab(Item)%SysConfg = SlabOnly
ELSE IF (SameString(cAlphaArgs(8),'SlabAndZone')) THEN
VentSlab(Item)%SysConfg = SlabandZone
ELSE IF (SameString(cAlphaArgs(8),'SeriesSlabs')) THEN
VentSlab(Item)%SysConfg = SeriesSlabs
ELSE
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(8))//'="'//trim(cAlphaArgs(8))//'".')
CALL ShowContinueError('Control reset to SLAB ONLY Configuration.')
VentSlab(Item)%SysConfg = SlabOnly
END IF
! Hollow Core information :
VentSlab(Item)%CoreDiameter = rNumericArgs(4)
VentSlab(Item)%CoreLength = rNumericArgs(5)
VentSlab(Item)%CoreNumbers = rNumericArgs(6)
IF (SameString(cAlphaArgs(8),'SurfaceListNames')) THEN
IF(.not. lNumericBlanks(4)) THEN
CALL ShowWarningError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" '// &
' Core Diameter is not needed for the series slabs configuration- ignored.')
CALL ShowContinueError('...It has been asigned on SlabGroup.')
END IF
END IF
IF (SameString(cAlphaArgs(8),'SurfaceListNames')) THEN
IF(.not. lNumericBlanks(5)) THEN
CALL ShowWarningError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" '// &
' Core Length is not needed for the series slabs configuration- ignored.')
CALL ShowContinueError('...It has been asigned on SlabGroup.')
END IF
END IF
IF (SameString(cAlphaArgs(8),'SurfaceListNames')) THEN
IF(.not. lNumericBlanks(6)) THEN
CALL ShowWarningError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" '// &
' Core Numbers is not needed for the series slabs configuration- ignored.')
CALL ShowContinueError('...It has been asigned on SlabGroup.')
END IF
END IF
! Process the temperature control type
IF (SameString(cAlphaArgs(9),OutsideAirDryBulbTemperature)) THEN
VentSlab(Item)%ControlType = ODBControl
ELSE IF (SameString(cAlphaArgs(9),OutsideAirWetBulbTemperature)) THEN
VentSlab(Item)%ControlType = OWBControl
ELSE IF (SameString(cAlphaArgs(9),OperativeTemperature)) THEN
VentSlab(Item)%ControlType = OPTControl
ELSE IF (SameString(cAlphaArgs(9),MeanAirTemperature)) THEN
VentSlab(Item)%ControlType = MATControl
ELSE IF (SameString(cAlphaArgs(9),MeanRadiantTemperature)) THEN
VentSlab(Item)%ControlType = MRTControl
ELSE IF (SameString(cAlphaArgs(9),SlabSurfaceTemperature)) THEN
VentSlab(Item)%ControlType = SURControl
ELSE IF (SameString(cAlphaArgs(9),SlabSurfaceDewPointTemperature)) THEN
VentSlab(Item)%ControlType = DPTZControl
ELSE
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(9))//'="'//trim(cAlphaArgs(9))//'".')
CALL ShowContinueError('Control reset to ODB control.')
VentSlab(Item)%ControlType = ODBControl
END IF
! Heating User Input Data For Ventilated Slab Control :
! High Air Temp :
VentSlab(Item)%HotAirHiTempSched = cAlphaArgs(10)
VentSlab(Item)%HotAirHiTempSchedPtr = GetScheduleIndex(cAlphaArgs(10))
IF ((VentSlab(Item)%HotAirHiTempSchedPtr == 0).AND. (.not. lAlphaBlanks(10))) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(10))//'="'//trim(cAlphaArgs(10))//'" not found.')
ErrorsFound=.true.
END IF
! Low Air Temp :
VentSlab(Item)%HotAirLoTempSched = cAlphaArgs(11)
VentSlab(Item)%HotAirLoTempSchedPtr = GetScheduleIndex(cAlphaArgs(11))
IF ((VentSlab(Item)%HotAirLoTempSchedPtr == 0).AND. (.not. lAlphaBlanks(11))) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(11))//'="'//trim(cAlphaArgs(11))//'" not found.')
ErrorsFound=.true.
END IF
VentSlab(Item)%HotCtrlHiTempSched = cAlphaArgs(12)
VentSlab(Item)%HotCtrlHiTempSchedPtr = GetScheduleIndex(cAlphaArgs(12))
IF ((VentSlab(Item)%HotCtrlHiTempSchedPtr == 0).AND. (.not. lAlphaBlanks(12))) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(12))//'="'//trim(cAlphaArgs(12))//'" not found.')
ErrorsFound=.true.
END IF
VentSlab(Item)%HotCtrlLoTempSched = cAlphaArgs(13)
VentSlab(Item)%HotCtrlLoTempSchedPtr = GetScheduleIndex(cAlphaArgs(13))
IF ((VentSlab(Item)%HotCtrlLoTempSchedPtr == 0).AND. (.not. lAlphaBlanks(13))) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(13))//'="'//trim(cAlphaArgs(13))//'" not found.')
ErrorsFound=.true.
END IF
! Cooling User Input Data For Ventilated Slab Control :
! Cooling High Temp Sch.
VentSlab(Item)%ColdAirHiTempSched = cAlphaArgs(13)
VentSlab(Item)%ColdAirHiTempSchedPtr = GetScheduleIndex(cAlphaArgs(14))
IF ((VentSlab(Item)%ColdAirHiTempSchedPtr == 0).AND. (.not. lAlphaBlanks(14))) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(14))//'="'//trim(cAlphaArgs(14))//'" not found.')
ErrorsFound=.true.
END IF
! Cooling Low Temp Sch.
VentSlab(Item)%ColdAirLoTempSched = cAlphaArgs(15)
VentSlab(Item)%ColdAirLoTempSchedPtr = GetScheduleIndex(cAlphaArgs(15))
IF ((VentSlab(Item)%ColdAirLoTempSchedPtr == 0).AND. (.not. lAlphaBlanks(15))) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(15))//'="'//trim(cAlphaArgs(15))//'" not found.')
ErrorsFound=.true.
END IF
! Cooling Control High Sch.
VentSlab(Item)%ColdCtrlHiTempSched = cAlphaArgs(16)
VentSlab(Item)%ColdCtrlHiTempSchedPtr = GetScheduleIndex(cAlphaArgs(16))
IF ((VentSlab(Item)%ColdCtrlHiTempSchedPtr == 0).AND. (.not. lAlphaBlanks(16))) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(16))//'="'//trim(cAlphaArgs(16))//'" not found.')
ErrorsFound=.true.
END IF
! Cooling Control Low Sch.
VentSlab(Item)%ColdCtrlLoTempSched = cAlphaArgs(17)
VentSlab(Item)%ColdCtrlLoTempSchedPtr = GetScheduleIndex(cAlphaArgs(17))
IF ((VentSlab(Item)%ColdCtrlLoTempSchedPtr == 0).AND. (.not. lAlphaBlanks(17))) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(17))//'="'//trim(cAlphaArgs(17))//'" not found.')
ErrorsFound=.true.
END IF
! Main air nodes (except outside air node):
! Refer the Unit Ventilator Air Node note
! MJW CR7903 - Ventilated slab was not drawing properly in HVAC Diagram svg output
! This object is structured differently from other zone equipment in that it functions
! as both a parent and non-parent, and it has an implicit OA mixer. This makes it difficult
! to register the nodes in a way that HVAC Diagram can understand and in a way that satisfies
! node connection tests. Here's an explanation of the changes made for this CR:
! In general, nodes associated with the ventilated slab system (the overall parent object)
! are registered with "-SYSTEM" appended to the object type and object name
! This same suffix is also added later when SetUpCompSets is called, for the same reason
! In general, nodes associated with the implicit OA mixer object
! are registered with "-OA MIXER" appended to the object type and object name
! %ReturnAirNode is one inlet to the implicit oa mixer
! For SlabOnly and SeriesSlab this node does nothing,
! so NodeConnectionType_Internal,ObjectIsNotParent, -OA MIXER
! For SlabandZone, this node extracts air from the zone,
! so NodeConnectionType_Inlet,ObjectIsNotParent, -OA MIXER
! For SlabandZone, this node is also used to associate the whole system with a pair of zone inlet/exhaust nodes,
! so it is registered again as NodeConnectionType_Inlet,1,ObjectIsParent, -SYSTEM
! %RadInNode is the ultimate air inlet to the slab or series of slabs
! For all types of ventilated slab, this is NodeConnectionType_Inlet,ObjectIsNotParent
! %OAMixerOutNode is the outlet from the implicit OA mixer
! For all types of ventilated slab, this is NodeConnectionType_Outlet,ObjectIsNotParent
! %FanOutletNode is the outlet from the explicit fan child object (redundant input, should mine from child)
! For all types of ventilated slab, this is NodeConnectionType_Internal,ObjectIsParent
! %ZoneAirInNode is applicable only to SlabandZone configuration. It is the node that flows into the zone,
! and it is also the outlet from the ventilated slab section, so it must be registered twice
! First for the overall system, NodeConnectionType_Outlet,ObjectIsParent, -SYSTEM
! Second as the slab outlet, NodeConnectionType_Outlet,ObjectIsNotParent
! %OutsideAirNode is the outdoor air inlet to the OA mixer
! For all types of ventilated slab, this is NodeConnectionType_Inlet,ObjectIsNotParent, -OA MIXER
IF (VentSlab(Item)%SysConfg == SlabOnly) THEN
VentSlab(Item)%ReturnAirNode = &
GetOnlySingleNode(cAlphaArgs(18),ErrorsFound, &
TRIM(CurrentModuleObject)//'-OA MIXER',TRIM(cAlphaArgs(1))//'-OA MIXER', &
NodeType_Air,NodeConnectionType_Internal,1,ObjectIsNotParent)
VentSlab(Item)%RadInNode = &
GetOnlySingleNode(cAlphaArgs(19),ErrorsFound,CurrentModuleObject,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
VentSlab(Item)%OAMixerOutNode = &
GetOnlySingleNode(cAlphaArgs(23),ErrorsFound, &
TRIM(CurrentModuleObject)//'-OA MIXER',TRIM(cAlphaArgs(1))//'-OA MIXER', &
NodeType_Air, NodeConnectionType_Outlet,1,ObjectIsNotParent)
VentSlab(Item)%FanOutletNode = &
GetOnlySingleNode(cAlphaArgs(24),ErrorsFound,CurrentModuleObject,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Internal,1,ObjectIsParent)
ELSE IF (VentSlab(Item)%SysConfg == SeriesSlabs) THEN
VentSlab(Item)%ReturnAirNode = &
GetOnlySingleNode(cAlphaArgs(18),ErrorsFound, &
TRIM(CurrentModuleObject)//'-OA MIXER',TRIM(cAlphaArgs(1))//'-OA MIXER', &
NodeType_Air,NodeConnectionType_Internal,1,ObjectIsNotParent)
VentSlab(Item)%RadInNode = &
GetOnlySingleNode(cAlphaArgs(19),ErrorsFound,CurrentModuleObject,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
VentSlab(Item)%OAMixerOutNode = &
GetOnlySingleNode(cAlphaArgs(23),ErrorsFound, &
TRIM(CurrentModuleObject)//'-OA MIXER',TRIM(cAlphaArgs(1))//'-OA MIXER', &
NodeType_Air, NodeConnectionType_Outlet,1,ObjectIsNotParent)
VentSlab(Item)%FanOutletNode = &
GetOnlySingleNode(cAlphaArgs(24),ErrorsFound,CurrentModuleObject,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Internal,1,ObjectIsParent)
ELSE IF (VentSlab(Item)%SysConfg == SlabandZone) THEN
VentSlab(Item)%ReturnAirNode = &
GetOnlySingleNode(cAlphaArgs(18),ErrorsFound, &
TRIM(CurrentModuleObject)//'-SYSTEM',TRIM(cAlphaArgs(1))//'-SYSTEM', &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent)
VentSlab(Item)%ReturnAirNode = &
GetOnlySingleNode(cAlphaArgs(18),ErrorsFound, &
TRIM(CurrentModuleObject)//'-OA MIXER',TRIM(cAlphaArgs(1))//'-OA MIXER', &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
VentSlab(Item)%RadInNode = &
GetOnlySingleNode(cAlphaArgs(19),ErrorsFound,CurrentModuleObject,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
VentSlab(Item)%OAMixerOutNode = &
GetOnlySingleNode(cAlphaArgs(23),ErrorsFound, &
TRIM(CurrentModuleObject)//'-OA MIXER',TRIM(cAlphaArgs(1))//'-OA MIXER', &
NodeType_Air, NodeConnectionType_Outlet,1,ObjectIsNotParent)
VentSlab(Item)%FanOutletNode = &
GetOnlySingleNode(cAlphaArgs(24),ErrorsFound,CurrentModuleObject,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Internal,1,ObjectIsParent)
END IF
IF (VentSlab(Item)%SysConfg == SlabOnly) THEN
IF(.not. lAlphaBlanks(20)) THEN
CALL ShowWarningError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" '// &
trim(cAlphaFields(20))//'="'//trim(cAlphaArgs(20))//'" not needed - ignored.')
CALL ShowContinueError('It is used for "SlabAndZone" only')
END IF
ELSE IF (VentSlab(Item)%SysConfg == SlabandZone) THEN
IF (lAlphaBlanks(20)) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(20))//' is blank and must be entered.')
ErrorsFound=.TRUE.
END IF
VentSlab(Item)%ZoneAirInNode = &
GetOnlySingleNode(cAlphaArgs(20),ErrorsFound, &
TRIM(CurrentModuleObject)//'-SYSTEM',TRIM(cAlphaArgs(1))//'-SYSTEM', &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsParent)
VentSlab(Item)%ZoneAirInNode = &
GetOnlySingleNode(cAlphaArgs(20),ErrorsFound,CurrentModuleObject,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
END IF
VentSlab(Item)%OutsideAirNode = &
! Set connection type to 'Inlet', because it now uses an OA node
GetOnlySingleNode(cAlphaArgs(21),ErrorsFound, &
TRIM(CurrentModuleObject)//'-OA MIXER',TRIM(cAlphaArgs(1))//'-OA MIXER', &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
IF (.not. lAlphaBlanks(21)) THEN
CALL CheckAndAddAirNodeNumber(VentSlab(Item)%OutsideAirNode,IsValid)
IF (.not. IsValid) THEN
CALL ShowWarningError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))// &
'", Adding OutdoorAir:Node='//TRIM(cAlphaArgs(21)))
ENDIF
ENDIF
VentSlab(Item)%AirReliefNode = &
GetOnlySingleNode(cAlphaArgs(22),ErrorsFound, &
TRIM(CurrentModuleObject)//'-OA MIXER',TRIM(cAlphaArgs(1))//'-OA MIXER', &
NodeType_Air,NodeConnectionType_ReliefAir,1,ObjectIsNotParent)
! Fan information:
VentSlab(Item)%FanName = cAlphaArgs(25)
IF (VentSlab(Item)%OAControlType == FixedOAControl) THEN
VentSlab(Item)%OutAirVolFlow = VentSlab(Item)%MinOutAirVolFlow
VentSlab(Item)%MaxOASchedName = VentSlab(Item)%MinOASchedName
VentSlab(Item)%MaxOASchedPtr = GetScheduleIndex(VentSlab(Item)%MinOASchedName)
END IF
! Add fan to component sets array
CALL SetUpCompSets(TRIM(CurrentModuleObject)//'-SYSTEM', TRIM(VentSlab(Item)%Name)//'-SYSTEM', &
'UNDEFINED',cAlphaArgs(25),cAlphaArgs(23),cAlphaArgs(24))
! Coil options assign
SELECT CASE (cAlphaArgs(26))
CASE ('HEATINGANDCOOLING')
VentSlab(Item)%CoilOption = BothOption
CASE ('HEATING')
VentSlab(Item)%CoilOption = HeatingOption
CASE ('COOLING')
VentSlab(Item)%CoilOption = CoolingOption
CASE ('NONE')
VentSlab(Item)%CoilOption = NoneOption
CASE DEFAULT
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(26))//'="'//trim(cAlphaArgs(26))//'".')
ErrorsFound = .TRUE.
END SELECT
IF (VentSlab(Item)%CoilOption == BothOption .or. VentSlab(Item)%CoilOption == HeatingOption) THEN
! Heating coil information:
! A27, \field Heating Coil Object Type
! \type choice
! \key Coil:Heating:Water
! \key Coil:Heating:Electric
! \key Coil:Heating:Gas
! \key Coil:Heating:Steam
! A28, \field Heating Coil Name
! \type object-list
! \object-list HeatingCoilName
! Heating coil information:
IF (.not. lAlphaBlanks(28)) THEN
VentSlab(Item)%HCoilPresent = .TRUE.
VentSlab(Item)%HCoilTypeCh = cAlphaArgs(27)
errflag=.false.
SELECT CASE (cAlphaArgs(27))
CASE ('COIL:HEATING:WATER')
VentSlab(Item)%HCoilType = Heating_WaterCoilType
VentSlab(Item)%HCoil_PlantTypeNum = TypeOf_CoilWaterSimpleHeating
CASE ('COIL:HEATING:STEAM')
VentSlab(Item)%HCoilType = Heating_SteamCoilType
VentSlab(Item)%HCoil_PlantTypeNum = TypeOf_CoilSteamAirHeating
VentSlab(Item)%HCoil_FluidIndex=FindRefrigerant('Steam')
IF (VentSlab(Item)%HCoil_FluidIndex == 0) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))// &
'Steam Properties not found.')
IF (SteamMessageNeeded) &
CALL ShowContinueError('Steam Fluid Properties should have been included in the input file.')
ErrorsFound=.true.
SteamMessageNeeded=.false.
ENDIF
CASE ('COIL:HEATING:ELECTRIC')
VentSlab(Item)%HCoilType = Heating_ElectricCoilType
CASE ('COIL:HEATING:GAS')
VentSlab(Item)%HCoilType = Heating_GasCoilType
CASE DEFAULT
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(27))//'="'//trim(cAlphaArgs(27))//'".')
ErrorsFound = .TRUE.
END SELECT
if (.not. errflag) then
VentSlab(Item)%HCoilName = cAlphaArgs(28)
CALL ValidateComponent(cAlphaArgs(27),VentSlab(Item)%HCoilName,IsNotOK,CurrentModuleObject)
IF (IsNotOK) THEN
CALL ShowContinueError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(28))//'="'//trim(cAlphaArgs(28))//'".')
CALL ShowContinueError('... not valid for '//trim(cAlphaFields(27))//'="'// &
trim(cAlphaArgs(27))//'".')
ErrorsFound=.true.
ENDIF
endif
VentSlab(Item)%MinVolHotWaterFlow = 0.0d0
VentSlab(Item)%MinVolHotSteamFlow = 0.0d0
! The heating coil control node is necessary for a hot water coil, but not necessary for an
! electric or gas coil.
IF (VentSlab(Item)%HCoilType .EQ. Heating_GasCoilType .OR. &
VentSlab(Item)%HCoilType .EQ. Heating_ElectricCoilType) THEN
IF (.not. lAlphaBlanks(29)) THEN
CALL ShowWarningError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" '// &
trim(cAlphaFields(29))//'="'//trim(cAlphaArgs(29))//'" not needed - ignored.')
CALL ShowContinueError('..It is used for hot water coils only.')
END IF
ELSE
IF(lAlphaBlanks(29)) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(29))//' is blank and must be entered.')
ErrorsFound=.true.
END IF
VentSlab(Item)%HotControlNode = &
GetOnlySingleNode(cAlphaArgs(29),ErrorsFound,CurrentModuleObject,cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Actuator,1,ObjectIsParent)
END IF
VentSlab(Item)%HotControlOffset = 0.001d0
IF (VentSlab(Item)%HCoilType == Heating_WaterCoilType) THEN
VentSlab(Item)%MaxVolHotWaterFlow = GetWaterCoilMaxFlowRate('Coil:Heating:Water', &
VentSlab(Item)%HCoilName,ErrorsFound)
VentSlab(Item)%MaxVolHotSteamFlow = GetWaterCoilMaxFlowRate('Coil:Heating:Water', &
VentSlab(Item)%HCoilName,ErrorsFound)
ELSEIF (VentSlab(Item)%HCoilType == Heating_SteamCoilType) THEN
VentSlab(Item)%MaxVolHotWaterFlow = GetSteamCoilMaxFlowRate('Coil:Heating:Steam', &
VentSlab(Item)%HCoilName,ErrorsFound)
VentSlab(Item)%MaxVolHotSteamFlow = GetSteamCoilMaxFlowRate('Coil:Heating:Steam', &
VentSlab(Item)%HCoilName,ErrorsFound)
ENDIF
ELSE ! no heating coil
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))// &
'" missing heating coil.')
CALL ShowContinueError('a heating coil is required for '//trim(cAlphaFields(26))// &
'="'//trim(cAlphaArgs(26))//'".')
ErrorsFound=.true.
ENDIF
ENDIF
IF (VentSlab(Item)%CoilOption == BothOption .or. VentSlab(Item)%CoilOption == CoolingOption) THEN
! Cooling coil information (if one is present):
! A30, \field Cooling Coil Object Type
! \type choice
! \key Coil:Cooling:Water
! \key Coil:Cooling:Water:DetailedGeometry
! \key CoilSystem:Cooling:Water:HeatExchangerAssisted
! A31, \field Cooling Coil Name
! \type object-list
! \object-list CoolingCoilsWater
! Cooling coil information (if one is present):
IF (.not. lAlphaBlanks(31)) THEN
VentSlab(Item)%CCoilPresent = .TRUE.
VentSlab(Item)%CCoilTypeCh = cAlphaArgs(30)
errflag=.false.
SELECT CASE (cAlphaArgs(30))
CASE ('COIL:COOLING:WATER')
VentSlab(Item)%CCoilType = Cooling_CoilWaterCooling
VentSlab(Item)%CCoil_PlantTypeNum = TypeOf_CoilWaterCooling
VentSlab(Item)%CCoilPlantName=cAlphaArgs(31)
CASE ('COIL:COOLING:WATER:DETAILEDGEOMETRY')
VentSlab(Item)%CCoilType = Cooling_CoilDetailedCooling
VentSlab(Item)%CCoil_PlantTypeNum = TypeOf_CoilWaterDetailedFlatCooling
VentSlab(Item)%CCoilPlantName=cAlphaArgs(31)
CASE ('COILSYSTEM:COOLING:WATER:HEATEXCHANGERASSISTED')
VentSlab(Item)%CCoilType = Cooling_CoilHXAssisted
CALL GetHXCoilTypeAndName(cAlphaArgs(30),cAlphaArgs(31),ErrorsFound, &
VentSlab(Item)%CCoilPlantType,VentSlab(Item)%CCoilPlantName)
IF (SameString(VentSlab(Item)%CCoilPlantType,'Coil:Cooling:Water')) THEN
VentSlab(Item)%CCoil_PlantTypeNum=TypeOf_CoilWaterCooling
ELSEIF (SameString(VentSlab(Item)%CCoilPlantType,'Coil:Cooling:Water:DetailedGeometry')) THEN
VentSlab(Item)%CCoil_PlantTypeNum=TypeOf_CoilWaterDetailedFlatCooling
ELSE
CALL ShowSevereError('GetVentilatedSlabInput: '//trim(CurrentModuleObject)//'="'//trim(VentSlab(Item)%Name)// &
'", invalid')
CALL ShowContinueError('For: '//TRIM(cAlphaFields(30))//'="'//TRIM(cAlphaArgs(30))//'".')
CALL ShowContinueError('Invalid Coil Type='//trim(VentSlab(Item)%CCoilPlantType)// &
', Name='//trim(VentSlab(Item)%CCoilPlantName))
CALL ShowContinueError('must be "Coil:Cooling:Water" or "Coil:Cooling:Water:DetailedGeometry"')
ErrorsFound=.true.
ENDIF
CASE DEFAULT
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(29))//'="'//trim(cAlphaArgs(29))//'".')
ErrorsFound=.TRUE.
errflag=.true.
END SELECT
if (.not. errflag) then
VentSlab(Item)%CCoilName = cAlphaArgs(31)
CALL ValidateComponent(cAlphaArgs(30),VentSlab(Item)%CCoilName,IsNotOK,'ZoneHVAC:VentilatedSlab ')
IF (IsNotOK) THEN
CALL ShowContinueError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(31))//'="'//trim(cAlphaArgs(31))//'".')
CALL ShowContinueError('... not valid for '//trim(cAlphaFields(30))//'="'// &
trim(cAlphaArgs(30))//'".')
ErrorsFound=.true.
ENDIF
endif
VentSlab(Item)%MinVolColdWaterFlow = 0.0d0
VentSlab(Item)%ColdControlNode = &
GetOnlySingleNode(cAlphaArgs(32),ErrorsFound,CurrentModuleObject,cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Actuator,1,ObjectIsParent)
IF (lAlphaBlanks(32)) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFields(32))//' is blank and must be entered.')
ErrorsFound=.true.
END IF
VentSlab(Item)%ColdControlOffset = 0.001d0
IF (VentSlab(Item)%CCoilType == Cooling_CoilWaterCooling) THEN
VentSlab(Item)%MaxVolColdWaterFlow = GetWaterCoilMaxFlowRate('Coil:Cooling:Water', &
VentSlab(Item)%CCoilName,ErrorsFound)
ELSEIF (VentSlab(Item)%CCoilType == Cooling_CoilDetailedCooling) THEN
VentSlab(Item)%MaxVolColdWaterFlow = GetWaterCoilMaxFlowRate('Coil:Cooling:Water:DetailedGeometry', &
VentSlab(Item)%CCoilName,ErrorsFound)
ELSEIF (VentSlab(Item)%CCoilType == Cooling_CoilHXAssisted) THEN
VentSlab(Item)%MaxVolColdWaterFlow = GetHXAssistedCoilFlowRate('CoilSystem:Cooling:Water:HeatExchangerAssisted', &
VentSlab(Item)%CCoilName,ErrorsFound)
ENDIF
ELSE ! No Cooling Coil
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))// &
'" missing cooling coil.')
CALL ShowContinueError('a cooling coil is required for '//trim(cAlphaFields(26))// &
'="'//trim(cAlphaArgs(26))//'".')
ErrorsFound=.true.
END IF
ENDIF
IF (.NOT. lAlphaBlanks(33)) THEN
VentSlab(Item)%AvailManagerListName = cAlphaArgs(33)
ZoneComp(VentilatedSlab_Num)%ZoneCompAvailMgrs(Item)%AvailManagerListName = cAlphaArgs(33)
ENDIF
SELECT CASE (VentSlab(Item)%CoilOption)
CASE (Bothoption) ! 'HeatingAndCooling'
! Add cooling coil to component sets array when present
CALL SetUpCompSets(TRIM(CurrentModuleObject)//'-SYSTEM', TRIM(VentSlab(Item)%Name)//'-SYSTEM', &
cAlphaArgs(30), cAlphaArgs(31), cAlphaArgs(24), 'UNDEFINED')
! Add heating coil to component sets array when cooling coil present
CALL SetUpCompSets(TRIM(CurrentModuleObject)//'-SYSTEM', TRIM(VentSlab(Item)%Name)//'-SYSTEM', &
cAlphaArgs(27), cAlphaArgs(28), 'UNDEFINED', cAlphaArgs(19))
CASE (HeatingOption) ! 'Heating'
! Add heating coil to component sets array when no cooling coil present
CALL SetUpCompSets(TRIM(CurrentModuleObject)//'-SYSTEM', TRIM(VentSlab(Item)%Name)//'-SYSTEM', &
cAlphaArgs(27), cAlphaArgs(28), cAlphaArgs(24), cAlphaArgs(19))
CASE (CoolingOption) ! 'Cooling'
! Add cooling coil to component sets array when no heating coil present
CALL SetUpCompSets(TRIM(CurrentModuleObject)//'-SYSTEM', TRIM(VentSlab(Item)%Name)//'-SYSTEM', &
cAlphaArgs(30), cAlphaArgs(31), cAlphaArgs(24), cAlphaArgs(19))
CASE (NoneOption)
CASE DEFAULT
END SELECT
END DO ! ...loop over all of the ventilated slab found in the input file
DEALLOCATE(cAlphaArgs)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(rNumericArgs)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
IF (ErrorsFound) Call ShowFatalError(CurrentModuleObject//' errors occurred in input. Program terminates.')
! Setup Report variables for the VENTILATED SLAB
DO Item = 1, NumOfVentSlabs
! CALL SetupOutputVariable('Ventilated Slab Direct Heat Loss Rate [W]', &
! VentSlab(Item)%DirectHeatLossRate,'System', &
! 'Average', VentSlab(Item)%Name)
! CALL SetupOutputVariable('Ventilated Slab Direct Heat Loss [W]', &
! VentSlab(Item)%DirectHeatLoss,'System', &
! 'Sum', VentSlab(Item)%Name)
! CALL SetupOutputVariable('Ventilated Slab Direct Heat Gain Rate [W]', &
! VentSlab(Item)%DirectHeatGainRate,'System', &
! 'Average', VentSlab(Item)%Name)
! CALL SetupOutputVariable('Ventilated Slab Direct Heat Gain [J]', &
! VentSlab(Item)%DirectHeatGain,'System', &
! 'Sum', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Radiant Heating Rate [W]', &
VentSlab(Item)%RadHeatingPower,'System', &
'Average', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Radiant Heating Energy [J]', &
VentSlab(Item)%RadHeatingEnergy,'System', &
'Sum', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Radiant Cooling Rate [W]', &
VentSlab(Item)%RadCoolingPower,'System', &
'Average', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Radiant Cooling Energy [J]', &
VentSlab(Item)%RadCoolingEnergy,'System', &
'Sum', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Coil Heating Rate [W]', &
VentSlab(Item)%HeatCoilPower,'System', &
'Average', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Coil Heating Energy [J]', &
VentSlab(Item)%HeatCoilEnergy,'System', &
'Sum', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Coil Total Cooling Rate [W]', &
VentSlab(Item)%TotCoolCoilPower,'System', &
'Average', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Coil Total Cooling Energy [J]', &
VentSlab(Item)%TotCoolCoilEnergy,'System', &
'Sum', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Coil Sensible Cooling Rate [W]', &
VentSlab(Item)%SensCoolCoilPower,'System', &
'Average', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Coil Sensible Cooling Energy [J]', &
VentSlab(Item)%SensCoolCoilEnergy,'System', &
'Sum', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Coil Latent Cooling Rate [W]', &
VentSlab(Item)%LateCoolCoilPower,'System', &
'Average', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Coil Latent Cooling Energy [J]', &
VentSlab(Item)%LateCoolCoilEnergy,'System', &
'Sum', VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Air Mass Flow Rate [kg/s]', &
VentSlab(Item)%AirMassFlowRate,'System','Average', &
VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Fan Electric Power [W]', &
VentSlab(Item)%ElecFanPower,'System', &
'Average', VentSlab(Item)%Name)
!! Note that the ventilated slab fan electric is NOT metered because this value is already metered through the fan component
CALL SetupOutputVariable('Zone Ventilated Slab Fan Electric Energy [J]', &
VentSlab(Item)%ElecFanEnergy,'System','Sum', &
VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Inlet Air Temperature [C]', &
VentSlab(Item)%SlabInTemp,'System','Average', &
VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Outlet Air Temperature [C]', &
VentSlab(Item)%SlabOutTemp,'System','Average', &
VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Zone Inlet Air Temperature [C]', &
VentSlab(Item)%ZoneInletTemp,'System','Average', &
VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Return Air Temperature [C]', &
VentSlab(Item)%ReturnAirTemp,'System','Average', &
VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Fan Outlet Air Temperature [C]', &
VentSlab(Item)%FanOutletTemp,'System','Average', &
VentSlab(Item)%Name)
CALL SetupOutputVariable('Zone Ventilated Slab Fan Availability Status []', VentSlab(Item)%AvailStatus,&
'System','Average',VentSlab(Item)%Name)
END DO
RETURN
END SUBROUTINE GetVentilatedSlabInput