source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vdif_kc.F @ 224

Last change on this file since 224 was 222, checked in by ymipsl, 10 years ago

Creating temporary dynamico/lmdz/saturn branche

YM

File size: 18.4 KB
Line 
1      SUBROUTINE vdif_kc(ngrid,dt,g,zlev,zlay,u,v,teta,cd,q2,km,kn)
2      IMPLICIT NONE
3c.......................................................................
4#include "dimensions.h"
5#include "dimphys.h"
6c.......................................................................
7c
8c dt : pas de temps
9c g  : g
10c zlev : altitude a chaque niveau (interface inferieure de la couche
11c        de meme indice)
12c zlay : altitude au centre de chaque couche
13c u,v : vitesse au centre de chaque couche
14c       (en entree : la valeur au debut du pas de temps)
15c teta : temperature potentielle au centre de chaque couche
16c        (en entree : la valeur au debut du pas de temps)
17c cd : cdrag
18c      (en entree : la valeur au debut du pas de temps)
19c q2 : $q^2$ au bas de chaque couche
20c      (en entree : la valeur au debut du pas de temps)
21c      (en sortie : la valeur a la fin du pas de temps)
22c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
23c      couche)
24c      (en sortie : la valeur a la fin du pas de temps)
25c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
26c      (en sortie : la valeur a la fin du pas de temps)
27c 
28c.......................................................................
29      INTEGER,INTENT(IN) :: ngrid
30      REAL,INTENT(IN) :: dt,g
31      REAL,INTENT(IN) :: zlev(ngrid,nlayermx+1)
32      REAL,INTENT(IN) :: zlay(ngrid,nlayermx)
33      REAL,INTENT(IN) :: u(ngrid,nlayermx)
34      REAL,INTENT(IN) :: v(ngrid,nlayermx)
35      REAL,INTENT(IN) :: teta(ngrid,nlayermx)
36      REAL,INTENT(IN) :: cd(ngrid)
37      REAL,INTENT(INOUT) :: q2(ngrid,nlayermx+1)
38      REAL,INTENT(OUT) :: km(ngrid,nlayermx+1)
39      REAL,INTENT(OUT) :: kn(ngrid,nlayermx+1)
40c.......................................................................
41c
42c nlay : nombre de couches       
43c nlev : nombre de niveaux
44c ngrid : nombre de points de grille       
45c unsdz : 1 sur l'epaisseur de couche
46c unsdzdec : 1 sur la distance entre le centre de la couche et le
47c            centre de la couche inferieure
48c q : echelle de vitesse au bas de chaque couche
49c     (valeur a la fin du pas de temps)
50c
51c.......................................................................
52      INTEGER,PARAMETER :: nlay=nlayermx
53      INTEGER,PARAMETER :: nlev=nlayermx+1
54      REAL unsdz(ngrid,nlayermx)
55      REAL unsdzdec(ngrid,nlayermx+1)
56      REAL q(ngrid,nlayermx+1)
57c.......................................................................
58c
59c kmpre : km au debut du pas de temps
60c qcstat : q : solution stationnaire du probleme couple
61c          (valeur a la fin du pas de temps)
62c q2cstat : q2 : solution stationnaire du probleme couple
63c           (valeur a la fin du pas de temps)
64c
65c.......................................................................
66      REAL kmpre(ngrid,nlayermx+1)
67      REAL qcstat
68      REAL q2cstat
69c.......................................................................
70c
71c long : longueur de melange calculee selon Blackadar
72c
73c.......................................................................
74      REAL long(ngrid,nlayermx+1)
75c.......................................................................
76c
77c kmq3 : terme en q^3 dans le developpement de km
78c        (valeur au debut du pas de temps)
79c kmcstat : valeur de km solution stationnaire du systeme {q2 ; du/dz}
80c           (valeur a la fin du pas de temps)
81c knq3 : terme en q^3 dans le developpement de kn
82c mcstat : valeur de m solution stationnaire du systeme {q2 ; du/dz}
83c          (valeur a la fin du pas de temps)
84c m2cstat : valeur de m2 solution stationnaire du systeme {q2 ; du/dz}
85c           (valeur a la fin du pas de temps)
86c m : valeur a la fin du pas de temps
87c mpre : valeur au debut du pas de temps
88c m2 : valeur a la fin du pas de temps
89c n2 : valeur a la fin du pas de temps
90c
91c.......................................................................
92      REAL kmq3
93      REAL kmcstat
94      REAL knq3
95      REAL mcstat
96      REAL m2cstat
97      REAL m(ngrid,nlayermx+1)
98      REAL mpre(ngrid,nlayermx+1)
99      REAL m2(ngrid,nlayermx+1)
100      REAL n2(ngrid,nlayermx+1)
101c.......................................................................
102c
103c gn : intermediaire pour les coefficients de stabilite
104c gnmin : borne inferieure de gn (-0.23 ou -0.28)
105c gnmax : borne superieure de gn (0.0233)
106c gninf : vrai si gn est en dessous de sa borne inferieure
107c gnsup : vrai si gn est en dessus de sa borne superieure
108c gm : drole d'objet bien utile
109c ri : nombre de Richardson
110c sn : coefficient de stabilite pour n
111c snq2 : premier terme du developement limite de sn en q2
112c sm : coefficient de stabilite pour m
113c smq2 : premier terme du developement limite de sm en q2
114c
115c.......................................................................
116      REAL gn
117      REAL,PARAMETER :: gnmin=-10.E+0
118      REAL,PARAMETER :: gnmax=0.0233E+0
119      LOGICAL gninf
120      LOGICAL gnsup
121      REAL gm
122c      REAL ri(ngrid,nlayermx+1)
123      REAL sn(ngrid,nlayermx+1)
124      REAL snq2(ngrid,nlayermx+1)
125      REAL sm(ngrid,nlayermx+1)
126      REAL smq2(ngrid,nlayermx+1)
127c.......................................................................
128c
129c kappa : consatnte de Von Karman (0.4)
130c long0 : longueur de reference pour le calcul de long (160)
131c a1,a2,b1,b2,c1 : constantes d'origine pour les  coefficients
132c                  de stabilite (0.92/0.74/16.6/10.1/0.08)
133c cn1,cn2 : constantes pour sn
134c cm1,cm2,cm3,cm4 : constantes pour sm
135c
136c.......................................................................
137      REAL,PARAMETER :: kappa=0.4E+0
138      REAL,PARAMETER :: long0=160.E+0
139      REAL,PARAMETER :: a1=0.92E+0,a2=0.74E+0
140      REAL,PARAMETER :: b1=16.6E+0,b2=10.1E+0,c1=0.08E+0
141      REAL,PARAMETER :: cn1=a2*(1.E+0 -6.E+0 *a1/b1)
142      REAL,PARAMETER :: cn2=-3.E+0 *a2*(6.E+0 *a1+b2)
143      REAL,PARAMETER :: cm1=a1*(1.E+0 -3.E+0 *c1-6.E+0 *a1/b1)
144      REAL,PARAMETER :: cm2=a1*(-3.E+0 *a2*((b2-3.E+0 *a2)*
145     &          (1.E+0 -6.E+0 *a1/b1)-3.E+0 *c1*(b2+6.E+0 *a1)))
146      REAL,PARAMETER :: cm3=-3.E+0 *a2*(6.E+0 *a1+b2)
147      REAL,PARAMETER :: cm4=-9.E+0 *a1*a2
148c.......................................................................
149c
150c termq : termes en $q$ dans l'equation de q2
151c termq3 : termes en $q^3$ dans l'equation de q2
152c termqm2 : termes en $q*m^2$ dans l'equation de q2
153c termq3m2 : termes en $q^3*m^2$ dans l'equation de q2
154c
155c.......................................................................
156      REAL termq
157      REAL termq3
158      REAL termqm2
159      REAL termq3m2
160c.......................................................................
161c
162c q2min : borne inferieure de q2
163c q2max : borne superieure de q2
164c
165c.......................................................................
166      REAL,PARAMETER :: q2min=1.E-3
167      REAL,PARAMETER :: q2max=1.E+2
168c.......................................................................
169c knmin : borne inferieure de kn
170c kmmin : borne inferieure de km
171c.......................................................................
172      REAL,PARAMETER :: knmin=1.E-5
173      REAL,PARAMETER :: kmmin=1.E-5
174c.......................................................................
175      INTEGER ilay,ilev,igrid
176      REAL tmp1,tmp2
177c.......................................................................
178c
179
180! initialization of local variables:
181      long(:,:)=0.
182      n2(:,:)=0.
183      sn(:,:)=0.
184      snq2(:,:)=0.
185      sm(:,:)=0.
186      smq2(:,:)=0.
187
188c.......................................................................
189c  traitment des valeur de q2 en entree
190c.......................................................................
191c
192      DO ilev=1,nlev
193       DO igrid=1,ngrid
194        q2(igrid,ilev)=amax1(q2(igrid,ilev),q2min)
195        q(igrid,ilev)=sqrt(q2(igrid,ilev))
196       ENDDO
197      ENDDO
198c
199      DO igrid=1,ngrid
200        tmp1=cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2)
201        q2(igrid,1)=b1**(2.E+0/3.E+0)*tmp1
202        q2(igrid,1)=amax1(q2(igrid,1),q2min)
203        q(igrid,1)=sqrt(q2(igrid,1))
204      ENDDO
205c
206c.......................................................................
207c  les increments verticaux
208c.......................................................................
209c
210c!!!!! allerte !!!!!c
211c!!!!! zlev n'est pas declare a nlev !!!!!c
212c!!!!! ---->
213c                                                     DO igrid=1,ngrid 
214c           zlev(igrid,nlev)=zlay(igrid,nlay)
215c    &             +( zlay(igrid,nlay) - zlev(igrid,nlev-1) )
216c                                                     ENDDO           
217c!!!!! <----
218c!!!!! allerte !!!!!c
219c
220      DO ilay=1,nlay
221       DO igrid=1,ngrid
222        unsdz(igrid,ilay)=1.E+0/(zlev(igrid,ilay+1)-zlev(igrid,ilay))
223       ENDDO
224      ENDDO
225
226      DO igrid=1,ngrid
227        unsdzdec(igrid,1)=1.E+0/(zlay(igrid,1)-zlev(igrid,1))
228      ENDDO
229
230      DO ilay=2,nlay
231        DO igrid=1,ngrid
232          unsdzdec(igrid,ilay)=1.E+0/
233     &                          (zlay(igrid,ilay)-zlay(igrid,ilay-1))
234        ENDDO
235      ENDDO
236     
237      DO igrid=1,ngrid
238        unsdzdec(igrid,nlay+1)=1.E+0/
239     &                          (zlev(igrid,nlay+1)-zlay(igrid,nlay))
240      ENDDO
241c
242c.......................................................................
243c  le cisaillement et le gradient de temperature
244c.......................................................................
245c
246      DO igrid=1,ngrid
247        m2(igrid,1)=(unsdzdec(igrid,1)
248     &                   *u(igrid,1))**2
249     &                 +(unsdzdec(igrid,1)
250     &                   *v(igrid,1))**2
251        m(igrid,1)=sqrt(m2(igrid,1))
252        mpre(igrid,1)=m(igrid,1)
253      ENDDO
254c
255c-----------------------------------------------------------------------
256      DO ilev=2,nlev-1
257       DO igrid=1,ngrid
258c-----------------------------------------------------------------------
259c
260        n2(igrid,ilev)=g*unsdzdec(igrid,ilev)
261     &                   *(teta(igrid,ilev)-teta(igrid,ilev-1))
262     &                   /(teta(igrid,ilev)+teta(igrid,ilev-1)) *2.E+0
263c
264c --->
265c       on ne sais traiter que les cas stratifies. et l'ajustement
266c       convectif est cense faire en sorte que seul des configurations
267c       stratifiees soient rencontrees en entree de cette routine.
268c       mais, bon ... on sait jamais (meme on sait que n2 prends
269c       quelques valeurs negatives ... parfois) alors :
270c<---
271c
272        IF (n2(igrid,ilev).lt.0.E+0) THEN
273          n2(igrid,ilev)=0.E+0
274        ENDIF
275c
276        m2(igrid,ilev)=(unsdzdec(igrid,ilev)
277     &                     *(u(igrid,ilev)-u(igrid,ilev-1)))**2
278     &                   +(unsdzdec(igrid,ilev)
279     &                     *(v(igrid,ilev)-v(igrid,ilev-1)))**2
280        m(igrid,ilev)=sqrt(m2(igrid,ilev))
281        mpre(igrid,ilev)=m(igrid,ilev)
282c
283c-----------------------------------------------------------------------
284       ENDDO
285      ENDDO
286c-----------------------------------------------------------------------
287c
288      DO igrid=1,ngrid
289        m2(igrid,nlev)=m2(igrid,nlev-1)
290        m(igrid,nlev)=m(igrid,nlev-1)
291        mpre(igrid,nlev)=m(igrid,nlev)
292      ENDDO
293     
294c
295c.......................................................................
296c  calcul des fonctions de stabilite
297c.......................................................................
298c
299c-----------------------------------------------------------------------
300      DO ilev=2,nlev-1
301       DO igrid=1,ngrid
302c-----------------------------------------------------------------------
303c
304        tmp1=kappa*(zlev(igrid,ilev)-zlev(igrid,1))
305        long(igrid,ilev)=tmp1/(1.E+0 + tmp1/long0)
306        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
307     &                                           * n2(igrid,ilev)
308        gm=long(igrid,ilev)**2 / q2(igrid,ilev)
309     &                                           * m2(igrid,ilev)
310c
311        gninf=.false.
312        gnsup=.false.
313        long(igrid,ilev)=long(igrid,ilev)
314        long(igrid,ilev)=long(igrid,ilev)
315c
316        IF (gn.lt.gnmin) THEN
317          gninf=.true.
318          gn=gnmin
319        ENDIF
320c
321        IF (gn.gt.gnmax) THEN
322          gnsup=.true.
323          gn=gnmax
324        ENDIF
325c
326        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
327        sm(igrid,ilev)=
328     &    (cm1+cm2*gn)
329     &   /( (1.E+0 +cm3*gn)
330     &     *(1.E+0 +cm4*gn) )
331c
332        IF ((gninf).or.(gnsup)) THEN
333          snq2(igrid,ilev)=0.E+0
334          smq2(igrid,ilev)=0.E+0
335        ELSE
336          snq2(igrid,ilev)=
337     &     -gn
338     &     *(-cn1*cn2/(1.E+0 +cn2*gn)**2 )
339          smq2(igrid,ilev)=
340     &     -gn
341     &     *( cm2*(1.E+0 +cm3*gn)
342     &           *(1.E+0 +cm4*gn)
343     &       -( cm3*(1.E+0 +cm4*gn)
344     &         +cm4*(1.E+0 +cm3*gn) )
345     &       *(cm1+cm2*gn)            )
346     &     /( (1.E+0 +cm3*gn)
347     &       *(1.E+0 +cm4*gn) )**2
348        ENDIF
349c
350c --->
351c       la decomposition de Taylor en q2 n'a de sens que
352c       dans les cas stratifies ou sn et sm sont quasi
353c       proportionnels a q2. ailleurs on laisse le meme
354c       algorithme car l'ajustement convectif fait le travail.
355c       mais c'est delirant quand sn et snq2 n'ont pas le meme
356c       signe : dans ces cas, on ne fait pas la decomposition.
357c<---
358c
359        IF (snq2(igrid,ilev)*sn(igrid,ilev).le.0.E+0)
360     &      snq2(igrid,ilev)=0.E+0
361        IF (smq2(igrid,ilev)*sm(igrid,ilev).le.0.E+0)
362     &      smq2(igrid,ilev)=0.E+0
363c
364c-----------------------------------------------------------------------
365       ENDDO ! of DO igrid=1,ngrid
366      ENDDO ! of DO ilev=2,nlev-1
367c-----------------------------------------------------------------------
368c
369c.......................................................................
370c  calcul de km et kn au debut du pas de temps
371c.......................................................................
372c
373      DO igrid=1,ngrid
374        kn(igrid,1)=knmin
375        km(igrid,1)=kmmin
376        kmpre(igrid,1)=km(igrid,1)
377      ENDDO
378c
379c-----------------------------------------------------------------------
380      DO ilev=2,nlev-1
381       DO igrid=1,ngrid
382        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
383     &                                         *sn(igrid,ilev)
384        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
385     &                                         *sm(igrid,ilev)
386        kmpre(igrid,ilev)=km(igrid,ilev)
387       ENDDO
388      ENDDO
389c-----------------------------------------------------------------------
390c
391      DO igrid=1,ngrid
392        kn(igrid,nlev)=kn(igrid,nlev-1)
393        km(igrid,nlev)=km(igrid,nlev-1)
394        kmpre(igrid,nlev)=km(igrid,nlev)
395      ENDDO
396c
397c.......................................................................
398c  boucle sur les niveaux 2 a nlev-1
399c.......................................................................
400c
401c---->
402      DO 10001 ilev=2,nlev-1
403c---->
404      DO 10002 igrid=1,ngrid
405c
406c.......................................................................
407c
408c  calcul des termes sources et puits de l'equation de q2
409c  ------------------------------------------------------
410c
411        knq3=kn(igrid,ilev)*snq2(igrid,ilev)
412     &                                    /sn(igrid,ilev)
413        kmq3=km(igrid,ilev)*smq2(igrid,ilev)
414     &                                    /sm(igrid,ilev)
415c
416        termq=0.E+0
417        termq3=0.E+0
418        termqm2=0.E+0
419        termq3m2=0.E+0
420c
421        tmp1=dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
422        tmp2=dt*2.E+0 *kmq3*m2(igrid,ilev)
423        termqm2=termqm2
424     &    +dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
425     &    -dt*2.E+0 *kmq3*m2(igrid,ilev)
426        termq3m2=termq3m2
427     &    +dt*2.E+0 *kmq3*m2(igrid,ilev)
428c 
429        termq=termq
430     &    -dt*2.E+0 *kn(igrid,ilev)*n2(igrid,ilev)
431     &    +dt*2.E+0 *knq3*n2(igrid,ilev)
432        termq3=termq3
433     &    -dt*2.E+0 *knq3*n2(igrid,ilev)
434c
435        termq3=termq3
436     &    -dt*2.E+0 *q(igrid,ilev)**3 / (b1*long(igrid,ilev))
437c
438c.......................................................................
439c
440c  resolution stationnaire couplee avec le gradient de vitesse local
441c  -----------------------------------------------------------------
442c
443c  -----{on cherche le cisaillement qui annule l'equation de q^2
444c        supposee en q3}
445c
446        tmp1=termq+termq3
447        tmp2=termqm2+termq3m2
448        m2cstat=m2(igrid,ilev)
449     &      -(tmp1+tmp2)/(dt*2.E+0*km(igrid,ilev))
450        mcstat=sqrt(m2cstat)
451c
452c  -----{puis on ecrit la valeur de q qui annule l'equation de m
453c        supposee en q3}
454c
455        IF (ilev.eq.2) THEN
456          kmcstat=1.E+0 / mcstat
457     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
458     &                        *mpre(igrid,ilev+1)
459     &      +unsdz(igrid,ilev-1)
460     &              *cd(igrid)
461     &              *( sqrt(u(igrid,3)**2+v(igrid,3)**2)
462     &                -mcstat/unsdzdec(igrid,ilev)
463     &                -mpre(igrid,ilev+1)/unsdzdec(igrid,ilev+1) )**2)
464     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
465        ELSE
466          kmcstat=1.E+0 / mcstat
467     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
468     &                        *mpre(igrid,ilev+1)
469     &      +unsdz(igrid,ilev-1)*kmpre(igrid,ilev-1)
470     &                          *mpre(igrid,ilev-1) )
471     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
472        ENDIF
473        tmp2=kmcstat
474     &      /( sm(igrid,ilev)/q2(igrid,ilev) )
475     &      /long(igrid,ilev)
476        qcstat=tmp2**(1.E+0/3.E+0)
477        q2cstat=qcstat**2
478c
479c.......................................................................
480c
481c  choix de la solution finale
482c  ---------------------------
483c
484          q(igrid,ilev)=qcstat
485          q2(igrid,ilev)=q2cstat
486          m(igrid,ilev)=mcstat
487          m2(igrid,ilev)=m2cstat
488c
489c --->
490c       pour des raisons simples q2 est minore 
491c<---
492c
493        IF (q2(igrid,ilev).lt.q2min) THEN
494          q2(igrid,ilev)=q2min
495          q(igrid,ilev)=sqrt(q2min)
496        ENDIF
497c
498c.......................................................................
499c
500c  calcul final de kn et km
501c  ------------------------
502c
503        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
504     &                                           * n2(igrid,ilev)
505        IF (gn.lt.gnmin) gn=gnmin
506        IF (gn.gt.gnmax) gn=gnmax
507        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
508        sm(igrid,ilev)=
509     &    (cm1+cm2*gn)
510     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
511        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
512     &                 *sn(igrid,ilev)
513        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
514     &                 *sm(igrid,ilev)
515c
516c.......................................................................
517c
51810002 CONTINUE
519c
52010001 CONTINUE
521c
522c.......................................................................
523c
524c
525      DO igrid=1,ngrid
526        kn(igrid,1)=knmin
527        km(igrid,1)=kmmin
528        q2(igrid,nlev)=q2(igrid,nlev-1)
529        q(igrid,nlev)=q(igrid,nlev-1)
530        kn(igrid,nlev)=kn(igrid,nlev-1)
531        km(igrid,nlev)=km(igrid,nlev-1)
532      ENDDO
533
534      END
Note: See TracBrowser for help on using the repository browser.