1 | ! |
---|
2 | ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/yamada.F,v 1.1 2004/06/22 11:45:36 lmdzadmin Exp $ |
---|
3 | ! |
---|
4 | SUBROUTINE yamada(ngrid,dt,g,rconst,plev,temp |
---|
5 | s ,zlev,zlay,u,v,teta,cd,q2,km,kn,ustar |
---|
6 | s ,l_mix) |
---|
7 | c....................................................................... |
---|
8 | use dimphy |
---|
9 | IMPLICIT NONE |
---|
10 | c....................................................................... |
---|
11 | c |
---|
12 | c dt : pas de temps |
---|
13 | c g : g |
---|
14 | c zlev : altitude a chaque niveau (interface inferieure de la couche |
---|
15 | c de meme indice) |
---|
16 | c zlay : altitude au centre de chaque couche |
---|
17 | c u,v : vitesse au centre de chaque couche |
---|
18 | c (en entree : la valeur au debut du pas de temps) |
---|
19 | c teta : temperature potentielle au centre de chaque couche |
---|
20 | c (en entree : la valeur au debut du pas de temps) |
---|
21 | c cd : cdrag |
---|
22 | c (en entree : la valeur au debut du pas de temps) |
---|
23 | c q2 : $q^2$ au bas de chaque couche |
---|
24 | c (en entree : la valeur au debut du pas de temps) |
---|
25 | c (en sortie : la valeur a la fin du pas de temps) |
---|
26 | c km : diffusivite turbulente de quantite de mouvement (au bas de chaque |
---|
27 | c couche) |
---|
28 | c (en sortie : la valeur a la fin du pas de temps) |
---|
29 | c kn : diffusivite turbulente des scalaires (au bas de chaque couche) |
---|
30 | c (en sortie : la valeur a la fin du pas de temps) |
---|
31 | c |
---|
32 | c....................................................................... |
---|
33 | REAL dt,g,rconst |
---|
34 | real plev(klon,klev+1),temp(klon,klev) |
---|
35 | real ustar(klon),snstable |
---|
36 | REAL zlev(klon,klev+1) |
---|
37 | REAL zlay(klon,klev) |
---|
38 | REAL u(klon,klev) |
---|
39 | REAL v(klon,klev) |
---|
40 | REAL teta(klon,klev) |
---|
41 | REAL cd(klon) |
---|
42 | REAL q2(klon,klev+1) |
---|
43 | REAL km(klon,klev+1) |
---|
44 | REAL kn(klon,klev+1) |
---|
45 | integer l_mix,ngrid |
---|
46 | |
---|
47 | logical first |
---|
48 | save first |
---|
49 | data first/.true./ |
---|
50 | |
---|
51 | integer ig,k |
---|
52 | |
---|
53 | real ri,zrif,zalpha,zsm |
---|
54 | real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev) |
---|
55 | |
---|
56 | real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1) |
---|
57 | real l(klon,klev+1),l0(klon) |
---|
58 | |
---|
59 | real sq(klon),sqz(klon),zz(klon,klev+1) |
---|
60 | integer iter |
---|
61 | |
---|
62 | real ric,rifc,b1,kap |
---|
63 | save ric,rifc,b1,kap |
---|
64 | data ric,rifc,b1,kap/0.195,0.191,16.6,0.3/ |
---|
65 | |
---|
66 | real frif,falpha,fsm |
---|
67 | |
---|
68 | frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156)) |
---|
69 | falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri) |
---|
70 | fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri)) |
---|
71 | |
---|
72 | if (0.eq.1.and.first) then |
---|
73 | do ig=1,1000 |
---|
74 | ri=(ig-800.)/500. |
---|
75 | if (ri.lt.ric) then |
---|
76 | zrif=frif(ri) |
---|
77 | else |
---|
78 | zrif=rifc |
---|
79 | endif |
---|
80 | if(zrif.lt.0.16) then |
---|
81 | zalpha=falpha(zrif) |
---|
82 | zsm=fsm(zrif) |
---|
83 | else |
---|
84 | zalpha=1.12 |
---|
85 | zsm=0.085 |
---|
86 | endif |
---|
87 | print*,ri,rif,zalpha,zsm |
---|
88 | enddo |
---|
89 | first=.false. |
---|
90 | endif |
---|
91 | |
---|
92 | c Correction d'un bug sauvage a verifier. |
---|
93 | c do k=2,klevp1 |
---|
94 | do k=2,klev |
---|
95 | do ig=1,ngrid |
---|
96 | dz(ig,k)=zlay(ig,k)-zlay(ig,k-1) |
---|
97 | m2(ig,k)=((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig,k-1))**2) |
---|
98 | s /(dz(ig,k)*dz(ig,k)) |
---|
99 | n2(ig,k)=g*2.*(teta(ig,k)-teta(ig,k-1)) |
---|
100 | s /(teta(ig,k-1)+teta(ig,k)) /dz(ig,k) |
---|
101 | ri=n2(ig,k)/max(m2(ig,k),1.e-10) |
---|
102 | if (ri.lt.ric) then |
---|
103 | rif(ig,k)=frif(ri) |
---|
104 | else |
---|
105 | rif(ig,k)=rifc |
---|
106 | endif |
---|
107 | if(rif(ig,k).lt.0.16) then |
---|
108 | alpha(ig,k)=falpha(rif(ig,k)) |
---|
109 | sm(ig,k)=fsm(rif(ig,k)) |
---|
110 | else |
---|
111 | alpha(ig,k)=1.12 |
---|
112 | sm(ig,k)=0.085 |
---|
113 | endif |
---|
114 | zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k) |
---|
115 | enddo |
---|
116 | enddo |
---|
117 | |
---|
118 | c iterration pour determiner la longueur de melange |
---|
119 | |
---|
120 | do ig=1,ngrid |
---|
121 | l0(ig)=100. |
---|
122 | enddo |
---|
123 | do k=2,klev-1 |
---|
124 | do ig=1,ngrid |
---|
125 | l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig)) |
---|
126 | enddo |
---|
127 | enddo |
---|
128 | |
---|
129 | do iter=1,10 |
---|
130 | do ig=1,ngrid |
---|
131 | sq(ig)=1.e-10 |
---|
132 | sqz(ig)=1.e-10 |
---|
133 | enddo |
---|
134 | do k=2,klev-1 |
---|
135 | do ig=1,ngrid |
---|
136 | q2(ig,k)=l(ig,k)**2*zz(ig,k) |
---|
137 | l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig)) |
---|
138 | s ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) |
---|
139 | zq=sqrt(q2(ig,k)) |
---|
140 | sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1)) |
---|
141 | sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1)) |
---|
142 | enddo |
---|
143 | enddo |
---|
144 | do ig=1,ngrid |
---|
145 | l0(ig)=0.2*sqz(ig)/sq(ig) |
---|
146 | enddo |
---|
147 | c(abd 3 5 2) print*,'ITER=',iter,' L0=',l0 |
---|
148 | |
---|
149 | enddo |
---|
150 | |
---|
151 | do k=2,klev |
---|
152 | do ig=1,ngrid |
---|
153 | l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig)) |
---|
154 | s ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) |
---|
155 | q2(ig,k)=l(ig,k)**2*zz(ig,k) |
---|
156 | km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k) |
---|
157 | kn(ig,k)=km(ig,k)*alpha(ig,k) |
---|
158 | enddo |
---|
159 | enddo |
---|
160 | |
---|
161 | return |
---|
162 | end |
---|