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) | :: | RegenInHumRat | |||
real(kind=r64), | intent(inout) | :: | RegenOutHumRat | |||
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 CheckModelBoundOutput_HumRat(ExchNum, RegenInHumRat, RegenOutHumRat, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Mangesh Basarkar, FSEC
! DATE WRITTEN January 2007
! MODIFIED June 2007, R. Raustad, changed requirement that regen outlet temp be less than inlet temp
! 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
INTEGER, INTENT(IN) :: ExchNum ! number of the current heat exchanger being simulated
REAL(r64), INTENT(IN) :: RegenInHumRat ! current regen inlet hum rat passed to eqn
REAL(r64), INTENT(INOUT) :: RegenOutHumRat ! 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:
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 when regeneration outlet humidity ratio is less than regeneration inlet humidity ratio
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenOutHumRatFailedMess)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedErrorCount = &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedErrorCount + 1
IF (BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedErrorCount < 2) THEN
CALL ShowWarningError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedBuffer1))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedBuffer2))
CALL ShowContinueError('...Regeneration outlet air humidity ratio should always be greater than or equal ' &
//'to regen inlet air humidity ratio. Verify correct model coefficients.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// &
'" - Regeneration outlet air humidity ratio should be greater than regen inlet air humidity ratio error continues...',&
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedErrIndex, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedLast, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedLast)
END IF
END IF
! print error for regeneration outlet humidity ratio
IF(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenOutHumRatMessage)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatErrorCount = &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatErrorCount + 1
IF (BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatErrorCount < 2) THEN
CALL ShowWarningError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatBuffer1))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatBuffer2))
CALL ShowContinueError(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatBuffer3))
CALL ShowContinueError('...Regeneration outlet air humidity ratio outside model boundaries may ' &
//'adversely affect desiccant model performance.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// &
'" - Regeneration outlet air humidity ratio is out of range error continues...', &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatErrIndex, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatLast, &
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatLast)
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
! checking for regeneration outlet humidity ratio less than or equal to regeneration inlet humidity ratio
IF(RegenOutHumRat .LT. RegenInHumRat)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedLast = RegenOutHumRat
OutputChar=RoundSigDigits(RegenOutHumRat,6)
OutputCharHi=RoundSigDigits(RegenInHumRat,6)
! IF(RegenOutHumRat .LT. RegenInHumRat)THEN
! RegenOutHumRat = RegenInHumRat
! END IF
IF(.NOT. WarmupFlag .AND. .NOT. FirstHVACIteration)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenOutHumRatFailedMess = .TRUE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedBuffer1 = &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// '" - Regeneration outlet air ' &
// 'humidity ratio is less than the inlet air humidity ratio at '//TRIM(OutputChar)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedBuffer2 = '...Regen inlet air humidity ' &
//'ratio = '//TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', ' &
//Trim(CurMnDy)//', ' //TRIM(CreateSysTimeIntervalString())
CharValue=RoundSigDigits(RegenOutHumRat,6)
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatFailedBuffer3 = '...Regen outlet air humidity ' &
//'ratio equation: regeneration outlet air humidity ratio allowed from the model = ' //TRIM(CharValue)
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenOutHumRatFailedMess = .FALSE.
END IF
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenOutHumRatFailedMess = .FALSE.
END IF
! check boundaries of regen outlet humrat and post warnings to individual buffers to print at end of time step
! checking model bounds for regeneration outlet humidity ratio
IF(RegenOutHumRat .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%MinRegenAirOutHumRat .OR. &
RegenOutHumRat .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%MaxRegenAirOutHumRat)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatLast = RegenOutHumRat
OutputChar=RoundSigDigits(RegenOutHumRat,6)
OutputCharLo=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%MinRegenAirOutHumRat,6)
OutputCharHi=RoundSigDigits(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%MaxRegenAirOutHumRat,6)
IF(RegenOutHumRat .LT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%MinRegenAirOutHumRat)THEN
RegenOutHumRat = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%MinRegenAirOutHumRat
END IF
IF(RegenOutHumRat .GT. BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%MaxRegenAirOutHumRat)THEN
RegenOutHumRat = BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%MaxRegenAirOutHumRat
END IF
IF(.NOT. WarmupFlag .AND. .NOT. FirstHVACIteration)THEN
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenOutHumRatMessage = .TRUE.
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatBuffer1 = &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PerfType)//' "'// &
TRIM(BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%Name)// '" - Regeneration outlet air ' &
// 'humidity ratio is outside model boundaries at '//TRIM(OutputChar)//'.'
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatBuffer2 = '...Valid range = ' &
//TRIM(OutputCharLo)//' to ' //TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', ' &
//Trim(CurMnDy)//', ' //TRIM(CreateSysTimeIntervalString())
CharValue=RoundSigDigits(RegenOutHumRat,6)
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%RegenOutHumRatBuffer3 = '...Regen outlet air humidity ' &
//'ratio equation: regeneration outlet air humidity ratio allowed from the model = ' //TRIM(CharValue)
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenOutHumRatMessage = .FALSE.
END IF
ELSE
BalDesDehumPerfData(ExchCond(ExchNum)%PerfDataIndex)%PrintRegenOutHumRatMessage = .FALSE.
END IF
END SUBROUTINE CheckModelBoundOutput_HumRat