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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 191 - (show annotations)
Mon May 9 19:56:28 2016 UTC (8 years ago) by guez
File size: 20683 byte(s)
Extracted the call to read_comdissnew out of conf_gcm.

Made ok_instan a variable of module clesphys, itau_phy a variable of
module phyetat0_m, nid_ins a variable of module ini_histins_m, itap a
variable of new module time_phylmdz, so that histwrite_phy can be
called from any procedure without the need to cascade those variables
into that procedure. Made itau_w a variable of module time_phylmdz so
that it is computed only once per time step of physics.

Extracted variables of module clesphys which were in namelist
conf_phys_nml into their own namelist, clesphys_nml, and created
procedure read_clesphys reading clesphys_nml, to avoid side effect.

No need for double precision in procedure getso4fromfile. Assume there
is a single variable for the whole year in the NetCDF file instead of
one variable per month.

Created generic procedure histwrite_phy and removed procedure
write_histins, following LMDZ. histwrite_phy has only two arguments,
can be called from anywhere, and should manage the logic of writing or
not writing into various history files with various operations. So the
test on ok_instan goes inside histwrite_phy.

Test for raz_date in phyetat0 instead of physiq to avoid side effect.

Created procedure increment_itap to avoid side effect.

Removed unnecessary differences between procedures readsulfate and
readsulfate_pi.

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

  ViewVC Help
Powered by ViewVC 1.1.21