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(in) | :: | T_RegenInTemp | |||
real(kind=r64), | intent(in) | :: | T_RegenInHumRat | |||
real(kind=r64), | intent(in) | :: | T_ProcInTemp | |||
real(kind=r64), | intent(in) | :: | T_ProcInHumRat | |||
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 CheckModelBoundsRH_TempEq(ExchNum, T_RegenInTemp, T_RegenInHumRat, T_ProcInTemp, T_ProcInHumRat, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad, FSEC
! DATE WRITTEN January 2007
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
!
! To verify that the empirical model's independent variables result in a relative humidity that is within the range
! of relative humidities used when creating the empirical model. Both the regeneration and process inlet are tested.
! 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.
! In addition, the range of relative humidities in the original data set may influence the output of the
! empirical model. This subroutine tests the relative humidities passed to the empirical model and warns the
! user if these relative humidities are out of bounds based on the limits set by the user.
!
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: CreateSysTimeIntervalString,RoundSigDigits
USE DataGlobals, ONLY: CurrentTime
USE DataHVACGlobals, ONLY: SysTimeElapsed, TimeStepSys
USE Psychrometrics, ONLY: PsyRhFnTdbWPb
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS
INTEGER, INTENT(IN) :: ExchNum ! number of the current heat exchanger being simulated
REAL(r64), INTENT(IN) :: T_RegenInTemp ! current regen inlet temperature passed to eqn
REAL(r64), INTENT(IN) :: T_RegenInHumRat ! current regen inlet hum rat passed to eqn
REAL(r64), INTENT(IN) :: T_ProcInTemp ! current process inlet temperature passed to eqn
REAL(r64), INTENT(IN) :: T_ProcInHumRat ! current regen outlet hum rat from eqn
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:
REAL(r64) :: RegenInletRH = 0.0d0 ! Regeneration inlet air relative humidity
REAL(r64) :: ProcInletRH = 0.0d0 ! Process inlet air relative humidity
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
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
IF(WarmupFlag .OR. FirstHVACIteration)RETURN
! 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 when regeneration inlet relative humidity is outside model boundaries
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenInRelHumTempMess)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempErrorCount = &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempErrorCount + 1
IF (BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempErrorCount < 2) THEN
CALL ShowWarningError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempBuffer1))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempBuffer2))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempBuffer3))
CALL ShowContinueError('...Using regeneration inlet air relative humidities that are outside the regeneration '&
//'outlet temperature equation model boundaries may adversely affect desiccant model performance. '&
//'Verify correct model coefficients.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// &
'" - Regeneration inlet air relative humidity related to regen outlet air temperature equation is outside '// &
'model boundaries error continues...', &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempErrIndex, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempLast, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempLast)
END IF
END IF
! print error when process inlet relative humidity is outside model boundaries
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintProcInRelHumTempMess)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempErrorCount = &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempErrorCount + 1
IF (BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempErrorCount < 2) THEN
CALL ShowWarningError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempBuffer1))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempBuffer2))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempBuffer3))
CALL ShowContinueError('...Using process inlet air relative humidities that are outside the regeneration '&
//'outlet temperature equation model boundaries may adversely affect desiccant model performance. '&
//'Verify correct model coefficients.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// &
'" - Process inlet air relative humidity related to regen outlet air temperature equation is outside '// &
'model boundaries error continues...', &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempErrIndex, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempLast, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempLast)
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
! Check that condition is not above saturation curve prior to next calc (PsyRhFnTdbWPb) to avoid psyc routine errors
!
! *
! *
! x------*---------- T_HumRat
! | *
! | *
! *----------------- PsyWFnTdpPb(Tdp,Pb)
! * |
! |
!
! T_Temp
!
IF(T_RegenInHumRat .GT. PsyWFnTdpPb(T_RegenInTemp,OutBaroPress) .OR. &
T_ProcInHumRat .GT. PsyWFnTdpPb(T_ProcInTemp ,OutBaroPress)) THEN
! reset RH print flags just in case
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenInRelHumTempMess = .FALSE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintProcInRelHumTempMess = .FALSE.
RETURN
END IF
! 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(T_RegenInTemp-T_ProcInTemp) .LT. Small)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenInRelHumTempMess = .FALSE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintProcInRelHumTempMess = .FALSE.
RETURN
END IF
RegenInletRH = PsyRhFnTdbWPb(T_RegenInTemp, T_RegenInHumRat,OutBaroPress)
ProcInletRH = MIN(1.0d0,PsyRhFnTdbWPb(T_ProcInTemp, T_ProcInHumRat, OutBaroPress))
! checking if regeneration inlet relative humidity is within model boundaries
IF(RegenInletRH .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%T_MinRegenAirInRelHum .OR. &
RegenInletRH .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%T_MaxRegenAirInRelHum)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempLast = RegenInletRH*100.0d0
OutputChar=RoundSigDigits(RegenInletRH*100.0d0,1)
OutputCharLo=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%T_MinRegenAirInRelHum*100.0d0,1)
OutputCharHi=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%T_MaxRegenAirInRelHum*100.0d0,1)
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenInRelHumTempMess = .TRUE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempBuffer1 = &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// '" - Regeneration inlet air relative ' &
//'humidity related to regen outlet air temperature equation is outside model boundaries at '//TRIM(OutputChar)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempBuffer2 = &
'...Model limit on regeneration inlet air relative humidity is '//TRIM(OutputCharLo)//' to '//TRIM(OutputCharHi)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenInRelHumTempBuffer3 = &
'...Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//', ' //TRIM(CreateSysTimeIntervalString())
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenInRelHumTempMess = .FALSE.
END IF
! checking if process inlet relative humidity is within model boundaries
IF(ProcInletRH .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%T_MinProcAirInRelHum .OR. &
ProcInletRH .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%T_MaxProcAirInRelHum)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempLast = ProcInletRH*100.0d0
OutputChar=RoundSigDigits(ProcInletRH*100.0d0,1)
OutputCharLo=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%T_MinProcAirInRelHum*100.0d0,1)
OutputCharHi=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%T_MaxProcAirInRelHum*100.0d0,1)
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintProcInRelHumTempMess = .TRUE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempBuffer1 = &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// '" - Process inlet air relative ' &
//'humidity related to regen outlet air temperature equation is outside model boundaries at '//TRIM(OutputChar)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempBuffer2 = &
'...Model limit on process inlet air relative humidity is '//TRIM(OutputCharLo)//' to '//TRIM(OutputCharHi)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%ProcInRelHumTempBuffer3 = &
'...Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//', ' //TRIM(CreateSysTimeIntervalString())
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintProcInRelHumTempMess = .FALSE.
END IF
END SUBROUTINE CheckModelBoundsRH_TempEq