/[lmdze]/trunk/Sources/phylmd/yamada4.f
ViewVC logotype

Annotation of /trunk/Sources/phylmd/yamada4.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (hide annotations)
Tue Aug 5 13:31:32 2008 UTC (15 years, 9 months ago) by guez
Original Path: trunk/libf/phylmd/yamada4.f
File size: 15589 byte(s)
Created rule for "compare_sampl_*" files in
"Documentation/Manuel_LMDZE.texfol/Graphiques/GNUmakefile".

Extracted "qcheck", "radiornpb", "minmaxqfi" into separate files.

Read pressure coordinate of ozone coefficients once per run instead of
every day.

Added some "intent" attributes.

Added argument "nq" to "ini_histday". Replaced calls to "gr_fi_ecrit"
by calls to "gr_phy_write_2d". "Sigma_O3_Royer" is written to
"histday.nc" only if "nq >= 4". Moved "ini_histrac" to module
"ini_hist".

Compute "zmasse" in "physiq", pass it to "phytrac".

Removed computations of "pftsol*" and "ppsrf*" in "phytrac".

Do not use variable "rg" from module "YOMCST" in "TLIFT".

1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/yamada4.F,v 1.1 2004/06/22 11:45:36 lmdzadmin Exp $
3     !
4     SUBROUTINE yamada4(ngrid,dt,g,rconst,plev,temp
5     s ,zlev,zlay,u,v,teta,cd,q2,km,kn,kq,ustar
6     s ,iflag_pbl)
7     use dimens_m
8     use dimphy
9     IMPLICIT NONE
10     c.......................................................................
11     c.......................................................................
12     c
13     c dt : pas de temps
14     c g : g
15     c zlev : altitude a chaque niveau (interface inferieure de la couche
16     c de meme indice)
17     c zlay : altitude au centre de chaque couche
18     c u,v : vitesse au centre de chaque couche
19     c (en entree : la valeur au debut du pas de temps)
20     c teta : temperature potentielle au centre de chaque couche
21     c (en entree : la valeur au debut du pas de temps)
22     c cd : cdrag
23     c (en entree : la valeur au debut du pas de temps)
24     c q2 : $q^2$ au bas de chaque couche
25     c (en entree : la valeur au debut du pas de temps)
26     c (en sortie : la valeur a la fin du pas de temps)
27     c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
28     c couche)
29     c (en sortie : la valeur a la fin du pas de temps)
30     c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
31     c (en sortie : la valeur a la fin du pas de temps)
32     c
33     c iflag_pbl doit valoir entre 6 et 9
34     c l=6, on prend systematiquement une longueur d'equilibre
35     c iflag_pbl=6 : MY 2.0
36     c iflag_pbl=7 : MY 2.0.Fournier
37     c iflag_pbl=8 : MY 2.5
38     c iflag_pbl=9 : un test ?
39    
40     c.......................................................................
41 guez 12 REAL, intent(in):: dt
42 guez 17 real, intent(in):: g
43     real rconst
44 guez 3 real plev(klon,klev+1),temp(klon,klev)
45     real ustar(klon)
46     real kmin,qmin,pblhmin(klon),coriol(klon)
47     REAL zlev(klon,klev+1)
48     REAL zlay(klon,klev)
49     REAL u(klon,klev)
50     REAL v(klon,klev)
51     REAL teta(klon,klev)
52     REAL cd(klon)
53     REAL q2(klon,klev+1),qpre
54     REAL unsdz(klon,klev)
55     REAL unsdzdec(klon,klev+1)
56    
57     REAL km(klon,klev+1)
58     REAL kmpre(klon,klev+1),tmp2
59     REAL mpre(klon,klev+1)
60     REAL kn(klon,klev+1)
61     REAL kq(klon,klev+1)
62     real ff(klon,klev+1),delta(klon,klev+1)
63     real aa(klon,klev+1),aa0,aa1
64     integer iflag_pbl,ngrid
65    
66    
67     integer nlay,nlev
68     PARAMETER (nlay=klev)
69     PARAMETER (nlev=klev+1)
70    
71     logical first
72     integer ipas
73     save first,ipas
74     data first,ipas/.true.,0/
75    
76    
77     integer ig,k
78    
79    
80     real ri,zrif,zalpha,zsm,zsn
81     real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
82    
83     real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
84     real dtetadz(klon,klev+1)
85     real m2cstat,mcstat,kmcstat
86     real l(klon,klev+1),l0(klon)
87     save l0
88    
89     real sq(klon),sqz(klon),zz(klon,klev+1)
90     integer iter
91    
92     real ric,rifc,b1,kap
93     save ric,rifc,b1,kap
94     data ric,rifc,b1,kap/0.195,0.191,16.6,0.4/
95    
96     real frif,falpha,fsm
97     real fl,zzz,zl0,zq2,zn2
98    
99     real rino(klon,klev+1),smyam(klon,klev),styam(klon,klev)
100     s ,lyam(klon,klev),knyam(klon,klev)
101     s ,w2yam(klon,klev),t2yam(klon,klev)
102     common/pbldiag/rino,smyam,styam,lyam,knyam,w2yam,t2yam
103    
104     frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
105     falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri)
106     fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
107     fl(zzz,zl0,zq2,zn2)=
108     s max(min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
109     s ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) ,1.)
110    
111     if (.not.(iflag_pbl.ge.6.and.iflag_pbl.le.9)) then
112     stop'probleme de coherence dans appel a MY'
113     endif
114    
115     ipas=ipas+1
116     if (0.eq.1.and.first) then
117     do ig=1,1000
118     ri=(ig-800.)/500.
119     if (ri.lt.ric) then
120     zrif=frif(ri)
121     else
122     zrif=rifc
123     endif
124     if(zrif.lt.0.16) then
125     zalpha=falpha(zrif)
126     zsm=fsm(zrif)
127     else
128     zalpha=1.12
129     zsm=0.085
130     endif
131     c print*,ri,rif,zalpha,zsm
132     enddo
133     endif
134    
135     c.......................................................................
136     c les increments verticaux
137     c.......................................................................
138     c
139     c!!!!! allerte !!!!!c
140     c!!!!! zlev n'est pas declare a nlev !!!!!c
141     c!!!!! ---->
142     DO ig=1,ngrid
143     zlev(ig,nlev)=zlay(ig,nlay)
144     & +( zlay(ig,nlay) - zlev(ig,nlev-1) )
145     ENDDO
146     c!!!!! <----
147     c!!!!! allerte !!!!!c
148     c
149     DO k=1,nlay
150     DO ig=1,ngrid
151     unsdz(ig,k)=1.E+0/(zlev(ig,k+1)-zlev(ig,k))
152     ENDDO
153     ENDDO
154     DO ig=1,ngrid
155     unsdzdec(ig,1)=1.E+0/(zlay(ig,1)-zlev(ig,1))
156     ENDDO
157     DO k=2,nlay
158     DO ig=1,ngrid
159     unsdzdec(ig,k)=1.E+0/(zlay(ig,k)-zlay(ig,k-1))
160     ENDDO
161     ENDDO
162     DO ig=1,ngrid
163     unsdzdec(ig,nlay+1)=1.E+0/(zlev(ig,nlay+1)-zlay(ig,nlay))
164     ENDDO
165     c
166     c.......................................................................
167    
168     do k=2,klev
169     do ig=1,ngrid
170     dz(ig,k)=zlay(ig,k)-zlay(ig,k-1)
171     m2(ig,k)=((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig,k-1))**2)
172     s /(dz(ig,k)*dz(ig,k))
173     dtetadz(ig,k)=(teta(ig,k)-teta(ig,k-1))/dz(ig,k)
174     n2(ig,k)=g*2.*dtetadz(ig,k)/(teta(ig,k-1)+teta(ig,k))
175     c n2(ig,k)=0.
176     ri=n2(ig,k)/max(m2(ig,k),1.e-10)
177     if (ri.lt.ric) then
178     rif(ig,k)=frif(ri)
179     else
180     rif(ig,k)=rifc
181     endif
182     if(rif(ig,k).lt.0.16) then
183     alpha(ig,k)=falpha(rif(ig,k))
184     sm(ig,k)=fsm(rif(ig,k))
185     else
186     alpha(ig,k)=1.12
187     sm(ig,k)=0.085
188     endif
189     zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k)
190     c print*,'RIF L=',k,rif(ig,k),ri*alpha(ig,k)
191    
192    
193     enddo
194     enddo
195    
196    
197     c====================================================================
198     c Au premier appel, on determine l et q2 de facon iterative.
199     c iterration pour determiner la longueur de melange
200    
201    
202     if (first.or.iflag_pbl.eq.6) then
203     do ig=1,ngrid
204     l0(ig)=10.
205     enddo
206     do k=2,klev-1
207     do ig=1,ngrid
208     l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
209     enddo
210     enddo
211    
212     do iter=1,10
213     do ig=1,ngrid
214     sq(ig)=1.e-10
215     sqz(ig)=1.e-10
216     enddo
217     do k=2,klev-1
218     do ig=1,ngrid
219     q2(ig,k)=l(ig,k)**2*zz(ig,k)
220     l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k))
221     zq=sqrt(q2(ig,k))
222     sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
223     sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
224     enddo
225     enddo
226     do ig=1,ngrid
227     l0(ig)=0.2*sqz(ig)/sq(ig)
228     c l0(ig)=30.
229     enddo
230     c print*,'ITER=',iter,' L0=',l0
231    
232     enddo
233    
234     c print*,'Fin de l initialisation de q2 et l0'
235    
236     endif ! first
237    
238     c====================================================================
239     c Calcul de la longueur de melange.
240     c====================================================================
241    
242     c Mise a jour de l0
243     do ig=1,ngrid
244     sq(ig)=1.e-10
245     sqz(ig)=1.e-10
246     enddo
247     do k=2,klev-1
248     do ig=1,ngrid
249     zq=sqrt(q2(ig,k))
250     sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
251     sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
252     enddo
253     enddo
254     do ig=1,ngrid
255     l0(ig)=0.2*sqz(ig)/sq(ig)
256     c l0(ig)=30.
257     enddo
258     c print*,'ITER=',iter,' L0=',l0
259     c calcul de l(z)
260     do k=2,klev
261     do ig=1,ngrid
262     l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k))
263     if(first) then
264     q2(ig,k)=l(ig,k)**2*zz(ig,k)
265     endif
266     enddo
267     enddo
268    
269     c====================================================================
270     c Yamada 2.0
271     c====================================================================
272     if (iflag_pbl.eq.6) then
273    
274     do k=2,klev
275     do ig=1,ngrid
276     q2(ig,k)=l(ig,k)**2*zz(ig,k)
277     enddo
278     enddo
279    
280    
281     else if (iflag_pbl.eq.7) then
282     c====================================================================
283     c Yamada 2.Fournier
284     c====================================================================
285    
286     c Calcul de l, km, au pas precedent
287     do k=2,klev
288     do ig=1,ngrid
289     c print*,'SMML=',sm(ig,k),l(ig,k)
290     delta(ig,k)=q2(ig,k)/(l(ig,k)**2*sm(ig,k))
291     kmpre(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
292     mpre(ig,k)=sqrt(m2(ig,k))
293     c print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k)
294     enddo
295     enddo
296    
297     do k=2,klev-1
298     do ig=1,ngrid
299     m2cstat=max(alpha(ig,k)*n2(ig,k)+delta(ig,k)/b1,1.e-12)
300     mcstat=sqrt(m2cstat)
301    
302     c print*,'M2 L=',k,mpre(ig,k),mcstat
303     c
304     c -----{puis on ecrit la valeur de q qui annule l'equation de m
305     c supposee en q3}
306     c
307     IF (k.eq.2) THEN
308     kmcstat=1.E+0 / mcstat
309     & *( unsdz(ig,k)*kmpre(ig,k+1)
310     & *mpre(ig,k+1)
311     & +unsdz(ig,k-1)
312     & *cd(ig)
313     & *( sqrt(u(ig,3)**2+v(ig,3)**2)
314     & -mcstat/unsdzdec(ig,k)
315     & -mpre(ig,k+1)/unsdzdec(ig,k+1) )**2)
316     & /( unsdz(ig,k)+unsdz(ig,k-1) )
317     ELSE
318     kmcstat=1.E+0 / mcstat
319     & *( unsdz(ig,k)*kmpre(ig,k+1)
320     & *mpre(ig,k+1)
321     & +unsdz(ig,k-1)*kmpre(ig,k-1)
322     & *mpre(ig,k-1) )
323     & /( unsdz(ig,k)+unsdz(ig,k-1) )
324     ENDIF
325     c print*,'T2 L=',k,tmp2
326     tmp2=kmcstat
327     & /( sm(ig,k)/q2(ig,k) )
328     & /l(ig,k)
329     q2(ig,k)=max(tmp2,1.e-12)**(2./3.)
330     c print*,'Q2 L=',k,q2(ig,k)
331     c
332     enddo
333     enddo
334    
335     else if (iflag_pbl.ge.8) then
336     c====================================================================
337     c Yamada 2.5 a la Didi
338     c====================================================================
339    
340    
341     c Calcul de l, km, au pas precedent
342     do k=2,klev
343     do ig=1,ngrid
344     c print*,'SMML=',sm(ig,k),l(ig,k)
345     delta(ig,k)=q2(ig,k)/(l(ig,k)**2*sm(ig,k))
346     if (delta(ig,k).lt.1.e-20) then
347     c print*,'ATTENTION L=',k,' Delta=',delta(ig,k)
348     delta(ig,k)=1.e-20
349     endif
350     km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
351     aa0=
352     s (m2(ig,k)-alpha(ig,k)*n2(ig,k)-delta(ig,k)/b1)
353     aa1=
354     s (m2(ig,k)*(1.-rif(ig,k))-delta(ig,k)/b1)
355     c abder print*,'AA L=',k,aa0,aa1,aa1/max(m2(ig,k),1.e-20)
356     aa(ig,k)=aa1*dt/(delta(ig,k)*l(ig,k))
357     c print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k)
358     qpre=sqrt(q2(ig,k))
359     if (iflag_pbl.eq.8 ) then
360     if (aa(ig,k).gt.0.) then
361     q2(ig,k)=(qpre+aa(ig,k)*qpre*qpre)**2
362     else
363     q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
364     endif
365     else ! iflag_pbl=9
366     if (aa(ig,k)*qpre.gt.0.9) then
367     q2(ig,k)=(qpre*10.)**2
368     else
369     q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
370     endif
371     endif
372     q2(ig,k)=min(max(q2(ig,k),1.e-10),1.e4)
373     c print*,'Q2 L=',k,q2(ig,k),qpre*qpre
374     enddo
375     enddo
376    
377     endif ! Fin du cas 8
378    
379     c print*,'OK8'
380    
381     c====================================================================
382     c Calcul des coefficients de mélange
383     c====================================================================
384     do k=2,klev
385     c print*,'k=',k
386     do ig=1,ngrid
387     cabde print*,'KML=',l(ig,k),q2(ig,k),sm(ig,k)
388     zq=sqrt(q2(ig,k))
389     km(ig,k)=l(ig,k)*zq*sm(ig,k)
390     kn(ig,k)=km(ig,k)*alpha(ig,k)
391     kq(ig,k)=l(ig,k)*zq*0.2
392     c print*,'KML=',km(ig,k),kn(ig,k)
393     enddo
394     enddo
395    
396     c Traitement des cas noctrunes avec l'introduction d'une longueur
397     c minilale.
398    
399     c====================================================================
400     c Traitement particulier pour les cas tres stables.
401     c D'apres Holtslag Boville.
402    
403     print*,'YAMADA4 0'
404    
405     do ig=1,ngrid
406     coriol(ig)=1.e-4
407     pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5)
408     enddo
409    
410     print*,'pblhmin ',pblhmin
411     CTest a remettre 21 11 02
412     c test abd 13 05 02 if(0.eq.1) then
413     if(1.eq.1) then
414     do k=2,klev
415     do ig=1,klon
416     if (teta(ig,2).gt.teta(ig,1)) then
417     qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
418     kmin=kap*zlev(ig,k)*qmin
419     else
420     kmin=-1. ! kmin n'est utilise que pour les SL stables.
421     endif
422     if (kn(ig,k).lt.kmin.or.km(ig,k).lt.kmin) then
423     c print*,'Seuil min Km K=',k,kmin,km(ig,k),kn(ig,k)
424     c s ,sqrt(q2(ig,k)),pblhmin(ig),qmin/sm(ig,k)
425     kn(ig,k)=kmin
426     km(ig,k)=kmin
427     kq(ig,k)=kmin
428     c la longueur de melange est suposee etre l= kap z
429     c K=l q Sm d'ou q2=(K/l Sm)**2
430     q2(ig,k)=(qmin/sm(ig,k))**2
431     endif
432     enddo
433     enddo
434     endif
435    
436     print*,'YAMADA4 1'
437     c Diagnostique pour stokage
438    
439     rino=rif
440     smyam(:,1:klev)=sm(:,1:klev)
441     styam=sm(:,1:klev)*alpha(:,1:klev)
442     lyam(1:klon,1:klev)=l(:,1:klev)
443     knyam(1:klon,1:klev)=kn(:,1:klev)
444    
445     c Estimations de w'2 et T'2 d'apres Abdela et McFarlane
446    
447     if(1.eq.0)then
448     w2yam=q2(:,1:klev)*0.24
449     s +lyam(:,1:klev)*5.17*kn(:,1:klev)*n2(:,1:klev)
450     s /sqrt(q2(:,1:klev))
451    
452     t2yam=9.1*kn(:,1:klev)*dtetadz(:,1:klev)**2/sqrt(q2(:,1:klev))
453     s *lyam(:,1:klev)
454     endif
455    
456     c print*,'OKFIN'
457     first=.false.
458     return
459     end

  ViewVC Help
Powered by ViewVC 1.1.21