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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ExchNum | |||
real(kind=r64), | intent(inout) | :: | H_RegenInTemp | |||
real(kind=r64), | intent(inout) | :: | H_RegenInHumRat | |||
real(kind=r64), | intent(inout) | :: | H_ProcInTemp | |||
real(kind=r64), | intent(inout) | :: | H_ProcInHumRat | |||
real(kind=r64), | intent(inout) | :: | H_FaceVel | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 CheckModelBoundsHumRatEq(ExchNum, H_RegenInTemp, H_RegenInHumRat, H_ProcInTemp, H_ProcInHumRat, H_FaceVel, &
FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Mangesh Basarkar, FSEC
! DATE WRITTEN January 2007
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
!
! To verify that the empirical model's independent variables are within the limits used during the
! developement of the empirical model.
! METHODOLOGY EMPLOYED:
! The empirical models used for simulating a desiccant enhanced cooling coil are based on a limited data set.
! Extrapolation of empirical models can cause instability and the independent variables may need to be limited.
! The range of each independent variable is provided by the user and are based on the limits of the
! empirical model. These limits are tested in this subroutine each time step and returned for use by the calling
! routine.
!
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: CreateSysTimeIntervalString,RoundSigDigits
USE DataGlobals, ONLY: CurrentTime
USE DataHVACGlobals, ONLY: SysTimeElapsed, TimeStepSys
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! regen outlet humidity ratio equation
INTEGER, INTENT(IN) :: ExchNum ! number of the current heat exchanger being simulated
REAL(r64), INTENT(INOUT) :: H_RegenInTemp ! current regen inlet temperature (C) for regen outlet hum rat eqn
REAL(r64), INTENT(INOUT) :: H_RegenInHumRat ! current regen inlet hum rat for regen outlet hum rat eqn
REAL(r64), INTENT(INOUT) :: H_ProcInTemp ! current process inlet temperature (C) for regen outlet hum rat eqn
REAL(r64), INTENT(INOUT) :: H_ProcInHumRat ! current process inlet hum rat for regen outlet hum rat eqn
REAL(r64), INTENT(INOUT) :: H_FaceVel ! current process and regen face velocity (m/s)
LOGICAL, INTENT(IN) :: FirstHVACIteration ! First HVAC iteration flag
! SUBROUTINE PARAMETER DEFINITIONS:
! CHARACTER(len=*), PARAMETER :: OutputFormat ='(F10.6)'
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=32) :: OutputChar = ' ' ! character string for warning messages
CHARACTER(len=32) :: OutputCharLo = ' ' ! character string for warning messages
CHARACTER(len=32) :: OutputCharHi = ' ' ! character string for warning messages
CHARACTER(len=32) :: CharValue = ' ' ! character string for warning messages
REAL(r64),SAVE :: TimeStepSysLast = 0.0d0 ! last system time step (used to check for downshifting)
REAL(r64) :: CurrentEndTime = 0.0d0 ! end time of time step for current simulation time step
REAL(r64),SAVE :: CurrentEndTimeLast = 0.0d0 ! end time of time step for last simulation time step
! current end time is compared with last to see if time step changed
! calculate end time of current time step
CurrentEndTime = CurrentTime + SysTimeElapsed
! Print warning messages only when valid and only for the first ocurrance. Let summary provide statistics.
! Wait for next time step to print warnings. If simulation iterates, print out
! the warning for the last iteration only. Must wait for next time step to accomplish this.
! If a warning occurs and the simulation down shifts, the warning is not valid.
IF(CurrentEndTime .GT. CurrentEndTimeLast .AND. TimeStepSys .GE. TimeStepSysLast)THEN
! print error for variables of regeneration outlet humidity ratio equation
! Regen inlet temp for humidity ratio eqn
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_RegenInTempMessage)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempErrorCount = &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempErrorCount + 1
IF (BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempErrorCount < 2) THEN
CALL ShowWarningError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempBuffer1))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempBuffer2))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempBuffer3))
CALL ShowContinueError('...Using regeneration inlet air temperatures that are outside the regeneration inlet ' &
//'air temperature equation model boundaries may adversely affect desiccant model performance.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)//'" - Regeneration inlet air '//&
'temperature used in regen outlet air humidity ratio equation is out of range error continues...',&
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempErrIndex, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempLast, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempLast)
END IF
END IF
! Regen inlet humidity ratio for humidity ratio eqn
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_RegenInHumRatMessage)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatErrorCount = &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatErrorCount + 1
IF (BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatErrorCount < 2) THEN
CALL ShowWarningError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatBuffer1))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatBuffer2))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatBuffer3))
CALL ShowContinueError('...Using regeneration inlet air humidity ratios that are outside the regeneration ' &
//'outlet air humidity ratio equation model boundaries may adversely affect desiccant model performance.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// &
'" - Regeneration inlet air humidity ratio used in regen outlet air humidity ratio equation is out of range ' &
//'error continues...', BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatErrIndex, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatLast, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatLast)
END IF
END IF
! Process inlet temp for humidity ratio eqn
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInTempMessage)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempErrorCount = &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempErrorCount + 1
IF (BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempErrorCount < 2) THEN
CALL ShowWarningError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempBuffer1))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempBuffer2))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempBuffer3))
CALL ShowContinueError('...Using process inlet air temperatures that are outside the regeneration outlet ' &
//'air humidity ratio equation model may adversely affect desiccant model performance.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)//'" - Process inlet air '// &
'temperature used in regen outlet air humidity ratio equation is out of range error continues...', &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempErrIndex, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempLast, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempLast)
END IF
END IF
! Process inlet humidity ratio for humidity ratio eqn
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInHumRatMessage)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatErrorCount = &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatErrorCount + 1
IF (BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatErrorCount < 2) THEN
CALL ShowWarningError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatBuffer1))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatBuffer2))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatBuffer3))
CALL ShowContinueError('...Using process inlet air humidity ratios that are outside the regeneration outlet ' &
//'humidity ratio equation model boundaries may adversely affect desiccant model performance.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)//'" - Process inlet air '// &
'humidity ratio used in regen outlet air humidity ratio equation is out of range error continues...', &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%T_ProcInHumRatErrIndex, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatLast, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatLast)
END IF
END IF
! Process and regeneration face velocity for humidity ratio eqn
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_FaceVelMessage)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelErrorCount = &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelErrorCount + 1
IF (BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelErrorCount < 2) THEN
CALL ShowWarningError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelBuffer1))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelBuffer2))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelBuffer3))
CALL ShowContinueError('...Using process and regeneration face velocities that are outside the regeneration outlet ' &
//'air humidity ratio equation model boundaries may adversely affect desiccant model performance.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)//'" - Process and regen face '// &
'velocity used in regen outlet air humidity ratio equation is out of range error continues...', &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelocityErrIndex, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelLast, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelLast)
END IF
END IF
END IF ! IF(CurrentEndTime .GT. CurrentEndTimeLast .AND. TimeStepSys .GE. TimeStepSysLast)THEN
! save last system time step and last end time of current time step (used to determine if warning is valid)
TimeStepSysLast = TimeStepSys
CurrentEndTimeLast = CurrentEndTime
! If regen and procees inlet temperatures are the same the coil is off, do not print out of bounds warning for this case
IF(ABS(H_RegenInTemp-H_ProcInTemp) .LT. Small)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_RegenInTempMessage = .FALSE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_RegenInHumRatMessage = .FALSE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInTempMessage = .FALSE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInHumRatMessage = .FALSE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_FaceVelMessage = .FALSE.
RETURN
END IF
! check boundaries of independent variables and post warnings to individual buffers to print at end of time step
! checking model bounds for variables of regeneration outlet humidity ratio equation
! Regen inlet temp
IF(H_RegenInTemp .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinRegenAirInTemp .OR. &
H_RegenInTemp .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxRegenAirInTemp)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempLast = H_RegenInTemp
OutputChar=RoundSigDigits(H_RegenInTemp,2)
OutputCharLo=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinRegenAirInTemp,2)
OutputCharHi=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxRegenAirInTemp,2)
IF(H_RegenInTemp .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinRegenAirInTemp)THEN
H_RegenInTemp = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinRegenAirInTemp
END IF
IF(H_RegenInTemp .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxRegenAirInTemp)THEN
H_RegenInTemp = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxRegenAirInTemp
END IF
IF(.NOT. WarmupFlag .AND. .NOT. FirstHVACIteration)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_RegenInTempMessage = .TRUE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempBuffer1 = &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// '" - Regeneration inlet air ' &
//'temperature used in regen outlet air humidity ratio equation is outside model boundaries at ' //TRIM(OutputChar)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempBuffer2 = '...Valid range = ' &
//TRIM(OutputCharLo)//' to ' //TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', ' &
//Trim(CurMnDy)//' , ' //TRIM(CreateSysTimeIntervalString())
CharValue=RoundSigDigits(H_RegenInTemp,2)
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInTempBuffer3 = '...Regeneration outlet air humidity ratio ' &
//'equation: regeneration inlet air temperature passed to the model = '//TRIM(CharValue)
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_RegenInTempMessage = .FALSE.
END IF
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_RegenInTempMessage = .FALSE.
END IF
! regen inlet humidity ratio
IF(H_RegenInHumRat .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinRegenAirInHumRat .OR. &
H_RegenInHumRat .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxRegenAirInHumRat)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatLast = H_RegenInHumRat
OutputChar=RoundSigDigits(H_RegenInHumRat,6)
OutputCharLo=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinRegenAirInHumRat,6)
OutputCharHi=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxRegenAirInHumRat,6)
IF(H_RegenInHumRat .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinRegenAirInHumRat)THEN
H_RegenInHumRat = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinRegenAirInHumRat
END IF
IF(H_RegenInHumRat .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxRegenAirInHumRat)THEN
H_RegenInHumRat = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxRegenAirInHumRat
END IF
IF(.NOT. WarmupFlag .AND. .NOT. FirstHVACIteration)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_RegenInHumRatMessage = .TRUE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatBuffer1 = &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// '" - Regeneration inlet air humidity ' &
// 'ratio used in regen outlet air humidity ratio equation is outside model boundaries at ' //TRIM(OutputChar)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatBuffer2 = '...Valid range = ' &
//TRIM(OutputCharLo)//' to ' //TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', ' &
//Trim(CurMnDy)//' ' //TRIM(CreateSysTimeIntervalString())
CharValue=RoundSigDigits(H_RegenInHumRat,6)
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_RegenInHumRatBuffer3 = '...Regeneration outlet air humidity ' &
//'ratio equation: regeneration inlet air humidity ratio passed to the model = '//TRIM(CharValue)
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_RegenInHumRatMessage = .FALSE.
END IF
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_RegenInHumRatMessage = .FALSE.
END IF
! process inlet temp
IF(H_ProcInTemp .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinProcAirInTemp .OR. &
H_ProcInTemp .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxProcAirInTemp)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempLast = H_ProcInTemp
OutputChar=RoundSigDigits(H_ProcInTemp,2)
OutputCharLo=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinProcAirInTemp,2)
OutputCharHi=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxProcAirInTemp,2)
IF(H_ProcInTemp .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinProcAirInTemp)THEN
H_ProcInTemp = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinProcAirInTemp
END IF
IF(H_ProcInTemp .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxProcAirInTemp)THEN
H_ProcInTemp = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxProcAirInTemp
END IF
IF(.NOT. WarmupFlag .AND. .NOT. FirstHVACIteration)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInTempMessage = .TRUE.
! Suppress warning message when process inlet temperature = 0 (DX coil is off)
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempLast == 0.0d0) &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInTempMessage = .FALSE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempBuffer1 = &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// '" - Process inlet air temperature ' &
// 'used in regen outlet air humidity ratio equation is outside model boundaries at '//TRIM(OutputChar)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempBuffer2 = '...Valid range = ' &
//TRIM(OutputCharLo)//' to ' //TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', ' &
//Trim(CurMnDy)//' ' //TRIM(CreateSysTimeIntervalString())
CharValue=RoundSigDigits(H_ProcInTemp,6)
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInTempBuffer3 = '...Regeneration outlet air humidity ratio ' &
//'equation: process inlet air temperature passed to the model = '//TRIM(CharValue)
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInTempMessage = .FALSE.
END IF
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInTempMessage = .FALSE.
END IF
! process inlet humidity ratio
IF(H_ProcInHumRat .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinProcAirInHumRat .OR. &
H_ProcInHumRat .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxProcAirInHumRat)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatLast = H_ProcInHumRat
OutputChar=RoundSigDigits(H_ProcInHumRat,6)
OutputCharLo=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinProcAirInHumRat,6)
OutputCharHi=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxProcAirInHumRat,6)
IF(H_ProcInHumRat .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinProcAirInHumRat)THEN
H_ProcInHumRat = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinProcAirInHumRat
END IF
IF(H_ProcInHumRat .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxProcAirInHumRat)THEN
H_ProcInHumRat = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxProcAirInHumRat
END IF
IF(.NOT. WarmupFlag .AND. .NOT. FirstHVACIteration)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInHumRatMessage = .TRUE.
! Suppress warning message when process inlet humrat = 0 (DX coil is off)
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatLast == 0.0d0) &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInHumRatMessage = .FALSE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatBuffer1 = &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// '" - Process inlet air humidity ratio ' &
// 'used in regen outlet air humidity ratio equation is outside model boundaries at '//TRIM(OutputChar)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatBuffer2 = '...Valid range = ' &
//TRIM(OutputCharLo)//' to ' //TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', ' &
//Trim(CurMnDy)//', ' //TRIM(CreateSysTimeIntervalString())
CharValue=RoundSigDigits(H_ProcInHumRat,6)
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_ProcInHumRatBuffer3 = '...Regeneration outlet air humidity ' &
//'ratio equation: process inlet air humidity ratio passed to the model = '//TRIM(CharValue)
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInHumRatMessage = .FALSE.
END IF
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_ProcInHumRatMessage = .FALSE.
END IF
! regeneration and process face velocity
IF(H_FaceVel .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinFaceVel .OR. &
H_FaceVel .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxFaceVel)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelLast = H_FaceVel
OutputChar=RoundSigDigits(H_FaceVel,6)
OutputCharLo=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinFaceVel,6)
OutputCharHi=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxFaceVel,6)
IF(H_FaceVel .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinFaceVel)THEN
H_FaceVel = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MinFaceVel
END IF
IF(H_FaceVel .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxFaceVel)THEN
H_FaceVel = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_MaxFaceVel
END IF
IF(.NOT. WarmupFlag .AND. .NOT. FirstHVACIteration)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_FaceVelMessage = .TRUE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelBuffer1 = &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// '" - Process and regen inlet air face ' &
// 'velocity used in regen outlet air humidity ratio equation is outside model boundaries at '//TRIM(OutputChar)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelBuffer2 = '...Valid range = ' &
//TRIM(OutputCharLo)//' to ' //TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', ' &
//Trim(CurMnDy)//', ' //TRIM(CreateSysTimeIntervalString())
CharValue=RoundSigDigits(H_FaceVel,6)
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%H_FaceVelBuffer3 = '...Regeneration outlet air humidity ratio ' &
//'equation: process and regeneration face velocity passed to the model = '//TRIM(CharValue)
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_FaceVelMessage = .FALSE.
END IF
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintH_FaceVelMessage = .FALSE.
END IF
END SUBROUTINE CheckModelBoundsHumRatEq