SUBROUTINE GetHeatRecoveryInput
! SUBROUTINE INFORMATION:
! AUTHOR Michael Wetter
! DATE WRITTEN March 1999
! MODIFIED F Buhl Nov 2000, D Shirey Feb 2003, R. Raustad FSEC - Feb 2009 (EconoLockout inputs)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for heat recovery units and stores it in
! appropriate data structures.
! METHODOLOGY EMPLOYED:
! Uses InputProcessor "Get" routines to obtain data.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
USE DataIPShortCuts
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 :: ExchIndex ! loop index
INTEGER :: ExchNum ! current heat exchanger number
INTEGER :: PerfDataIndex ! desiccant balance heat exchanger performance data loop index
INTEGER :: PerfDataNum ! current desiccant balanced heat exchanger performance data set number
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers 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) :: HeatExchPerfType =' ' ! Desiccant balanced heat exchanger performance data type
CHARACTER(len=*), PARAMETER :: RoutineName='GetHeatRecoveryInput: ' ! include trailing blank space
NumAirToAirPlateExchs = GetNumObjectsFound('HeatExchanger:AirToAir:FlatPlate')
NumAirToAirGenericExchs = GetNumObjectsFound('HeatExchanger:AirToAir:SensibleAndLatent')
NumDesiccantBalancedExchs = GetNumObjectsFound('HeatExchanger:Desiccant:BalancedFlow')
NumDesBalExchsPerfDataType1 = GetNumObjectsFound('HeatExchanger:Desiccant:BalancedFlow:PerformanceDataType1')
NumHeatExchangers = NumAirToAirPlateExchs + NumAirToAirGenericExchs + NumDesiccantBalancedExchs
! allocate the data array
ALLOCATE(ExchCond(NumHeatExchangers))
ALLOCATE(CheckEquipName(NumHeatExchangers))
CheckEquipName=.true.
IF (NumDesBalExchsPerfDataType1 .GT. 0) THEN
ALLOCATE(BalDesDehumPerfData(NumDesBalExchsPerfDataType1))
END IF
! loop over the air to air plate heat exchangers and load their input data
DO ExchIndex = 1,NumAirToAirPlateExchs
cCurrentModuleObject='HeatExchanger:AirToAir:FlatPlate'
CALL GetObjectItem(cCurrentModuleObject,ExchIndex,cAlphaArgs,NumAlphas,&
rNumericArgs,NumNumbers,IOStatus,NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ExchNum = ExchIndex
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1),ExchCond%Name,ExchNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
ExchCond(ExchNum)%Name = cAlphaArgs(1)
ExchCond(ExchNum)%ExchTypeNum = HX_AIRTOAIR_FLATPLATE
IF (lAlphaFieldBlanks(2)) THEN
ExchCond(ExchNum)%SchedPtr = ScheduleAlwaysOn
ELSE
ExchCond(ExchNum)%SchedPtr = GetScheduleIndex(cAlphaArgs(2))
IF (ExchCond(ExchNum)%SchedPtr .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered ='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.TRUE.
END IF
END IF
SELECT CASE(TRIM(cAlphaArgs(3)))
CASE('COUNTERFLOW')
ExchCond(ExchNum)%FlowArr = Counter_Flow
CASE('PARALLELFLOW')
ExchCond(ExchNum)%FlowArr = Parallel_Flow
CASE('CROSSFLOWBOTHUNMIXED')
ExchCond(ExchNum)%FlowArr = Cross_Flow_Both_Unmixed
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': incorrect flow arrangement: '//TRIM(cAlphaArgs(3)))
ErrorsFound=.true.
END SELECT
SELECT CASE(TRIM(cAlphaArgs(4)))
CASE('YES')
ExchCond(ExchNum)%EconoLockOut = EconoLockOut_Yes
CASE('NO')
ExchCond(ExchNum)%EconoLockOut = EconoLockOut_No
CASE DEFAULT
IF(lAlphaFieldBlanks(4))THEN
ExchCond(ExchNum)%EconoLockOut = EconoLockOut_Yes
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': incorrect econo lockout: '//TRIM(cAlphaArgs(4)))
ErrorsFound=.true.
END IF
END SELECT
ExchCond(ExchNum)%hARatio = rNumericArgs(1)
ExchCond(ExchNum)%NomSupAirVolFlow = rNumericArgs(2)
ExchCond(ExchNum)%NomSupAirInTemp = rNumericArgs(3)
ExchCond(ExchNum)%NomSupAirOutTemp = rNumericArgs(4)
ExchCond(ExchNum)%NomSecAirVolFlow = rNumericArgs(5)
ExchCond(ExchNum)%NomSecAirInTemp = rNumericArgs(6)
ExchCond(ExchNum)%NomElecPower = rNumericArgs(7)
ExchCond(ExchNum)%SupInletNode = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
ExchCond(ExchNum)%SupOutletNode = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
ExchCond(ExchNum)%SecInletNode = &
GetOnlySingleNode(cAlphaArgs(7),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,2,ObjectIsNotParent)
ExchCond(ExchNum)%SecOutletNode = &
GetOnlySingleNode(cAlphaArgs(8),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,2,ObjectIsNotParent)
CALL TestCompSet(cHXTypes(ExchCond(ExchNum)%ExchTypeNum),ExchCond(ExchNum)%Name,cAlphaArgs(5), &
cAlphaArgs(6),'Process Air Nodes')
END DO ! end of input loop over air to air plate heat exchangers
! loop over the air to air generic heat exchangers and load their input data
DO ExchIndex = 1,NumAirToAirGenericExchs
cCurrentModuleObject='HeatExchanger:AirToAir:SensibleAndLatent'
CALL GetObjectItem(cCurrentModuleObject,ExchIndex,cAlphaArgs,NumAlphas,&
rNumericArgs,NumNumbers,IOStatus,NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ExchNum = ExchIndex+NumAirToAirPlateExchs
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1),ExchCond%Name,ExchNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
ExchCond(ExchNum)%Name = cAlphaArgs(1)
ExchCond(ExchNum)%ExchTypeNum = HX_AIRTOAIR_GENERIC
IF (lAlphaFieldBlanks(2)) THEN
ExchCond(ExchNum)%SchedPtr = ScheduleAlwaysOn
ELSE
ExchCond(ExchNum)%SchedPtr = GetScheduleIndex(cAlphaArgs(2))
IF (ExchCond(ExchNum)%SchedPtr .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered ='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.TRUE.
END IF
END IF
ExchCond(ExchNum)%NomSupAirVolFlow = rNumericArgs(1)
ExchCond(ExchNum)%HeatEffectSensible100 = rNumericArgs(2)
ExchCond(ExchNum)%HeatEffectLatent100 = rNumericArgs(3)
ExchCond(ExchNum)%HeatEffectSensible75 = rNumericArgs(4)
ExchCond(ExchNum)%HeatEffectLatent75 = rNumericArgs(5)
IF (ExchCond(ExchNum)%HeatEffectSensible75 .LT. ExchCond(ExchNum)%HeatEffectSensible100) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(ExchCond(ExchNum)%Name)//&
'" sensible heating effectiveness at 75% rated flow is less than at 100% rated flow.')
CALL ShowContinueError('Sensible heating effectiveness at 75% rated flow is usually greater than at 100% rated flow.')
END IF
IF (ExchCond(ExchNum)%HeatEffectLatent75 .LT. ExchCond(ExchNum)%HeatEffectLatent100) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(ExchCond(ExchNum)%Name)//&
'" latent heating effectiveness at 75% rated flow is less than at 100% rated flow.')
CALL ShowContinueError('Latent heating effectiveness at 75% rated flow is usually greater than at 100% rated flow.')
END IF
ExchCond(ExchNum)%CoolEffectSensible100 = rNumericArgs(6)
ExchCond(ExchNum)%CoolEffectLatent100 = rNumericArgs(7)
ExchCond(ExchNum)%CoolEffectSensible75 = rNumericArgs(8)
ExchCond(ExchNum)%CoolEffectLatent75 = rNumericArgs(9)
IF (ExchCond(ExchNum)%CoolEffectSensible75 .LT. ExchCond(ExchNum)%CoolEffectSensible100) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(ExchCond(ExchNum)%Name)//&
'" sensible cooling effectiveness at 75% rated flow is less than at 100% rated flow.')
CALL ShowContinueError('Sensible cooling effectiveness at 75% rated flow is usually greater than at 100% rated flow.')
END IF
IF (ExchCond(ExchNum)%CoolEffectLatent75 .LT. ExchCond(ExchNum)%CoolEffectLatent100) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(ExchCond(ExchNum)%Name)//&
'" latent cooling effectiveness at 75% rated flow is less than at 100% rated flow.')
CALL ShowContinueError('Latent cooling effectiveness at 75% rated flow is usually greater than at 100% rated flow.')
END IF
ExchCond(ExchNum)%SupInletNode = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
ExchCond(ExchNum)%SupOutletNode = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
ExchCond(ExchNum)%SecInletNode = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,2,ObjectIsNotParent)
ExchCond(ExchNum)%SecOutletNode = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,2,ObjectIsNotParent)
ExchCond(ExchNum)%NomElecPower = rNumericArgs(10)
IF(SameString(cAlphaArgs(7),'Yes')) THEN
ExchCond(ExchNum)%ControlToTemperatureSetpoint = .TRUE.
ELSE
IF(.NOT. SameString(cAlphaArgs(7),'No')) THEN
CALL ShowSevereError('Rotary HX Speed Modulation or Plate Bypass for Temperature Control for ')
CALL ShowContinueError(TRIM(ExchCond(ExchNum)%Name)//' must be set to Yes or No')
ErrorsFound = .TRUE.
END IF
END IF
IF (SameString(cAlphaArgs(8),'Plate')) THEN
ExchCond(ExchNum)%ExchConfigNum = Plate
ELSE IF(SameString(cAlphaArgs(8),'Rotary')) THEN
ExchCond(ExchNum)%ExchConfigNum = Rotary
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' configuration not found= '//TRIM(cAlphaArgs(8)))
CALL ShowContinueError('HX configuration must be either Plate or Rotary')
ErrorsFound=.TRUE.
END IF
! Added additional inputs for frost control
ExchCond(ExchNum)%FrostControlType = cAlphaArgs(9)
IF(.NOT. SameString(ExchCond(ExchNum)%FrostControlType,'None')) THEN
IF(.NOT. SameString(ExchCond(ExchNum)%FrostControlType,'ExhaustOnly')) THEN
IF(.NOT. SameString(ExchCond(ExchNum)%FrostControlType,'ExhaustAirRecirculation')) THEN
IF(.NOT. SameString(ExchCond(ExchNum)%FrostControlType,'MinimumExhaustTemperature')) THEN
CALL ShowSevereError('Invalid Frost Control method for '//TRIM(ExchCond(ExchNum)%Name)//' = '//TRIM(cAlphaArgs(9)))
ErrorsFound = .TRUE.
END IF
END IF
END IF
END IF
IF(.not. SameString(cAlphaArgs(9),'None'))THEN
ExchCond(ExchNum)%ThresholdTemperature = rNumericArgs(11)
ExchCond(ExchNum)%InitialDefrostTime = rNumericArgs(12)
ExchCond(ExchNum)%RateofDefrostTimeIncrease = rNumericArgs(13)
END IF
SELECT CASE(TRIM(cAlphaArgs(10)))
CASE('YES')
ExchCond(ExchNum)%EconoLockOut = EconoLockOut_Yes
CASE('NO')
ExchCond(ExchNum)%EconoLockOut = EconoLockOut_No
CASE DEFAULT
IF(lAlphaFieldBlanks(10))THEN
ExchCond(ExchNum)%EconoLockOut = EconoLockOut_Yes
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': incorrect econo lockout: '//TRIM(cAlphaArgs(10)))
ErrorsFound=.true.
END IF
END SELECT
CALL TestCompSet(cHXTypes(ExchCond(ExchNum)%ExchTypeNum),ExchCond(ExchNum)%Name,cAlphaArgs(3), &
cAlphaArgs(4),'Process Air Nodes')
END DO ! end of input loop over air to air generic heat exchangers
! loop over the desiccant balanced heat exchangers and load their input data
DO ExchIndex = 1,NumDesiccantBalancedExchs
cCurrentModuleObject = 'HeatExchanger:Desiccant:BalancedFlow'
CALL GetObjectItem(cCurrentModuleObject,ExchIndex,cAlphaArgs,NumAlphas,&
rNumericArgs,NumNumbers,IOStatus,NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ExchNum = ExchIndex+NumAirToAirPlateExchs+NumAirToAirGenericExchs
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1),ExchCond%Name,ExchNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
ExchCond(ExchNum)%Name = cAlphaArgs(1)
ExchCond(ExchNum)%ExchTypeNum = HX_DESICCANT_BALANCED
IF (lAlphaFieldBlanks(2)) THEN
ExchCond(ExchNum)%SchedPtr = ScheduleAlwaysOn
ELSE
ExchCond(ExchNum)%SchedPtr = GetScheduleIndex(cAlphaArgs(2))
IF (ExchCond(ExchNum)%SchedPtr .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered ='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.TRUE.
END IF
END IF
! desiccant HX's usually refer to process and regeneration air streams
! In this module, Sup = Regeneration nodes and Sec = Process nodes
! regeneration air inlet and outlet nodes
ExchCond(ExchNum)%SupInletNode = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
ExchCond(ExchNum)%SupOutletNode = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
! process air inlet and outlet nodes
ExchCond(ExchNum)%SecInletNode = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,2,ObjectIsNotParent)
ExchCond(ExchNum)%SecOutletNode = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,2,ObjectIsNotParent)
! Set up the component set for the process side of the HX (Sec = Process)
CALL TestCompSet(cHXTypes(ExchCond(ExchNum)%ExchTypeNum),ExchCond(ExchNum)%Name,NodeID(ExchCond(ExchNum)%SecInletNode), &
NodeID(ExchCond(ExchNum)%SecOutletNode),'Process Air Nodes')
HeatExchPerfType = cAlphaArgs(7)
IF(SameString(HeatExchPerfType,'HeatExchanger:Desiccant:BalancedFlow:PerformanceDataType1'))THEN
ExchCond(ExchNum)%HeatExchPerfTypeNum = BALANCEDHX_PERFDATATYPE1
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(ExchCond(ExchNum)%Name)//'"')
CALL ShowContinueError('Invalid performance data type selected.')
CALL ShowContinueError('...performance data type selected = '//TRIM(HeatExchPerfType))
ErrorsFound=.TRUE.
END IF
ExchCond(ExchNum)%HeatExchPerfName = cAlphaArgs(8)
SELECT CASE(TRIM(cAlphaArgs(9)))
CASE('YES')
ExchCond(ExchNum)%EconoLockOut = EconoLockOut_Yes
CASE('NO')
ExchCond(ExchNum)%EconoLockOut = EconoLockOut_No
CASE DEFAULT
IF(lAlphaFieldBlanks(9))THEN
ExchCond(ExchNum)%EconoLockOut = EconoLockOut_No
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': incorrect econo lockout: '//TRIM(cAlphaArgs(9)))
ErrorsFound=.true.
END IF
END SELECT
END DO ! end of input loop over desiccant balanced heat exchangers
! get performance data set for balanced desiccant heat exchanger
DO PerfDataIndex = 1,NumDesBalExchsPerfDataType1
cCurrentModuleObject = 'HeatExchanger:Desiccant:BalancedFlow:PerformanceDataType1'
CALL GetObjectItem(cCurrentModuleObject,PerfDataIndex,cAlphaArgs,NumAlphas,&
rNumericArgs,NumNumbers,IOStatus,NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
PerfDataNum = PerfDataIndex
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1),BalDesDehumPerfData%Name,PerfDataNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
BalDesDehumPerfData(PerfDataNum)%Name = cAlphaArgs(1)
BalDesDehumPerfData(PerfDataNum)%PerfType = cCurrentModuleObject
BalDesDehumPerfData(PerfDataNum)%NomSupAirVolFlow = rNumericArgs(1)
! check validity
IF (BalDesDehumPerfData(PerfDataNum)%NomSupAirVolFlow .LE. 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Nominal air flow rate must be greater than zero.')
CALL ShowContinueError('... value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%NomSupAirVolFlow,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%NomProcAirFaceVel = rNumericArgs(2)
! check validity
IF (BalDesDehumPerfData(PerfDataNum)%NomProcAirFaceVel .LE. 0.0d0 .OR. &
BalDesDehumPerfData(PerfDataNum)%NomProcAirFaceVel .GT. 6.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Nominal air face velocity cannot be less than or equal to zero or greater than 6 m/s.')
CALL ShowContinueError('... value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%NomProcAirFaceVel,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%NomElecPower = rNumericArgs(3)
! check validity
IF (BalDesDehumPerfData(PerfDataNum)%NomElecPower < 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Nominal electric power cannot be less than zero.')
CALL ShowContinueError('... value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%NomElecPower,6))
ErrorsFound = .TRUE.
END IF
! regen outlet temp variables
BalDesDehumPerfData(PerfDataNum)%B1 = rNumericArgs(4)
BalDesDehumPerfData(PerfDataNum)%B2 = rNumericArgs(5)
BalDesDehumPerfData(PerfDataNum)%B3 = rNumericArgs(6)
BalDesDehumPerfData(PerfDataNum)%B4 = rNumericArgs(7)
BalDesDehumPerfData(PerfDataNum)%B5 = rNumericArgs(8)
BalDesDehumPerfData(PerfDataNum)%B6 = rNumericArgs(9)
BalDesDehumPerfData(PerfDataNum)%B7 = rNumericArgs(10)
BalDesDehumPerfData(PerfDataNum)%B8 = rNumericArgs(11)
! Check that the minimum is not greater than or equal to the maximum for each of the following model boundaries
BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInHumRat = rNumericArgs(12)
BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInHumRat = rNumericArgs(13)
IF(BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInHumRat .GE. BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInHumRat)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of regeneration inlet air humidity ratio must be less than the maximum.')
CALL ShowContinueError('... minimum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInHumRat,6))
CALL ShowContinueError('... maximum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInHumRat .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of regeneration inlet air humidity ratio must be greater than'// &
' or equal to 0.')
CALL ShowContinueError('... minimum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInHumRat .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the maximum value of regeneration inlet air humidity ratio must be less than or equal to 1.')
CALL ShowContinueError('... maximum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInTemp = rNumericArgs(14)
BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInTemp = rNumericArgs(15)
IF(BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInTemp .GE. BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInTemp)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of regeneration inlet air temperature must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInTemp,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInTemp,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInHumRat = rNumericArgs(16)
BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInHumRat = rNumericArgs(17)
IF(BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInHumRat .GE. BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInHumRat)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of process inlet air humidity ratio must be less than the maximum.')
CALL ShowContinueError('... minimum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInHumRat,6))
CALL ShowContinueError('... maximum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInHumRat .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of process inlet air humidity ratio must be greater than or equal to 0.')
CALL ShowContinueError('... minimum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInHumRat .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the maximum value of process inlet air humidity ratio must be less than or equal to 1.')
CALL ShowContinueError('... maximum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInTemp = rNumericArgs(18)
BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInTemp = rNumericArgs(19)
IF(BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInTemp .GE. BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInTemp)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of process inlet air temperature must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInTemp,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInTemp,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%T_MinFaceVel = rNumericArgs(20)
BalDesDehumPerfData(PerfDataNum)%T_MaxFaceVel = rNumericArgs(21)
IF(BalDesDehumPerfData(PerfDataNum)%T_MinFaceVel .GE. BalDesDehumPerfData(PerfDataNum)%T_MaxFaceVel)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of regen air velocity must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinFaceVel,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxFaceVel,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%MinRegenAirOutTemp = rNumericArgs(22)
BalDesDehumPerfData(PerfDataNum)%MaxRegenAirOutTemp = rNumericArgs(23)
IF(BalDesDehumPerfData(PerfDataNum)%MinRegenAirOutTemp .GE. BalDesDehumPerfData(PerfDataNum)%MaxRegenAirOutTemp)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of regen outlet air temperature must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%MinRegenAirOutTemp,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%MaxRegenAirOutTemp,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInRelHum = rNumericArgs(24)/100.0d0
BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInRelHum = rNumericArgs(25)/100.0d0
IF(BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInRelHum .GE. BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInRelHum)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of regen inlet air relative humidity must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInRelHum*100.0d0,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInRelHum .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of regen inlet air relative humidity must be greater than or equal to 0.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinRegenAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInRelHum .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the maximum value of regen inlet air relative humidity must be less than or equal to 100.')
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxRegenAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInRelHum = rNumericArgs(26)/100.0d0
BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInRelHum = rNumericArgs(27)/100.0d0
IF(BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInRelHum .GE. BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInRelHum)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of process inlet air relative humidity must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInRelHum*100.0d0,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInRelHum .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the minimum value of process inlet air relative humidity must be greater than or equal to 0.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MinProcAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInRelHum .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in max boundary for the regen outlet air temperature equation.')
CALL ShowContinueError('... the maximum value of process inlet air relative humidity must be less than or equal to 100.')
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%T_MaxProcAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
! regen outlet humidity ratio variables
BalDesDehumPerfData(PerfDataNum)%C1 = rNumericArgs(28)
BalDesDehumPerfData(PerfDataNum)%C2 = rNumericArgs(29)
BalDesDehumPerfData(PerfDataNum)%C3 = rNumericArgs(30)
BalDesDehumPerfData(PerfDataNum)%C4 = rNumericArgs(31)
BalDesDehumPerfData(PerfDataNum)%C5 = rNumericArgs(32)
BalDesDehumPerfData(PerfDataNum)%C6 = rNumericArgs(33)
BalDesDehumPerfData(PerfDataNum)%C7 = rNumericArgs(34)
BalDesDehumPerfData(PerfDataNum)%C8 = rNumericArgs(35)
! Check that the minimum is not greater than or equal to the maximum for each of the following model boundaries
BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInHumRat = rNumericArgs(36)
BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInHumRat = rNumericArgs(37)
IF(BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInHumRat .GE. BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInHumRat)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of regeneration inlet air humidity ratio must be less than the maximum.')
CALL ShowContinueError('... minimum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInHumRat,6))
CALL ShowContinueError('... maximum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInHumRat .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of regeneration inlet air humidity ratio must be greater than'// &
' or equal to 0.')
CALL ShowContinueError('... minimum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInHumRat .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the maximum value of regeneration inlet air humidity ratio must be less than or equal to 1.')
CALL ShowContinueError('... maximum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInTemp = rNumericArgs(38)
BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInTemp = rNumericArgs(39)
IF(BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInTemp .GE. BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInTemp)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of regeneration inlet air temperature must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInTemp,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInTemp,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInHumRat = rNumericArgs(40)
BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInHumRat = rNumericArgs(41)
IF(BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInHumRat .GE. BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInHumRat)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of process inlet air humidity ratio must be less than the maximum.')
CALL ShowContinueError('... minimum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInHumRat,6))
CALL ShowContinueError('... maximum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInHumRat .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of process inlet air humidity ratio must be greater than or equal to 0.')
CALL ShowContinueError('... minimum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInHumRat .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the maximum value of process inlet air humidity ratio must be less than or equal to 1.')
CALL ShowContinueError('... maximum value entered by user = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInHumRat,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInTemp = rNumericArgs(42)
BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInTemp = rNumericArgs(43)
IF(BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInTemp .GE. BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInTemp)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of process inlet air temperature must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInTemp,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInTemp,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%H_MinFaceVel = rNumericArgs(44)
BalDesDehumPerfData(PerfDataNum)%H_MaxFaceVel = rNumericArgs(45)
IF(BalDesDehumPerfData(PerfDataNum)%H_MinFaceVel .GE. BalDesDehumPerfData(PerfDataNum)%H_MaxFaceVel)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of regen air velocity must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinFaceVel,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxFaceVel,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%MinRegenAirOutHumRat = rNumericArgs(46)
BalDesDehumPerfData(PerfDataNum)%MaxRegenAirOutHumRat = rNumericArgs(47)
IF(BalDesDehumPerfData(PerfDataNum)%MinRegenAirOutHumRat .GE. BalDesDehumPerfData(PerfDataNum)%MaxRegenAirOutHumRat)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of regen outlet air humidity ratio must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%MinRegenAirOutHumRat,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%MaxRegenAirOutHumRat,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%MinRegenAirOutHumRat .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of regen outlet air humidity ratio must be greater than or equal to 0.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%MinRegenAirOutHumRat,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%MaxRegenAirOutHumRat .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the maximum value of regen outlet air humidity ratio must be less or equal to 1.')
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%MaxRegenAirOutHumRat,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInRelHum = rNumericArgs(48)/100.0d0
BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInRelHum = rNumericArgs(49)/100.0d0
IF(BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInRelHum .GE. BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInRelHum)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of regen inlet air relative humidity must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInRelHum*100.0d0,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInRelHum .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of regen inlet air relative humidity must be greater than or equal to 0.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinRegenAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInRelHum .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the maximum value of regen inlet air relative humidity must be less or equal to 100.')
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxRegenAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInRelHum = rNumericArgs(50)/100.0d0
BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInRelHum = rNumericArgs(51)/100.0d0
IF(BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInRelHum .GE. BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInRelHum)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min/max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of process inlet air relative humidity must be less than the maximum.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInRelHum*100.0d0,6))
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInRelHum .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in min boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the minimum value of process inlet air relative humidity must be greater than or equal to 0.')
CALL ShowContinueError('... minimum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MinProcAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
IF(BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInRelHum .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(BalDesDehumPerfData(PerfDataNum)%Name)//'"')
CALL ShowContinueError('Error found in max boundary for the regen outlet air humidity ratio equation.')
CALL ShowContinueError('... the maximum value of process inlet air relative humidity must be less than or equal to 100.')
CALL ShowContinueError('... maximum value entered = ' &
//RoundSigDigits(BalDesDehumPerfData(PerfDataNum)%H_MaxProcAirInRelHum*100.0d0,6))
ErrorsFound = .TRUE.
END IF
END DO
! getting performance data set for balanced desiccant heat exchanger ends
! match desiccant heat exchanger index to performance data index
DO ExchIndex = 1, NumDesiccantBalancedExchs
ExchNum = ExchIndex + NumAirToAirPlateExchs + NumAirToAirGenericExchs
DO PerfDataNum = 1, NumDesBalExchsPerfDataType1
IF (SameString(ExchCond(ExchNum)%HeatExchPerfName,BalDesDehumPerfData(PerfDataNum)%Name)) THEN
ExchCond(ExchNum)%PerfDataIndex = PerfDataNum
EXIT
END IF
END DO
IF(ExchCond(ExchNum)%PerfDataIndex .EQ. 0)THEN
CALL ShowSevereError(TRIM(cHXTypes(ExchCond(ExchNum)%ExchTypeNum))//' "'//TRIM(ExchCond(ExchNum)%Name)//'"')
CALL ShowContinueError('... Performance data set not found = '//TRIM(ExchCond(ExchNum)%HeatExchPerfName))
ErrorsFound = .TRUE.
ELSE
IF(.NOT. ErrorsFound)THEN
ExchCond(ExchNum)%FaceArea = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%NomSupAirVolFlow/ &
(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%NomProcAirFaceVel)
END IF
END IF
END DO
! matching done
! setup common report variables for heat exchangers
DO ExchIndex = 1,NumHeatExchangers
ExchNum = ExchIndex
! CurrentModuleObject='HeatExchanger:AirToAir:FlatPlate/AirToAir:SensibleAndLatent/Desiccant:BalancedFlow')
CALL SetupOutputVariable('Heat Exchanger Sensible Heating Rate [W]',ExchCond(ExchNum)%SensHeatingRate,'System','Average',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Sensible Heating Energy [J]',ExchCond(ExchNum)%SensHeatingEnergy,'System','Sum',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Latent Gain Rate [W]',ExchCond(ExchNum)%LatHeatingRate,'System','Average',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Latent Gain Energy [J]',ExchCond(ExchNum)%LatHeatingEnergy,'System','Sum',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Total Heating Rate [W]',ExchCond(ExchNum)%TotHeatingRate,'System','Average',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Total Heating Energy [J]',ExchCond(ExchNum)%TotHeatingEnergy,'System','Sum',&
ExchCond(ExchNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey = 'HEAT RECOVERY FOR HEATING',GroupKey = 'System')
CALL SetupOutputVariable('Heat Exchanger Sensible Cooling Rate [W]',ExchCond(ExchNum)%SensCoolingRate,'System','Average',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Sensible Cooling Energy [J]',ExchCond(ExchNum)%SensCoolingEnergy,'System','Sum',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Latent Cooling Rate [W]',ExchCond(ExchNum)%LatCoolingRate,'System','Average',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Latent Cooling Energy [J]',ExchCond(ExchNum)%LatCoolingEnergy,'System','Sum',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Total Cooling Rate [W]',ExchCond(ExchNum)%TotCoolingRate,'System','Average',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Total Cooling Energy [J]',ExchCond(ExchNum)%TotCoolingEnergy,'System','Sum',&
ExchCond(ExchNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey = 'HEAT RECOVERY FOR COOLING',GroupKey = 'System')
CALL SetupOutputVariable('Heat Exchanger Electric Power [W]',ExchCond(ExchNum)%ElecUseRate,'System','Average',&
ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Electric Energy [J]',ExchCond(ExchNum)%ElecUseEnergy,&
'System','Sum',ExchCond(ExchNum)%Name, &
ResourceTypeKey='ELECTRICITY',EndUseKey = 'HEATRECOVERY',GroupKey = 'System')
END DO
! setup additional report variables for generic heat exchangers
DO ExchIndex = 1,NumAirToAirGenericExchs
! generic heat exchangers are read in after flat plate heat exchanger objects (index needs to be set correctly)
! CurrentModuleObject=HeatExchanger:AirToAir:SensibleAndLatent
ExchNum = ExchIndex + NumAirToAirPlateExchs
CALL SetupOutputVariable('Heat Exchanger Sensible Effectiveness []',ExchCond(ExchNum)%SensEffectiveness,'System',&
'Average',ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Latent Effectiveness []',ExchCond(ExchNum)%LatEffectiveness,'System',&
'Average',ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Supply Air Bypass Mass Flow Rate [kg/s]',ExchCond(ExchNum)%SupBypassMassFlow,'System',&
'Average',ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Exhaust Air Bypass Mass Flow Rate [kg/s]',ExchCond(ExchNum)%SecBypassMassFlow, &
'System','Average',ExchCond(ExchNum)%Name)
CALL SetupOutputVariable('Heat Exchanger Defrost Time Fraction []',ExchCond(ExchNum)%DefrostFraction, &
'System','Average',ExchCond(ExchNum)%Name)
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in input. Program terminates.')
END IF
RETURN
END SUBROUTINE GetHeatRecoveryInput