/wrfv2_fire/phys/module_gfs_funcphys.F
FORTRAN Legacy | 2935 lines | 838 code | 0 blank | 2097 comment | 10 complexity | 517cea571067e7bd1bea44ea1624eb52 MD5 | raw file
Possible License(s): AGPL-1.0
Large files files are truncated, but you can click here to view the full file
- !-------------------------------------------------------------------------------
- module module_gfs_funcphys
- !$$$ Module Documentation Block
- !
- ! Module: funcphys API for basic thermodynamic physics
- ! Author: Iredell Org: W/NX23 Date: 1999-03-01
- !
- ! Abstract: This module provides an Application Program Interface
- ! for computing basic thermodynamic physics functions, in particular
- ! (1) saturation vapor pressure as a function of temperature,
- ! (2) dewpoint temperature as a function of vapor pressure,
- ! (3) equivalent potential temperature as a function of temperature
- ! and scaled pressure to the kappa power,
- ! (4) temperature and specific humidity along a moist adiabat
- ! as functions of equivalent potential temperature and
- ! scaled pressure to the kappa power,
- ! (5) scaled pressure to the kappa power as a function of pressure, and
- ! (6) temperature at the lifting condensation level as a function
- ! of temperature and dewpoint depression.
- ! The entry points required to set up lookup tables start with a "g".
- ! All the other entry points are functions starting with an "f" or
- ! are subroutines starting with an "s". These other functions and
- ! subroutines are elemental; that is, they return a scalar if they
- ! are passed only scalars, but they return an array if they are passed
- ! an array. These other functions and subroutines can be inlined, too.
- !
- ! Program History Log:
- ! 1999-03-01 Mark Iredell
- ! 1999-10-15 Mark Iredell SI unit for pressure (Pascals)
- ! 2001-02-26 Mark Iredell Ice phase changes of Hong and Moorthi
- !
- ! Public Variables:
- ! krealfp Integer parameter kind or length of reals (=kind_phys)
- !
- ! Public Subprograms:
- ! gpvsl Compute saturation vapor pressure over liquid table
- !
- ! fpvsl Elementally compute saturation vapor pressure over liquid
- ! function result Real(krealfp) saturation vapor pressure in Pascals
- ! t Real(krealfp) temperature in Kelvin
- !
- ! fpvslq Elementally compute saturation vapor pressure over liquid
- ! function result Real(krealfp) saturation vapor pressure in Pascals
- ! t Real(krealfp) temperature in Kelvin
- !
- ! fpvslx Elementally compute saturation vapor pressure over liquid
- ! function result Real(krealfp) saturation vapor pressure in Pascals
- ! t Real(krealfp) temperature in Kelvin
- !
- ! gpvsi Compute saturation vapor pressure over ice table
- !
- ! fpvsi Elementally compute saturation vapor pressure over ice
- ! function result Real(krealfp) saturation vapor pressure in Pascals
- ! t Real(krealfp) temperature in Kelvin
- !
- ! fpvsiq Elementally compute saturation vapor pressure over ice
- ! function result Real(krealfp) saturation vapor pressure in Pascals
- ! t Real(krealfp) temperature in Kelvin
- !
- ! fpvsix Elementally compute saturation vapor pressure over ice
- ! function result Real(krealfp) saturation vapor pressure in Pascals
- ! t Real(krealfp) temperature in Kelvin
- !
- ! gpvs Compute saturation vapor pressure table
- !
- ! fpvs Elementally compute saturation vapor pressure
- ! function result Real(krealfp) saturation vapor pressure in Pascals
- ! t Real(krealfp) temperature in Kelvin
- !
- ! fpvsq Elementally compute saturation vapor pressure
- ! function result Real(krealfp) saturation vapor pressure in Pascals
- ! t Real(krealfp) temperature in Kelvin
- !
- ! fpvsx Elementally compute saturation vapor pressure
- ! function result Real(krealfp) saturation vapor pressure in Pascals
- ! t Real(krealfp) temperature in Kelvin
- !
- ! gtdpl Compute dewpoint temperature over liquid table
- !
- ! ftdpl Elementally compute dewpoint temperature over liquid
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! ftdplq Elementally compute dewpoint temperature over liquid
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! ftdplx Elementally compute dewpoint temperature over liquid
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! ftdplxg Elementally compute dewpoint temperature over liquid
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! t Real(krealfp) guess dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! gtdpi Compute dewpoint temperature table over ice
- !
- ! ftdpi Elementally compute dewpoint temperature over ice
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! ftdpiq Elementally compute dewpoint temperature over ice
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! ftdpix Elementally compute dewpoint temperature over ice
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! ftdpixg Elementally compute dewpoint temperature over ice
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! t Real(krealfp) guess dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! gtdp Compute dewpoint temperature table
- !
- ! ftdp Elementally compute dewpoint temperature
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! ftdpq Elementally compute dewpoint temperature
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! ftdpx Elementally compute dewpoint temperature
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! ftdpxg Elementally compute dewpoint temperature
- ! function result Real(krealfp) dewpoint temperature in Kelvin
- ! t Real(krealfp) guess dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! gthe Compute equivalent potential temperature table
- !
- ! fthe Elementally compute equivalent potential temperature
- ! function result Real(krealfp) equivalent potential temperature in Kelvin
- ! t Real(krealfp) LCL temperature in Kelvin
- ! pk Real(krealfp) LCL pressure over 1e5 Pa to the kappa power
- !
- ! ftheq Elementally compute equivalent potential temperature
- ! function result Real(krealfp) equivalent potential temperature in Kelvin
- ! t Real(krealfp) LCL temperature in Kelvin
- ! pk Real(krealfp) LCL pressure over 1e5 Pa to the kappa power
- !
- ! fthex Elementally compute equivalent potential temperature
- ! function result Real(krealfp) equivalent potential temperature in Kelvin
- ! t Real(krealfp) LCL temperature in Kelvin
- ! pk Real(krealfp) LCL pressure over 1e5 Pa to the kappa power
- !
- ! gtma Compute moist adiabat tables
- !
- ! stma Elementally compute moist adiabat temperature and moisture
- ! the Real(krealfp) equivalent potential temperature in Kelvin
- ! pk Real(krealfp) pressure over 1e5 Pa to the kappa power
- ! tma Real(krealfp) parcel temperature in Kelvin
- ! qma Real(krealfp) parcel specific humidity in kg/kg
- !
- ! stmaq Elementally compute moist adiabat temperature and moisture
- ! the Real(krealfp) equivalent potential temperature in Kelvin
- ! pk Real(krealfp) pressure over 1e5 Pa to the kappa power
- ! tma Real(krealfp) parcel temperature in Kelvin
- ! qma Real(krealfp) parcel specific humidity in kg/kg
- !
- ! stmax Elementally compute moist adiabat temperature and moisture
- ! the Real(krealfp) equivalent potential temperature in Kelvin
- ! pk Real(krealfp) pressure over 1e5 Pa to the kappa power
- ! tma Real(krealfp) parcel temperature in Kelvin
- ! qma Real(krealfp) parcel specific humidity in kg/kg
- !
- ! stmaxg Elementally compute moist adiabat temperature and moisture
- ! tg Real(krealfp) guess parcel temperature in Kelvin
- ! the Real(krealfp) equivalent potential temperature in Kelvin
- ! pk Real(krealfp) pressure over 1e5 Pa to the kappa power
- ! tma Real(krealfp) parcel temperature in Kelvin
- ! qma Real(krealfp) parcel specific humidity in kg/kg
- !
- ! gpkap Compute pressure to the kappa table
- !
- ! fpkap Elementally raise pressure to the kappa power.
- ! function result Real(krealfp) p over 1e5 Pa to the kappa power
- ! p Real(krealfp) pressure in Pascals
- !
- ! fpkapq Elementally raise pressure to the kappa power.
- ! function result Real(krealfp) p over 1e5 Pa to the kappa power
- ! p Real(krealfp) pressure in Pascals
- !
- ! fpkapo Elementally raise pressure to the kappa power.
- ! function result Real(krealfp) p over 1e5 Pa to the kappa power
- ! p Real(krealfp) surface pressure in Pascals
- !
- ! fpkapx Elementally raise pressure to the kappa power.
- ! function result Real(krealfp) p over 1e5 Pa to the kappa power
- ! p Real(krealfp) pressure in Pascals
- !
- ! grkap Compute pressure to the 1/kappa table
- !
- ! frkap Elementally raise pressure to the 1/kappa power.
- ! function result Real(krealfp) pressure in Pascals
- ! pkap Real(krealfp) p over 1e5 Pa to the 1/kappa power
- !
- ! frkapq Elementally raise pressure to the kappa power.
- ! function result Real(krealfp) pressure in Pascals
- ! pkap Real(krealfp) p over 1e5 Pa to the kappa power
- !
- ! frkapx Elementally raise pressure to the kappa power.
- ! function result Real(krealfp) pressure in Pascals
- ! pkap Real(krealfp) p over 1e5 Pa to the kappa power
- !
- ! gtlcl Compute LCL temperature table
- !
- ! ftlcl Elementally compute LCL temperature.
- ! function result Real(krealfp) temperature at the LCL in Kelvin
- ! t Real(krealfp) temperature in Kelvin
- ! tdpd Real(krealfp) dewpoint depression in Kelvin
- !
- ! ftlclq Elementally compute LCL temperature.
- ! function result Real(krealfp) temperature at the LCL in Kelvin
- ! t Real(krealfp) temperature in Kelvin
- ! tdpd Real(krealfp) dewpoint depression in Kelvin
- !
- ! ftlclo Elementally compute LCL temperature.
- ! function result Real(krealfp) temperature at the LCL in Kelvin
- ! t Real(krealfp) temperature in Kelvin
- ! tdpd Real(krealfp) dewpoint depression in Kelvin
- !
- ! ftlclx Elementally compute LCL temperature.
- ! function result Real(krealfp) temperature at the LCL in Kelvin
- ! t Real(krealfp) temperature in Kelvin
- ! tdpd Real(krealfp) dewpoint depression in Kelvin
- !
- ! gfuncphys Compute all physics function tables
- !
- ! Attributes:
- ! Language: Fortran 90
- !
- !$$$
- use module_gfs_machine,only:kind_phys
- use module_gfs_physcons
- implicit none
- private
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- ! Public Variables
- ! integer,public,parameter:: krealfp=selected_real_kind(15,45)
- integer,public,parameter:: krealfp=kind_phys
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- ! Private Variables
- real(krealfp),parameter:: psatb=con_psat*1.e-5
- integer,parameter:: nxpvsl=7501
- real(krealfp) c1xpvsl,c2xpvsl,tbpvsl(nxpvsl)
- integer,parameter:: nxpvsi=7501
- real(krealfp) c1xpvsi,c2xpvsi,tbpvsi(nxpvsi)
- integer,parameter:: nxpvs=7501
- real(krealfp) c1xpvs,c2xpvs,tbpvs(nxpvs)
- integer,parameter:: nxtdpl=5001
- real(krealfp) c1xtdpl,c2xtdpl,tbtdpl(nxtdpl)
- integer,parameter:: nxtdpi=5001
- real(krealfp) c1xtdpi,c2xtdpi,tbtdpi(nxtdpi)
- integer,parameter:: nxtdp=5001
- real(krealfp) c1xtdp,c2xtdp,tbtdp(nxtdp)
- integer,parameter:: nxthe=241,nythe=151
- real(krealfp) c1xthe,c2xthe,c1ythe,c2ythe,tbthe(nxthe,nythe)
- integer,parameter:: nxma=151,nyma=121
- real(krealfp) c1xma,c2xma,c1yma,c2yma,tbtma(nxma,nyma),tbqma(nxma,nyma)
- ! integer,parameter:: nxpkap=5501
- integer,parameter:: nxpkap=11001
- real(krealfp) c1xpkap,c2xpkap,tbpkap(nxpkap)
- integer,parameter:: nxrkap=5501
- real(krealfp) c1xrkap,c2xrkap,tbrkap(nxrkap)
- integer,parameter:: nxtlcl=151,nytlcl=61
- real(krealfp) c1xtlcl,c2xtlcl,c1ytlcl,c2ytlcl,tbtlcl(nxtlcl,nytlcl)
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- ! Public Subprograms
- public gpvsl,fpvsl,fpvslq,fpvslx
- public gpvsi,fpvsi,fpvsiq,fpvsix
- public gpvs,fpvs,fpvsq,fpvsx
- public gtdpl,ftdpl,ftdplq,ftdplx,ftdplxg
- public gtdpi,ftdpi,ftdpiq,ftdpix,ftdpixg
- public gtdp,ftdp,ftdpq,ftdpx,ftdpxg
- public gthe,fthe,ftheq,fthex
- public gtma,stma,stmaq,stmax,stmaxg
- public gpkap,fpkap,fpkapq,fpkapo,fpkapx
- public grkap,frkap,frkapq,frkapx
- public gtlcl,ftlcl,ftlclq,ftlclo,ftlclx
- public gfuncphys
- contains
- !-------------------------------------------------------------------------------
- subroutine gpvsl
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: gpvsl Compute saturation vapor pressure table over liquid
- ! Author: N Phillips W/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Computes saturation vapor pressure table as a function of
- ! temperature for the table lookup function fpvsl.
- ! Exact saturation vapor pressures are calculated in subprogram fpvslx.
- ! The current implementation computes a table with a length
- ! of 7501 for temperatures ranging from 180. to 330. Kelvin.
- !
- ! Program History Log:
- ! 91-05-07 Iredell
- ! 94-12-30 Iredell expand table
- ! 1999-03-01 Iredell f90 module
- !
- ! Usage: call gpvsl
- !
- ! Subprograms called:
- ! (fpvslx) inlinable function to compute saturation vapor pressure
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- integer jx
- real(krealfp) xmin,xmax,xinc,x,t
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xmin=180.0_krealfp
- xmax=330.0_krealfp
- xinc=(xmax-xmin)/(nxpvsl-1)
- ! c1xpvsl=1.-xmin/xinc
- c2xpvsl=1./xinc
- c1xpvsl=1.-xmin*c2xpvsl
- do jx=1,nxpvsl
- x=xmin+(jx-1)*xinc
- t=x
- tbpvsl(jx)=fpvslx(t)
- enddo
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end subroutine
- !-------------------------------------------------------------------------------
- ! elemental function fpvsl(t)
- function fpvsl(t)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: fpvsl Compute saturation vapor pressure over liquid
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute saturation vapor pressure from the temperature.
- ! A linear interpolation is done between values in a lookup table
- ! computed in gpvsl. See documentation for fpvslx for details.
- ! Input values outside table range are reset to table extrema.
- ! The interpolation accuracy is almost 6 decimal places.
- ! On the Cray, fpvsl is about 4 times faster than exact calculation.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell expand table
- ! 1999-03-01 Iredell f90 module
- !
- ! Usage: pvsl=fpvsl(t)
- !
- ! Input argument list:
- ! t Real(krealfp) temperature in Kelvin
- !
- ! Output argument list:
- ! fpvsl Real(krealfp) saturation vapor pressure in Pascals
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) fpvsl
- real(krealfp),intent(in):: t
- integer jx
- real(krealfp) xj
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xj=min(max(c1xpvsl+c2xpvsl*t,1._krealfp),real(nxpvsl,krealfp))
- jx=min(xj,nxpvsl-1._krealfp)
- fpvsl=tbpvsl(jx)+(xj-jx)*(tbpvsl(jx+1)-tbpvsl(jx))
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function fpvslq(t)
- function fpvslq(t)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: fpvslq Compute saturation vapor pressure over liquid
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute saturation vapor pressure from the temperature.
- ! A quadratic interpolation is done between values in a lookup table
- ! computed in gpvsl. See documentation for fpvslx for details.
- ! Input values outside table range are reset to table extrema.
- ! The interpolation accuracy is almost 9 decimal places.
- ! On the Cray, fpvslq is about 3 times faster than exact calculation.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell quadratic interpolation
- ! 1999-03-01 Iredell f90 module
- !
- ! Usage: pvsl=fpvslq(t)
- !
- ! Input argument list:
- ! t Real(krealfp) temperature in Kelvin
- !
- ! Output argument list:
- ! fpvslq Real(krealfp) saturation vapor pressure in Pascals
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) fpvslq
- real(krealfp),intent(in):: t
- integer jx
- real(krealfp) xj,dxj,fj1,fj2,fj3
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xj=min(max(c1xpvsl+c2xpvsl*t,1._krealfp),real(nxpvsl,krealfp))
- jx=min(max(nint(xj),2),nxpvsl-1)
- dxj=xj-jx
- fj1=tbpvsl(jx-1)
- fj2=tbpvsl(jx)
- fj3=tbpvsl(jx+1)
- fpvslq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function fpvslx(t)
- function fpvslx(t)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: fpvslx Compute saturation vapor pressure over liquid
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Exactly compute saturation vapor pressure from temperature.
- ! The water model assumes a perfect gas, constant specific heats
- ! for gas and liquid, and neglects the volume of the liquid.
- ! The model does account for the variation of the latent heat
- ! of condensation with temperature. The ice option is not included.
- ! The Clausius-Clapeyron equation is integrated from the triple point
- ! to get the formula
- ! pvsl=con_psat*(tr**xa)*exp(xb*(1.-tr))
- ! where tr is ttp/t and other values are physical constants.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell exact computation
- ! 1999-03-01 Iredell f90 module
- !
- ! Usage: pvsl=fpvslx(t)
- !
- ! Input argument list:
- ! t Real(krealfp) temperature in Kelvin
- !
- ! Output argument list:
- ! fpvslx Real(krealfp) saturation vapor pressure in Pascals
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) fpvslx
- real(krealfp),intent(in):: t
- real(krealfp),parameter:: dldt=con_cvap-con_cliq
- real(krealfp),parameter:: heat=con_hvap
- real(krealfp),parameter:: xpona=-dldt/con_rv
- real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp)
- real(krealfp) tr
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- tr=con_ttp/t
- fpvslx=con_psat*(tr**xpona)*exp(xponb*(1.-tr))
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- subroutine gpvsi
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: gpvsi Compute saturation vapor pressure table over ice
- ! Author: N Phillips W/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Computes saturation vapor pressure table as a function of
- ! temperature for the table lookup function fpvsi.
- ! Exact saturation vapor pressures are calculated in subprogram fpvsix.
- ! The current implementation computes a table with a length
- ! of 7501 for temperatures ranging from 180. to 330. Kelvin.
- !
- ! Program History Log:
- ! 91-05-07 Iredell
- ! 94-12-30 Iredell expand table
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: call gpvsi
- !
- ! Subprograms called:
- ! (fpvsix) inlinable function to compute saturation vapor pressure
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- integer jx
- real(krealfp) xmin,xmax,xinc,x,t
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xmin=180.0_krealfp
- xmax=330.0_krealfp
- xinc=(xmax-xmin)/(nxpvsi-1)
- ! c1xpvsi=1.-xmin/xinc
- c2xpvsi=1./xinc
- c1xpvsi=1.-xmin*c2xpvsi
- do jx=1,nxpvsi
- x=xmin+(jx-1)*xinc
- t=x
- tbpvsi(jx)=fpvsix(t)
- enddo
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end subroutine
- !-------------------------------------------------------------------------------
- ! elemental function fpvsi(t)
- function fpvsi(t)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: fpvsi Compute saturation vapor pressure over ice
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute saturation vapor pressure from the temperature.
- ! A linear interpolation is done between values in a lookup table
- ! computed in gpvsi. See documentation for fpvsix for details.
- ! Input values outside table range are reset to table extrema.
- ! The interpolation accuracy is almost 6 decimal places.
- ! On the Cray, fpvsi is about 4 times faster than exact calculation.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell expand table
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: pvsi=fpvsi(t)
- !
- ! Input argument list:
- ! t Real(krealfp) temperature in Kelvin
- !
- ! Output argument list:
- ! fpvsi Real(krealfp) saturation vapor pressure in Pascals
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) fpvsi
- real(krealfp),intent(in):: t
- integer jx
- real(krealfp) xj
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xj=min(max(c1xpvsi+c2xpvsi*t,1._krealfp),real(nxpvsi,krealfp))
- jx=min(xj,nxpvsi-1._krealfp)
- fpvsi=tbpvsi(jx)+(xj-jx)*(tbpvsi(jx+1)-tbpvsi(jx))
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function fpvsiq(t)
- function fpvsiq(t)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: fpvsiq Compute saturation vapor pressure over ice
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute saturation vapor pressure from the temperature.
- ! A quadratic interpolation is done between values in a lookup table
- ! computed in gpvsi. See documentation for fpvsix for details.
- ! Input values outside table range are reset to table extrema.
- ! The interpolation accuracy is almost 9 decimal places.
- ! On the Cray, fpvsiq is about 3 times faster than exact calculation.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell quadratic interpolation
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: pvsi=fpvsiq(t)
- !
- ! Input argument list:
- ! t Real(krealfp) temperature in Kelvin
- !
- ! Output argument list:
- ! fpvsiq Real(krealfp) saturation vapor pressure in Pascals
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) fpvsiq
- real(krealfp),intent(in):: t
- integer jx
- real(krealfp) xj,dxj,fj1,fj2,fj3
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xj=min(max(c1xpvsi+c2xpvsi*t,1._krealfp),real(nxpvsi,krealfp))
- jx=min(max(nint(xj),2),nxpvsi-1)
- dxj=xj-jx
- fj1=tbpvsi(jx-1)
- fj2=tbpvsi(jx)
- fj3=tbpvsi(jx+1)
- fpvsiq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function fpvsix(t)
- function fpvsix(t)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: fpvsix Compute saturation vapor pressure over ice
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Exactly compute saturation vapor pressure from temperature.
- ! The water model assumes a perfect gas, constant specific heats
- ! for gas and ice, and neglects the volume of the ice.
- ! The model does account for the variation of the latent heat
- ! of condensation with temperature. The liquid option is not included.
- ! The Clausius-Clapeyron equation is integrated from the triple point
- ! to get the formula
- ! pvsi=con_psat*(tr**xa)*exp(xb*(1.-tr))
- ! where tr is ttp/t and other values are physical constants.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell exact computation
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: pvsi=fpvsix(t)
- !
- ! Input argument list:
- ! t Real(krealfp) temperature in Kelvin
- !
- ! Output argument list:
- ! fpvsix Real(krealfp) saturation vapor pressure in Pascals
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) fpvsix
- real(krealfp),intent(in):: t
- real(krealfp),parameter:: dldt=con_cvap-con_csol
- real(krealfp),parameter:: heat=con_hvap+con_hfus
- real(krealfp),parameter:: xpona=-dldt/con_rv
- real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp)
- real(krealfp) tr
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- tr=con_ttp/t
- fpvsix=con_psat*(tr**xpona)*exp(xponb*(1.-tr))
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- subroutine gpvs
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: gpvs Compute saturation vapor pressure table
- ! Author: N Phillips W/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Computes saturation vapor pressure table as a function of
- ! temperature for the table lookup function fpvs.
- ! Exact saturation vapor pressures are calculated in subprogram fpvsx.
- ! The current implementation computes a table with a length
- ! of 7501 for temperatures ranging from 180. to 330. Kelvin.
- !
- ! Program History Log:
- ! 91-05-07 Iredell
- ! 94-12-30 Iredell expand table
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: call gpvs
- !
- ! Subprograms called:
- ! (fpvsx) inlinable function to compute saturation vapor pressure
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- integer jx
- real(krealfp) xmin,xmax,xinc,x,t
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xmin=180.0_krealfp
- xmax=330.0_krealfp
- xinc=(xmax-xmin)/(nxpvs-1)
- ! c1xpvs=1.-xmin/xinc
- c2xpvs=1./xinc
- c1xpvs=1.-xmin*c2xpvs
- do jx=1,nxpvs
- x=xmin+(jx-1)*xinc
- t=x
- tbpvs(jx)=fpvsx(t)
- enddo
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end subroutine
- !-------------------------------------------------------------------------------
- ! elemental function fpvs(t)
- function fpvs(t)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: fpvs Compute saturation vapor pressure
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute saturation vapor pressure from the temperature.
- ! A linear interpolation is done between values in a lookup table
- ! computed in gpvs. See documentation for fpvsx for details.
- ! Input values outside table range are reset to table extrema.
- ! The interpolation accuracy is almost 6 decimal places.
- ! On the Cray, fpvs is about 4 times faster than exact calculation.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell expand table
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: pvs=fpvs(t)
- !
- ! Input argument list:
- ! t Real(krealfp) temperature in Kelvin
- !
- ! Output argument list:
- ! fpvs Real(krealfp) saturation vapor pressure in Pascals
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) fpvs
- real(krealfp),intent(in):: t
- integer jx
- real(krealfp) xj
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xj=min(max(c1xpvs+c2xpvs*t,1._krealfp),real(nxpvs,krealfp))
- jx=min(xj,nxpvs-1._krealfp)
- fpvs=tbpvs(jx)+(xj-jx)*(tbpvs(jx+1)-tbpvs(jx))
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function fpvsq(t)
- function fpvsq(t)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: fpvsq Compute saturation vapor pressure
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute saturation vapor pressure from the temperature.
- ! A quadratic interpolation is done between values in a lookup table
- ! computed in gpvs. See documentation for fpvsx for details.
- ! Input values outside table range are reset to table extrema.
- ! The interpolation accuracy is almost 9 decimal places.
- ! On the Cray, fpvsq is about 3 times faster than exact calculation.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell quadratic interpolation
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: pvs=fpvsq(t)
- !
- ! Input argument list:
- ! t Real(krealfp) temperature in Kelvin
- !
- ! Output argument list:
- ! fpvsq Real(krealfp) saturation vapor pressure in Pascals
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) fpvsq
- real(krealfp),intent(in):: t
- integer jx
- real(krealfp) xj,dxj,fj1,fj2,fj3
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xj=min(max(c1xpvs+c2xpvs*t,1._krealfp),real(nxpvs,krealfp))
- jx=min(max(nint(xj),2),nxpvs-1)
- dxj=xj-jx
- fj1=tbpvs(jx-1)
- fj2=tbpvs(jx)
- fj3=tbpvs(jx+1)
- fpvsq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function fpvsx(t)
- function fpvsx(t)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: fpvsx Compute saturation vapor pressure
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Exactly compute saturation vapor pressure from temperature.
- ! The saturation vapor pressure over either liquid and ice is computed
- ! over liquid for temperatures above the triple point,
- ! over ice for temperatures 20 degress below the triple point,
- ! and a linear combination of the two for temperatures in between.
- ! The water model assumes a perfect gas, constant specific heats
- ! for gas, liquid and ice, and neglects the volume of the condensate.
- ! The model does account for the variation of the latent heat
- ! of condensation and sublimation with temperature.
- ! The Clausius-Clapeyron equation is integrated from the triple point
- ! to get the formula
- ! pvsl=con_psat*(tr**xa)*exp(xb*(1.-tr))
- ! where tr is ttp/t and other values are physical constants.
- ! The reference for this computation is Emanuel(1994), pages 116-117.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell exact computation
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: pvs=fpvsx(t)
- !
- ! Input argument list:
- ! t Real(krealfp) temperature in Kelvin
- !
- ! Output argument list:
- ! fpvsx Real(krealfp) saturation vapor pressure in Pascals
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) fpvsx
- real(krealfp),intent(in):: t
- real(krealfp),parameter:: tliq=con_ttp
- real(krealfp),parameter:: tice=con_ttp-20.0
- real(krealfp),parameter:: dldtl=con_cvap-con_cliq
- real(krealfp),parameter:: heatl=con_hvap
- real(krealfp),parameter:: xponal=-dldtl/con_rv
- real(krealfp),parameter:: xponbl=-dldtl/con_rv+heatl/(con_rv*con_ttp)
- real(krealfp),parameter:: dldti=con_cvap-con_csol
- real(krealfp),parameter:: heati=con_hvap+con_hfus
- real(krealfp),parameter:: xponai=-dldti/con_rv
- real(krealfp),parameter:: xponbi=-dldti/con_rv+heati/(con_rv*con_ttp)
- real(krealfp) tr,w,pvl,pvi
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- tr=con_ttp/t
- if(t.ge.tliq) then
- fpvsx=con_psat*(tr**xponal)*exp(xponbl*(1.-tr))
- elseif(t.lt.tice) then
- fpvsx=con_psat*(tr**xponai)*exp(xponbi*(1.-tr))
- else
- w=(t-tice)/(tliq-tice)
- pvl=con_psat*(tr**xponal)*exp(xponbl*(1.-tr))
- pvi=con_psat*(tr**xponai)*exp(xponbi*(1.-tr))
- fpvsx=w*pvl+(1.-w)*pvi
- endif
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- subroutine gtdpl
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: gtdpl Compute dewpoint temperature over liquid table
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute dewpoint temperature table as a function of
- ! vapor pressure for inlinable function ftdpl.
- ! Exact dewpoint temperatures are calculated in subprogram ftdplxg.
- ! The current implementation computes a table with a length
- ! of 5001 for vapor pressures ranging from 1 to 10001 Pascals
- ! giving a dewpoint temperature range of 208 to 319 Kelvin.
- !
- ! Program History Log:
- ! 91-05-07 Iredell
- ! 94-12-30 Iredell expand table
- ! 1999-03-01 Iredell f90 module
- !
- ! Usage: call gtdpl
- !
- ! Subprograms called:
- ! (ftdplxg) inlinable function to compute dewpoint temperature over liquid
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- integer jx
- real(krealfp) xmin,xmax,xinc,t,x,pv
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xmin=1
- xmax=10001
- xinc=(xmax-xmin)/(nxtdpl-1)
- c1xtdpl=1.-xmin/xinc
- c2xtdpl=1./xinc
- t=208.0
- do jx=1,nxtdpl
- x=xmin+(jx-1)*xinc
- pv=x
- t=ftdplxg(t,pv)
- tbtdpl(jx)=t
- enddo
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end subroutine
- !-------------------------------------------------------------------------------
- ! elemental function ftdpl(pv)
- function ftdpl(pv)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: ftdpl Compute dewpoint temperature over liquid
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute dewpoint temperature from vapor pressure.
- ! A linear interpolation is done between values in a lookup table
- ! computed in gtdpl. See documentation for ftdplxg for details.
- ! Input values outside table range are reset to table extrema.
- ! The interpolation accuracy is better than 0.0005 Kelvin
- ! for dewpoint temperatures greater than 250 Kelvin,
- ! but decreases to 0.02 Kelvin for a dewpoint around 230 Kelvin.
- ! On the Cray, ftdpl is about 75 times faster than exact calculation.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell expand table
- ! 1999-03-01 Iredell f90 module
- !
- ! Usage: tdpl=ftdpl(pv)
- !
- ! Input argument list:
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! Output argument list:
- ! ftdpl Real(krealfp) dewpoint temperature in Kelvin
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) ftdpl
- real(krealfp),intent(in):: pv
- integer jx
- real(krealfp) xj
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xj=min(max(c1xtdpl+c2xtdpl*pv,1._krealfp),real(nxtdpl,krealfp))
- jx=min(xj,nxtdpl-1._krealfp)
- ftdpl=tbtdpl(jx)+(xj-jx)*(tbtdpl(jx+1)-tbtdpl(jx))
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function ftdplq(pv)
- function ftdplq(pv)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: ftdplq Compute dewpoint temperature over liquid
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute dewpoint temperature from vapor pressure.
- ! A quadratic interpolation is done between values in a lookup table
- ! computed in gtdpl. see documentation for ftdplxg for details.
- ! Input values outside table range are reset to table extrema.
- ! the interpolation accuracy is better than 0.00001 Kelvin
- ! for dewpoint temperatures greater than 250 Kelvin,
- ! but decreases to 0.002 Kelvin for a dewpoint around 230 Kelvin.
- ! On the Cray, ftdplq is about 60 times faster than exact calculation.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell quadratic interpolation
- ! 1999-03-01 Iredell f90 module
- !
- ! Usage: tdpl=ftdplq(pv)
- !
- ! Input argument list:
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! Output argument list:
- ! ftdplq Real(krealfp) dewpoint temperature in Kelvin
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) ftdplq
- real(krealfp),intent(in):: pv
- integer jx
- real(krealfp) xj,dxj,fj1,fj2,fj3
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xj=min(max(c1xtdpl+c2xtdpl*pv,1._krealfp),real(nxtdpl,krealfp))
- jx=min(max(nint(xj),2),nxtdpl-1)
- dxj=xj-jx
- fj1=tbtdpl(jx-1)
- fj2=tbtdpl(jx)
- fj3=tbtdpl(jx+1)
- ftdplq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function ftdplx(pv)
- function ftdplx(pv)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: ftdplx Compute dewpoint temperature over liquid
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: exactly compute dewpoint temperature from vapor pressure.
- ! An approximate dewpoint temperature for function ftdplxg
- ! is obtained using ftdpl so gtdpl must be already called.
- ! See documentation for ftdplxg for details.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell exact computation
- ! 1999-03-01 Iredell f90 module
- !
- ! Usage: tdpl=ftdplx(pv)
- !
- ! Input argument list:
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! Output argument list:
- ! ftdplx Real(krealfp) dewpoint temperature in Kelvin
- !
- ! Subprograms called:
- ! (ftdpl) inlinable function to compute dewpoint temperature over liquid
- ! (ftdplxg) inlinable function to compute dewpoint temperature over liquid
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) ftdplx
- real(krealfp),intent(in):: pv
- real(krealfp) tg
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- tg=ftdpl(pv)
- ftdplx=ftdplxg(tg,pv)
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function ftdplxg(tg,pv)
- function ftdplxg(tg,pv)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: ftdplxg Compute dewpoint temperature over liquid
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Exactly compute dewpoint temperature from vapor pressure.
- ! A guess dewpoint temperature must be provided.
- ! The water model assumes a perfect gas, constant specific heats
- ! for gas and liquid, and neglects the volume of the liquid.
- ! The model does account for the variation of the latent heat
- ! of condensation with temperature. The ice option is not included.
- ! The Clausius-Clapeyron equation is integrated from the triple point
- ! to get the formula
- ! pvs=con_psat*(tr**xa)*exp(xb*(1.-tr))
- ! where tr is ttp/t and other values are physical constants.
- ! The formula is inverted by iterating Newtonian approximations
- ! for each pvs until t is found to within 1.e-6 Kelvin.
- ! This function can be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell exact computation
- ! 1999-03-01 Iredell f90 module
- !
- ! Usage: tdpl=ftdplxg(tg,pv)
- !
- ! Input argument list:
- ! tg Real(krealfp) guess dewpoint temperature in Kelvin
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! Output argument list:
- ! ftdplxg Real(krealfp) dewpoint temperature in Kelvin
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) ftdplxg
- real(krealfp),intent(in):: tg,pv
- real(krealfp),parameter:: terrm=1.e-6
- real(krealfp),parameter:: dldt=con_cvap-con_cliq
- real(krealfp),parameter:: heat=con_hvap
- real(krealfp),parameter:: xpona=-dldt/con_rv
- real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp)
- real(krealfp) t,tr,pvt,el,dpvt,terr
- integer i
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- t=tg
- do i=1,100
- tr=con_ttp/t
- pvt=con_psat*(tr**xpona)*exp(xponb*(1.-tr))
- el=heat+dldt*(t-con_ttp)
- dpvt=el*pvt/(con_rv*t**2)
- terr=(pvt-pv)/dpvt
- t=t-terr
- if(abs(terr).le.terrm) exit
- enddo
- ftdplxg=t
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- subroutine gtdpi
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: gtdpi Compute dewpoint temperature over ice table
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute dewpoint temperature table as a function of
- ! vapor pressure for inlinable function ftdpi.
- ! Exact dewpoint temperatures are calculated in subprogram ftdpixg.
- ! The current implementation computes a table with a length
- ! of 5001 for vapor pressures ranging from 0.1 to 1000.1 Pascals
- ! giving a dewpoint temperature range of 197 to 279 Kelvin.
- !
- ! Program History Log:
- ! 91-05-07 Iredell
- ! 94-12-30 Iredell expand table
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: call gtdpi
- !
- ! Subprograms called:
- ! (ftdpixg) inlinable function to compute dewpoint temperature over ice
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- integer jx
- real(krealfp) xmin,xmax,xinc,t,x,pv
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xmin=0.1
- xmax=1000.1
- xinc=(xmax-xmin)/(nxtdpi-1)
- c1xtdpi=1.-xmin/xinc
- c2xtdpi=1./xinc
- t=197.0
- do jx=1,nxtdpi
- x=xmin+(jx-1)*xinc
- pv=x
- t=ftdpixg(t,pv)
- tbtdpi(jx)=t
- enddo
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end subroutine
- !-------------------------------------------------------------------------------
- ! elemental function ftdpi(pv)
- function ftdpi(pv)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: ftdpi Compute dewpoint temperature over ice
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute dewpoint temperature from vapor pressure.
- ! A linear interpolation is done between values in a lookup table
- ! computed in gtdpi. See documentation for ftdpixg for details.
- ! Input values outside table range are reset to table extrema.
- ! The interpolation accuracy is better than 0.0005 Kelvin
- ! for dewpoint temperatures greater than 250 Kelvin,
- ! but decreases to 0.02 Kelvin for a dewpoint around 230 Kelvin.
- ! On the Cray, ftdpi is about 75 times faster than exact calculation.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell expand table
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: tdpi=ftdpi(pv)
- !
- ! Input argument list:
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! Output argument list:
- ! ftdpi Real(krealfp) dewpoint temperature in Kelvin
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) ftdpi
- real(krealfp),intent(in):: pv
- integer jx
- real(krealfp) xj
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xj=min(max(c1xtdpi+c2xtdpi*pv,1._krealfp),real(nxtdpi,krealfp))
- jx=min(xj,nxtdpi-1._krealfp)
- ftdpi=tbtdpi(jx)+(xj-jx)*(tbtdpi(jx+1)-tbtdpi(jx))
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function ftdpiq(pv)
- function ftdpiq(pv)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: ftdpiq Compute dewpoint temperature over ice
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: Compute dewpoint temperature from vapor pressure.
- ! A quadratic interpolation is done between values in a lookup table
- ! computed in gtdpi. see documentation for ftdpixg for details.
- ! Input values outside table range are reset to table extrema.
- ! the interpolation accuracy is better than 0.00001 Kelvin
- ! for dewpoint temperatures greater than 250 Kelvin,
- ! but decreases to 0.002 Kelvin for a dewpoint around 230 Kelvin.
- ! On the Cray, ftdpiq is about 60 times faster than exact calculation.
- ! This function should be expanded inline in the calling routine.
- !
- ! Program History Log:
- ! 91-05-07 Iredell made into inlinable function
- ! 94-12-30 Iredell quadratic interpolation
- ! 1999-03-01 Iredell f90 module
- ! 2001-02-26 Iredell ice phase
- !
- ! Usage: tdpi=ftdpiq(pv)
- !
- ! Input argument list:
- ! pv Real(krealfp) vapor pressure in Pascals
- !
- ! Output argument list:
- ! ftdpiq Real(krealfp) dewpoint temperature in Kelvin
- !
- ! Attributes:
- ! Language: Fortran 90.
- !
- !$$$
- implicit none
- real(krealfp) ftdpiq
- real(krealfp),intent(in):: pv
- integer jx
- real(krealfp) xj,dxj,fj1,fj2,fj3
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- xj=min(max(c1xtdpi+c2xtdpi*pv,1._krealfp),real(nxtdpi,krealfp))
- jx=min(max(nint(xj),2),nxtdpi-1)
- dxj=xj-jx
- fj1=tbtdpi(jx-1)
- fj2=tbtdpi(jx)
- fj3=tbtdpi(jx+1)
- ftdpiq=(((fj3+fj1)/2-fj2)*dxj+(fj3-fj1)/2)*dxj+fj2
- ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- end function
- !-------------------------------------------------------------------------------
- ! elemental function ftdpix(pv)
- function ftdpix(pv)
- !$$$ Subprogram Documentation Block
- !
- ! Subprogram: ftdpix Compute dewpoint temperature over ice
- ! Author: N Phillips w/NMC2X2 Date: 30 dec 82
- !
- ! Abstract: exactly compute dewpoint temperature from vapor pressure.
- ! An approximate dewpoint temperature for function ftdpixg
- ! is obtained using ftdpi so gtdpi must be already called.
- ! See documentation for ftdpixg for details.
- !
- ! Program History Log:
- ! 91-05-07 Iredell …
Large files files are truncated, but you can click here to view the full file