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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 202 - (hide annotations)
Wed Jun 8 12:23:41 2016 UTC (7 years, 9 months ago) by guez
File size: 21124 byte(s)
Promoted lmt_pas from local variable of physiq to variable of module
conf_gcm_m.

Removed variable run_off of module interface_surf. Was not
used. Called run_off_ter in LMDZ, but not used nor printed there
either.

Simplified logic in interfoce_lim. The way it was convoluted with
interfsurf_hq and clmain was quite a mess. Extracted reading of SST
into a separate procedure: read_sst. We do not need SST and pctsrf_new
at the same time: SST is not needed for sea-ice surface. I did not
like this programming: going through the procedure repeatedly for
different purposes and testing inside whether there was something to
do or it was already done. Reading is now only controlled by itap and
lmt_pas, instead of debut, jour, jour_lu and deja_lu. Now we do not
copy from pct_tmp to pctsrf_new every time step.

Simplified processing of pctsrf in clmain and below. It was quite
troubling: pctsrf_new was intent out in interfoce_lim but only defined
for ocean and sea-ice. Also the idea of having arrays for all
surfaces, pcsrf and pctsrf_new, in interfsurf_hq, which is called for
a particular surface, was troubling. pctsrf_new for all surfaces was
intent out in intefsurf_hq, but not defined for all surfaces at each
call. Removed argument pctsrf_new of clmain: was a duplicate of pctsrf
on output, and not used in physiq. Replaced pctsrf_new in clmain by
pctsrf_new_oce and pctsrf_new_sic, which were the only ones modified.

