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 GetZoneDehumidifierInput
! SUBROUTINE INFORMATION:
! AUTHOR Don Shirey, FSEC
! DATE WRITTEN July/Aug 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Retrieve the inputs from the input data file (idf) being simulated.
! METHODOLOGY EMPLOYED:
! Standard EnergyPlus methodology using available utility routines where appropriate.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, GetObjectDefMaxArgs
USE NodeInputManager, ONLY: GetOnlySingleNode
USE CurveManager, ONLY: GetCurveIndex, GetCurveType, CurveValue
USE WaterManager, ONLY: SetupTankSupplyComponent
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetZoneDehumidifierInput'
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='ZoneHVAC:Dehumidifier:DX'
! Curve Types
INTEGER, PARAMETER :: Quadratic = 1
INTEGER, PARAMETER :: Biquadratic = 2
INTEGER, PARAMETER :: Cubic = 3
REAL(r64), PARAMETER :: RatedInletAirTemp = 26.7d0
REAL(r64), PARAMETER :: RatedInletAirRH = 60.0d0
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ZoneDehumidIndex ! Loop index
INTEGER :: NumAlphas=0 ! Number of Alphas to allocate arrays, then used for each GetObjectItem call
INTEGER :: NumNumbers=0 ! Number of Numbers to allocate arrays, then used for each GetObjectItem call
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: ErrorsFound=.FALSE. ! Set to true if errors in input, fatal at end of routine
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
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)
REAL(r64) :: CurveVal ! Output from curve object (water removal or energy factor curves)
NumDehumidifiers = GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(ZoneDehumid(NumDehumidifiers))
ALLOCATE(CheckEquipName(NumDehumidifiers))
CheckEquipName=.true.
CALL GetObjectDefMaxArgs(CurrentModuleObject,TotalArgs,NumAlphas,NumNumbers)
ALLOCATE(Alphas(NumAlphas))
Alphas=' '
ALLOCATE(cAlphaFields(NumAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(NumNumbers))
cNumericFields=' '
ALLOCATE(Numbers(NumNumbers))
Numbers=0.0d0
ALLOCATE(lAlphaBlanks(NumAlphas))
lAlphaBlanks=.TRUE.
ALLOCATE(lNumericBlanks(NumNumbers))
lNumericBlanks=.TRUE.
DO ZoneDehumidIndex=1,NumDehumidifiers
CALL GetObjectItem(CurrentModuleObject,ZoneDehumidIndex,Alphas,NumAlphas, &
Numbers,NumNumbers,IOStatus, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(Alphas(1),ZoneDehumid%Name,ZoneDehumidIndex-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) Alphas(1)='xxxxx'
END IF
! A1, \field Name
ZoneDehumid(ZoneDehumidIndex)%Name = Alphas(1)
ZoneDehumid(ZoneDehumidIndex)%UnitType = CurrentModuleObject ! 'ZoneHVAC:Dehumidifier:DX'
ZoneDehumid(ZoneDehumidIndex)%UnitType_Num = ZoneDehumidUnit ! 'ZoneHVAC:Dehumidifier:DX' = 1
! A2, \field Availability Schedule Name
IF (lAlphaBlanks(2)) THEN
ZoneDehumid(ZoneDehumidIndex)%SchedPtr = ScheduleAlwaysOn
ELSE
ZoneDehumid(ZoneDehumidIndex)%SchedPtr = GetScheduleIndex(Alphas(2)) ! Convert schedule name to pointer
IF (ZoneDehumid(ZoneDehumidIndex)%SchedPtr .EQ. 0) THEN
CALL ShowSevereError(TRIM(cAlphaFields(2))//' not found = '//TRIM(Alphas(2)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
ErrorsFound=.TRUE.
ENDIF
END IF
! A3 , \field Air Inlet Node Name
ZoneDehumid(ZoneDehumidIndex)%AirInletNodeNum = &
GetOnlySingleNode(Alphas(3),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
! A4 , \field Air Outlet Node Name
ZoneDehumid(ZoneDehumidIndex)%AirOutletNodeNum = &
GetOnlySingleNode(Alphas(4),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
! N1, \field Rated Water Removal
ZoneDehumid(ZoneDehumidIndex)%RatedWaterRemoval = Numbers(1)
IF (ZoneDehumid(ZoneDehumidIndex)%RatedWaterRemoval .LE. 0.0d0) THEN
CALL ShowSevereError(TRIM(cNumericFields(1))//' must be greater than zero.')
CALL ShowContinueError('Value specified = '//TRIM(TrimSigDigits(Numbers(1),5)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
ErrorsFound=.TRUE.
END IF
! N2, \field Rated Energy Factor
ZoneDehumid(ZoneDehumidIndex)%RatedEnergyFactor = Numbers(2)
IF (ZoneDehumid(ZoneDehumidIndex)%RatedEnergyFactor .LE. 0.0d0) THEN
CALL ShowSevereError(TRIM(cNumericFields(2))//' must be greater than zero.')
CALL ShowContinueError('Value specified = '//TRIM(TrimSigDigits(Numbers(2),5)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
ErrorsFound=.TRUE.
END IF
! N3, \field Rated Air Flow Rate
ZoneDehumid(ZoneDehumidIndex)%RatedAirVolFlow = Numbers(3)
IF (ZoneDehumid(ZoneDehumidIndex)%RatedAirVolFlow .LE. 0.0d0) THEN
CALL ShowSevereError(TRIM(cNumericFields(3))//' must be greater than zero.')
CALL ShowContinueError('Value specified = '//TRIM(TrimSigDigits(Numbers(3),5)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
ErrorsFound=.TRUE.
END IF
! A5, \field Water Removal Curve Name
ZoneDehumid(ZoneDehumidIndex)%WaterRemovalCurveIndex = GetCurveIndex(Alphas(5)) ! Convert curve name to index number
IF (ZoneDehumid(ZoneDehumidIndex)%WaterRemovalCurveIndex .EQ. 0) THEN
IF (lAlphaBlanks(5)) THEN
CALL ShowSevereError(RoutineName//':'//TRIM(CurrentModuleObject)//'="'//TRIM(cAlphaFields(5))// &
'" is required, missing for '//TRIM(cAlphaFields(1))// &
' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
ELSE
CALL ShowSevereError(TRIM(cAlphaFields(5))//' not found = '//TRIM(Alphas(5)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
END IF
ErrorsFound = .TRUE.
ELSE
! Verify Curve object, only legal type is BiQuadratic
SELECT CASE(GetCurveType(ZoneDehumid(ZoneDehumidIndex)%WaterRemovalCurveIndex))
CASE('BIQUADRATIC')
ZoneDehumid(ZoneDehumidIndex)%WaterRemovalCurveType=Biquadratic
CurveVal = CurveValue(ZoneDehumid(ZoneDehumidIndex)%WaterRemovalCurveIndex,RatedInletAirTemp,RatedInletAirRH)
IF(CurveVal .GT. 1.10d0 .OR. CurveVal .LT. 0.90d0) THEN
CALL ShowWarningError(TRIM(cAlphaFields(5))//' output is not equal to 1.0')
CALL ShowContinueError('(+ or -10%) at rated conditions for '//TRIM(CurrentModuleObject)//' = ' &
//TRIM(Alphas(1)))
CALL ShowContinueError('Curve output at rated conditions = '//TRIM(TrimSigDigits(CurveVal,3)))
END IF
CASE DEFAULT
CALL ShowSevereError(RoutineName//':'//TRIM(CurrentModuleObject)//'="'//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name)// &
'" illegal '//TRIM(cAlphaFields(5))//' type for this object = '// &
TRIM(GetCurveType(ZoneDehumid(ZoneDehumidIndex)%WaterRemovalCurveIndex)))
CALL ShowContinueError('Curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
END IF
! A6, \field Energy Factor Curve Name
ZoneDehumid(ZoneDehumidIndex)%EnergyFactorCurveIndex = GetCurveIndex(Alphas(6)) ! convert curve name to number
IF (ZoneDehumid(ZoneDehumidIndex)%EnergyFactorCurveIndex .EQ. 0) THEN
IF (lAlphaBlanks(6)) THEN
CALL ShowSevereError(RoutineName//':'//TRIM(CurrentModuleObject)//'="'//TRIM(cAlphaFields(6))// &
'" is required, missing for '//TRIM(cAlphaFields(1))// &
' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
ELSE
CALL ShowSevereError(TRIM(cAlphaFields(6))//' not found = '//TRIM(Alphas(6)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
END IF
ErrorsFound = .TRUE.
ELSE
! Verify Curve Object, only legal type is BiQuadratic
SELECT CASE(GetCurveType(ZoneDehumid(ZoneDehumidIndex)%EnergyFactorCurveIndex))
CASE('BIQUADRATIC')
ZoneDehumid(ZoneDehumidIndex)%EnergyFactorCurveType=Biquadratic
CurveVal = CurveValue(ZoneDehumid(ZoneDehumidIndex)%EnergyFactorCurveIndex,RatedInletAirTemp,RatedInletAirRH)
IF(CurveVal .GT. 1.10d0 .OR. CurveVal .LT. 0.90d0) THEN
CALL ShowWarningError(TRIM(cAlphaFields(6))//' output is not equal to 1.0')
CALL ShowContinueError('(+ or -10%) at rated conditions for '//TRIM(CurrentModuleObject)//' = ' &
//TRIM(Alphas(1)))
CALL ShowContinueError('Curve output at rated conditions = '//TRIM(TrimSigDigits(CurveVal,3)))
END IF
CASE DEFAULT
CALL ShowSevereError(RoutineName//':'//TRIM(CurrentModuleObject)//'="'//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name)// &
'" illegal '//TRIM(cAlphaFields(6))//' type for this object = '// &
TRIM(GetCurveType(ZoneDehumid(ZoneDehumidIndex)%EnergyFactorCurveIndex)))
CALL ShowContinueError('Curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
END IF
! A7, \field Part Load Fraction Correlation Curve Name
ZoneDehumid(ZoneDehumidIndex)%PartLoadCurveIndex = GetCurveIndex(Alphas(7)) ! convert curve name to number
IF (ZoneDehumid(ZoneDehumidIndex)%PartLoadCurveIndex .EQ. 0) THEN
IF (lAlphaBlanks(7)) THEN
CALL ShowSevereError(RoutineName//':'//TRIM(CurrentModuleObject)//'="'//TRIM(cAlphaFields(7))// &
'" is required, missing for '//TRIM(cAlphaFields(1))// &
' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
ELSE
CALL ShowSevereError(TRIM(cAlphaFields(7))//' not found = '//TRIM(Alphas(7)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
END IF
ErrorsFound = .TRUE.
ELSE
! Verify Curve Object, legal types are Quadratic and Cubic
SELECT CASE(GetCurveType(ZoneDehumid(ZoneDehumidIndex)%PartLoadCurveIndex))
CASE('QUADRATIC')
ZoneDehumid(ZoneDehumidIndex)%PartLoadCurveType=Quadratic
CASE('CUBIC')
ZoneDehumid(ZoneDehumidIndex)%PartLoadCurveType=Cubic
CASE DEFAULT
CALL ShowSevereError(RoutineName//':'//TRIM(CurrentModuleObject)//'="'//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name)// &
'" illegal '//TRIM(cAlphaFields(7))//' type for this object = '// &
TRIM(GetCurveType(ZoneDehumid(ZoneDehumidIndex)%PartLoadCurveIndex)))
CALL ShowContinueError('Curve type must be Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
! N4, \field Minimum Dry-Bulb Temperature for Dehumidifier Operation
! N5, \field Maximum Dry-Bulb Temperature for Dehumidifier Operation
ZoneDehumid(ZoneDehumidIndex)%MinInletAirTemp = Numbers(4)
ZoneDehumid(ZoneDehumidIndex)%MaxInletAirTemp = Numbers(5)
IF (ZoneDehumid(ZoneDehumidIndex)%MinInletAirTemp .GE. ZoneDehumid(ZoneDehumidIndex)%MaxInletAirTemp) THEN
CALL ShowSevereError(TRIM(cNumericFields(5))//' must be greater than '//TRIM(cNumericFields(4)))
CALL ShowContinueError(TRIM(cNumericFields(5))//' specified = '//TRIM(TrimSigDigits(Numbers(5),1)))
CALL ShowContinueError(TRIM(cNumericFields(4))//' specified = '//TRIM(TrimSigDigits(Numbers(4),1)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
ErrorsFound=.TRUE.
END IF
! N6, \field Off Cycle Parasitic Electric Load
ZoneDehumid(ZoneDehumidIndex)%OffCycleParasiticLoad = Numbers(6) ! Off Cycle Parasitic Load [W]
IF (ZoneDehumid(ZoneDehumidIndex)%OffCycleParasiticLoad .LT. 0.0d0) THEN
CALL ShowSevereError(TRIM(cNumericFields(6))//' must be >= zero.')
CALL ShowContinueError('Value specified = '//TRIM(TrimSigDigits(Numbers(6),2)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(ZoneDehumid(ZoneDehumidIndex)%Name))
ErrorsFound=.TRUE.
END IF
! A8; \field Condensate Collection Water Storage Tank Name
ZoneDehumid(ZoneDehumidIndex)%CondensateCollectName = Alphas(8)
IF (lAlphaBlanks(8)) THEN
ZoneDehumid(ZoneDehumidIndex)%CondensateCollectMode = CondensateDiscarded
ELSE
ZoneDehumid(ZoneDehumidIndex)%CondensateCollectMode = CondensateToTank
CALL SetupTankSupplyComponent(ZoneDehumid(ZoneDehumidIndex)%Name,TRIM(CurrentModuleObject), &
ZoneDehumid(ZoneDehumidIndex)%CondensateCollectName, ErrorsFound, ZoneDehumid(ZoneDehumidIndex)%CondensateTankID, &
ZoneDehumid(ZoneDehumidIndex)%CondensateTankSupplyARRID )
END IF
END DO ! DO ZoneDehumidIndex=1,NumDehumidifiers
DEALLOCATE(Alphas)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(Numbers)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//':'//CurrentModuleObject//': Errors found in input.')
END IF
DO ZoneDehumidIndex=1,NumDehumidifiers
! Set up report variables for the dehumidifiers
CALL SetupOutputVariable('Zone Dehumidifier Sensible Heating Rate [W]',ZoneDehumid(ZoneDehumidIndex)%SensHeatingRate, &
'System','Average',ZoneDehumid(ZoneDehumidIndex)%Name)
CALL SetupOutputVariable('Zone Dehumidifier Sensible Heating Energy [J]',ZoneDehumid(ZoneDehumidIndex)%SensHeatingEnergy, &
'System','Sum',ZoneDehumid(ZoneDehumidIndex)%Name)
CALL SetupOutputVariable('Zone Dehumidifier Removed Water Mass Flow Rate [kg/s]', &
ZoneDehumid(ZoneDehumidIndex)%WaterRemovalRate, &
'System','Average',ZoneDehumid(ZoneDehumidIndex)%Name)
CALL SetupOutputVariable('Zone Dehumidifier Removed Water Mass [kg]',ZoneDehumid(ZoneDehumidIndex)%WaterRemoved, &
'System','Sum',ZoneDehumid(ZoneDehumidIndex)%Name)
CALL SetupOutputVariable('Zone Dehumidifier Electric Power [W]',ZoneDehumid(ZoneDehumidIndex)%ElecPower, &
'System','Average',ZoneDehumid(ZoneDehumidIndex)%Name)
CALL SetupOutputVariable('Zone Dehumidifier Electric Energy [J]',ZoneDehumid(ZoneDehumidIndex)%ElecConsumption, &
'System','Sum',ZoneDehumid(ZoneDehumidIndex)%Name, &
ResourceTypeKey='Electric',EndUseKey='COOLING',GroupKey='System')
CALL SetupOutputVariable('Zone Dehumidifier Off Cycle Parasitic Electric Power [W]', &
ZoneDehumid(ZoneDehumidIndex)%OffCycleParasiticElecPower, &
'System','Average',ZoneDehumid(ZoneDehumidIndex)%Name)
CALL SetupOutputVariable('Zone Dehumidifier Off Cycle Parasitic Electric Energy [J]', &
ZoneDehumid(ZoneDehumidIndex)%OffCycleParasiticElecCons, &
'System','Sum',ZoneDehumid(ZoneDehumidIndex)%Name)
CALL SetupOutputVariable('Zone Dehumidifier Part Load Ratio []',ZoneDehumid(ZoneDehumidIndex)%DehumidPLR, &
'System','Average',ZoneDehumid(ZoneDehumidIndex)%Name)
CALL SetupOutputVariable('Zone Dehumidifier Runtime Fraction []',ZoneDehumid(ZoneDehumidIndex)%DehumidRTF, &
'System','Average',ZoneDehumid(ZoneDehumidIndex)%Name)
CALL SetupOutputVariable('Zone Dehumidifier Outlet Air Temperature [C]',ZoneDehumid(ZoneDehumidIndex)%OutletAirTemp, &
'System','Average',ZoneDehumid(ZoneDehumidIndex)%Name)
IF (ZoneDehumid(ZoneDehumidIndex)%CondensateCollectMode == CondensateToTank) THEN
CALL SetupOutputVariable('Zone Dehumidifier Condensate Volume Flow Rate [m3/s]', &
ZoneDehumid(ZoneDehumidIndex)%DehumidCondVolFlowRate, &
'System','Average',ZoneDehumid(ZoneDehumidIndex)%Name)
CALL SetupOutputVariable('Zone Dehumidifier Condensate Volume [m3]',ZoneDehumid(ZoneDehumidIndex)%DehumidCondVol, &
'System','Sum',ZoneDehumid(ZoneDehumidIndex)%Name,ResourceTypeKey='OnSiteWater', &
EndUseKey='Condensate',GroupKey='System')
END IF
END DO
RETURN
END SUBROUTINE GetZoneDehumidifierInput