Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in) | :: | TDB | |||
real(kind=r64), | intent(in) | :: | dW | |||
real(kind=r64), | intent(in) | :: | PB | |||
character(len=*), | intent(in), | optional | :: | calledfrom |
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.
FUNCTION PsyRhFnTdbWPb(TDB,dW,PB,calledfrom) RESULT(RHValue)
! FUNCTION INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN Nov 1988
! MODIFIED Aug 1989, Michael J. Witte
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! This function provides the relative humidity value (0.0-1.0) as a result of
! dry-bulb temperature, humidity ratio and barometric pressure.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! ASHRAE HANDBOOK FUNDAMENTALS 1985, P6.12, EQN 10,21,23
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
REAL(r64), intent(in) :: TDB ! dry-bulb temperature {C}
REAL(r64), intent(in) :: dW ! humidity ratio
REAL(r64), intent(in) :: PB ! barometric pressure {Pascals}
character(len=*), intent(in), optional :: calledfrom ! routine this function was called from (error messages)
REAL(r64) :: RHValue ! relative humidity value (0.0-1.0)
! FUNCTION PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! FUNCTION LOCAL VARIABLE DECLARATIONS:
REAL(r64) U ! Degree of Saturation
REAL(r64) PWS ! Pressure -- saturated for pure water
REAL(r64) W ! humidity ratio
IF (PRESENT(calledfrom)) THEN
PWS=PsyPsatFnTemp(TDB,calledfrom)
ELSE
PWS=PsyPsatFnTemp(TDB,'PsyRhFnTdbWPb')
ENDIF
! Find Degree Of Saturation
W=MAX(dW,1.0d-5)
U=W/(0.62198d0*PWS/(PB-PWS))
! Calculate The Relative Humidity
RHValue=U/(1.0d0-(1.0d0-U)*(PWS/PB))
!
# 1277
! VALIDITY TEST
IF (RHValue < 0.0d0 .or. RHValue > 1.0d0) THEN
IF (RHValue > 1.0d0) THEN
IF (RHValue > 1.01d0) THEN
IF (.not. WarmupFlag) THEN
IF (iPsyErrIndex(iPsyRhFnTdbWPb) == 0) THEN
String=' Dry-Bulb= '//TRIM(TrimSigDigits(TDB,2))// &
' Humidity Ratio= '//TRIM(TrimSigDigits(W,3))// &
' Calculated Relative Humidity [%]= '//TRIM(TrimSigDigits(RHValue*100.d0,2))
CALL ShowWarningMessage('Calculated Relative Humidity out of range (PsyRhFnTdbWPb) ')
if (present(calledfrom)) then
CALL ShowContinueErrorTimeStamp(' Routine='//trim(calledfrom)//',')
else
CALL ShowContinueErrorTimeStamp(' Routine=Unknown,')
endif
CALL ShowContinueError(TRIM(String))
CALL ShowContinueError('Relative Humidity being reset to 100.0%')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('Calculated Relative Humidity out of range (PsyRhFnTdbWPb)', &
iPsyErrIndex(iPsyRhFnTdbWPb),ReportMinOf=RHValue*100.d0,ReportMaxOf=RHValue*100.d0, &
ReportMinUnits='%',ReportMaxUnits='%')
ENDIF
ENDIF
RHValue=1.0d0
ELSE ! RHValue < 0.0
IF (RHValue < -0.05d0) THEN
IF (.not. WarmupFlag) THEN
IF (iPsyErrIndex(iPsyRhFnTdbWPb) == 0) THEN
String=' Dry-Bulb= '//TRIM(TrimSigDigits(TDB,2))// &
' Humidity Ratio= '//TRIM(TrimSigDigits(W,3))// &
' Calculated Relative Humidity [%]= '//TRIM(TrimSigDigits(RHValue*100.d0,2))
CALL ShowWarningMessage('Calculated Relative Humidity out of range (PsyRhFnTdbWPb) ')
if (present(calledfrom)) then
CALL ShowContinueErrorTimeStamp(' Routine='//trim(calledfrom)//',')
else
CALL ShowContinueErrorTimeStamp(' Routine=Unknown,')
endif
CALL ShowContinueError(TRIM(String))
CALL ShowContinueError('Relative Humidity being reset to 1%')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('Calculated Relative Humidity out of range (PsyRhFnTdbWPb)', &
iPsyErrIndex(iPsyRhFnTdbWPb),ReportMinOf=RHValue*100.d0,ReportMaxOf=RHValue*100.d0, &
ReportMinUnits='%',ReportMaxUnits='%')
ENDIF
ENDIF
RHValue=.01d0
ENDIF
ENDIF ! RHValue in proper range
! RHValue is the result
RETURN
END FUNCTION PsyRhFnTdbWPb