!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***s/r pnm2 - calculates MSL pressure
*
#include "model_macros_f.h"
*
subroutine pnm2( F_pnm, F_vts, F_fis, F_lnps, F_la, 1
% F_vtund, F_fiund, F_und,
% DIST_DIM, Nk)
*
#include "impnone.cdk"
*
integer DIST_DIM, Nk
*
real F_pnm(DIST_SHAPE), F_vts(DIST_SHAPE,Nk)
real F_fis(DIST_SHAPE,Nk)
real F_lnps(DIST_SHAPE,Nk), F_la (DIST_SHAPE)
*
integer F_und
real F_vtund(DIST_SHAPE,F_und),F_fiund(DIST_SHAPE,F_und)
*
*author
* andre methot - alain patoine - after pnm1
*
*revision
* v2_00 - Lee V. - initial MPI version (from pnm2 v1_03)
* v3_00 - Desgagne & Lee - Lam configuration
*
*object
*******************************************************************************
* *
* The hypsometric equation is used: *
* *
* / \ *
* | p | *
* _ | t | *
* fi - fi = - R T ln |----| (1) *
* t b d | p | *
* | b | *
* \ / *
* *
* Here the subscript t and b stand respectively for top and bottom of the *
* considered layer. *
* dT *
* We consider a constant temperature lapse rate --- = - L *
* _ dfi *
* (e.g. L = STLO) and use the definition of T: *
* *
* / \ *
* | fi - fi | *
* _ | t b | *
* T = - L |----------------| , (2) *
* | / T / \ | *
* | ln | t / T | | *
* | \ / b / | *
* \ / *
* *
* into expression (1) and get an expression for p : *
* b *
* *
* / / T / \ \ *
* | ln | b / T | | *
* | \ / t / | *
* p = p exp | -------------- | *
* b t | R L | *
* | d | *
* \ / *
* *
* In the case where L -> 0, we have to revert to expression (1) in which *
* _ *
* we use T = T . *
* t *
* *
* At points where we want to use underground temperatures for calculation, *
* we recursively compute the pressure at the bottom of each layer. *
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* *
* The temperature lapse rate in each virtual layer is either computed using *
* the provided temperatures or assumed to be the Shumman-Newel lapse rate *
* for the layer near ground except, when the temperatures exceeds given *
* critical values: *
* *
* T = 301.75 - lat / 4 *
* c *
* *
* If T is lower than T , the algorithm ensures that the bottom temperature *
* t c *
* is not greater than T . *
* c *
* Else, if T exceeds T , then the bottom temperature is set to: *
* t c *
* *
* 2 *
* T = T - 0.005 * ( T - T ) . *
* b c t c *
* *
*******************************************************************************
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_pnm O - MSL pressure
* F_vts I - surface virtual temperature
* F_fis I - surface geopotential height
* F_lnps I - surface log of hydrostatic pressure
* F_la I - geographical latitude (radian)
* F_vtund I - virtual temperatures for underground extrapolation
* F_fiund I - geopotential levels for which virtual temperature is
* given for underground extrapolation
* F_und I - number of virtual temperature levels for underground
* extrapolation
* = 0 if no underground temperature is used and the
* the traditional scheme will be used
*
*notes
* All fields in arguments are assumed to be workable on the same grid
* (fni x fnj). This grid could be the staggered or the non staggered.
*
* It is important that the data stored in F_vtund and F_fiund be ordered
* in the proper manner:
* F_vtund(i,j,1) and F_fiund(i,j,1) --> highest level
* F_vtund(i,j,2) and F_fiund(i,j,2) --> second highest level
* ......................................and so on
*
*implicits
#include "glb_ld.cdk"
#include "dcst.cdk"
*
*modules
* none
*
**
integer i, j, pnund, pn1
real prl, prvtc, prsmall
real prlptop, prvttop, prfitop
real prlpbot, prvtbot, prfibot
*
*
prsmall = .001
*
do 100 j= 1, l_nj
do 100 i= 1, l_ni
*
* calculation of critical temperature
* --------------------
*
prvtc = 301.75 - abs( (F_la(i,j) * 180.) / ( 4. * Dcst_pi_8) )
*
*
do pnund=1,F_und+1
if ( pnund .gt. F_und ) go to 30
if ( F_fis(i,j,l_nk) .gt. F_fiund(i,j,pnund) ) go to 30
enddo
*
30 continue
*
prlptop = F_lnps(i,j,l_nk)
prvttop = F_vts(i,j,l_nk)
prfitop = F_fis(i,j,l_nk)
*
do 40 pn1=pnund,F_und
*
if ( prvttop .le. prvtc ) then
prvtbot = min( F_vtund(i,j,pn1), prvtc )
else
prvtbot = prvtc - 0.005 * ( prvttop - prvtc ) **2
endif
*
prfibot = F_fiund (i,j,pn1)
*
if ( abs(prvtbot-prvttop) .le. prsmall ) then
prlpbot = prlptop + (prfitop-prfibot)/(Dcst_rgasd_8*prvttop)
else
prl = - ( prvttop - prvtbot ) / ( prfitop - prfibot )
prlpbot = prlptop + (log(prvtbot/prvttop)) / (Dcst_rgasd_8*prl)
endif
*
prlptop = prlpbot
prvttop = F_vtund(i,j,pn1)
prfitop = prfibot
*
40 continue
*
if ( prvttop .le. prvtc ) then
prvtbot = min( 1.0d0*prvttop + Dcst_stlo_8 * 1.0d0*prfitop, 1.0d0*prvtc)
else
prvtbot = prvtc - 0.005 * ( prvttop - prvtc ) **2
endif
*
* calculation of MSL pressure
* ------------
*
if ((abs(prvtbot-prvttop).le.prsmall) .or. (prfitop.le.0.0)) then
F_pnm(i,j) = exp (prlptop+prfitop/(Dcst_rgasd_8*prvttop))
else
prl = - ( prvttop - prvtbot ) / ( prfitop )
F_pnm(i,j)=exp (prlptop+(log(prvtbot/prvttop))/(Dcst_rgasd_8*prl))
endif
*
100 continue
*
return
end