/[lmdze]/trunk/libf/phylmd/yamada.f
ViewVC logotype

Contents of /trunk/libf/phylmd/yamada.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 12 - (show annotations)
Mon Jul 21 16:05:07 2008 UTC (15 years, 10 months ago) by guez
File size: 5566 byte(s) 
-- Minor modification of input/output:

Created procedure "read_logic". Variables of module "logic" are read
by "read_logic" instead of "conf_gcm". Variable "offline" of module
"conf_gcm" is read from namelist instead of "*.def".

Deleted arguments "dtime", "co2_ppm_etat0", "solaire_etat0",
"tabcntr0" and local variables "radpas", "tab_cntrl" of
"phyetat0". "phyetat0" does not read "controle" in "startphy.nc" any
longer. "phyetat0" now reads global attribute "itau_phy" from
"startphy.nc". "phyredem" does not create variable "controle" in
"startphy.nc" any longer. "phyredem" now writes global attribute
"itau_phy" of "startphy.nc". Deleted argument "tabcntr0" of
"printflag". Removed diagnostic messages written by "printflag" for
comparison of the variable "controle" of "startphy.nc" and the
variables read from "*.def" or namelist input.

-- Removing unwanted functionality:

Removed variable "lunout" from module "iniprint", replaced everywhere
by standard output.

Removed case "ocean == 'couple'" in "clmain", "interfsurf_hq" and
"physiq". Removed procedure "interfoce_cpl".

-- Should not change anything at run time:

Automated creation of graphs in documentation. More documentation on
input files.

Converted Fortran files to free format: "phyredem.f90", "printflag.f90".

Split module "clesphy" into "clesphys" and "clesphys2".

Removed variables "conser", "leapf", "forward", "apphys", "apdiss" and
"statcl" from module "logic". Added arguments "conser" to "advect",
"leapf" to "integrd". Added local variables "forward", "leapf",
"apphys", "conser", "apdiss" in "leapfrog".

Added intent attributes.

Deleted arguments "dtime" of "phyredem", "pdtime" of "flxdtdq", "sh"
of "phytrac", "dt" of "yamada".

Deleted local variables "dtime", "co2_ppm_etat0", "solaire_etat0",
"length", "tabcntr0" in "physiq". Replaced all references to "dtime"
by references to "pdtphys".
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,g,rconst,plev,temp
5 s ,zlev,zlay,u,v,teta,cd,q2,km,kn,ustar
6 s ,l_mix)
7 use dimens_m
8 use dimphy
9 IMPLICIT NONE
10 c.......................................................................
11 c.......................................................................
12 c
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 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
48 integer nlay,nlev
49 PARAMETER (nlay=klev)
50 PARAMETER (nlev=klev+1)
51
52 logical first
53 save first
54 data first/.true./
55
56
57 integer ig,k
58
59 real ri,zrif,zalpha,zsm
60 real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
61
62 real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
63 real l(klon,klev+1),l0(klon)
64
65 real sq(klon),sqz(klon),zz(klon,klev+1)
66 integer iter
67
68 real ric,rifc,b1,kap
69 save ric,rifc,b1,kap
70 data ric,rifc,b1,kap/0.195,0.191,16.6,0.3/
71
72 real frif,falpha,fsm
73
74 frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
75 falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri)
76 fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
77
78 if (0.eq.1.and.first) then
79 do ig=1,1000
80 ri=(ig-800.)/500.
81 if (ri.lt.ric) then
82 zrif=frif(ri)
83 else
84 zrif=rifc
85 endif
86 if(zrif.lt.0.16) then
87 zalpha=falpha(zrif)
88 zsm=fsm(zrif)
89 else
90 zalpha=1.12
91 zsm=0.085
92 endif
93 print*,ri,rif,zalpha,zsm
94 enddo
95 first=.false.
96 endif
97
98 c Correction d'un bug sauvage a verifier.
99 c do k=2,nlev
100 do k=2,nlay
101 do ig=1,ngrid
102 dz(ig,k)=zlay(ig,k)-zlay(ig,k-1)
103 m2(ig,k)=((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig,k-1))**2)
104 s /(dz(ig,k)*dz(ig,k))
105 n2(ig,k)=g*2.*(teta(ig,k)-teta(ig,k-1))
106 s /(teta(ig,k-1)+teta(ig,k)) /dz(ig,k)
107 ri=n2(ig,k)/max(m2(ig,k),1.e-10)
108 if (ri.lt.ric) then
109 rif(ig,k)=frif(ri)
110 else
111 rif(ig,k)=rifc
112 endif
113 if(rif(ig,k).lt.0.16) then
114 alpha(ig,k)=falpha(rif(ig,k))
115 sm(ig,k)=fsm(rif(ig,k))
116 else
117 alpha(ig,k)=1.12
118 sm(ig,k)=0.085
119 endif
120 zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k)
121 enddo
122 enddo
123
124 c iterration pour determiner la longueur de melange
125
126 do ig=1,ngrid
127 l0(ig)=100.
128 enddo
129 do k=2,klev-1
130 do ig=1,ngrid
131 l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
132 enddo
133 enddo
134
135 do iter=1,10
136 do ig=1,ngrid
137 sq(ig)=1.e-10
138 sqz(ig)=1.e-10
139 enddo
140 do k=2,klev-1
141 do ig=1,ngrid
142 q2(ig,k)=l(ig,k)**2*zz(ig,k)
143 l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
144 s ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10)))
145 zq=sqrt(q2(ig,k))
146 sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
147 sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
148 enddo
149 enddo
150 do ig=1,ngrid
151 l0(ig)=0.2*sqz(ig)/sq(ig)
152 enddo
153 c(abd 3 5 2) print*,'ITER=',iter,' L0=',l0
154
155 enddo
156
157 do k=2,klev
158 do ig=1,ngrid
159 l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
160 s ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10)))
161 q2(ig,k)=l(ig,k)**2*zz(ig,k)
162 km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
163 kn(ig,k)=km(ig,k)*alpha(ig,k)
164 enddo
165 enddo
166
167 return
168 end
  ViewVC Help
Powered by ViewVC 1.1.21