source: dynamico_lmdz/simple_physics/phyparam/physics/turbulence.F90

Last change on this file was 4233, checked in by dubos, 5 years ago

simple_physics : enforce F2003 strictly

File size: 13.0 KB
Line 
1MODULE turbulence
2
3#include "use_logging.h"
4
5  IMPLICIT NONE
6  SAVE
7  PRIVATE
8
9  REAL, PARAMETER :: karman=0.4
10  REAL :: lmixmin=100., emin_turb=1e-8
11
12  PUBLIC :: vdif, lmixmin, emin_turb
13
14CONTAINS
15
16  PURE SUBROUTINE vdif_cd( ngrid,pz0,pg,pz,pu,pv,pts,ph,pcdv,pcdh)
17    !=======================================================================
18    !
19    !   Subject: computation of the surface drag coefficient using the
20    !   -------  approch developed by Loui for ECMWF.
21    !
22    !   Author: Frederic Hourdin  15 /10 /93
23    !   -------
24    !
25    !   Arguments:
26    !   ----------
27    !
28    !   inputs:
29    !   ------
30    !     ngrid            size of the horizontal grid
31    !     pz0(ngrid)       roughness length ?
32    !     pg               gravity (m s -2)
33    !     pz(ngrid)        height of the first atmospheric layer
34    !     pu(ngrid)        u component of the wind in that layer
35    !     pv(ngrid)        v component of the wind in that layer
36    !     pts(ngrid)       surfacte temperature
37    !     ph(ngrid)        potential temperature T*(p/ps)^kappa
38    !
39    !   outputs:
40    !   --------
41    !     pcdv(ngrid)      Cd for the wind
42    !     pcdh(ngrid)      Cd for potential temperature
43    !
44    !=======================================================================
45    !
46    !-----------------------------------------------------------------------
47    !   Declarations:
48    !   -------------
49
50    !   Arguments:
51    !   ----------
52
53    INTEGER, INTENT(IN) ::  ngrid
54    REAL, INTENT(IN)  ::  pg, pz0(ngrid), pz(ngrid), &
55         pu(ngrid),pv(ngrid), pts(ngrid),ph(ngrid)
56    REAL, INTENT(OUT) :: pcdv(ngrid),pcdh(ngrid)
57
58    !   Local:
59    !   ------
60
61    REAL, PARAMETER :: b=5., c=5., d=5., umin2=1e-12, &
62         c2b=2.*b, c3bc=3.*b*c, c3b=3.*b
63    INTEGER ig
64    REAL zu2,z1,zri,zcd0,zz
65
66    !-----------------------------------------------------------------------
67    !   couche de surface:
68    !   ------------------
69
70    !     DO ig=1,ngrid
71    !        zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin2
72    !        pcdv(ig)=pz0(ig)*(1.+sqrt(zu2))
73    !        pcdh(ig)=pcdv(ig)
74    !     ENDDO
75    !     RETURN
76
77
78!!!! WARNING, verifier la formule originale de Louis!
79    DO ig=1,ngrid
80       zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin2
81       zri=pg*pz(ig)*(ph(ig)-pts(ig))/(ph(ig)*zu2)
82       z1=1.+pz(ig)/pz0(ig)
83       zcd0=karman/log(z1)
84       zcd0=zcd0*zcd0*sqrt(zu2)
85       IF(zri.LT.0.) THEN
86          z1=b*zri/(1.+c3bc*zcd0*sqrt(-z1*zri))
87          pcdv(ig)=zcd0*(1.-2.*z1)
88          pcdh(ig)=zcd0*(1.-3.*z1)
89       ELSE
90          zz=sqrt(1.+d*zri)
91          pcdv(ig)=zcd0/(1.+c2b*zri/zz)
92          pcdh(ig)=zcd0/(1.+c3b*zri*zz)
93       ENDIF
94    ENDDO
95
96    !-----------------------------------------------------------------------
97
98  END SUBROUTINE vdif_cd
99
100  PURE SUBROUTINE vdif_k(ngrid,nlay,   &
101       ptimestep,pg,pzlev,pzlay,pz0,pu,pv,ph,pkv,pkh)
102    ! FIXME : pkh := pkv
103    INTEGER, INTENT(IN) :: ngrid,nlay
104    REAL, INTENT(IN) ::  ptimestep, pg, &
105         pzlay(ngrid,nlay),pzlev(ngrid,nlay+1), pz0(ngrid), &
106         pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
107    REAL, INTENT(OUT) :: pkv(ngrid,nlay+1),pkh(ngrid,nlay+1)
108
109    INTEGER ig,il
110    REAL zdu,zdv,zri,zdvodz2,zdz,z1,lmix
111
112    DO ig=1,ngrid
113       pkv(ig,1)=0.
114       pkh(ig,1)=0.
115       pkv(ig,nlay+1)=0.
116       pkh(ig,nlay+1)=0.
117    ENDDO
118
119    DO il=2,nlay
120       DO ig=1,ngrid
121          z1=pzlev(ig,il)+pz0(ig)
122          lmix=karman*z1/(1.+karman*z1/lmixmin)
123          !           lmix=lmixmin
124          ! WARNING test lmix=lmixmin
125          zdu=pu(ig,il)-pu(ig,il-1)
126          zdv=pv(ig,il)-pv(ig,il-1)
127          zdz=pzlay(ig,il)-pzlay(ig,il-1)
128          zdvodz2=(zdu*zdu+zdv*zdv)/(zdz*zdz)
129          IF(zdvodz2.LT.1.e-5) THEN
130             pkv(ig,il)=lmix*sqrt(emin_turb)
131          ELSE
132             zri=2.*pg*(ph(ig,il)-ph(ig,il-1)) &
133                  / (zdz* (ph(ig,il)+ph(ig,il-1)) *zdvodz2  )
134             pkv(ig,il)= &
135                  lmix*sqrt(MAX(lmix*lmix*zdvodz2*(1-zri/.4),emin_turb))
136          ENDIF
137          pkh(ig,il)=pkv(ig,il)
138       ENDDO
139    ENDDO
140
141  END SUBROUTINE vdif_k
142
143
144  SUBROUTINE multipl(n,x1,x2,y)
145    !=======================================================================
146    !   multiplication de deux vecteurs
147    !=======================================================================
148    INTEGER n,i
149    REAL x1(n),x2(n),y(n)
150
151    DO i=1,n
152       y(i)=x1(i)*x2(i)
153    END DO
154  END SUBROUTINE multipl
155
156  SUBROUTINE vdif(ngrid,nlay,ptime, &
157       ptimestep,pcapcal,pz0, &
158       pplay,pplev,pzlay,pzlev, &
159       pu,pv,ph,ptsrf,pemis, &
160       pdufi,pdvfi,pdhfi,pfluxsrf, &
161       pdudif,pdvdif,pdhdif,pdtsrf, &
162       lwrite)
163    USE phys_const
164
165    !=======================================================================
166    !
167    !   Diffusion verticale
168    !   Shema implicite
169    !   On commence par rajouter au variables x la tendance physique
170    !   et on resoult en fait:
171    !      x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
172    !
173    !   arguments:
174    !   ----------
175    !
176    !   entree:
177    !   -------
178    !
179    !
180    !=======================================================================
181
182    !
183    !   arguments:
184    !   ----------
185
186    INTEGER ngrid,nlay
187    REAL ptime,ptimestep
188    REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
189    REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
190    REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
191    REAL ptsrf(ngrid),pemis(ngrid)
192    REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay)
193    REAL pfluxsrf(ngrid)
194    REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay)
195    REAL pdtsrf(ngrid),pcapcal(ngrid),pz0(ngrid)
196    LOGICAL lwrite
197    !
198    !   local:
199    !   ------
200
201    INTEGER ilev,ig,ilay,nlev
202    INTEGER unit,ierr,it1,it2
203    INTEGER cluvdb,putdat,putvdim,setname,setvdim
204    REAL z4st,zdplanck(ngrid),zu2
205    REAL zkv(ngrid,nlay+1),zkh(ngrid,nlay+1)
206    REAL zcdv(ngrid),zcdh(ngrid)
207    REAL zu(ngrid,nlay),zv(ngrid,nlay)
208    REAL zh(ngrid,nlay)
209    REAL ztsrf2(ngrid)
210    REAL z1(ngrid),z2(ngrid)
211    REAL za(ngrid,nlay),zb(ngrid,nlay)
212    REAL zb0(ngrid,nlay)
213    REAL zc(ngrid,nlay),zd(ngrid,nlay)
214    REAL zcst1
215
216    !
217    !-----------------------------------------------------------------------
218    !   initialisations:
219    !   ----------------
220
221    nlev=nlay+1
222
223    !   computation of rho*dz and dt*rho/dz=dt*rho**2 g/dp:
224    !   with rho=p/RT=p/ (R Theta) (p/ps)**kappa
225    !   ---------------------------------
226
227    DO ilay=1,nlay
228       DO ig=1,ngrid
229          za(ig,ilay) = (pplev(ig,ilay)-pplev(ig,ilay+1))/g
230       ENDDO
231    ENDDO
232
233    zcst1=4.*g*ptimestep/(r*r)
234    DO ilev=2,nlev-1
235       DO ig=1,ngrid
236          zb0(ig,ilev)=pplev(ig,ilev) &
237               *(pplev(ig,1)/pplev(ig,ilev))**rcp &
238               /(ph(ig,ilev-1)+ph(ig,ilev))
239          zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev) &
240               / (pplay(ig,ilev-1)-pplay(ig,ilev))
241       ENDDO
242    ENDDO
243    DO ig=1,ngrid
244       zb0(ig,1)=ptimestep*pplev(ig,1)/(r*ptsrf(ig))
245    ENDDO
246    IF(lwrite) THEN
247       ig=ngrid/2+1
248       WRITELOG(*,*) 'Pression (mbar) altitude (km),u,v,theta, rho dz'
249       DO ilay=1,nlay
250          WRITELOG(*,*) .01*pplay(ig,ilay),.001*pzlay(ig,ilay), &
251               pu(ig,ilay),pv(ig,ilay),ph(ig,ilay),za(ig,ilay)
252       ENDDO
253       WRITELOG(*,*) 'Pression (mbar) altitude (km),zb'
254       DO ilev=1,nlay
255          WRITELOG(*,*) .01*pplev(ig,ilev),.001*pzlev(ig,ilev), &
256               zb0(ig,ilev)
257       ENDDO
258       LOG_DBG('vdif')
259    ENDIF
260
261    !-----------------------------------------------------------------------
262    !   2. ajout des tendances physiques:
263    !   ------------------------------
264
265    DO ilev=1,nlay
266       DO ig=1,ngrid
267          zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
268          zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
269          zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep
270       ENDDO
271    ENDDO
272
273    !-----------------------------------------------------------------------
274    !   3. calcul de  cd :
275    !   ----------------
276    !
277    CALL vdif_cd( ngrid,pz0,g,pzlay,pu,pv,ptsrf,ph,zcdv,zcdh)
278    CALL vdif_k(ngrid,nlay,ptimestep,g,pzlev,pzlay,pz0,pu,pv,ph,zkv,zkh)
279
280    DO ig=1,ngrid
281       zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
282       zcdv(ig)=zcdv(ig)*sqrt(zu2)
283       zcdh(ig)=zcdh(ig)*sqrt(zu2)
284    ENDDO
285
286    IF(lwrite) THEN
287       WRITELOG(*,*) 'Diagnostique diffusion verticale'
288       WRITELOG(*,*) 'LMIXMIN',lmixmin
289       WRITELOG(*,*) 'coefficients Cd pour v et h'
290       WRITELOG(*,*) zcdv(ngrid/2+1),zcdh(ngrid/2+1)
291       WRITELOG(*,*) 'coefficients K pour v et h'
292       DO ilev=1,nlay
293          WRITELOG(*,*) zkv(ngrid/2+1,ilev),zkh(ngrid/2+1,ilev)
294       ENDDO
295       LOG_DBG('vdif')
296    ENDIF
297
298    !-----------------------------------------------------------------------
299    !   integration verticale pour u:
300    !   -----------------------------
301
302    CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2))
303    CALL multipl(ngrid,zcdv,zb0,zb)
304    DO ig=1,ngrid
305       z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
306       zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig)
307       zd(ig,nlay)=zb(ig,nlay)*z1(ig)
308    ENDDO
309
310    DO ilay=nlay-1,1,-1
311       DO ig=1,ngrid
312          z1(ig) = 1./(za(ig,ilay)+zb(ig,ilay) &
313               + zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
314          zc(ig,ilay) = (za(ig,ilay)*zu(ig,ilay) &
315               + zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
316          zd(ig,ilay) = zb(ig,ilay)*z1(ig)
317       ENDDO
318    ENDDO
319
320    DO ig=1,ngrid
321       zu(ig,1)=zc(ig,1)
322    ENDDO
323    DO ilay=2,nlay
324       DO ig=1,ngrid
325          zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1)
326       ENDDO
327    ENDDO
328
329    !-----------------------------------------------------------------------
330    !   integration verticale pour v:
331    !   -----------------------------
332    !
333    DO ig=1,ngrid
334       z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
335       zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig)
336       zd(ig,nlay)=zb(ig,nlay)*z1(ig)
337    ENDDO
338
339    DO ilay=nlay-1,1,-1
340       DO ig=1,ngrid
341          z1(ig)=1./(za(ig,ilay)+zb(ig,ilay) &
342               + zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
343          zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay) &
344               + zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
345          zd(ig,ilay)=zb(ig,ilay)*z1(ig)
346       ENDDO
347    ENDDO
348
349    DO ig=1,ngrid
350       zv(ig,1)=zc(ig,1)
351    ENDDO
352    DO ilay=2,nlay
353       DO ig=1,ngrid
354          zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1)
355       ENDDO
356    ENDDO
357
358    !-----------------------------------------------------------------------
359    !   integration verticale pour h:
360    !   -----------------------------
361    !
362    CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
363    CALL multipl(ngrid,zcdh,zb0,zb)
364    DO ig=1,ngrid
365       z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
366       zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig)
367       zd(ig,nlay)=zb(ig,nlay)*z1(ig)
368    ENDDO
369
370    DO ilay=nlay-1,1,-1
371       DO ig=1,ngrid
372          z1(ig)=1./(za(ig,ilay)+zb(ig,ilay) &
373               + zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
374          zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay) &
375               + zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
376          zd(ig,ilay)=zb(ig,ilay)*z1(ig)
377       ENDDO
378    ENDDO
379
380    !-----------------------------------------------------------------------
381    !   rajout eventuel de planck dans le shema implicite:
382    !   --------------------------------------------------
383
384    z4st=4.*5.67e-8*ptimestep
385    DO ig=1,ngrid
386       zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
387    ENDDO
388
389    !-----------------------------------------------------------------------
390    !   calcul le l evolution de la temperature du sol:
391    !   -----------------------------------------------
392
393    DO ig=1,ngrid
394       z1(ig) = pcapcal(ig)*ptsrf(ig)+cpp*zb(ig,1)*zc(ig,1) &
395            + zdplanck(ig)*ptsrf(ig)+ pfluxsrf(ig)*ptimestep
396       z2(ig) = pcapcal(ig)+cpp*zb(ig,1)*(1.-zd(ig,1))+zdplanck(ig)
397       ztsrf2(ig) = z1(ig)/z2(ig)
398       zh(ig,1) = zc(ig,1)+zd(ig,1)*ztsrf2(ig)
399       pdtsrf(ig) = (ztsrf2(ig)-ptsrf(ig))/ptimestep
400    ENDDO
401
402    !-----------------------------------------------------------------------
403    !   integration verticale finale:
404    !   -----------------------------
405
406    DO ilay=2,nlay
407       DO ig=1,ngrid
408          zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zh(ig,ilay-1)
409       ENDDO
410    ENDDO
411
412    !-----------------------------------------------------------------------
413    !   calcul final des tendances de la diffusion verticale:
414    !   -----------------------------------------------------
415
416    DO ilev = 1, nlay
417       DO ig=1,ngrid
418          pdudif(ig,ilev) = ( zu(ig,ilev) &
419               - (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep) )/ptimestep
420          pdvdif(ig,ilev) = ( zv(ig,ilev) &
421               - (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep) )/ptimestep
422          pdhdif(ig,ilev) = ( zh(ig,ilev) &
423               - (ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep) )/ptimestep
424       ENDDO
425    ENDDO
426
427    IF(lwrite) THEN
428       WRITELOG(*,*)
429       WRITELOG(*,*) 'Diagnostique de la diffusion verticale'
430       WRITELOG(*,*) 'h avant et apres diffusion verticale'
431       WRITELOG(*,*) ptsrf(ngrid/2+1),ztsrf2(ngrid/2+1)
432       DO  ilev=1,nlay
433          WRITELOG(*,*) ph(ngrid/2+1,ilev),zh(ngrid/2+1,ilev)
434       ENDDO
435       LOG_DBG('vdif')
436    END IF
437
438  END SUBROUTINE vdif
439
440END MODULE turbulence
Note: See TracBrowser for help on using the repository browser.