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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 154 - (show annotations)
Tue Jul 7 17:49:23 2015 UTC (8 years, 8 months ago) by guez
File size: 22514 byte(s)
Removed argument dtphys of physiq. Use it directly from comconst in
physiq instead.

Donwgraded variables eignfnu, eignfnv of module inifgn_m to dummy
arguments of SUBROUTINE inifgn. They were not used elsewhere than in
the calling procedure inifilr. Renamed argument dv of inifgn to eignval_v.

Made alboc and alboc_cd independent of the size of arguments. Now we
can call them only at indices knindex in interfsurf_hq, where we need
them. Fixed a bug in alboc_cd: rmu0 was modified, and the
corresponding actual argument in interfsurf_hq is an intent(in)
argument of interfsurf_hq.

Variables of size knon instead of klon in interfsur_lim and interfsurf_hq.

Removed argument alb_new of interfsurf_hq because it was the same than
alblw. Simplified test on cycle_diurne, following LMDZ.

Moved tests on nbapp_rad from physiq to read_clesphys2. No need for
separate counter itaprad, we can use itap. Define lmt_pas and radpas
from integer input parameters instead of real-type computed values.

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

  ViewVC Help
Powered by ViewVC 1.1.21