source: dynamico_lmdz/simple_physics/phyparam/physics/vdif_mod.F90 @ 4191

Last change on this file since 4191 was 4189, checked in by dubos, 5 years ago

simple_physics : cleanup

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