/[lmdze]/trunk/phylmd/pbl_surface.f
ViewVC logotype

Contents of /trunk/phylmd/pbl_surface.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 227 - (show annotations)
Thu Nov 2 15:47:03 2017 UTC (6 years, 6 months ago) by guez
Original Path: trunk/Sources/phylmd/clmain.f
File size: 20092 byte(s)
Rename phisinit to phis in restart.nc: clearer, same name as Fortran variable.

In aaam_bud, use rlat and rlon from phyetat0_m instead of having these
module variables associated to actual arguments in physiq.

In clmain, too many wind variables make the procedure hard to
understand. Use yu(:knon, 1) and yv(:knon, 1) instead of u1lay(:knon)
and v1lay(:knon). Note that when yu(:knon, 1) and yv(:knon, 1) are
used as actual arguments, they are probably copied to new arrays since
the elements are not contiguous. Rename yu10m to wind10m because this
is the norm of wind vector, not its zonal component. Rename yustar to
ustar. Rename uzon and vmer to u1 and v1 since these are wind
components at first layer and u1 and v1 are the names of corresponding
dummy arguments in stdlevvar.

In clmain, rename yzlev to zlev.

In clmain, screenc, stdlevvar and coefcdrag, remove the code
corresponding to zxli true (not used in LMDZ either).

Subroutine ustarhb becomes a function. Simplifications using the fact
that zx_alf2 = 0 and zx_alf1 = 1 (discarding the possibility to change
this).

In procedure vdif_kcay, remove unused dummy argument plev. Remove
useless computations of sss and sssq.

In clouds_gno, exp(100.) would overflow in single precision. Set
maximum to exp(80.) instead.

In physiq, use u(:, 1) and v(:, 1) as arguments to phytrac instead of
creating ad hoc variables yu1 and yv1.

In stdlevvar, rename dummy argument u_10m to wind10m, following the
corresponding modification in clmain. Simplifications using the fact
that ok_pred = 0 and ok_corr = 1 (discarding the possibility to change
this).

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

  ViewVC Help
Powered by ViewVC 1.1.21