Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE GetDXCoolingSystemInput
! SUBROUTINE INFORMATION:
! AUTHOR Richard Liesen
! DATE WRITTEN Mar 2001
! Feb 2005 M. J. Witte, GARD Analytics, Inc.
! Add dehumidification controls and support for multimode DX coil
! Feb 2013 Bo Shen, Oak Ridge National Lab
! Add Coil:Cooling:DX:VariableSpeed, capable of both sensible and latent cooling
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for system and stores it in System data structures
! METHODOLOGY EMPLOYED:
! Uses "Get" routines to read in data.
! REFERENCES:
! USE STATEMENTS:
USE InputProcessor
USE NodeInputManager, ONLY: GetOnlySingleNode
USE DataHeatBalance, ONLY: Zone
USE BranchNodeConnections, ONLY: SetUpCompSets, TestCompSet
USE HVACHXAssistedCoolingCoil, ONLY: GetHXDXCoilName, GetHXDXCoilIndex
USE VariableSpeedCoils, ONLY: GetCoilIndexVariableSpeed
USE PackagedThermalStorageCoil, ONLY: GetTESCoilIndex
USE DataIPShortCuts
USE DXCoils, ONLY: SetCoilSystemCoolingData, SetDXCoilTypeData, GetDXCoilIndex
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: DXSystemNum ! The DXCoolingSystem that you are currently loading input into
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: IOSTAT
CHARACTER(len=*), PARAMETER :: RoutineName='GetDXCoolingSystemInput: ' ! include trailing blank space
LOGICAL :: ErrorsFound = .FALSE. ! If errors detected in input
LOGICAL :: ErrFound = .FALSE. ! used for mining functions
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
Integer :: DXCoolSysNum
LOGICAL :: FanErrorsFound ! flag returned on fan operating mode check
LOGICAL :: DXErrorsFound ! flag returned on DX coil name check
CHARACTER(len=MaxNameLength) :: HXDXCoolCoilName ! Name of DX cooling coil used with Heat Exchanger Assisted Cooling Coil
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in getting objects
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: Alphas ! 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(:) :: Numbers ! 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.
INTEGER :: TotalArgs=0 ! Total number of alpha and numeric arguments (max) for a
! certain object in the input file
! Flow
CurrentModuleObject='CoilSystem:Cooling:DX'
NumDXSystem = GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(DXCoolingSystem(NumDXSystem))
ALLOCATE(CheckEquipName(NumDXSystem))
CheckEquipName=.true.
CALL GetObjectDefMaxArgs('CoilSystem:Cooling:DX',TotalArgs,NumAlphas,NumNums)
ALLOCATE(Alphas(NumAlphas))
Alphas=' '
ALLOCATE(cAlphaFields(NumAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(NumNums))
cNumericFields=' '
ALLOCATE(Numbers(NumNums))
Numbers=0.0d0
ALLOCATE(lAlphaBlanks(NumAlphas))
lAlphaBlanks=.TRUE.
ALLOCATE(lNumericBlanks(NumNums))
lNumericBlanks=.TRUE.
! Get the data for the DX Cooling System
DO DXCoolSysNum = 1, NumDXSystem
CALL GetObjectItem(CurrentModuleObject,DXCoolSysNum,Alphas,NumAlphas, &
Numbers,NumNums,IOSTAT,NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DXCoolingSystem%Name,DXCoolSysNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1) ='xxxxx'
ENDIF
DXCoolingSystem(DXCoolSysNum)%DXCoolingSystemType = CurrentModuleObject ! push Object Name into data array
DXCoolingSystem(DXCoolSysNum)%Name = Alphas(1)
IF (lAlphaBlanks(2)) THEN
DXCoolingSystem(DXCoolSysNum)%SchedPtr = ScheduleAlwaysOn
ELSE
DXCoolingSystem(DXCoolSysNum)%SchedPtr = GetScheduleIndex(Alphas(2))
IF (DXCoolingSystem(DXCoolSysNum)%SchedPtr == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': invalid '//TRIM(cAlphaFields(2))// &
' entered ='//TRIM(Alphas(2))// &
' for '//TRIM(cAlphaFields(1))//'='//TRIM(Alphas(1)))
ErrorsFound=.true.
END IF
END IF
DXCoolingSystem(DXCoolSysNum)%DXCoolingCoilInletNodeNum = &
GetOnlySingleNode(Alphas(3),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent)
DXCoolingSystem(DXCoolSysNum)%DXCoolingCoilOutletNodeNum = &
GetOnlySingleNode(Alphas(4),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsParent)
CALL TestCompSet(TRIM(CurrentModuleObject),Alphas(1),Alphas(3),Alphas(4),'Air Nodes')
DXCoolingSystem(DXCoolSysNum)%DXSystemControlNodeNum = &
GetOnlySingleNode(Alphas(5),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Sensor,1,ObjectIsParent)
IF (DXCoolingSystem(DXCoolSysNum)%DXSystemControlNodeNum .EQ. 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//': control node must be input')
CALL ShowContinueError('Error occurred in '//TRIM(cAlphaFields(1))//'='//TRIM(Alphas(1)))
ErrorsFound=.true.
ENDIF
! Get Cooling System Information if available
IF (SameString(Alphas(6),'Coil:Cooling:DX:SingleSpeed') .OR. &
SameString(Alphas(6),'Coil:Cooling:DX:VariableSpeed') .OR. &
SameString(Alphas(6),'Coil:Cooling:DX:TwoSpeed') .OR. &
SameString(Alphas(6),'Coil:Cooling:DX:TwoStageWithHumidityControlMode') .OR. &
SameString(Alphas(6),'CoilSystem:Cooling:DX:HeatExchangerAssisted') .OR. &
SameString(Alphas(6),'Coil:Cooling:DX:SingleSpeed:ThermalStorage') ) THEN
DXCoolingSystem(DXCoolSysNum)%CoolingCoilType = Alphas(6)
DXCoolingSystem(DXCoolSysNum)%CoolingCoilName = Alphas(7)
ErrFound = .FALSE.
IF (SameString(Alphas(6),'Coil:Cooling:DX:SingleSpeed')) THEN
DXCoolingSystem(DXCoolSysNum)%CoolingCoilType_Num=CoilDX_CoolingSingleSpeed
CALL GetDXCoilIndex(DXCoolingSystem(DXCoolSysNum)%CoolingCoilName, DXCoolingSystem(DXCoolSysNum)%CoolingCoilIndex, &
ErrFound,CurrentModuleObject)
IF(ErrFound)THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(DXCoolingSystem(DXCoolSysNum)%Name))
ErrorsFound = .TRUE.
END IF
ELSEIF (SameString(Alphas(6),'Coil:Cooling:DX:VariableSpeed')) THEN
DXCoolingSystem(DXCoolSysNum)%CoolingCoilType_Num=Coil_CoolingAirToAirVariableSpeed
DXCoolingSystem(DXCoolSysNum)%CoolingCoilIndex = &
GetCoilIndexVariableSpeed('Coil:Cooling:DX:VariableSpeed',DXCoolingSystem(DXCoolSysNum)%CoolingCoilName,ErrFound)
IF(ErrFound)THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(DXCoolingSystem(DXCoolSysNum)%Name))
ErrorsFound = .TRUE.
END IF
ELSEIF (SameString(Alphas(6),'Coil:Cooling:DX:TwoSpeed')) THEN
DXCoolingSystem(DXCoolSysNum)%CoolingCoilType_Num=CoilDX_CoolingTwoSpeed
CALL GetDXCoilIndex(DXCoolingSystem(DXCoolSysNum)%CoolingCoilName, DXCoolingSystem(DXCoolSysNum)%CoolingCoilIndex, &
ErrFound,CurrentModuleObject)
IF(ErrFound)THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(DXCoolingSystem(DXCoolSysNum)%Name))
ErrorsFound = .TRUE.
END IF
ELSEIF (SameString(Alphas(6),'CoilSystem:Cooling:DX:HeatExchangerAssisted')) THEN
DXCoolingSystem(DXCoolSysNum)%CoolingCoilType_Num=CoilDX_CoolingHXAssisted
CALL GetHXDXCoilIndex(DXCoolingSystem(DXCoolSysNum)%CoolingCoilName, DXCoolingSystem(DXCoolSysNum)%CoolingCoilIndex, &
ErrFound,CurrentModuleObject)
IF(ErrFound)THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(DXCoolingSystem(DXCoolSysNum)%Name))
ErrorsFound = .TRUE.
END IF
DXErrorsFound = .FALSE.
HXDXCoolCoilName = GetHXDXCoilName(Alphas(6),Alphas(7),DXErrorsFound)
IF(DXErrorsFound)THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//' = "'//TRIM(DXCoolingSystem(DXCoolSysNum)%Name)//'"')
CALL ShowContinueError('CoilSystem:Cooling:DX:HeatExchangerAssisted "'//TRIM(Alphas(7))//'" not found.')
ErrorsFound = .TRUE.
END IF
ELSEIF (SameString(Alphas(6),'Coil:Cooling:DX:TwoStageWithHumidityControlMode')) THEN
DXCoolingSystem(DXCoolSysNum)%CoolingCoilType_Num=CoilDX_CoolingTwoStageWHumControl
CALL GetDXCoilIndex(DXCoolingSystem(DXCoolSysNum)%CoolingCoilName, DXCoolingSystem(DXCoolSysNum)%CoolingCoilIndex, &
ErrFound,CurrentModuleObject)
IF(ErrFound)THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(DXCoolingSystem(DXCoolSysNum)%Name))
ErrorsFound = .TRUE.
END IF
ELSEIF (SameString(Alphas(6), 'Coil:Cooling:DX:SingleSpeed:ThermalStorage')) THEN
DXCoolingSystem(DXCoolSysNum)%CoolingCoilType_Num=CoilDX_PackagedThermalStorageCooling
CALL GetTESCoilIndex(DXCoolingSystem(DXCoolSysNum)%CoolingCoilName, DXCoolingSystem(DXCoolSysNum)%CoolingCoilIndex, &
ErrFound,CurrentModuleObject)
IF(ErrFound)THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(DXCoolingSystem(DXCoolSysNum)%Name))
ErrorsFound = .TRUE.
END IF
ENDIF
ELSE
CALL ShowSevereError('Invalid entry for '//TRIM(cAlphaFields(6))//' :'//TRIM(Alphas(6)))
CALL ShowContinueError('In '//TRIM(CurrentModuleObject)//'="'//TRIM(DXCoolingSystem(DXCoolSysNum)%Name)//'".')
ErrorsFound=.true.
END IF
CALL ValidateComponent(DXCoolingSystem(DXCoolSysNum)%CoolingCoilType,DXCoolingSystem(DXCoolSysNum)%CoolingCoilName, &
IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError('In '//TRIM(CurrentModuleObject)//' = "'//TRIM(DXCoolingSystem(DXCoolSysNum)%Name)//'".')
ErrorsFound=.true.
ENDIF
CALL SetUpCompSets(DXCoolingSystem(DXCoolSysNum)%DXCoolingSystemType, DXCoolingSystem(DXCoolSysNum)%Name, &
Alphas(6),Alphas(7),Alphas(3),Alphas(4))
FanErrorsFound = .FALSE.
! Supply air fan operating mode defaulted to constant fan cycling coil/compressor
DXCoolingSystem(DXCoolSysNum)%FanOpMode = ContFanCycCoil
! Dehumidification control mode
IF (SameString(Alphas(8),'None')) THEN
DXCoolingSystem(DXCoolSysNum)%DehumidControlType=DehumidControl_None
ELSEIF (SameString(Alphas(8),' ')) THEN
DXCoolingSystem(DXCoolSysNum)%DehumidControlType=DehumidControl_None
ELSEIF (SameString(Alphas(8),'Multimode')) THEN
IF (DXCoolingSystem(DXCoolSysNum)%CoolingCoilType_Num == CoilDX_CoolingTwoStageWHumControl) THEN
DXCoolingSystem(DXCoolSysNum)%DehumidControlType=DehumidControl_Multimode
ELSE IF (DXCoolingSystem(DXCoolSysNum)%CoolingCoilType_Num == CoilDX_CoolingHXAssisted) THEN
DXCoolingSystem(DXCoolSysNum)%DehumidControlType=DehumidControl_Multimode
ELSE
CALL ShowWarningError('Invalid entry for '//TRIM(cAlphaFields(8))//' :'//TRIM(Alphas(8)))
CALL ShowContinueError('In '//TRIM(CurrentModuleObject)//'="'//TRIM(DXCoolingSystem(DXCoolSysNum)%Name)//'".')
CALL ShowContinueError('Valid only with cooling coil type = Coil:Cooling:DX:TwoStageWithHumidityControlMode or '// &
'CoilSystem:Cooling:DX:HeatExchangerAssisted.')
CALL ShowContinueError('Setting '//TRIM(cAlphaFields(8))//' to None.')
DXCoolingSystem(DXCoolSysNum)%DehumidControlType=DehumidControl_None
END IF
ELSEIF (SameString(Alphas(8),'CoolReheat')) THEN
DXCoolingSystem(DXCoolSysNum)%DehumidControlType=DehumidControl_CoolReheat
ELSE
CALL ShowSevereError('Invalid entry for '//TRIM(cAlphaFields(8))//' :'//TRIM(Alphas(8)))
CALL ShowContinueError('In '//TRIM(CurrentModuleObject)//'="'//TRIM(DXCoolingSystem(DXCoolSysNum)%Name)//'".')
END IF
! Run on sensible load
IF (SameString(Alphas(9),'Yes')) THEN
DXCoolingSystem(DXCoolSysNum)%RunOnSensibleLoad= .TRUE.
ELSEIF (SameString(Alphas(9),' ')) THEN
DXCoolingSystem(DXCoolSysNum)%RunOnSensibleLoad= .TRUE.
ELSEIF (SameString(Alphas(9),'No')) THEN
DXCoolingSystem(DXCoolSysNum)%RunOnSensibleLoad= .FALSE.
ELSE
CALL ShowSevereError('Invalid entry for '//TRIM(cAlphaFields(9))//' :'//TRIM(Alphas(9)))
CALL ShowContinueError('In '//TRIM(CurrentModuleObject)//'="'//TRIM(DXCoolingSystem(DXCoolSysNum)%Name)//'".')
CALL ShowContinueError('Must be Yes or No.')
END IF
! Run on latent load
IF (SameString(Alphas(10),'Yes')) THEN
DXCoolingSystem(DXCoolSysNum)%RunOnLatentLoad= .TRUE.
ELSEIF (SameString(Alphas(10),' ')) THEN
DXCoolingSystem(DXCoolSysNum)%RunOnLatentLoad= .FALSE.
ELSEIF (SameString(Alphas(10),'No')) THEN
DXCoolingSystem(DXCoolSysNum)%RunOnLatentLoad= .FALSE.
ELSE
CALL ShowSevereError('Invalid entry for '//TRIM(cAlphaFields(10))//' :'//TRIM(Alphas(10)))
CALL ShowContinueError('In '//TRIM(CurrentModuleObject)//'="'//TRIM(DXCoolingSystem(DXCoolSysNum)%Name)//'".')
CALL ShowContinueError('Must be Yes or No.')
END IF
! Run as 100% DOAS DX coil
IF (lAlphaBlanks(11) .AND. NumAlphas <= 10)THEN
DXCoolingSystem(DXCoolSysNum)%ISHundredPercentDOASDXCoil= .FALSE.
ELSE
IF (SameString(Alphas(11),'Yes')) THEN
DXCoolingSystem(DXCoolSysNum)%ISHundredPercentDOASDXCoil= .TRUE.
ELSEIF (SameString(Alphas(11),' ')) THEN
DXCoolingSystem(DXCoolSysNum)%ISHundredPercentDOASDXCoil= .FALSE.
ELSEIF (SameString(Alphas(11),'No')) THEN
DXCoolingSystem(DXCoolSysNum)%ISHundredPercentDOASDXCoil= .FALSE.
ELSE
CALL ShowSevereError('Invalid entry for '//TRIM(cAlphaFields(11))//' :'//TRIM(Alphas(11)))
CALL ShowContinueError('In '//TRIM(CurrentModuleObject)//'="'//TRIM(DXCoolingSystem(DXCoolSysNum)%Name)//'".')
CALL ShowContinueError('Must be Yes or No.')
END IF
ENDIF
! considered as as 100% DOAS DX cooling coil
IF (DXCoolingSystem(DXCoolSysNum)%ISHundredPercentDOASDXCoil) THEN
! set the system DX Coil application type to the child DX coil
CALL SetDXCoilTypeData(DXCoolingSystem(DXCoolSysNum)%CoolingCoilName)
ENDIF
! DOAS DX Cooling Coil Leaving Minimum Air Temperature
IF (NumNums > 0)THEN
IF (.NOT. lNumericBlanks(1))THEN
DXCoolingSystem(DXCoolSysNum)%DOASDXCoolingCoilMinTout = Numbers(1)
ENDIF
ENDIF
IF (DXCoolingSystem(DXCoolSysNum)%CoolingCoilType_Num == CoilDX_CoolingTwoSpeed) THEN
CALL SetCoilSystemCoolingData(DXCoolingSystem(DXCoolSysNum)%CoolingCoilName, &
DXCoolingSystem(DXCoolSysNum)%Name )
ENDIF
END DO !End of the DX System Loop
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in input. Program terminates.')
ENDIF
DO DXSystemNum=1,NumDXSystem
! Setup Report variables for the DXCoolingSystem that is not reported in the components themselves
IF (SameString(DXCoolingSystem(DXSystemNum)%CoolingCoilType,'Coil:Cooling:DX:Twospeed') ) THEN
CALL SetupOutputVariable('Coil System Cycling Ratio []',DXCoolingSystem(DXSystemNum)%CycRatio, &
'System','Average',DXCoolingSystem(DXSystemNum)%Name)
CALL SetupOutputVariable('Coil System Compressor Speed Ratio []',DXCoolingSystem(DXSystemNum)%SpeedRatio, &
'System','Average',DXCoolingSystem(DXSystemNum)%Name)
ELSE
CALL SetupOutputVariable('Coil System Part Load Ratio []',DXCoolingSystem(DXSystemNum)%PartLoadFrac, &
'System','Average',DXCoolingSystem(DXSystemNum)%Name)
END IF
CALL SetupOutputVariable('Coil System Frost Control Status []',DXCoolingSystem(DXSystemNum)%FrostControlStatus, &
'System','Average',DXCoolingSystem(DXSystemNum)%Name)
END DO
DEALLOCATE(Alphas)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(Numbers)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
RETURN
END SUBROUTINE GetDXCoolingSystemInput