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) | :: | TowerNum | |||
real(kind=r64), | intent(in) | :: | Twb | |||
real(kind=r64), | intent(in) | :: | Tr | |||
real(kind=r64), | intent(in) | :: | Ta | |||
real(kind=r64), | intent(in) | :: | WaterFlowRateRatio | |||
real(kind=r64), | intent(out) | :: | TwbCapped | |||
real(kind=r64), | intent(out) | :: | TrCapped | |||
real(kind=r64), | intent(out) | :: | TaCapped | |||
real(kind=r64), | intent(out) | :: | WaterFlowRateRatioCapped |
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 CheckModelBounds(TowerNum, Twb,Tr, Ta, WaterFlowRateRatio, TwbCapped, TrCapped, TaCapped, WaterFlowRateRatioCapped)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN Feb 2005
! MODIFIED na
! RE-ENGINEERED
! 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 variable speed cooling tower 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 either by the CoolTools or York model limits, or
! specified by the user if the model is User Defined (in either the CoolTools or York model format).
! These limits are tested in this subroutine each time step and returned for use by the calling routine.
! The independent variables capped here may or may not be passed to the empirical model in the calling
! routine depending on their use.
!
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: CurrentTime
USE DataEnvironment, ONLY: EnvironmentName, CurMnDy
USE General, ONLY: CreateSysTimeIntervalString,RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: TowerNum ! index to tower
REAL(r64), INTENT(IN) :: Twb ! current inlet air wet-bulb temperature (C)
REAL(r64), INTENT(IN) :: Tr ! requested range temperature for current time step (C)
REAL(r64), INTENT(IN) :: Ta ! requested approach temperature for current time step (C)
REAL(r64), INTENT(IN) :: WaterFlowRateRatio ! current water flow rate ratio at water inlet node
REAL(r64), INTENT(OUT) :: TwbCapped ! bounded value of inlet air wet-bulb temperature (C)
REAL(r64), INTENT(OUT) :: TrCapped ! bounded value of range temperature (C)
REAL(r64), INTENT(OUT) :: TaCapped ! bounded value of approach temperature (C)
REAL(r64), INTENT(OUT) :: WaterFlowRateRatioCapped ! bounded value of water flow rate ratio
! SUBROUTINE PARAMETER DEFINITIONS:
! CHARACTER(len=*), PARAMETER :: OutputFormat ='(F5.2)'
! CHARACTER(len=*), PARAMETER :: OutputFormat2 ='(F8.5)'
! 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) :: TrimValue = ' ' ! 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
! initialize capped variables in case independent variables are in bounds
TwbCapped = Twb
TrCapped = Tr
TaCapped = Ta
WaterFlowRateRatioCapped = WaterFlowRateRatio
! 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
IF(VSTower(SimpleTower(TowerNum)%VSTower)%PrintTrMessage)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountTR = &
VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountTR + 1
IF (VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountTR < 2) THEN
CALL ShowWarningError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%TrBuffer1))
CALL ShowContinueError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%TrBuffer2))
CALL ShowContinueError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%TrBuffer3))
CALL ShowContinueError(' ...Range temperatures outside model boundaries may not ' &
//'adversely affect tower performance.')
CALL ShowContinueError(' ...This is not an unexpected occurrence when simulating actual conditions.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(SimpleTower(TowerNum)%TowerType)//' "'&
//TRIM(SimpleTower(TowerNum)%Name)//'" - Tower range temperature is out of range error continues...' &
,VSTower(SimpleTower(TowerNum)%VSTower)%ErrIndexTR,VSTower(SimpleTower(TowerNum)%VSTower)%TrLast, &
VSTower(SimpleTower(TowerNum)%VSTower)%TrLast)
END IF
END IF
IF(VSTower(SimpleTower(TowerNum)%VSTower)%PrintTwbMessage)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountIAWB = &
VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountIAWB + 1
IF (VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountIAWB < 6) THEN
CALL ShowWarningError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%TwbBuffer1))
CALL ShowContinueError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%TwbBuffer2))
CALL ShowContinueError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%TwbBuffer3))
CALL ShowContinueError(' ...Wet-bulb temperatures outside model boundaries may not ' &
//'adversely affect tower performance.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(SimpleTower(TowerNum)%TowerType)//' "'&
//TRIM(SimpleTower(TowerNum)%Name)//'" - Inlet air wet-bulb temperature is out of range error continues...' &
,VSTower(SimpleTower(TowerNum)%VSTower)%ErrIndexIAWB,VSTower(SimpleTower(TowerNum)%VSTower)%TwbLast, &
VSTower(SimpleTower(TowerNum)%VSTower)%TwbLast)
END IF
END IF
IF(VSTower(SimpleTower(TowerNum)%VSTower)%PrintTaMessage)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountTA = &
VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountTA + 1
IF (VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountTA < 2) THEN
CALL ShowWarningError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%TaBuffer1))
CALL ShowContinueError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%TaBuffer2))
CALL ShowContinueError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%TaBuffer3))
CALL ShowContinueError(' ...Approach temperatures outside model boundaries may not ' &
//'adversely affect tower performance.')
CALL ShowContinueError(' ...This is not an unexpected occurrence when simulating actual conditions.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(SimpleTower(TowerNum)%TowerType)//' "'&
//TRIM(SimpleTower(TowerNum)%Name)//'" - Tower approach temperature is out of range error continues...' &
,VSTower(SimpleTower(TowerNum)%VSTower)%ErrIndexTA,VSTower(SimpleTower(TowerNum)%VSTower)%TaLast, &
VSTower(SimpleTower(TowerNum)%VSTower)%TaLast)
END IF
END IF
IF(VSTower(SimpleTower(TowerNum)%VSTower)%PrintWFRRMessage)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountWFRR = &
VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountWFRR + 1
IF (VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountWFRR < 6) THEN
CALL ShowWarningError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%WFRRBuffer1))
CALL ShowContinueError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%WFRRBuffer2))
CALL ShowContinueError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%WFRRBuffer3))
CALL ShowContinueError(' ...Water flow rate ratios outside model boundaries may not ' &
//'adversely affect tower performance.')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(SimpleTower(TowerNum)%TowerType)//' "'&
//TRIM(SimpleTower(TowerNum)%Name)//'" - Water flow rate ratio is out of range error continues...' &
,VSTower(SimpleTower(TowerNum)%VSTower)%ErrIndexWFRR,VSTower(SimpleTower(TowerNum)%VSTower)%WaterFlowRateRatioLast, &
VSTower(SimpleTower(TowerNum)%VSTower)%WaterFlowRateRatioLast)
END IF
END IF
END IF
! 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 boundaries of independent variables and post warnings to individual buffers to print at end of time step
IF(Twb .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp .OR. &
Twb .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp)THEN
OutputChar=RoundSigDigits(Twb,2)
OutputCharLo=RoundSigDigits(VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp,2)
OutputCharHi=RoundSigDigits(VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp,2)
IF(Twb .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp)THEN
TwbCapped = VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp
END IF
IF(Twb .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp)THEN
TwbCapped = VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp
END IF
IF(.NOT. WarmUpFlag)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%PrintTwbMessage = .TRUE.
VSTower(SimpleTower(TowerNum)%VSTower)%TwbBuffer1 = TRIM(SimpleTower(TowerNum)%TowerType)//' "' &
//TRIM(SimpleTower(TowerNum)%Name)// &
'" - Inlet air wet-bulb temperature is outside model boundaries at '//TRIM(OutputChar)//'.'
VSTower(SimpleTower(TowerNum)%VSTower)%TwbBuffer2 = ' '//'...Valid range = '//TRIM(OutputCharLo)//' to ' &
//TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
TrimValue=RoundSigDigits(TwbCapped,6)
VSTower(SimpleTower(TowerNum)%VSTower)%TwbBuffer3 = ' ...Inlet air wet-bulb temperature passed to the model = ' &
//TRIM(TrimValue)
VSTower(SimpleTower(TowerNum)%VSTower)%TwbLast = Twb
ELSE
VSTower(SimpleTower(TowerNum)%VSTower)%PrintTwbMessage = .FALSE.
END IF
ELSE
VSTower(SimpleTower(TowerNum)%VSTower)%PrintTwbMessage = .FALSE.
END IF
IF(Tr .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp .OR. &
Tr .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp)THEN
OutputChar=RoundSigDigits(Tr,2)
OutputCharLo=RoundSigDigits(VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp,2)
OutputCharHi=RoundSigDigits(VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp,2)
IF(Tr .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp)THEN
TrCapped = VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp
END IF
IF(Tr .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp)THEN
TrCapped = VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp
END IF
IF(.NOT. WarmUpFlag)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%PrintTrMessage = .TRUE.
VSTower(SimpleTower(TowerNum)%VSTower)%TrBuffer1 = TRIM(SimpleTower(TowerNum)%TowerType)//' "' &
//TRIM(SimpleTower(TowerNum)%Name)// &
'" - Tower range temperature is outside model boundaries at '//TRIM(OutputChar)//'.'
VSTower(SimpleTower(TowerNum)%VSTower)%TrBuffer2 = ' '//'...Valid range = '//TRIM(OutputCharLo)//' to ' &
//TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
TrimValue=RoundSigDigits(Tr,5)
VSTower(SimpleTower(TowerNum)%VSTower)%TrBuffer3 = ' ...Tower range temperature passed to the model = '//TRIM(TrimValue)
VSTower(SimpleTower(TowerNum)%VSTower)%TrLast = Tr
ELSE
VSTower(SimpleTower(TowerNum)%VSTower)%PrintTrMessage = .FALSE.
END IF
ELSE
VSTower(SimpleTower(TowerNum)%VSTower)%PrintTrMessage = .FALSE.
END IF
IF(Ta .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp .OR. &
Ta .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp)THEN
OutputChar=RoundSigDigits(Ta,2)
OutputCharLo=RoundSigDigits(VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp,2)
OutputCharHi=RoundSigDigits(VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp,2)
IF(Ta .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp)THEN
TaCapped = VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp
END IF
IF(Ta .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp)THEN
TaCapped = VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp
END IF
IF(.NOT. WarmUpFlag)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%PrintTaMessage = .TRUE.
VSTower(SimpleTower(TowerNum)%VSTower)%TaBuffer1 = TRIM(SimpleTower(TowerNum)%TowerType)//' "' &
//TRIM(SimpleTower(TowerNum)%Name)// &
'" - Tower approach temperature is outside model boundaries at '//TRIM(OutputChar)//'.'
VSTower(SimpleTower(TowerNum)%VSTower)%TaBuffer2 = ' '//'...Valid range = '//TRIM(OutputCharLo)//' to ' &
//TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
TrimValue=RoundSigDigits(Ta,5)
VSTower(SimpleTower(TowerNum)%VSTower)%TaBuffer3 = ' ...Tower approach temperature passed to the model = ' &
//TRIM(TrimValue)
VSTower(SimpleTower(TowerNum)%VSTower)%TaLast = Ta
ELSE
VSTower(SimpleTower(TowerNum)%VSTower)%PrintTaMessage = .FALSE.
END IF
ELSE
VSTower(SimpleTower(TowerNum)%VSTower)%PrintTaMessage = .FALSE.
END IF
IF(SimpleTower(TowerNum)%TowerModelType .EQ. YorkCalcModel .OR. &
SimpleTower(TowerNum)%TowerModelType .EQ. YorkCalcUserDefined)THEN
! Water flow rate ratio warning not valid for YorkCalc model, print liquid to gas ratio
! warning instead (bottom of Subroutine VariableSpeedTower)
VSTower(SimpleTower(TowerNum)%VSTower)%PrintWFRRMessage = .FALSE.
ELSE
IF(WaterFlowRateRatio .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio .OR. &
WaterFlowRateRatio .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio)THEN
OutputChar=RoundSigDigits(WaterFlowRateRatio,2)
OutputCharLo=RoundSigDigits(VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio,2)
OutputCharHi=RoundSigDigits(VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio,2)
IF(WaterFlowRateRatio .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio)THEN
WaterFlowRateRatioCapped = VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio
END IF
IF(WaterFlowRateRatio .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio)THEN
WaterFlowRateRatioCapped = VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio
END IF
IF(.NOT. WarmUpFlag)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%PrintWFRRMessage = .TRUE.
VSTower(SimpleTower(TowerNum)%VSTower)%WFRRBuffer1 = TRIM(SimpleTower(TowerNum)%TowerType)//' "' &
//TRIM(SimpleTower(TowerNum)%Name)// &
'" - Water flow rate ratio is outside model boundaries at '//TRIM(OutputChar)//'.'
VSTower(SimpleTower(TowerNum)%VSTower)%WFRRBuffer2 = ' '//'...Valid range = '//TRIM(OutputCharLo)//' to ' &
//TRIM(OutputCharHi)//'. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
TrimValue=RoundSigDigits(WaterFlowRateRatioCapped,5)
VSTower(SimpleTower(TowerNum)%VSTower)%WFRRBuffer3 = ' ...Water flow rate ratio passed to the model = '//TRIM(TrimValue)
VSTower(SimpleTower(TowerNum)%VSTower)%WaterFlowRateRatioLast = WaterFlowRateRatio
ELSE
VSTower(SimpleTower(TowerNum)%VSTower)%PrintWFRRMessage = .FALSE.
END IF
ELSE
VSTower(SimpleTower(TowerNum)%VSTower)%PrintWFRRMessage = .FALSE.
END IF
END IF
END SUBROUTINE CheckModelBounds