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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 12 - (hide annotations)
Mon Jul 21 16:05:07 2008 UTC (15 years, 10 months ago) by guez
Original Path: trunk/libf/phylmd/yamada.f
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 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/yamada.F,v 1.1 2004/06/22 11:45:36 lmdzadmin Exp $
3     !
4 guez 12 SUBROUTINE yamada(ngrid,g,rconst,plev,temp
5 guez 3 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 guez 12 REAL g,rconst
34 guez 3 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