source: trunk/LMDZ.MARS/libf/phymars/pbl_parameters.F @ 566

Last change on this file since 566 was 566, checked in by acolaitis, 13 years ago

Something wierd happened in the last commit... So back to where it was and retry... Update to pbl_parameter so that several values of z_out can be sought in one pass. Pbl_parameter can also now be called when calltherm=false, as long as callrichsl=true.

File size: 13.8 KB
Line 
1      SUBROUTINE pbl_parameters(ngrid,nlay,ps,pplay,pz0,
2     & pg,zzlay,zzlev,pu,pv,wstar_in,hfmax,zmax,pts,ph,z_out,n_out,
3     & Teta_out,u_out,ustar,tstar,L_mo,vhf,vvv)
4      IMPLICIT NONE
5!=======================================================================
6!
7!   Anlysis of the PBL from input temperature, wind field and thermals outputs.
8!
9!   ------- 
10!
11!   Author: Arnaud Colaitis 09/01/12
12!   -------
13!
14!   Arguments:
15!   ----------
16!
17!   inputs:
18!   ------
19!     ngrid            size of the horizontal grid
20!     nlay             size of the vertical grid
21!     pz0(ngrid)       surface roughness length
22!     pg               gravity (m s -2)
23!     zzlay(ngrid,nlay)   height of mid-layers
24!     zzlev(ngrid,nlay+1)   height of layers interfaces
25!     pu(ngrid,nlay)   u component of the wind
26!     pv(ngrid,nlay)   v component of the wind
27!     wstar_in(ngrid)  free convection velocity in thermals
28!     hfmax(ngrid)     maximum vertical turbulent heat flux in thermals
29!     zmax(ngrid)      height reached by the thermals (pbl height)
30!     pts(ngrid)       surface temperature
31!     ph(ngrid,nlay)   potential temperature T*(p/ps)^kappa
32!     z_out(n_out)     heights of interpolation
33!     n_out            number of points for interpolation
34!
35!   outputs:
36!   ------
37!
38!     Teta_out(ngrid,n_out)  interpolated teta
39!     u_out(ngrid,n_out)     interpolated u
40!     ustar(ngrid)     friction velocity
41!     tstar(ngrid)     friction temperature
42!     wstar(ngrid)     free convection velocity
43!     L_mo(ngrid)      monin_obukhov length
44!
45!
46!=======================================================================
47!
48!-----------------------------------------------------------------------
49!   Declarations:
50!   -------------
51
52#include "comcstfi.h"
53#include "callkeys.h"
54
55!   Arguments:
56!   ----------
57
58      INTEGER, INTENT(IN) :: ngrid,nlay,n_out
59      REAL, INTENT(IN) :: pz0(ngrid),ps(ngrid),pplay(ngrid,nlay)
60      REAL, INTENT(IN) :: pg,zzlay(ngrid,nlay),zzlev(ngrid,nlay)
61      REAL, INTENT(IN) :: pu(ngrid,nlay),pv(ngrid,nlay)
62      REAL, INTENT(IN) :: wstar_in(ngrid),hfmax(ngrid),zmax(ngrid)
63      REAL, INTENT(IN) :: pts(ngrid),ph(ngrid,nlay)
64      REAL, INTENT(IN) :: z_out(n_out)
65
66!    Outputs:
67!    --------
68
69      REAL, INTENT(OUT) :: Teta_out(ngrid,n_out),u_out(ngrid,n_out)
70      REAL T_out(ngrid,n_out)
71      REAL, INTENT(OUT) :: ustar(ngrid), tstar(ngrid)
72      REAL wstar(ngrid)
73      REAL, INTENT(OUT) :: L_mo(ngrid)
74
75!   Local:
76!   ------
77
78      INTEGER ig,k,n
79      REAL karman,nu
80      DATA karman,nu/.41,0.001/
81      SAVE karman,nu
82
83!    Local(2):
84!    ---------
85     
86      REAL zout
87      REAL rib(ngrid)  ! Bulk Richardson number
88      REAL fm(ngrid) ! stability function for momentum
89      REAL fh(ngrid) ! stability function for heat
90      REAL z1z0,z1z0t ! ratios z1/z0 and z1/z0T
91          ! phim = 1+betam*zeta   or   (1-bm*zeta)**am
92          ! phih = alphah + betah*zeta    or   alphah(1.-bh*zeta)**ah
93      REAL betam, betah, alphah, bm, bh, lambda
94          ! ah and am are assumed to be -0.25 and -0.5 respectively
95      REAL cdn(ngrid),chn(ngrid)  ! neutral momentum and heat drag coefficient
96      REAL pz0t        ! initial thermal roughness length. (local)
97      REAL ric         ! critical richardson number
98      REAL reynolds(ngrid)    ! reynolds number for UBL
99      REAL prandtl(ngrid)     ! prandtl number for UBL
100      REAL pz0tcomp(ngrid)     ! computed z0t
101      REAL ite
102      REAL residual,zcd0,z1
103      REAL pcdv(ngrid),pcdh(ngrid)
104      REAL zu2(ngrid)                  ! Large-scale wind at first layer
105      REAL pbl_teta(ngrid)             ! mixed-layer potential temperature
106      INTEGER pbl_height_index(ngrid)  ! index of nearest vertical grid point for zmax
107      REAL dteta(ngrid,nlay),x(ngrid)  ! potential temperature gradient and z/zi
108      REAL dvhf(ngrid),dvvv(ngrid)     ! dimensionless vertical heat flux and
109                                       ! dimensionless vertical velocity variance
110      REAL vhf(ngrid),vvv(ngrid)       ! vertical heat flux and vertical velocity variance
111      INTEGER ii(1)
112! temporary
113      INTEGER dimout
114
115!------------------------------------------------------------------------
116!------------------------------------------------------------------------
117! PART I : RICHARDSON/REYNOLDS/THERMAL_ROUGHNESS/STABILITY_COEFFICIENTS
118!------------------------------------------------------------------------
119!------------------------------------------------------------------------
120
121      DO n=1,n_out
122
123c Initialisation :
124
125      L_mo(:)=0.
126      ustar(:)=0.
127      tstar(:)=0.
128      zout=z_out(n)
129      reynolds(:)=0.
130      pz0t = 0.
131      pz0tcomp(:) = 0.1*pz0(:)
132      rib(:)=0.
133      pcdv(:)=0.
134      pcdh(:)=0.
135
136      ! this formulation assumes alphah=1., implying betah=betam
137      ! We use Dyer et al. parameters, as they cover a broad range of Richardson numbers :
138
139      bm=16.            !UBL
140      bh=16.            !UBL
141      alphah=1.
142      betam=5.         !SBL
143      betah=5.         !SBL
144      lambda=(sqrt(bh/bm))/alphah
145      ric=betah/(betam**2)
146
147      DO ig=1,ngrid
148       ite=0.
149       residual=abs(pz0tcomp(ig)-pz0t)
150       zu2(ig)=MAX(pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
151     &                                ,(0.3*wstar_in(ig))**2)
152
153       DO WHILE((residual .gt. 0.01*pz0(ig)) .and.  (ite .lt. 10.))
154
155         pz0t=pz0tcomp(ig)
156         IF (zu2(ig) .ne. 0.) THEN
157            ! Richardson number formulation proposed by D.E. England et al. (1995)
158            rib(ig) = (pg/ph(ig,1))
159     &        *sqrt(zzlev(ig,2)*pz0(ig))
160     &        *(((log(zzlev(ig,2)/pz0(ig)))**2)/(log(zzlev(ig,2)/pz0t)))
161     &        *(ph(ig,1)-pts(ig))/zu2(ig)
162         ELSE
163            print*,'warning, infinite Richardson at surface'
164            print*,pu(ig,1),pv(ig,1)
165            rib(ig) = ric
166         ENDIF
167
168         z1z0=zzlev(ig,2)/pz0(ig)
169         z1z0t=zzlev(ig,2)/pz0t
170
171         cdn(ig)=karman/log(z1z0)
172         cdn(ig)=cdn(ig)*cdn(ig)
173         chn(ig)=cdn(ig)*log(z1z0)/log(z1z0t)
174
175         ! STABLE BOUNDARY LAYER :
176         IF (rib(ig) .gt. 0.) THEN
177            ! From D.E. England et al. (95)
178            prandtl(ig)=1.
179            if(rib(ig) .lt. ric) then
180               ! Assuming alphah=1. and bh=bm for stable conditions :
181               fm(ig)=((ric-rib(ig))/ric)**2
182               fh(ig)=((ric-rib(ig))/ric)**2
183            else
184               ! For Ri>Ric, we consider Ri->Infinity => no turbulent mixing at surface
185               fm(ig)=0.
186               fh(ig)=0.
187            endif
188         ! UNSTABLE BOUNDARY LAYER :
189         ELSE
190            ! From D.E. England et al. (95)
191            fm(ig)=sqrt(1.-lambda*bm*rib(ig))
192            fh(ig)=(1./alphah)*((1.-lambda*bh*rib(ig))**0.5)*
193     &                     (1.-lambda*bm*rib(ig))**0.25
194            prandtl(ig)=alphah*((1.-lambda*bm*rib(ig))**0.25)/
195     &             ((1.-lambda*bh*rib(ig))**0.5)
196         ENDIF
197 
198        reynolds(ig)=karman*sqrt(fm(ig))
199     &              *sqrt(zu2(ig))
200     &              *pz0(ig)/(log(z1z0)*nu)
201        pz0tcomp(ig)=pz0(ig)*exp(-karman*7.3*
202     &              (reynolds(ig)**0.25)*(prandtl(ig)**0.5))
203        residual = abs(pz0t-pz0tcomp(ig))
204        ite = ite+1
205 
206       ENDDO  ! of while
207       pz0t=0.
208
209! Drag computation:
210
211         pcdv(ig)=cdn(ig)*fm(ig)
212         pcdh(ig)=chn(ig)*fh(ig)
213       
214      ENDDO ! of ngrid
215
216!------------------------------------------------------------------------
217!------------------------------------------------------------------------
218! PART II : USTAR/TSTAR/U_OUT/TETA_OUT COMPUTATIONS
219!------------------------------------------------------------------------
220!------------------------------------------------------------------------
221
222
223! Large-scale wind at first layer (without gustiness) and
224! u* theta* computation
225
226      DO ig=1,ngrid
227         IF (rib(ig) .ge. ric) THEN
228           ustar(ig)=0.
229           tstar(ig)=0.
230         ELSE
231           ustar(ig)=sqrt(pcdv(ig))
232     &        *sqrt(pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1))
233           tstar(ig)=-pcdh(ig)*(pts(ig)-ph(ig,1))
234     &        /sqrt(pcdv(ig))
235         ENDIF
236      ENDDO
237
238! Monin Obukhov length:
239
240      DO ig=1,ngrid
241         IF (rib(ig) .gt. ric) THEN
242            L_mo(ig)=0.
243         ELSE
244            L_mo(ig)=pts(ig)*(ustar(ig)**2)/(pg*karman*tstar(ig))  !as defined here, L is positive for SBL, negative for UBL
245         ENDIF
246      ENDDO
247
248! Interpolation:
249
250      DO ig=1,ngrid
251        IF(zout .lt. pz0tcomp(ig)) THEN
252           u_out(ig,n)=0.
253           Teta_out(ig,n)=pts(ig)
254        ELSEIF (L_mo(ig) .gt. 0.) THEN
255           u_out(ig,n)=(ustar(ig)/karman)*log(zout/pz0(ig)) +
256     &            5.*(ustar(ig)/(karman*L_mo(ig)))*(zout-pz0(ig))
257           Teta_out(ig,n)=pts(ig)+(tstar(ig)/(prandtl(ig)*karman))
258     &                            *log(zout/pz0tcomp(ig)) +
259     &            5.*(tstar(ig)/(prandtl(ig)*karman*L_mo(ig)))
260     &                            *(zout-pz0tcomp(ig))
261        ELSEIF (L_mo(ig) .lt. 0.) THEN
262
263          IF(L_mo(ig) .gt. -1000.) THEN
264           
265           u_out(ig,n)=(ustar(ig)/karman)*(
266     &  2.*atan((1.-16.*zout/L_mo(ig))**0.25)
267     & -2.*atan((1.-16.*pz0(ig)/L_mo(ig))**0.25)
268     & -2.*log(1.+(1.-16.*zout/L_mo(ig))**0.25)
269     & +2.*log(1.+(1.-16.*pz0(ig)/L_mo(ig))**0.25)
270     & -   log(1.+sqrt(1.-16.*zout/L_mo(ig)))
271     & +   log(1.+sqrt(1.-16.*pz0(ig)/L_mo(ig)))
272     & +   log(zout/pz0(ig))
273     &                                  )
274
275           Teta_out(ig,n)=pts(ig)+(tstar(ig)/(prandtl(ig)*karman))*(
276     &  2.*log(1.+sqrt(1.-16.*pz0tcomp(ig)/L_mo(ig)))
277     & -2.*log(1.+sqrt(1.-16.*zout/L_mo(ig)))
278     & +   log(zout/pz0tcomp(ig))
279     &                                                        )
280
281          ELSE
282
283! We have to treat the case where L is very large and negative,
284! corresponding to a very nearly stable atmosphere (but not quite !)
285! i.e. teta* <0 and almost zero. We choose the cutoff
286! corresponding to L_mo < -1000 and use a 3rd order taylor expansion. The difference
287! between the two expression for z/L = -1/1000 is -1.54324*10^-9
288! (we do that to avoid using r*4 precision, otherwise, we get -inf values)         
289
290           u_out(ig,n)=(ustar(ig)/karman)*(
291     &     (4./L_mo(ig))*(zout-pz0(ig))
292     &   + (20./(L_mo(ig))**2)*(zout**2-pz0(ig)**2)
293     &   + (160./(L_mo(ig))**3)*(zout**3-pz0(ig)**3)
294     &   + log(zout/pz0(ig))
295     &                                   )
296
297           Teta_out(ig,n)=pts(ig)+(tstar(ig)/(prandtl(ig)*karman))*(
298     &     (8./L_mo(ig))*(zout-pz0tcomp(ig))
299     &   + (48./(L_mo(ig))**2)*(zout**2-pz0tcomp(ig)**2)
300     &   + (1280./(3.*(L_mo(ig))**3))*(zout**3-pz0tcomp(ig)**3)
301     &   + log(zout/pz0tcomp(ig))
302     &                                                           )
303
304          ENDIF
305        ELSE
306           u_out(ig,n)=0.
307           Teta_out(ig,n)=pts(ig)
308        ENDIF
309        IF(zout .lt. pz0(ig)) THEN
310           u_out(ig,n)=0.
311        ENDIF
312      ENDDO
313
314! when using convective adjustment without thermals, a vertical potential temperature
315! profile is assumed up to the thermal roughness length. Hence, theoretically, theta
316! interpolated at any height in the surface layer is theta at the first level.
317
318      IF ((.not.calltherm).and.(calladj)) THEN
319           Teta_out(:,n)=ph(:,1)
320      ENDIF
321
322              T_out(:,n) = Teta_out(:,n)*(exp(
323     &   (zout/zzlay(:,1))*(log(pplay(:,1)/ps))
324     &                             )
325     &                         )**rcp
326
327      ENDDO   !of n=1,n_out
328
329!------------------------------------------------------------------------
330!------------------------------------------------------------------------
331! PART III : WSTAR COMPUTATION
332!------------------------------------------------------------------------
333!------------------------------------------------------------------------
334
335! Detection of the mixed-layer potential temperature
336! ------------
337
338! Nearest index for the pbl height
339
340      IF (calltherm) THEN
341
342      pbl_height_index(:)=1
343
344      DO k=1,nlay-1
345         DO ig=1, ngrid
346            IF (abs(zmax(ig)-zzlay(ig,k)) .lt.
347     &              abs(zmax(ig)-zzlay(ig,pbl_height_index(ig)))) THEN
348               pbl_height_index(ig)=k
349            ENDIF
350         ENDDO
351      ENDDO
352
353! Potential temperature gradient
354
355      dteta(:,nlay)=0.
356      DO k=1,nlay-1
357         DO ig=1, ngrid
358         dteta(ig,k) = (ph(ig,k+1)-ph(ig,k))/(zzlay(ig,k+1)-zzlay(ig,k))
359         ENDDO
360      ENDDO
361
362! Computation of the pbl mixed layer temperature
363
364      DO ig=1, ngrid
365         ii=MINLOC(abs(dteta(ig,1:pbl_height_index(ig))))
366         pbl_teta(ig) = ph(ig,ii(1))
367      ENDDO
368
369! Recompute wstar
370! We follow Spiga et. al 2010 (QJRMS)
371! ------------
372
373      DO ig=1, ngrid
374         IF (zmax(ig) .gt. 0.) THEN
375            wstar(ig)=(pg*zmax(ig)*hfmax(ig)/pbl_teta(ig))**(1./3.)
376         ELSE
377            wstar(ig)=0.
378         ENDIF
379      ENDDO
380
381!------------------------------------------------------------------------
382!------------------------------------------------------------------------
383! PART IV : VERTICAL_VELOCITY_VARIANCE/VERTICAL_TURBULENT_FLUX PROFILES
384!------------------------------------------------------------------------
385!------------------------------------------------------------------------
386
387! We follow Spiga et. al 2010 (QJRMS)
388! ------------
389
390      DO ig=1, ngrid
391         IF (zmax(ig) .gt. 0.) THEN
392            x(ig) = zout/zmax(ig)
393         ELSE
394            x(ig) = 999.
395         ENDIF
396      ENDDO
397
398      DO ig=1, ngrid
399         ! dimensionless vertical heat flux
400         IF (x(ig) .le. 0.3) THEN
401            dvhf(ig) = ((-3.85/log(x(ig)))+0.07*log(x(ig)))
402     &                                       *exp(-4.61*x(ig))
403         ELSEIF (x(ig) .le. 1.) THEN
404            dvhf(ig) = -1.52*x(ig) + 1.24
405         ELSE
406            dvhf(ig) = 0.
407         ENDIF
408         ! dimensionless vertical velocity variance
409         IF (x(ig) .le. 1.) THEN
410            dvvv(ig) = 2.05*(x(ig)**(2./3.))*(1.-0.64*x(ig))**2
411         ELSE
412            dvvv(ig) = 0.
413         ENDIF
414      ENDDO
415
416      vhf(:) = dvhf(:)*hfmax(:)
417      vvv(:) = dvvv(:)*(wstar(:))**2
418
419      ENDIF ! of if calltherm
420
421      RETURN
422      END
Note: See TracBrowser for help on using the repository browser.