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 | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in) | :: | Press | |||
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 PsyTsatFnPb(Press,calledfrom) RESULT(Temp)
! FUNCTION INFORMATION:
! AUTHOR George Shih
! DATE WRITTEN May 1976
! RE-ENGINEERED Dec 2003; Rahul Chillar
! PURPOSE OF THIS FUNCTION:
! This function provides the saturation temperature from barometric pressure.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! 1989 ASHRAE Handbook - Fundamentals
! Checked against 2005 HOF, Chap 6, Table 3 (using pressure in, temperature out) with
! good correlation from -60C to 160C
! USE STATEMENTS:
USE General, ONLY: Iterate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
REAL(r64), intent(in) :: Press ! barometric pressure {Pascals}
character(len=*), intent(in), optional :: calledfrom ! routine this function was called from (error messages)
REAL(r64) :: Temp ! result=> saturation temperature {C}
! FUNCTION PARAMETER DEFINITIONS:
Integer, Parameter :: itmax = 50 ! Maximum number of iterations
REAL(r64) :: convTol=0.0001d0
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! FUNCTION LOCAL VARIABLE DECLARATIONS:
LOGICAL FlagError ! set when errors should be flagged
REAL(r64),SAVE:: Press_Save=-99999.d0
REAL(r64),SAVE:: tSat_Save =-99999.d0
REAL(r64):: tSat ! Water temperature guess
REAL(r64):: pSat ! Pressure corresponding to temp. guess
REAL(r64):: error ! Deviation of dependent variable in iteration
REAL(r64):: X1 ! Previous value of independent variable in ITERATE
REAL(r64):: Y1 ! Previous value of dependent variable in ITERATE
REAL(r64):: ResultX ! ResultX is the final Iteration result passed back to the calling routine
Integer :: iter ! Iteration counter
Integer :: icvg ! Iteration convergence flag
# 2599
! Check press in range.
FlagError=.false.
IF (Press <= 0.0017d0 .or. Press >= 1555000.d0) THEN
IF (.not. WarmupFlag) THEN
IF (iPsyErrIndex(iPsyTsatFnPb) == 0) THEN
CALL ShowWarningMessage('Pressure out of range (PsyTsatFnPb)')
if (present(calledfrom)) then
CALL ShowContinueErrorTimeStamp(' Routine='//trim(calledfrom)//',')
else
CALL ShowContinueErrorTimeStamp(' Routine=Unknown,')
endif
CALL ShowContinueError(' Input Pressure= '//TRIM(TrimSigDigits(Press,2)))
FlagError=.true.
ENDIF
CALL ShowRecurringWarningErrorAtEnd('Pressure out of range (PsyTsatFnPb)', &
iPsyErrIndex(iPsyTsatFnPb),ReportMinOf=Press,ReportMaxOf=Press,ReportMinUnits='Pa',ReportMaxUnits='Pa')
ENDIF
ENDIF
IF (Press == Press_save) THEN
Temp=tSat_Save
RETURN
ENDIF
Press_save=Press
! Uses an iterative process to determine the saturation temperature at a given
! pressure by correlating saturated water vapor as a function of temperature.
! Initial guess of boiling temperature
tSat = 100.0d0
iter = 0
! If above 1555000,set value of Temp corresponding to Saturation Pressure of 1555000 Pascal.
IF (Press>= 1555000.d0)Then
tSat= 200.0d0
! If below 0.0017,set value of Temp corresponding to Saturation Pressure of 0.0017 Pascal.
Else IF(Press<=0.0017d0)Then
tSat= -100.0d0
! Setting Value of PsyTsatFnPb= 0C, due to non-continuous function for Saturation Pressure at 0C.
Else IF((Press > 611.000d0) .and. (Press < 611.25d0))Then
tSat= 0.0d0
Else
! Iterate to find the saturation temperature
! of water given the total pressure
! Set iteration loop parameters
! make sure these are initialized
DO iter = 1,itmax
! Calculate saturation pressure for estimated boiling temperature
IF (PRESENT(calledfrom)) THEN
pSat = PsyPsatFnTemp(tSat,calledfrom)
ELSE
pSat = PsyPsatFnTemp(tSat,'PsyTsatFnPb')
ENDIF
!Compare with specified pressure and update estimate of temperature
error = Press - pSat
Call ITERATE (ResultX,convTol,tSat,error,X1,Y1,iter,icvg)
tSat = ResultX
!If converged leave loop iteration
IF (icvg .EQ. 1) Exit
! Water temperature not converged, repeat calculations with new
! estimate of water temperature
End Do
! Saturation temperature has not converged after maximum specified
! iterations. Print error message, set return error flag, and RETURN
End IF !End If for the Pressure Range Checking
# 2679
IF (iter > itmax) THEN
IF (.not. WarmupFlag) THEN
IF (iPsyErrIndex(iPsyTsatFnPb2) == 0) THEN
CALL ShowWarningMessage('Saturation Temperature not converged after '//TRIM(TrimSigDigits(iter))// &
' iterations (PsyTsatFnPb)')
if (present(calledfrom)) then
CALL ShowContinueErrorTimeStamp(' Routine='//trim(calledfrom)//',')
else
CALL ShowContinueErrorTimeStamp(' Routine=Unknown,')
endif
CALL ShowContinueError(' Input Pressure= '//TRIM(TrimSigDigits(Press,2)))
FlagError=.true.
ENDIF
CALL ShowRecurringWarningErrorAtEnd('Saturation Temperature not converged after max iterations (PsyTsatFnPb)', &
iPsyErrIndex(iPsyTsatFnPb2),ReportMinOf=tSat,ReportMaxOf=tSat,ReportMinUnits='C',ReportMaxUnits='C')
ENDIF
ENDIF
! Result is SatTemperature
Temp = tSat
tSat_Save=tSat
IF (FlagError) THEN
CALL ShowContinueError(' Resultant Temperature= '//TRIM(TrimSigDigits(Temp,2)))
ENDIF
RETURN
END FUNCTION PsyTsatFnPb