1 guez 38 module clmain_m
2 guez 3
3 guez 38 IMPLICIT NONE
4 guez 3
5 guez 38 contains
6 guez 3
7 guez 202 SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, jour, rmu0, ts, cdmmax, &
8     cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, snow, &
9     qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &
10     rlat, rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11     flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12     zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13     trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
14 guez 3
15 guez 99 ! From phylmd/clmain.F, version 1.6, 2005/11/16 14:47:19
16 guez 62 ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
17     ! Objet : interface de couche limite (diffusion verticale)
18 guez 3
19 guez 62 ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
20     ! de la couche limite pour les traceurs se fait avec "cltrac" et
21 guez 145 ! ne tient pas compte de la diff\'erentiation des sous-fractions
22     ! de sol.
23 guez 3
24 guez 145 ! Pour pouvoir extraire les coefficients d'\'echanges et le vent
25     ! dans la premi\`ere couche, trois champs ont \'et\'e cr\'e\'es : "ycoefh",
26     ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois
27     ! champs sur les quatre sous-surfaces du mod\`ele.
28 guez 3
29 guez 49 use clqh_m, only: clqh
30 guez 62 use clvent_m, only: clvent
31 guez 47 use coefkz_m, only: coefkz
32     use coefkzmin_m, only: coefkzmin
33 guez 202 USE conf_gcm_m, ONLY: prt_level, lmt_pas
34 guez 62 USE conf_phys_m, ONLY: iflag_pbl
35     USE dimphy, ONLY: klev, klon, zmasq
36     USE dimsoil, ONLY: nsoilmx
37 guez 47 use hbtm_m, only: hbtm
38 guez 62 USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
39 guez 202 USE interfoce_lim_m, ONLY: interfoce_lim
40 guez 104 use stdlevvar_m, only: stdlevvar
41 guez 62 USE suphec_m, ONLY: rd, rg, rkappa
42 guez 202 use time_phylmdz, only: itap
43 guez 62 use ustarhb_m, only: ustarhb
44     use vdif_kcay_m, only: vdif_kcay
45 guez 47 use yamada4_m, only: yamada4
46 guez 15
47 guez 62 REAL, INTENT(IN):: dtime ! interval du temps (secondes)
48 guez 202
49 guez 62 REAL, INTENT(inout):: pctsrf(klon, nbsrf)
50 guez 202 ! tableau des pourcentages de surface de chaque maille
51 guez 62
52     REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
53     REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)
54     REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
55     INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
56     REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal
57 guez 104 REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)
58 guez 71 REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59 guez 99 REAL, INTENT(IN):: ksta, ksta_ter
60     LOGICAL, INTENT(IN):: ok_kzmin
61 guez 101
62 guez 118 REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
63     ! soil temperature of surface fraction
64    
65 guez 99 REAL, INTENT(inout):: qsol(klon)
66 guez 101 ! column-density of water in soil, in kg m-2
67    
68 guez 62 REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
69     REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
70 guez 191 REAL, INTENT(inout):: snow(klon, nbsrf)
71 guez 70 REAL qsurf(klon, nbsrf)
72     REAL evap(klon, nbsrf)
73 guez 155 REAL, intent(inout):: falbe(klon, nbsrf)
74 guez 70
75     REAL fluxlat(klon, nbsrf)
76    
77 guez 101 REAL, intent(in):: rain_fall(klon)
78     ! liquid water mass flux (kg/m2/s), positive down
79    
80     REAL, intent(in):: snow_f(klon)
81     ! solid water mass flux (kg/m2/s), positive down
82    
83 guez 72 REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
84 guez 154 REAL, intent(in):: fder(klon)
85 guez 145 REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
86 guez 70
87 guez 191 REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)
88 guez 70
89     real agesno(klon, nbsrf)
90     REAL, INTENT(IN):: rugoro(klon)
91    
92 guez 38 REAL d_t(klon, klev), d_q(klon, klev)
93 guez 49 ! d_t------output-R- le changement pour "t"
94     ! d_q------output-R- le changement pour "q"
95 guez 62
96     REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
97     ! changement pour "u" et "v"
98    
99 guez 104 REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"
100 guez 70
101 guez 38 REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
102 guez 49 ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
103     ! (orientation positive vers le bas)
104     ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
105 guez 70
106     REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)
107     ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
108     ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
109    
110     REAL, INTENT(out):: cdragh(klon), cdragm(klon)
111     real q2(klon, klev+1, nbsrf)
112    
113 guez 99 REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
114 guez 49 ! dflux_t derive du flux sensible
115     ! dflux_q derive du flux latent
116 guez 191 ! IM "slab" ocean
117 guez 70
118     REAL, intent(out):: ycoefh(klon, klev)
119     REAL, intent(out):: zu1(klon)
120     REAL zv1(klon)
121     REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
122     REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
123    
124 guez 191 ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
125     ! (Comme les autres diagnostics on cumule dans physiq ce qui
126     ! permet de sortir les grandeurs par sous-surface)
127     REAL pblh(klon, nbsrf) ! height of planetary boundary layer
128 guez 70 REAL capcl(klon, nbsrf)
129     REAL oliqcl(klon, nbsrf)
130     REAL cteicl(klon, nbsrf)
131     REAL pblt(klon, nbsrf)
132     ! pblT------- T au nveau HCL
133     REAL therm(klon, nbsrf)
134     REAL trmb1(klon, nbsrf)
135     ! trmb1-------deep_cape
136     REAL trmb2(klon, nbsrf)
137     ! trmb2--------inhibition
138     REAL trmb3(klon, nbsrf)
139     ! trmb3-------Point Omega
140     REAL plcl(klon, nbsrf)
141     REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
142     ! ffonte----Flux thermique utilise pour fondre la neige
143     ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
144     ! hauteur de neige, en kg/m2/s
145     REAL run_off_lic_0(klon)
146    
147     ! Local:
148 guez 15
149 guez 202 LOGICAL:: firstcal = .true.
150    
151     ! la nouvelle repartition des surfaces sortie de l'interface
152     REAL, save:: pctsrf_new_oce(klon)
153     REAL, save:: pctsrf_new_sic(klon)
154    
155 guez 70 REAL y_fqcalving(klon), y_ffonte(klon)
156     real y_run_off_lic_0(klon)
157 guez 15
158 guez 70 REAL rugmer(klon)
159 guez 15
160 guez 38 REAL ytsoil(klon, nsoilmx)
161 guez 15
162 guez 38 REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
163     REAL yalb(klon)
164     REAL yu1(klon), yv1(klon)
165 guez 49 ! on rajoute en output yu1 et yv1 qui sont les vents dans
166     ! la premiere couche
167 guez 101 REAL ysnow(klon), yqsurf(klon), yagesno(klon)
168    
169     real yqsol(klon)
170     ! column-density of water in soil, in kg m-2
171    
172     REAL yrain_f(klon)
173     ! liquid water mass flux (kg/m2/s), positive down
174    
175     REAL ysnow_f(klon)
176     ! solid water mass flux (kg/m2/s), positive down
177    
178 guez 99 REAL yfder(klon)
179 guez 38 REAL yrugm(klon), yrads(klon), yrugoro(klon)
180 guez 15
181 guez 38 REAL yfluxlat(klon)
182 guez 15
183 guez 38 REAL y_d_ts(klon)
184     REAL y_d_t(klon, klev), y_d_q(klon, klev)
185     REAL y_d_u(klon, klev), y_d_v(klon, klev)
186     REAL y_flux_t(klon, klev), y_flux_q(klon, klev)
187     REAL y_flux_u(klon, klev), y_flux_v(klon, klev)
188     REAL y_dflux_t(klon), y_dflux_q(klon)
189 guez 62 REAL coefh(klon, klev), coefm(klon, klev)
190 guez 38 REAL yu(klon, klev), yv(klon, klev)
191     REAL yt(klon, klev), yq(klon, klev)
192     REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)
193 guez 15
194 guez 38 REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
195 guez 15
196 guez 38 REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
197     REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
198     REAL ykmq(klon, klev+1)
199 guez 70 REAL yq2(klon, klev+1)
200 guez 38 REAL q2diag(klon, klev+1)
201 guez 15
202 guez 38 REAL u1lay(klon), v1lay(klon)
203     REAL delp(klon, klev)
204     INTEGER i, k, nsrf
205 guez 15
206 guez 38 INTEGER ni(klon), knon, j
207 guez 40
208 guez 38 REAL pctsrf_pot(klon, nbsrf)
209 guez 145 ! "pourcentage potentiel" pour tenir compte des \'eventuelles
210 guez 40 ! apparitions ou disparitions de la glace de mer
211 guez 15
212 guez 191 REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
213 guez 15
214 guez 38 REAL yt2m(klon), yq2m(klon), yu10m(klon)
215     REAL yustar(klon)
216 guez 15
217 guez 38 REAL yt10m(klon), yq10m(klon)
218     REAL ypblh(klon)
219     REAL ylcl(klon)
220     REAL ycapcl(klon)
221     REAL yoliqcl(klon)
222     REAL ycteicl(klon)
223     REAL ypblt(klon)
224     REAL ytherm(klon)
225     REAL ytrmb1(klon)
226     REAL ytrmb2(klon)
227     REAL ytrmb3(klon)
228     REAL uzon(klon), vmer(klon)
229     REAL tair1(klon), qair1(klon), tairsol(klon)
230     REAL psfce(klon), patm(klon)
231 guez 15
232 guez 38 REAL qairsol(klon), zgeo1(klon)
233     REAL rugo1(klon)
234 guez 15
235 guez 38 ! utiliser un jeu de fonctions simples
236     LOGICAL zxli
237     PARAMETER (zxli=.FALSE.)
238 guez 15
239 guez 38 !------------------------------------------------------------
240 guez 15
241 guez 38 ytherm = 0.
242 guez 15
243 guez 38 DO k = 1, klev ! epaisseur de couche
244     DO i = 1, klon
245     delp(i, k) = paprs(i, k) - paprs(i, k+1)
246     END DO
247     END DO
248     DO i = 1, klon ! vent de la premiere couche
249     zx_alf1 = 1.0
250     zx_alf2 = 1.0 - zx_alf1
251     u1lay(i) = u(i, 1)*zx_alf1 + u(i, 2)*zx_alf2
252     v1lay(i) = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2
253     END DO
254 guez 15
255 guez 40 ! Initialization:
256     rugmer = 0.
257     cdragh = 0.
258     cdragm = 0.
259     dflux_t = 0.
260     dflux_q = 0.
261     zu1 = 0.
262     zv1 = 0.
263     ypct = 0.
264     yts = 0.
265     ysnow = 0.
266     yqsurf = 0.
267     yrain_f = 0.
268     ysnow_f = 0.
269     yfder = 0.
270     yrugos = 0.
271     yu1 = 0.
272     yv1 = 0.
273     yrads = 0.
274     ypaprs = 0.
275     ypplay = 0.
276     ydelp = 0.
277     yu = 0.
278     yv = 0.
279     yt = 0.
280     yq = 0.
281     y_flux_u = 0.
282     y_flux_v = 0.
283     y_dflux_t = 0.
284     y_dflux_q = 0.
285 guez 38 ytsoil = 999999.
286     yrugoro = 0.
287 guez 40 d_ts = 0.
288 guez 38 yfluxlat = 0.
289     flux_t = 0.
290     flux_q = 0.
291     flux_u = 0.
292     flux_v = 0.
293 guez 40 d_t = 0.
294     d_q = 0.
295     d_u = 0.
296     d_v = 0.
297 guez 70 ycoefh = 0.
298 guez 15
299 guez 145 ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
300     ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
301     ! (\`a affiner)
302 guez 15
303 guez 202 pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
304     pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
305 guez 38 pctsrf_pot(:, is_oce) = 1. - zmasq
306     pctsrf_pot(:, is_sic) = 1. - zmasq
307 guez 15
308 guez 202 ! Tester si c'est le moment de lire le fichier:
309     if (mod(itap - 1, lmt_pas) == 0) then
310     CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
311     endif
312    
313 guez 99 ! Boucler sur toutes les sous-fractions du sol:
314    
315 guez 49 loop_surface: DO nsrf = 1, nbsrf
316     ! Chercher les indices :
317 guez 38 ni = 0
318     knon = 0
319     DO i = 1, klon
320 guez 145 ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
321 guez 38 ! "potentielles"
322     IF (pctsrf_pot(i, nsrf) > epsfra) THEN
323     knon = knon + 1
324     ni(knon) = i
325     END IF
326     END DO
327 guez 15
328 guez 62 if_knon: IF (knon /= 0) then
329 guez 38 DO j = 1, knon
330     i = ni(j)
331 guez 62 ypct(j) = pctsrf(i, nsrf)
332     yts(j) = ts(i, nsrf)
333     ysnow(j) = snow(i, nsrf)
334     yqsurf(j) = qsurf(i, nsrf)
335 guez 155 yalb(j) = falbe(i, nsrf)
336 guez 62 yrain_f(j) = rain_fall(i)
337     ysnow_f(j) = snow_f(i)
338     yagesno(j) = agesno(i, nsrf)
339     yfder(j) = fder(i)
340     yrugos(j) = rugos(i, nsrf)
341     yrugoro(j) = rugoro(i)
342     yu1(j) = u1lay(i)
343     yv1(j) = v1lay(i)
344 guez 175 yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
345 guez 62 ypaprs(j, klev+1) = paprs(i, klev+1)
346     y_run_off_lic_0(j) = run_off_lic_0(i)
347 guez 38 END DO
348 guez 3
349 guez 99 ! For continent, copy soil water content
350     IF (nsrf == is_ter) THEN
351     yqsol(:knon) = qsol(ni(:knon))
352 guez 62 ELSE
353     yqsol = 0.
354     END IF
355 guez 3
356 guez 62 DO k = 1, nsoilmx
357     DO j = 1, knon
358     i = ni(j)
359     ytsoil(j, k) = ftsoil(i, k, nsrf)
360 guez 38 END DO
361 guez 47 END DO
362 guez 3
363 guez 38 DO k = 1, klev
364     DO j = 1, knon
365     i = ni(j)
366 guez 62 ypaprs(j, k) = paprs(i, k)
367     ypplay(j, k) = pplay(i, k)
368     ydelp(j, k) = delp(i, k)
369     yu(j, k) = u(i, k)
370     yv(j, k) = v(i, k)
371     yt(j, k) = t(i, k)
372     yq(j, k) = q(i, k)
373 guez 38 END DO
374     END DO
375 guez 3
376 guez 62 ! calculer Cdrag et les coefficients d'echange
377     CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &
378     yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))
379     IF (iflag_pbl == 1) THEN
380     CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
381     coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
382     coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
383     END IF
384 guez 3
385 guez 70 ! on met un seuil pour coefm et coefh
386 guez 62 IF (nsrf == is_oce) THEN
387     coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)
388     coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)
389 guez 38 END IF
390 guez 3
391 guez 62 IF (ok_kzmin) THEN
392     ! Calcul d'une diffusion minimale pour les conditions tres stables
393     CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
394 guez 70 coefm(:knon, 1), ycoefm0, ycoefh0)
395 guez 62 coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
396     coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
397 guez 98 END IF
398 guez 3
399 guez 62 IF (iflag_pbl >= 3) THEN
400 guez 145 ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
401     ! Fr\'ed\'eric Hourdin
402 guez 62 yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
403     + ypplay(:knon, 1))) &
404     * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
405     DO k = 2, klev
406     yzlay(1:knon, k) = yzlay(1:knon, k-1) &
407     + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
408     / ypaprs(1:knon, k) &
409     * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
410     END DO
411     DO k = 1, klev
412     yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &
413     / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))
414     END DO
415     yzlev(1:knon, 1) = 0.
416     yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &
417     - yzlay(:knon, klev - 1)
418     DO k = 2, klev
419     yzlev(1:knon, k) = 0.5*(yzlay(1:knon, k)+yzlay(1:knon, k-1))
420     END DO
421     DO k = 1, klev + 1
422     DO j = 1, knon
423     i = ni(j)
424     yq2(j, k) = q2(i, k, nsrf)
425     END DO
426     END DO
427    
428     CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
429 guez 99 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
430 guez 62
431 guez 145 ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
432 guez 62
433     IF (iflag_pbl >= 11) THEN
434 guez 145 CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
435     yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
436     iflag_pbl)
437 guez 62 ELSE
438     CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
439     coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
440     END IF
441    
442     coefm(:knon, 2:) = ykmm(:knon, 2:klev)
443     coefh(:knon, 2:) = ykmn(:knon, 2:klev)
444 guez 38 END IF
445 guez 3
446 guez 62 ! calculer la diffusion des vitesses "u" et "v"
447 guez 70 CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
448     ypplay, ydelp, y_d_u, y_flux_u)
449     CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
450     ypplay, ydelp, y_d_v, y_flux_v)
451 guez 3
452 guez 62 ! calculer la diffusion de "q" et de "h"
453 guez 191 CALL clqh(dtime, jour, firstcal, rlat, knon, nsrf, ni(:knon), &
454 guez 202 ytsoil, yqsol, rmu0, yrugos, yrugoro, yu1, yv1, &
455 guez 191 coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, yrads, &
456     yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &
457 guez 202 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
458 guez 191 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &
459     y_fqcalving, y_ffonte, y_run_off_lic_0)
460 guez 3
461 guez 62 ! calculer la longueur de rugosite sur ocean
462     yrugm = 0.
463     IF (nsrf == is_oce) THEN
464     DO j = 1, knon
465     yrugm(j) = 0.018*coefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &
466     0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))
467     yrugm(j) = max(1.5E-05, yrugm(j))
468     END DO
469     END IF
470 guez 38 DO j = 1, knon
471 guez 62 y_dflux_t(j) = y_dflux_t(j)*ypct(j)
472     y_dflux_q(j) = y_dflux_q(j)*ypct(j)
473     yu1(j) = yu1(j)*ypct(j)
474     yv1(j) = yv1(j)*ypct(j)
475 guez 38 END DO
476 guez 3
477 guez 62 DO k = 1, klev
478     DO j = 1, knon
479     i = ni(j)
480     coefh(j, k) = coefh(j, k)*ypct(j)
481     coefm(j, k) = coefm(j, k)*ypct(j)
482     y_d_t(j, k) = y_d_t(j, k)*ypct(j)
483     y_d_q(j, k) = y_d_q(j, k)*ypct(j)
484     flux_t(i, k, nsrf) = y_flux_t(j, k)
485     flux_q(i, k, nsrf) = y_flux_q(j, k)
486     flux_u(i, k, nsrf) = y_flux_u(j, k)
487     flux_v(i, k, nsrf) = y_flux_v(j, k)
488     y_d_u(j, k) = y_d_u(j, k)*ypct(j)
489     y_d_v(j, k) = y_d_v(j, k)*ypct(j)
490     END DO
491 guez 38 END DO
492 guez 3
493 guez 62 evap(:, nsrf) = -flux_q(:, 1, nsrf)
494 guez 15
495 guez 155 falbe(:, nsrf) = 0.
496 guez 62 snow(:, nsrf) = 0.
497     qsurf(:, nsrf) = 0.
498     rugos(:, nsrf) = 0.
499     fluxlat(:, nsrf) = 0.
500 guez 38 DO j = 1, knon
501     i = ni(j)
502 guez 62 d_ts(i, nsrf) = y_d_ts(j)
503 guez 155 falbe(i, nsrf) = yalb(j)
504 guez 62 snow(i, nsrf) = ysnow(j)
505     qsurf(i, nsrf) = yqsurf(j)
506     rugos(i, nsrf) = yz0_new(j)
507     fluxlat(i, nsrf) = yfluxlat(j)
508     IF (nsrf == is_oce) THEN
509     rugmer(i) = yrugm(j)
510     rugos(i, nsrf) = yrugm(j)
511     END IF
512     agesno(i, nsrf) = yagesno(j)
513     fqcalving(i, nsrf) = y_fqcalving(j)
514     ffonte(i, nsrf) = y_ffonte(j)
515     cdragh(i) = cdragh(i) + coefh(j, 1)
516     cdragm(i) = cdragm(i) + coefm(j, 1)
517     dflux_t(i) = dflux_t(i) + y_dflux_t(j)
518     dflux_q(i) = dflux_q(i) + y_dflux_q(j)
519     zu1(i) = zu1(i) + yu1(j)
520     zv1(i) = zv1(i) + yv1(j)
521 guez 38 END DO
522 guez 62 IF (nsrf == is_ter) THEN
523 guez 99 qsol(ni(:knon)) = yqsol(:knon)
524     else IF (nsrf == is_lic) THEN
525 guez 62 DO j = 1, knon
526     i = ni(j)
527     run_off_lic_0(i) = y_run_off_lic_0(j)
528     END DO
529     END IF
530 guez 118
531 guez 62 ftsoil(:, :, nsrf) = 0.
532     DO k = 1, nsoilmx
533     DO j = 1, knon
534     i = ni(j)
535     ftsoil(i, k, nsrf) = ytsoil(j, k)
536     END DO
537     END DO
538    
539 guez 38 DO j = 1, knon
540     i = ni(j)
541 guez 62 DO k = 1, klev
542     d_t(i, k) = d_t(i, k) + y_d_t(j, k)
543     d_q(i, k) = d_q(i, k) + y_d_q(j, k)
544     d_u(i, k) = d_u(i, k) + y_d_u(j, k)
545     d_v(i, k) = d_v(i, k) + y_d_v(j, k)
546 guez 70 ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
547 guez 62 END DO
548 guez 38 END DO
549 guez 62
550 guez 99 ! diagnostic t, q a 2m et u, v a 10m
551 guez 62
552 guez 38 DO j = 1, knon
553     i = ni(j)
554 guez 62 uzon(j) = yu(j, 1) + y_d_u(j, 1)
555     vmer(j) = yv(j, 1) + y_d_v(j, 1)
556     tair1(j) = yt(j, 1) + y_d_t(j, 1)
557     qair1(j) = yq(j, 1) + y_d_q(j, 1)
558     zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &
559     1)))*(ypaprs(j, 1)-ypplay(j, 1))
560     tairsol(j) = yts(j) + y_d_ts(j)
561     rugo1(j) = yrugos(j)
562     IF (nsrf == is_oce) THEN
563     rugo1(j) = rugos(i, nsrf)
564     END IF
565     psfce(j) = ypaprs(j, 1)
566     patm(j) = ypplay(j, 1)
567 guez 15
568 guez 62 qairsol(j) = yqsurf(j)
569 guez 38 END DO
570 guez 15
571 guez 62 CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &
572     zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &
573     yt10m, yq10m, yu10m, yustar)
574 guez 3
575 guez 62 DO j = 1, knon
576     i = ni(j)
577     t2m(i, nsrf) = yt2m(j)
578     q2m(i, nsrf) = yq2m(j)
579 guez 3
580 guez 62 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
581     u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)
582     v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)
583 guez 15
584 guez 62 END DO
585 guez 15
586 guez 186 CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t, &
587     y_flux_q, yu, yv, yt, yq, ypblh(:knon), ycapcl, yoliqcl, &
588 guez 62 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
589 guez 15
590 guez 38 DO j = 1, knon
591     i = ni(j)
592 guez 62 pblh(i, nsrf) = ypblh(j)
593     plcl(i, nsrf) = ylcl(j)
594     capcl(i, nsrf) = ycapcl(j)
595     oliqcl(i, nsrf) = yoliqcl(j)
596     cteicl(i, nsrf) = ycteicl(j)
597     pblt(i, nsrf) = ypblt(j)
598     therm(i, nsrf) = ytherm(j)
599     trmb1(i, nsrf) = ytrmb1(j)
600     trmb2(i, nsrf) = ytrmb2(j)
601     trmb3(i, nsrf) = ytrmb3(j)
602 guez 38 END DO
603 guez 3
604 guez 38 DO j = 1, knon
605 guez 62 DO k = 1, klev + 1
606     i = ni(j)
607     q2(i, k, nsrf) = yq2(j, k)
608     END DO
609 guez 38 END DO
610 guez 62 end IF if_knon
611 guez 49 END DO loop_surface
612 guez 15
613 guez 38 ! On utilise les nouvelles surfaces
614     rugos(:, is_oce) = rugmer
615 guez 202 pctsrf(:, is_oce) = pctsrf_new_oce
616     pctsrf(:, is_sic) = pctsrf_new_sic
617 guez 15
618 guez 202 firstcal = .false.
619    
620 guez 38 END SUBROUTINE clmain
621 guez 15
622 guez 38 end module clmain_m

  ViewVC Help
Powered by ViewVC 1.1.21