source: trunk/LMDZ.MARS/libf/phymars/pbl_parameters_mod.F90 @ 3726

Last change on this file since 3726 was 3726, checked in by emillour, 8 weeks ago

Mars PCM:
Turn "callkeys.h" into module "callkeys_mod.F90"
EM

File size: 19.8 KB
Line 
1 MODULE pbl_parameters_mod
2 
3!======================================================================================================================!
4! Subject:
5!---------
6!   Module used to compute the friction velocity, temperature, and monin_obukhov length from temperature, wind field and thermals outputs.
7!   Also interpolate theta and u;v in the surface layer based on the Monin Obukhov theory
8!   These are diagnostics only and do not influence the code.
9!----------------------------------------------------------------------------------------------------------------------!
10! Reference:
11!-----------
12!  Colaïtis, A., Spiga, A., Hourdin, F., Rio, C., Forget, F., and Millour, E. (2013), A thermal plume model for the Martian convective boundary layer, J. Geophys. Res. Planets, 118, 1468–1487, doi:10.1002/jgre.20104.
13!
14!======================================================================================================================!
15
16
17IMPLICIT NONE
18
19CONTAINS
20
21      SUBROUTINE pbl_parameters(ngrid,nlay,ps,pplay,pz0,pg,zzlay,zzlev,pu,pv,wstar_in,hfmax,zmax,tke,pts,ph,pqvap,pqsurf,mumean,z_out,n_out, &
22                                T_out,u_out,ustar,tstar,vhf,vvv)
23                               
24      USE comcstfi_h
25      use write_output_mod, only: write_output
26      use turb_mod, only: turb_resolved
27      use lmdz_atke_turbulence_ini, only : smmin, ric, cinf, cepsilon, pr_slope, pr_asym, pr_neut, ri0, ri1, cn, rpi
28      use watersat_mod, only: watersat
29      use paleoclimate_mod, only: include_waterbuoyancy
30      use callkeys_mod, only: calladj, calltherm, callatke
31
32      IMPLICIT NONE
33     
34!=======================================================================
35!
36!   Anlysis of the PBL from input temperature, wind field and thermals outputs: compute the friction velocity, temperature, and monin_obukhov length
37!   and interpolate the potential temperature and winds in the surface layer using the Monin Obukhov theory
38!
39!   ------- 
40!
41!   Author: Arnaud Colaitis 09/01/12; adapted in F90 by Lucas Lange 12/2023
42!   -------
43!
44!   Arguments:
45!   ----------
46!
47!   inputs:
48!   ------
49!     ngrid               size of the horizontal grid
50!     nlay                size of the vertical grid
51!     ps(ngrid)           surface pressure (Pa)
52!     pplay(ngrid,nlay)   pressure levels
53!     pz0(ngrid)          surface roughness length (m)
54!     pg                  gravity (m s -2)
55!     zzlay(ngrid,nlay)   height of mid-layers (m)
56!     zzlev(ngrid,nlay+1) height of layers interfaces (m)
57!     pu(ngrid,nlay)      u component of the wind (m/s)
58!     pv(ngrid,nlay)      v component of the wind (m/s)
59!     wstar_in(ngrid)     free convection velocity in PBL (m/s)
60!     hfmax(ngrid)        maximum vertical turbulent heat flux in thermals (W/m^2)
61!     zmax(ngrid)         height reached by the thermals (pbl height) (m)
62!     tke(ngrid,nlay+1)   turbulent kinetic energy (J/kg)
63!     pts(ngrid)          surface temperature (K)
64!     ph(ngrid,nlay)      potential temperature T*(p/ps)^kappa (k)
65!     z_out(n_out)        heights of interpolation (m)
66!     n_out               number of points for interpolation (1)
67!
68!   outputs:
69!   ------
70!
71!     T_out(ngrid,n_out)  interpolated potential temperature on z_out (K)
72!     u_out(ngrid,n_out)  interpolated winds on z_out (m/s)
73!     ustar(ngrid)     friction velocity (m/s)
74!     tstar(ngrid)     friction temperature (K)
75!
76!
77!=======================================================================
78!
79!-----------------------------------------------------------------------
80!   Declarations:
81!   -------------
82
83!   Arguments:
84!   ----------
85
86      INTEGER, INTENT(IN) :: ngrid,nlay,n_out                       ! size of the horizontal and vertical grid, interpolated altitudes for the surface layer
87      REAL, INTENT(IN) :: pz0(ngrid)                                ! surface roughness
88      REAL, INTENT(IN) :: ps(ngrid),pplay(ngrid,nlay)               ! surface pressure and pressure levels
89      REAL, INTENT(IN) :: pg,zzlay(ngrid,nlay),zzlev(ngrid,nlay)    ! surface gravity, altitude of the interface and mid-layers
90      REAL, INTENT(IN) :: pu(ngrid,nlay),pv(ngrid,nlay)             ! winds
91      REAL, INTENT(IN) :: wstar_in(ngrid),hfmax(ngrid),zmax(ngrid)  ! free convection velocity , vertical turbulent heat, pbl height
92      REAL, INTENT(IN) :: tke(ngrid,nlay+1)                         ! Turbulent kinetic energy
93      REAL, INTENT(IN) :: pts(ngrid),ph(ngrid,nlay)                 ! surface temperature, potentiel temperature
94      REAL, INTENT(IN) :: z_out(n_out)                              ! altitudes of the interpolation in the surface layer
95      REAL, INTENT(IN) :: mumean(ngrid)                             ! Molecular mass of the atmosphere (kg/mol)
96      REAL, INTENT(IN) :: pqvap(ngrid,nlay)                         ! Water vapor mixing ratio (kg/kg) to account for vapor flottability
97      REAL, INTENT(IN) :: pqsurf(ngrid)                             ! Water ice frost on the surface (kg/m^2) to account for vapor flottability
98
99!    Outputs:
100!    --------
101
102      REAL, INTENT(OUT) :: T_out(ngrid,n_out),u_out(ngrid,n_out)    ! Temperature and wind of the interpolation in the surface layer
103      REAL, INTENT(OUT) :: ustar(ngrid), tstar(ngrid)               ! Friction velocity and temperature       
104 
105!   Local:
106!   ------
107
108      INTEGER ig,k,n                                                ! Loop variables                   
109      INTEGER ii(1)                                                 ! Index to compute the pbl mixed layer temperature     
110      REAL karman,nu                                                ! Von Karman constant and fluid kinematic viscosity
111      DATA karman,nu/.41,0.001/
112
113!$OMP THREADPRIVATE(karman,nu)
114
115      SAVE karman,nu
116
117      REAL zout                                                     ! altitude to interpolate (local variable during the loop on z_out) (m)
118      REAL rib(ngrid)                                               ! Bulk Richardson number (1)
119      REAL fm(ngrid)                                                ! stability function for momentum (1)
120      REAL fh(ngrid)                                                ! stability function for heat (1)
121      REAL z1z0,z1z0t                                               ! ratios z1/z0 and z1/z0T (1)
122! Formalism for stability functions  fm= 1/phim^2; fh = 1/(phim*phih) where
123! phim = 1+betam*zeta   or   (1-bm*zeta)**am
124! phih = alphah + betah*zeta    or   alphah(1.-bh*zeta)**ah
125! ah and am are assumed to be -0.25 and -0.5 respectively
126! lambda is an intermediate variable to simplify the expression
127      REAL betam, betah, alphah, bm, bh, lambda
128
129      REAL cdn(ngrid),chn(ngrid)                                    ! neutral momentum and heat drag coefficient (1)
130      REAL pz0t                                                     ! initial thermal roughness length z0t for the iterative scheme (m)
131      REAL ric_colaitis                                             ! critical richardson number (1)
132      REAL reynolds(ngrid)                                          ! Reynolds number (1)
133      REAL prandtl(ngrid)                                           ! Prandtl number  (1)
134      REAL pz0tcomp(ngrid)                                          ! Computed z0t during the iterative scheme (m)
135      REAL ite                                                      ! Number of iteration (1)
136      REAL residual                                                 ! Residual between pz0t and pz0tcomp (m)
137      REAL itemax                                                   ! Maximum number of iteration (1)
138      REAL tol_iter                                                 ! Tolerance for the residual to ensure convergence (1)
139      REAL pcdv(ngrid),pcdh(ngrid)                                  ! momentum and heat drag coefficient (1)
140      REAL zu2(ngrid)                                               ! Near surface winds (m/s)
141      REAL x(ngrid)                                                 ! z/zi (1)
142      REAL dvhf(ngrid),dvvv(ngrid)                                  ! dimensionless vertical heat flux and  dimensionless vertical velocity variance
143      REAL vhf(ngrid),vvv(ngrid)                                    ! vertical heat flux (W/m^2) and vertical velocity variance (m/s)
144      REAL Teta_out(ngrid,n_out)                                    ! Temporary variable to compute interpolated potential temperature (K)
145      REAL sm                                                       ! Stability function computed with the ATKE scheme
146      REAL f_ri_cd_min                                              ! minimum of the stability function with the ATKE scheme
147      REAL ric_4interp                                              ! critical richardson number which is either the one from Colaitis et al. (2013) or ATKE (1)
148
149
150      REAL tsurf_v(ngrid)                                           ! Virtual surface temperature, accounting for vapor flottability
151      REAL temp_v(ngrid)                                            ! Potential virtual air temperature in the frist layer, accounting for vapor flottability
152      REAL mu_h2o                                                   ! Molecular mass of water vapor (kg/mol)
153      REAL tol_frost                                                ! Tolerance to consider the effect of frost on the surface
154      REAL qsat(ngrid)                                              ! saturated mixing ratio of water vapor
155
156
157!    Code:
158!    --------
159     
160!------------------------------------------------------------------------
161!------------------------------------------------------------------------
162! PART I : RICHARDSON/REYNOLDS/THERMAL_ROUGHNESS/STABILITY_COEFFICIENTS
163!------------------------------------------------------------------------
164!------------------------------------------------------------------------
165
166
167
168! Initialisation :
169
170      ustar(:)=0.
171      tstar(:)=0.
172      reynolds(:)=0.
173      pz0t = 0.
174      pz0tcomp(:) = 0.1*pz0(:)
175      rib(:)=0.
176      pcdv(:)=0.
177      pcdh(:)=0.
178      itemax= 10
179      tol_iter =  0.01
180      f_ri_cd_min = 0.01
181      mu_h2o = 18e-3
182      tol_frost = 1e-4
183      tsurf_v(:) = 0.
184      temp_v(:) = 0.
185
186! this formulation assumes alphah=1., implying betah=betam
187! We use Dyer et al. parameters, as they cover a broad range of Richardson numbers :
188      bm = 16.           
189      bh = 16.           
190      alphah = 1.
191      betam = 5.         
192      betah = 5.         
193      lambda = (sqrt(bh/bm))/alphah
194      ric_colaitis = betah/(betam**2)
195     
196      if(callatke) then
197         ric_4interp = ric
198      else
199         ric_4interp = ric_colaitis
200      endif
201     
202
203
204      IF(include_waterbuoyancy) then
205         temp_v(:) = ph(:,1)*(1.+pqvap(:,1)/(mu_h2o/mumean(:)))/(1.+pqvap(:,1))
206         DO ig = 1,ngrid
207            IF(pqsurf(ig).gt.tol_frost) then
208               call watersat(1,pts(ig),pplay(ig,1),qsat(ig))
209               tsurf_v(ig) = pts(ig)*(1.+qsat(ig)/(mu_h2o/mumean(ig)))/(1.+qsat(ig))
210            ELSE
211               tsurf_v(ig) = pts(ig)*(1.+pqvap(ig,1)/(mu_h2o/mumean(ig)))/(1.+pqvap(ig,1))
212            ENDIF
213         ENDDO
214      ELSE
215         tsurf_v(:) = pts(:)
216         temp_v(:) =  ph(:,1)
217      ENDIF
218     
219      DO ig=1,ngrid
220         ite = 0.
221         residual = abs(pz0tcomp(ig)-pz0t)
222         z1z0 = zzlay(ig,1)/pz0(ig)
223         cdn(ig) = karman/log(z1z0)
224         cdn(ig) = cdn(ig)*cdn(ig)
225         zu2(ig) = pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)  + (log(1.+0.7*wstar_in(ig) + 2.3*wstar_in(ig)**2))**2  ! near surface winds, accounting for buyoncy
226!         IF(turb_resolved) zu2(ig)=MAX(zu2(ig),1.)
227         DO WHILE((residual .gt. tol_iter*pz0(ig)) .and.  (ite .lt. itemax))
228! Computations of z0T; iterated until z0T converges 
229            pz0t = pz0tcomp(ig)
230            z1z0t=zzlay(ig,1)/pz0t
231            chn(ig) = cdn(ig)*log(z1z0)/log(z1z0t)
232            IF ((pu(ig,1) .ne. 0.) .or. (pv(ig,1) .ne. 0.)) then             
233            ! Richardson number formulation proposed by D.E. England et al. (1995)
234               rib(ig) = (pg/tsurf_v(ig))*sqrt(zzlay(ig,1)*pz0(ig))*(((log(zzlay(ig,1)/pz0(ig)))**2)/(log(zzlay(ig,1)/pz0t)))*(temp_v(ig)-tsurf_v(ig))/zu2(ig)
235            ELSE
236               print*,'warning, infinite Richardson at surface'
237               print*,pu(ig,1),pv(ig,1)
238               rib(ig) = ric_colaitis
239            ENDIF
240
241! Compute the stability functions fm; fh depending on the stability of the surface layer
242
243            IF(callatke) THEN
244               ! Computation following parameterizaiton from ATKE
245               IF(rib(ig) .gt. 0) THEN
246                  ! STABLE BOUNDARY LAYER :
247                  sm = MAX(smmin,cn*(1.-rib(ig)/ric))
248                  ! prandlt expression from venayagamoorthy and stretch 2010, Li et al 2019
249                  prandtl(ig) = pr_neut*exp(-pr_slope/pr_neut*rib(ig)+rib(ig)/pr_neut) + rib(ig) * pr_slope
250                  fm(ig) = max((sm**(3./2.) * sqrt(cepsilon) * (1 - rib(ig) / prandtl(ig))**(1./2.)),f_ri_cd_min)
251                  fh(ig) = max((fm(ig) / prandtl(ig)), f_ri_cd_min)
252               ELSE
253                  ! UNSTABLE BOUNDARY LAYER :
254                  sm = 2./rpi * (cinf - cn) * atan(-rib(ig)/ri0) + cn
255                  prandtl(ig) = -2./rpi * (pr_asym - pr_neut) * atan(rib(ig)/ri1) + pr_neut
256                  fm(ig) = MAX((sm**(3./2.) * sqrt(cepsilon) * (1 - rib(ig) / prandtl(ig))**(1./2.)),f_ri_cd_min)
257                  fh(ig) = MAX((fm(ig) / prandtl(ig)), f_ri_cd_min)
258                ENDIF ! Rib < 0
259             ELSE
260                ! Computation following parameterizaiton from from D.E. England et al. (95)
261                IF (rib(ig) .gt. 0.) THEN
262                   ! STABLE BOUNDARY LAYER :
263                   prandtl(ig) = 1.
264                   IF(rib(ig) .lt. ric_colaitis) THEN
265                      ! Assuming alphah=1. and bh=bm for stable conditions :
266                      fm(ig) = ((ric_colaitis-rib(ig))/ric_colaitis)**2
267                      fh(ig) = ((ric_colaitis-rib(ig))/ric_colaitis)**2
268                   ELSE
269                      ! For Ri>Ric, we consider Ri->Infinity => no turbulent mixing at surface
270                      fm(ig) = 1.
271                      fh(ig) = 1.
272                   ENDIF
273                ELSE
274                   ! UNSTABLE BOUNDARY LAYER :
275                   fm(ig) = sqrt(1.-lambda*bm*rib(ig))
276                   fh(ig) = (1./alphah)*((1.-lambda*bh*rib(ig))**0.5)*(1.-lambda*bm*rib(ig))**0.25
277                   prandtl(ig) = alphah*((1.-lambda*bm*rib(ig))**0.25)/((1.-lambda*bh*rib(ig))**0.5)
278                ENDIF ! Rib < 0
279             ENDIF ! atke
280             ! Recompute the reynolds and z0t
281             reynolds(ig) = karman*sqrt(fm(ig))*sqrt(zu2(ig))*pz0(ig)/(log(z1z0)*nu)
282             pz0tcomp(ig) = pz0(ig)*exp(-karman*7.3*(reynolds(ig)**0.25)*(prandtl(ig)**0.5)+5*karman)
283             residual = abs(pz0t-pz0tcomp(ig))
284             ite = ite+1
285         ENDDO  ! of while
286! Compute the coefficients Cdv; Cdh : neutral coefficient x stability functions       
287         pcdv(ig) = cdn(ig)*fm(ig)
288         pcdh(ig) = chn(ig)*fh(ig)         
289         pz0t = 0. ! for next grid point
290      ENDDO ! of ngrid
291
292!------------------------------------------------------------------------
293!------------------------------------------------------------------------
294! PART II : USTAR/TSTAR/U_OUT/TETA_OUT COMPUTATIONS
295!------------------------------------------------------------------------
296!------------------------------------------------------------------------
297
298! u* theta* computation
299      DO n=1,n_out
300         zout = z_out(n)
301         DO ig=1,ngrid
302            IF (rib(ig) .ge. ric_4interp) THEN !stable case, no turbulence
303               ustar(ig) = 0.
304               tstar(ig) = 0.
305            ELSE
306               ustar(ig) = sqrt(pcdv(ig))*sqrt(zu2(ig))   ! By definition, u* = sqrt(tau/U^2) = sqrt(Cdv)
307               tstar(ig) = -pcdh(ig)*(pts(ig)-ph(ig,1))/sqrt(pcdv(ig))                ! theta* = (T1-Tsurf)*Cdh(ig)/u*
308            ENDIF
309           
310! Interpolation:
311
312            IF(zout .lt. pz0tcomp(ig)) THEN                                           !  If z_out is in the surface layer , theta = tsurf; u = 0
313               u_out(ig,n) = 0.
314               Teta_out(ig,n) = pts(ig)
315            ELSEIF (zout .lt. pz0(ig)) THEN
316                u_out(ig,n) = 0.
317            ELSE
318               IF (rib(ig) .ge. ric_4interp) THEN ! ustar=tstar=0  (and fm=fh=0) because no turbulence
319                  u_out(ig,n) = 0
320                  Teta_out(ig,n) = pts(ig)
321               ELSE       
322! We use the MO theory: du/dz = u*/(kappa z) *1 /sqrt(fm); dtheta/zd = theta*/(Pr kappa z) * fm/fh
323                  u_out(ig,n)= ustar(ig)*log(zout/pz0(ig))/(karman*sqrt(fm(ig)))
324                  Teta_out(ig,n)=pts(ig)+(tstar(ig)*sqrt(fm(ig))*log(zout/(pz0tcomp(ig)))/(karman*fh(ig)))
325               ENDIF
326            ENDIF
327         ENDDO ! loop on n_out
328         
329! when using convective adjustment without thermals, a vertical potential temperature
330! profile is assumed up to the thermal roughness length. Hence, theoretically, theta
331! interpolated at any height in the surface layer is theta at the first level.
332
333         IF ((.not.calltherm).and.(calladj)) THEN
334            Teta_out(:,n)=ph(:,1)
335            u_out(:,n)=(sqrt(cdn(:))*sqrt(zu2(ig))/karman)*log(zout/pz0(:))
336         ENDIF
337         T_out(:,n) = Teta_out(:,n)*(exp((zout/zzlay(:,1))*(log(pplay(:,1)/ps))))**rcp ! not sure of what is done here: hydrostatic correction to account for the difference of pressure between zout and z1 ?
338      ENDDO   !of n=1,n_out
339
340
341!------------------------------------------------------------------------
342!------------------------------------------------------------------------
343! PART III : VERTICAL_VELOCITY_VARIANCE/VERTICAL_TURBULENT_FLUX PROFILES
344!------------------------------------------------------------------------
345!------------------------------------------------------------------------
346
347! We follow Spiga et. al 2010 (QJRMS)
348! ------------
349      IF (calltherm) THEN
350         DO ig=1, ngrid
351            IF (zmax(ig) .gt. 0.) THEN
352               x(ig) = zout/zmax(ig)
353            ELSE
354               x(ig) = 999.
355            ENDIF
356         ENDDO
357
358         DO ig=1, ngrid
359         ! dimensionless vertical heat flux
360            IF (x(ig) .le. 0.3) THEN
361               dvhf(ig) = ((-3.85/log(x(ig)))+0.07*log(x(ig))) *exp(-4.61*x(ig))
362            ELSEIF (x(ig) .le. 1.) THEN
363               dvhf(ig) = -1.52*x(ig) + 1.24
364            ELSE
365               dvhf(ig) = 0.
366            ENDIF
367         ! dimensionless vertical velocity variance
368            IF (x(ig) .le. 1.) THEN
369               dvvv(ig) = 2.05*(x(ig)**(2./3.))*(1.-0.64*x(ig))**2
370            ELSE
371               dvvv(ig) = 0.
372            ENDIF
373         ENDDO
374
375         vhf(:) = dvhf(:)*hfmax(:)
376         vvv(:) = dvvv(:)*(wstar_in(:))**2
377
378         ENDIF ! of if calltherm
379
380
381!------------------------------------------------------------------------
382!------------------------------------------------------------------------
383! PART IV : Outputs
384!------------------------------------------------------------------------
385!------------------------------------------------------------------------
386
387
388#ifndef MESOSCALE
389            call write_output('tke_pbl','Tke in the pbl after physic','J/kg',tke(:,:))
390            call write_output('rib_pbl','Richardson in pbl parameter','m/s',rib(:))
391            call write_output('cdn_pbl','neutral momentum coef','m/s',cdn(:))
392            call write_output('fm_pbl','momentum stab function','m/s',fm(:))
393            call write_output('uv','wind norm first layer','m/s',sqrt(zu2(:)))
394            call write_output('uvtrue','wind norm first layer','m/s',sqrt(pu(:,1)**2+pv(:,1)**2))
395            call write_output('chn_pbl','neutral momentum coef','m/s',chn(:))
396            call write_output('fh_pbl','momentum stab function','m/s',fh(:))
397            call write_output('B_pbl','buoyancy','m/',(ph(:,1)-pts(:))/pts(:))
398            call write_output('zot_pbl','buoyancy','ms',pz0tcomp(:))
399            call write_output('zz1','1st layer altitude','m',zzlay(:,1))
400#endif
401
402      RETURN
403 END SUBROUTINE pbl_parameters
404
405END MODULE pbl_parameters_mod
406     
Note: See TracBrowser for help on using the repository browser.