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

Contents of /trunk/phylmd/physiq.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 301 - (show annotations)
Thu Aug 2 17:23:07 2018 UTC (5 years, 7 months ago) by guez
File size: 37292 byte(s)
Move the call to conf_interface up to physiq, so there is no need to
test first call inside pbl_surface for this.

run_off_lic in fonte_neige was computed but not used. Pass it up to
pbl_surface so we can output it (following LMDZ).

Simplify the logic in interfsur_lim so we do not need debut.

Remove the tests on the order of surface types in interfsurf_hq. Just
add comments in indicesol.

1 module physiq_m
2
3 IMPLICIT none
4
5 contains
6
7 SUBROUTINE physiq(lafin, dayvrai, time, paprs, play, pphi, pphis, u, v, t, &
8 qx, omega, d_u, d_v, d_t, d_qx)
9
10 ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11 ! (subversion revision 678)
12
13 ! Author: Z. X. Li (LMD/CNRS) 1993
14
15 ! This is the main procedure for the "physics" part of the program.
16
17 use aaam_bud_m, only: aaam_bud
18 USE abort_gcm_m, ONLY: abort_gcm
19 use ajsec_m, only: ajsec
20 use calltherm_m, only: calltherm
21 USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ok_instan
22 USE clesphys2, ONLY: conv_emanuel, nbapp_rad, new_oliq, ok_orodr, ok_orolf
23 USE conf_interface_m, ONLY: conf_interface
24 USE pbl_surface_m, ONLY: pbl_surface
25 use clouds_gno_m, only: clouds_gno
26 use comconst, only: dtphys
27 USE comgeomphy, ONLY: airephy
28 USE concvl_m, ONLY: concvl
29 USE conf_gcm_m, ONLY: lmt_pas
30 USE conf_phys_m, ONLY: conf_phys
31 use conflx_m, only: conflx
32 USE ctherm, ONLY: iflag_thermals, nsplit_thermals
33 use diagcld2_m, only: diagcld2
34 USE dimensions, ONLY: llm, nqmx
35 USE dimphy, ONLY: klon
36 USE dimsoil, ONLY: nsoilmx
37 use drag_noro_m, only: drag_noro
38 use dynetat0_m, only: day_ref, annee_ref
39 USE fcttre, ONLY: foeew
40 use fisrtilp_m, only: fisrtilp
41 USE hgardfou_m, ONLY: hgardfou
42 USE histsync_m, ONLY: histsync
43 USE histwrite_phy_m, ONLY: histwrite_phy
44 USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
45 nbsrf
46 USE ini_histins_m, ONLY: ini_histins, nid_ins
47 use lift_noro_m, only: lift_noro
48 use netcdf95, only: NF95_CLOSE
49 use newmicro_m, only: newmicro
50 use nr_util, only: assert
51 use nuage_m, only: nuage
52 USE orbite_m, ONLY: orbite
53 USE ozonecm_m, ONLY: ozonecm
54 USE phyetat0_m, ONLY: phyetat0
55 USE phyredem_m, ONLY: phyredem
56 USE phyredem0_m, ONLY: phyredem0
57 USE phytrac_m, ONLY: phytrac
58 use radlwsw_m, only: radlwsw
59 use yoegwd, only: sugwd
60 USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt, rmo3, md
61 use time_phylmdz, only: itap, increment_itap
62 use transp_m, only: transp
63 use transp_lay_m, only: transp_lay
64 use unit_nml_m, only: unit_nml
65 USE ymds2ju_m, ONLY: ymds2ju
66 USE yoethf_m, ONLY: r2es, rvtmp2
67 use zenang_m, only: zenang
68
69 logical, intent(in):: lafin ! dernier passage
70
71 integer, intent(in):: dayvrai
72 ! current day number, based at value 1 on January 1st of annee_ref
73
74 REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
75
76 REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
77 ! pression pour chaque inter-couche, en Pa
78
79 REAL, intent(in):: play(:, :) ! (klon, llm)
80 ! pression pour le mileu de chaque couche (en Pa)
81
82 REAL, intent(in):: pphi(:, :) ! (klon, llm)
83 ! géopotentiel de chaque couche (référence sol)
84
85 REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
86
87 REAL, intent(in):: u(:, :) ! (klon, llm)
88 ! vitesse dans la direction X (de O a E) en m / s
89
90 REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m / s
91 REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
92
93 REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
94 ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
95
96 REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
97 REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
98 REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
99 REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K / s)
100
101 REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
102 ! tendance physique de "qx" (s-1)
103
104 ! Local:
105
106 LOGICAL:: firstcal = .true.
107
108 LOGICAL, PARAMETER:: ok_stratus = .FALSE.
109 ! Ajouter artificiellement les stratus
110
111 ! pour phystoke avec thermiques
112 REAL fm_therm(klon, llm + 1)
113 REAL entr_therm(klon, llm)
114 real, save:: q2(klon, llm + 1, nbsrf)
115
116 INTEGER, PARAMETER:: ivap = 1 ! indice de traceur pour vapeur d'eau
117 INTEGER, PARAMETER:: iliq = 2 ! indice de traceur pour eau liquide
118
119 REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
120 LOGICAL, save:: ancien_ok
121
122 REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
123 REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg / kg / s)
124
125 real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
126
127 REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
128 REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
129
130 REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
131 REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
132
133 ! prw: precipitable water
134 real prw(klon)
135
136 ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
137 ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
138 REAL flwp(klon), fiwp(klon)
139 REAL flwc(klon, llm), fiwc(klon, llm)
140
141 ! Variables propres a la physique
142
143 INTEGER, save:: radpas
144 ! Radiative transfer computations are made every "radpas" call to
145 ! "physiq".
146
147 REAL, save:: radsol(klon) ! bilan radiatif au sol calcule par code radiatif
148 REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
149
150 REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
151 ! soil temperature of surface fraction
152
153 REAL, save:: fevap(klon, nbsrf) ! evaporation
154 REAL fluxlat(klon, nbsrf)
155
156 REAL, save:: fqsurf(klon, nbsrf)
157 ! humidite de l'air au contact de la surface
158
159 REAL, save:: qsol(klon) ! column-density of water in soil, in kg m-2
160 REAL, save:: fsnow(klon, nbsrf) ! \'epaisseur neigeuse
161 REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
162
163 ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
164 REAL, save:: zmea(klon) ! orographie moyenne
165 REAL, save:: zstd(klon) ! deviation standard de l'OESM
166 REAL, save:: zsig(klon) ! pente de l'OESM
167 REAL, save:: zgam(klon) ! anisotropie de l'OESM
168 REAL, save:: zthe(klon) ! orientation de l'OESM
169 REAL, save:: zpic(klon) ! Maximum de l'OESM
170 REAL, save:: zval(klon) ! Minimum de l'OESM
171 REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
172 REAL zulow(klon), zvlow(klon)
173 INTEGER ktest(klon)
174
175 REAL, save:: agesno(klon, nbsrf) ! age de la neige
176 REAL, save:: run_off_lic_0(klon)
177
178 ! Variables li\'ees \`a la convection d'Emanuel :
179 REAL, save:: Ma(klon, llm) ! undilute upward mass flux
180 REAL, save:: sig1(klon, llm), w01(klon, llm)
181
182 ! Variables pour la couche limite (Alain Lahellec) :
183 REAL cdragh(klon) ! drag coefficient pour T and Q
184 REAL cdragm(klon) ! drag coefficient pour vent
185
186 REAL coefh(klon, 2:llm) ! coef d'echange pour phytrac
187
188 REAL, save:: ffonte(klon, nbsrf)
189 ! flux thermique utilise pour fondre la neige
190
191 REAL fqcalving(klon, nbsrf)
192 ! flux d'eau "perdue" par la surface et n\'ecessaire pour limiter
193 ! la hauteur de neige, en kg / m2 / s
194
195 REAL zxffonte(klon)
196
197 REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
198 REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
199
200 REAL, save:: pfrac_1nucl(klon, llm)
201 ! Produits des coefs lessi nucl (alpha = 1)
202
203 REAL frac_impa(klon, llm) ! fraction d'a\'erosols lessiv\'es (impaction)
204 REAL frac_nucl(klon, llm) ! idem (nucleation)
205
206 REAL, save:: rain_fall(klon)
207 ! liquid water mass flux (kg / m2 / s), positive down
208
209 REAL, save:: snow_fall(klon)
210 ! solid water mass flux (kg / m2 / s), positive down
211
212 REAL rain_tiedtke(klon), snow_tiedtke(klon)
213
214 REAL evap(klon) ! flux d'\'evaporation au sol
215 real devap(klon) ! derivative of the evaporation flux at the surface
216 REAL sens(klon) ! flux de chaleur sensible au sol
217 real dsens(klon) ! derivee du flux de chaleur sensible au sol
218 REAL, save:: dlw(klon) ! derivative of infra-red flux
219 REAL bils(klon) ! bilan de chaleur au sol
220 REAL fder(klon) ! Derive de flux (sensible et latente)
221 REAL ve(klon) ! integr. verticale du transport meri. de l'energie
222 REAL vq(klon) ! integr. verticale du transport meri. de l'eau
223 REAL ue(klon) ! integr. verticale du transport zonal de l'energie
224 REAL uq(klon) ! integr. verticale du transport zonal de l'eau
225
226 REAL, save:: frugs(klon, nbsrf) ! longueur de rugosite
227 REAL zxrugs(klon) ! longueur de rugosite
228
229 ! Conditions aux limites
230
231 INTEGER julien
232 REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
233 REAL, save:: albsol(klon) ! albedo du sol total, visible, moyen par maille
234 REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
235 real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
236
237 real, save:: clwcon(klon, llm), rnebcon(klon, llm)
238 real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
239
240 REAL rhcl(klon, llm) ! humidit\'e relative ciel clair
241 REAL dialiq(klon, llm) ! eau liquide nuageuse
242 REAL diafra(klon, llm) ! fraction nuageuse
243 REAL cldliq(klon, llm) ! eau liquide nuageuse
244 REAL cldfra(klon, llm) ! fraction nuageuse
245 REAL cldtau(klon, llm) ! epaisseur optique
246 REAL cldemi(klon, llm) ! emissivite infrarouge
247
248 REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
249 REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
250
251 REAL flux_u(klon, nbsrf), flux_v(klon, nbsrf)
252 ! tension du vent (flux turbulent de vent) à la surface, en Pa
253
254 ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
255 ! les variables soient r\'emanentes.
256 REAL, save:: heat(klon, llm) ! chauffage solaire
257 REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
258 REAL, save:: cool(klon, llm) ! refroidissement infrarouge
259 REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
260 REAL, save:: topsw(klon), toplw(klon), solsw(klon)
261 REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
262 real, save:: sollwdown(klon) ! downward LW flux at surface
263 REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
264 REAL, save:: albpla(klon)
265 REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
266 REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
267
268 REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
269 REAL conv_t(klon, llm) ! convergence of temperature (K / s)
270
271 REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
272 REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
273
274 REAL zxfluxlat(klon)
275 REAL dist, mu0(klon), fract(klon)
276 real longi
277 REAL z_avant(klon), z_apres(klon), z_factor(klon)
278 REAL zb
279 REAL zx_t, zx_qs, zcor
280 real zqsat(klon, llm)
281 INTEGER i, k, iq, nsrf
282 REAL zphi(klon, llm)
283
284 ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
285
286 REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
287 REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
288 REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
289 REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
290 REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
291 REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
292 REAL, SAVE:: therm(klon, nbsrf)
293 ! Grandeurs de sorties
294 REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
295 REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
296 REAL s_therm(klon)
297
298 ! Variables pour la convection de K. Emanuel :
299
300 REAL upwd(klon, llm) ! saturated updraft mass flux
301 REAL dnwd(klon, llm) ! saturated downdraft mass flux
302 REAL, save:: cape(klon)
303
304 INTEGER iflagctrl(klon) ! flag fonctionnement de convect
305
306 ! Variables du changement
307
308 ! con: convection
309 ! lsc: large scale condensation
310 ! ajs: ajustement sec
311 ! eva: \'evaporation de l'eau liquide nuageuse
312 ! vdf: vertical diffusion in boundary layer
313 REAL d_t_con(klon, llm), d_q_con(klon, llm)
314 REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
315 REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
316 REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
317 REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
318 REAL rneb(klon, llm)
319
320 REAL mfu(klon, llm), mfd(klon, llm)
321 REAL pen_u(klon, llm), pen_d(klon, llm)
322 REAL pde_u(klon, llm), pde_d(klon, llm)
323 INTEGER kcbot(klon), kctop(klon), kdtop(klon)
324 REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
325 REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
326
327 INTEGER, save:: ibas_con(klon), itop_con(klon)
328 real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
329
330 REAL, save:: rain_con(klon)
331 real rain_lsc(klon)
332 REAL, save:: snow_con(klon) ! neige (mm / s)
333 real snow_lsc(klon)
334 REAL d_ts(klon, nbsrf) ! variation of ftsol
335
336 REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
337 REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)
338
339 REAL d_u_oro(klon, llm), d_v_oro(klon, llm)
340 REAL d_t_oro(klon, llm)
341 REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
342 REAL d_t_lif(klon, llm)
343
344 REAL, save:: ratqs(klon, llm)
345 real ratqss(klon, llm), ratqsc(klon, llm)
346 real:: ratqsbas = 0.01, ratqshaut = 0.3
347
348 ! Parametres lies au nouveau schema de nuages (SB, PDF)
349 real:: fact_cldcon = 0.375
350 real:: facttemps = 1.e-4
351 logical:: ok_newmicro = .true.
352 real facteur
353
354 integer:: iflag_cldcon = 1
355 logical ptconv(klon, llm)
356
357 ! Variables pour effectuer les appels en s\'erie :
358
359 REAL t_seri(klon, llm), q_seri(klon, llm)
360 REAL ql_seri(klon, llm)
361 REAL u_seri(klon, llm), v_seri(klon, llm)
362 REAL tr_seri(klon, llm, nqmx - 2)
363
364 REAL zx_rh(klon, llm)
365
366 REAL zustrdr(klon), zvstrdr(klon)
367 REAL zustrli(klon), zvstrli(klon)
368 REAL aam, torsfc
369
370 REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
371 REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
372 REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.
373 REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.
374
375 REAL tsol(klon)
376
377 REAL d_t_ec(klon, llm)
378 ! tendance due \`a la conversion d'\'energie cin\'etique en
379 ! énergie thermique
380
381 REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
382 ! temperature and humidity at 2 m
383
384 REAL, save:: u10m_srf(klon, nbsrf), v10m_srf(klon, nbsrf)
385 ! composantes du vent \`a 10 m
386
387 REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
388 REAL u10m(klon), v10m(klon) ! vent \`a 10 m moyenn\' sur les sous-surfaces
389
390 ! Aerosol effects:
391
392 REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
393 LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
394
395 REAL:: bl95_b0 = 2., bl95_b1 = 0.2
396 ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
397 ! B). They link cloud droplet number concentration to aerosol mass
398 ! concentration.
399
400 real zmasse(klon, llm)
401 ! (column-density of mass of air in a cell, in kg m-2)
402
403 integer, save:: ncid_startphy
404
405 namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
406 ratqsbas, ratqshaut, ok_ade, bl95_b0, bl95_b1, iflag_thermals, &
407 nsplit_thermals
408
409 !----------------------------------------------------------------
410
411 IF (nqmx < 2) CALL abort_gcm('physiq', &
412 'eaux vapeur et liquide sont indispensables')
413
414 test_firstcal: IF (firstcal) THEN
415 ! initialiser
416 u10m_srf = 0.
417 v10m_srf = 0.
418 t2m = 0.
419 q2m = 0.
420 ffonte = 0.
421 rain_con = 0.
422 snow_con = 0.
423 d_u_con = 0.
424 d_v_con = 0.
425 rnebcon0 = 0.
426 clwcon0 = 0.
427 rnebcon = 0.
428 clwcon = 0.
429 pblh =0. ! Hauteur de couche limite
430 plcl =0. ! Niveau de condensation de la CLA
431 capCL =0. ! CAPE de couche limite
432 oliqCL =0. ! eau_liqu integree de couche limite
433 cteiCL =0. ! cloud top instab. crit. couche limite
434 pblt =0.
435 therm =0.
436
437 iflag_thermals = 0
438 nsplit_thermals = 1
439 print *, "Enter namelist 'physiq_nml'."
440 read(unit=*, nml=physiq_nml)
441 write(unit_nml, nml=physiq_nml)
442
443 call conf_phys
444
445 ! Initialiser les compteurs:
446
447 frugs = 0.
448 CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
449 fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
450 agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
451 q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
452 w01, ncid_startphy)
453
454 ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
455 q2 = 1e-8
456
457 radpas = lmt_pas / nbapp_rad
458 print *, "radpas = ", radpas
459
460 ! Initialisation pour le sch\'ema de convection d'Emanuel :
461 IF (conv_emanuel) THEN
462 ibas_con = 1
463 itop_con = 1
464 ENDIF
465
466 IF (ok_orodr) THEN
467 rugoro = MAX(1e-5, zstd * zsig / 2)
468 CALL SUGWD(paprs, play)
469 else
470 rugoro = 0.
471 ENDIF
472
473 ! Initialisation des sorties
474 call ini_histins(ok_newmicro)
475 CALL phyredem0
476 call conf_interface
477 ENDIF test_firstcal
478
479 ! We will modify variables *_seri and we will not touch variables
480 ! u, v, t, qx:
481 t_seri = t
482 u_seri = u
483 v_seri = v
484 q_seri = qx(:, :, ivap)
485 ql_seri = qx(:, :, iliq)
486 tr_seri = qx(:, :, 3:nqmx)
487
488 tsol = sum(ftsol * pctsrf, dim = 2)
489
490 ! Diagnostic de la tendance dynamique :
491 IF (ancien_ok) THEN
492 DO k = 1, llm
493 DO i = 1, klon
494 d_t_dyn(i, k) = (t_seri(i, k) - t_ancien(i, k)) / dtphys
495 d_q_dyn(i, k) = (q_seri(i, k) - q_ancien(i, k)) / dtphys
496 ENDDO
497 ENDDO
498 ELSE
499 DO k = 1, llm
500 DO i = 1, klon
501 d_t_dyn(i, k) = 0.
502 d_q_dyn(i, k) = 0.
503 ENDDO
504 ENDDO
505 ancien_ok = .TRUE.
506 ENDIF
507
508 ! Ajouter le geopotentiel du sol:
509 DO k = 1, llm
510 DO i = 1, klon
511 zphi(i, k) = pphi(i, k) + pphis(i)
512 ENDDO
513 ENDDO
514
515 ! Check temperatures:
516 CALL hgardfou(t_seri, ftsol)
517
518 call increment_itap
519 julien = MOD(dayvrai, 360)
520 if (julien == 0) julien = 360
521
522 forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
523
524 ! \'Evaporation de l'eau liquide nuageuse :
525 DO k = 1, llm
526 DO i = 1, klon
527 zb = MAX(0., ql_seri(i, k))
528 t_seri(i, k) = t_seri(i, k) &
529 - zb * RLVTT / RCPD / (1. + RVTMP2 * q_seri(i, k))
530 q_seri(i, k) = q_seri(i, k) + zb
531 ENDDO
532 ENDDO
533 ql_seri = 0.
534
535 frugs = MAX(frugs, 0.000015)
536 zxrugs = sum(frugs * pctsrf, dim = 2)
537
538 ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
539 ! la surface.
540
541 CALL orbite(REAL(julien), longi, dist)
542 CALL zenang(longi, time, dtphys * radpas, mu0, fract)
543 albsol = sum(falbe * pctsrf, dim = 2)
544
545 ! R\'epartition sous maille des flux longwave et shortwave
546 ! R\'epartition du longwave par sous-surface lin\'earis\'ee
547
548 forall (nsrf = 1: nbsrf)
549 fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
550 * (tsol - ftsol(:, nsrf))
551 fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
552 END forall
553
554 CALL pbl_surface(pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
555 ftsol, cdmmax, cdhmax, ftsoil, qsol, paprs, play, fsnow, fqsurf, &
556 fevap, falbe, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, frugs, &
557 agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, &
558 flux_q, flux_u, flux_v, cdragh, cdragm, q2, dsens, devap, coefh, t2m, &
559 q2m, u10m_srf, v10m_srf, pblh, capCL, oliqCL, cteiCL, pblT, therm, &
560 plcl, fqcalving, ffonte, run_off_lic_0)
561
562 ! Incr\'ementation des flux
563
564 sens = - sum(flux_t * pctsrf, dim = 2)
565 evap = - sum(flux_q * pctsrf, dim = 2)
566 fder = dlw + dsens + devap
567
568 DO k = 1, llm
569 DO i = 1, klon
570 t_seri(i, k) = t_seri(i, k) + d_t_vdf(i, k)
571 q_seri(i, k) = q_seri(i, k) + d_q_vdf(i, k)
572 u_seri(i, k) = u_seri(i, k) + d_u_vdf(i, k)
573 v_seri(i, k) = v_seri(i, k) + d_v_vdf(i, k)
574 ENDDO
575 ENDDO
576
577 ! Update surface temperature:
578
579 call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
580 ftsol = ftsol + d_ts
581 tsol = sum(ftsol * pctsrf, dim = 2)
582 zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
583 zt2m = sum(t2m * pctsrf, dim = 2)
584 zq2m = sum(q2m * pctsrf, dim = 2)
585 u10m = sum(u10m_srf * pctsrf, dim = 2)
586 v10m = sum(v10m_srf * pctsrf, dim = 2)
587 zxffonte = sum(ffonte * pctsrf, dim = 2)
588 s_pblh = sum(pblh * pctsrf, dim = 2)
589 s_lcl = sum(plcl * pctsrf, dim = 2)
590 s_capCL = sum(capCL * pctsrf, dim = 2)
591 s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
592 s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
593 s_pblT = sum(pblT * pctsrf, dim = 2)
594 s_therm = sum(therm * pctsrf, dim = 2)
595
596 ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
597 DO nsrf = 1, nbsrf
598 DO i = 1, klon
599 IF (pctsrf(i, nsrf) < epsfra) then
600 ftsol(i, nsrf) = tsol(i)
601 t2m(i, nsrf) = zt2m(i)
602 q2m(i, nsrf) = zq2m(i)
603 u10m_srf(i, nsrf) = u10m(i)
604 v10m_srf(i, nsrf) = v10m(i)
605 ffonte(i, nsrf) = zxffonte(i)
606 pblh(i, nsrf) = s_pblh(i)
607 plcl(i, nsrf) = s_lcl(i)
608 capCL(i, nsrf) = s_capCL(i)
609 oliqCL(i, nsrf) = s_oliqCL(i)
610 cteiCL(i, nsrf) = s_cteiCL(i)
611 pblT(i, nsrf) = s_pblT(i)
612 therm(i, nsrf) = s_therm(i)
613 end IF
614 ENDDO
615 ENDDO
616
617 dlw = - 4. * RSIGMA * tsol**3
618
619 ! Appeler la convection
620
621 if (conv_emanuel) then
622 CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
623 d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
624 upwd, dnwd, Ma, cape, iflagctrl, clwcon0, pmflxr, da, phi, mp)
625 snow_con = 0.
626 mfu = upwd + dnwd
627
628 zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
629 zqsat = zqsat / (1. - retv * zqsat)
630
631 ! Properties of convective clouds
632 clwcon0 = fact_cldcon * clwcon0
633 call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
634 rnebcon0)
635
636 forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
637 mfd = 0.
638 pen_u = 0.
639 pen_d = 0.
640 pde_d = 0.
641 pde_u = 0.
642 else
643 conv_q = d_q_dyn + d_q_vdf / dtphys
644 conv_t = d_t_dyn + d_t_vdf / dtphys
645 z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
646 CALL conflx(paprs, play, t_seri(:, llm:1:- 1), q_seri(:, llm:1:- 1), &
647 conv_t, conv_q, - evap, omega, d_t_con, d_q_con, rain_con, &
648 snow_con, mfu(:, llm:1:- 1), mfd(:, llm:1:- 1), pen_u, pde_u, &
649 pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, pmflxs)
650 WHERE (rain_con < 0.) rain_con = 0.
651 WHERE (snow_con < 0.) snow_con = 0.
652 ibas_con = llm + 1 - kcbot
653 itop_con = llm + 1 - kctop
654 END if
655
656 DO k = 1, llm
657 DO i = 1, klon
658 t_seri(i, k) = t_seri(i, k) + d_t_con(i, k)
659 q_seri(i, k) = q_seri(i, k) + d_q_con(i, k)
660 u_seri(i, k) = u_seri(i, k) + d_u_con(i, k)
661 v_seri(i, k) = v_seri(i, k) + d_v_con(i, k)
662 ENDDO
663 ENDDO
664
665 IF (.not. conv_emanuel) THEN
666 z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
667 z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
668 DO k = 1, llm
669 DO i = 1, klon
670 IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
671 q_seri(i, k) = q_seri(i, k) * z_factor(i)
672 ENDIF
673 ENDDO
674 ENDDO
675 ENDIF
676
677 ! Convection s\`eche (thermiques ou ajustement)
678
679 d_t_ajs = 0.
680 d_u_ajs = 0.
681 d_v_ajs = 0.
682 d_q_ajs = 0.
683 fm_therm = 0.
684 entr_therm = 0.
685
686 if (iflag_thermals == 0) then
687 ! Ajustement sec
688 CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)
689 t_seri = t_seri + d_t_ajs
690 q_seri = q_seri + d_q_ajs
691 else
692 call calltherm(play, paprs, pphi, u_seri, v_seri, t_seri, q_seri, &
693 d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
694 endif
695
696 ! Caclul des ratqs
697
698 if (iflag_cldcon == 1) then
699 ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
700 ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
701 do k = 1, llm
702 do i = 1, klon
703 if(ptconv(i, k)) then
704 ratqsc(i, k) = ratqsbas + fact_cldcon &
705 * (q_seri(i, 1) - q_seri(i, k)) / q_seri(i, k)
706 else
707 ratqsc(i, k) = 0.
708 endif
709 enddo
710 enddo
711 endif
712
713 ! ratqs stables
714 do k = 1, llm
715 do i = 1, klon
716 ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
717 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
718 enddo
719 enddo
720
721 ! ratqs final
722 if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
723 ! les ratqs sont une conbinaison de ratqss et ratqsc
724 ! ratqs final
725 ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
726 ! relaxation des ratqs
727 ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
728 ratqs = max(ratqs, ratqsc)
729 else
730 ! on ne prend que le ratqs stable pour fisrtilp
731 ratqs = ratqss
732 endif
733
734 CALL fisrtilp(paprs, play, t_seri, q_seri, ptconv, ratqs, d_t_lsc, &
735 d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, pfrac_impa, &
736 pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, psfl, rhcl)
737
738 WHERE (rain_lsc < 0) rain_lsc = 0.
739 WHERE (snow_lsc < 0) snow_lsc = 0.
740 DO k = 1, llm
741 DO i = 1, klon
742 t_seri(i, k) = t_seri(i, k) + d_t_lsc(i, k)
743 q_seri(i, k) = q_seri(i, k) + d_q_lsc(i, k)
744 ql_seri(i, k) = ql_seri(i, k) + d_ql_lsc(i, k)
745 cldfra(i, k) = rneb(i, k)
746 IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
747 ENDDO
748 ENDDO
749
750 ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
751
752 ! 1. NUAGES CONVECTIFS
753
754 IF (iflag_cldcon <= - 1) THEN
755 ! seulement pour Tiedtke
756 snow_tiedtke = 0.
757 if (iflag_cldcon == - 1) then
758 rain_tiedtke = rain_con
759 else
760 rain_tiedtke = 0.
761 do k = 1, llm
762 do i = 1, klon
763 if (d_q_con(i, k) < 0.) then
764 rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
765 * zmasse(i, k)
766 endif
767 enddo
768 enddo
769 endif
770
771 ! Nuages diagnostiques pour Tiedtke
772 CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
773 itop_con, diafra, dialiq)
774 DO k = 1, llm
775 DO i = 1, klon
776 IF (diafra(i, k) > cldfra(i, k)) THEN
777 cldliq(i, k) = dialiq(i, k)
778 cldfra(i, k) = diafra(i, k)
779 ENDIF
780 ENDDO
781 ENDDO
782 ELSE IF (iflag_cldcon == 3) THEN
783 ! On prend pour les nuages convectifs le maximum du calcul de
784 ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
785 ! d'un facteur facttemps.
786 facteur = dtphys * facttemps
787 do k = 1, llm
788 do i = 1, klon
789 rnebcon(i, k) = rnebcon(i, k) * facteur
790 if (rnebcon0(i, k) * clwcon0(i, k) &
791 > rnebcon(i, k) * clwcon(i, k)) then
792 rnebcon(i, k) = rnebcon0(i, k)
793 clwcon(i, k) = clwcon0(i, k)
794 endif
795 enddo
796 enddo
797
798 ! On prend la somme des fractions nuageuses et des contenus en eau
799 cldfra = min(max(cldfra, rnebcon), 1.)
800 cldliq = cldliq + rnebcon * clwcon
801 ENDIF
802
803 ! 2. Nuages stratiformes
804
805 IF (ok_stratus) THEN
806 CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
807 DO k = 1, llm
808 DO i = 1, klon
809 IF (diafra(i, k) > cldfra(i, k)) THEN
810 cldliq(i, k) = dialiq(i, k)
811 cldfra(i, k) = diafra(i, k)
812 ENDIF
813 ENDDO
814 ENDDO
815 ENDIF
816
817 ! Precipitation totale
818 DO i = 1, klon
819 rain_fall(i) = rain_con(i) + rain_lsc(i)
820 snow_fall(i) = snow_con(i) + snow_lsc(i)
821 ENDDO
822
823 ! Humidit\'e relative pour diagnostic :
824 DO k = 1, llm
825 DO i = 1, klon
826 zx_t = t_seri(i, k)
827 zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
828 zx_qs = MIN(0.5, zx_qs)
829 zcor = 1. / (1. - retv * zx_qs)
830 zx_qs = zx_qs * zcor
831 zx_rh(i, k) = q_seri(i, k) / zx_qs
832 zqsat(i, k) = zx_qs
833 ENDDO
834 ENDDO
835
836 ! Param\`etres optiques des nuages et quelques param\`etres pour
837 ! diagnostics :
838 if (ok_newmicro) then
839 CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
840 cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc)
841 else
842 CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
843 cldl, cldm, cldt, cldq)
844 endif
845
846 IF (MOD(itap - 1, radpas) == 0) THEN
847 wo = ozonecm(REAL(julien), paprs)
848 albsol = sum(falbe * pctsrf, dim = 2)
849 CALL radlwsw(dist, mu0, fract, paprs, play, tsol, albsol, t_seri, &
850 q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
851 radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
852 toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
853 swup0, swup, ok_ade, topswad, solswad)
854 ENDIF
855
856 ! Ajouter la tendance des rayonnements (tous les pas)
857 DO k = 1, llm
858 DO i = 1, klon
859 t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys &
860 / 86400.
861 ENDDO
862 ENDDO
863
864 ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
865 DO i = 1, klon
866 bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
867 ENDDO
868
869 ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
870
871 IF (ok_orodr) THEN
872 ! S\'election des points pour lesquels le sch\'ema est actif :
873 DO i = 1, klon
874 ktest(i) = 0
875 IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
876 ktest(i) = 1
877 ENDIF
878 ENDDO
879
880 CALL drag_noro(paprs, play, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
881 ktest, t_seri, u_seri, v_seri, zulow, zvlow, zustrdr, zvstrdr, &
882 d_t_oro, d_u_oro, d_v_oro)
883
884 ! ajout des tendances
885 DO k = 1, llm
886 DO i = 1, klon
887 t_seri(i, k) = t_seri(i, k) + d_t_oro(i, k)
888 u_seri(i, k) = u_seri(i, k) + d_u_oro(i, k)
889 v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)
890 ENDDO
891 ENDDO
892 ENDIF
893
894 IF (ok_orolf) THEN
895 ! S\'election des points pour lesquels le sch\'ema est actif :
896 DO i = 1, klon
897 ktest(i) = 0
898 IF (zpic(i) - zmea(i) > 100.) THEN
899 ktest(i) = 1
900 ENDIF
901 ENDDO
902
903 CALL lift_noro(paprs, play, zmea, zstd, zpic, ktest, t_seri, u_seri, &
904 v_seri, zulow, zvlow, zustrli, zvstrli, d_t_lif, d_u_lif, d_v_lif)
905
906 ! Ajout des tendances :
907 DO k = 1, llm
908 DO i = 1, klon
909 t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)
910 u_seri(i, k) = u_seri(i, k) + d_u_lif(i, k)
911 v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)
912 ENDDO
913 ENDDO
914 ENDIF
915
916 CALL aaam_bud(rg, romega, pphis, zustrdr, zustrli, &
917 sum((u_seri - u) / dtphys * zmasse, dim = 2), zvstrdr, &
918 zvstrli, sum((v_seri - v) / dtphys * zmasse, dim = 2), paprs, u, v, &
919 aam, torsfc)
920
921 ! Calcul des tendances traceurs
922 call phytrac(julien, time, firstcal, lafin, t, paprs, play, mfu, mfd, &
923 pde_u, pen_d, coefh, cdragh, fm_therm, entr_therm, u(:, 1), v(:, 1), &
924 ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &
925 tr_seri, zmasse, ncid_startphy)
926
927 ! Calculer le transport de l'eau et de l'energie (diagnostique)
928 CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
929
930 ! diag. bilKP
931
932 CALL transp_lay(paprs, t_seri, q_seri, u_seri, v_seri, zphi, &
933 ve_lay, vq_lay, ue_lay, uq_lay)
934
935 ! Accumuler les variables a stocker dans les fichiers histoire:
936
937 ! conversion Ec en énergie thermique
938 DO k = 1, llm
939 DO i = 1, klon
940 d_t_ec(i, k) = 0.5 / (RCPD * (1. + RVTMP2 * q_seri(i, k))) &
941 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)
942 t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)
943 d_t_ec(i, k) = d_t_ec(i, k) / dtphys
944 END DO
945 END DO
946
947 ! SORTIES
948
949 ! prw = eau precipitable
950 DO i = 1, klon
951 prw(i) = 0.
952 DO k = 1, llm
953 prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
954 ENDDO
955 ENDDO
956
957 ! Convertir les incrementations en tendances
958
959 DO k = 1, llm
960 DO i = 1, klon
961 d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
962 d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
963 d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
964 d_qx(i, k, ivap) = (q_seri(i, k) - qx(i, k, ivap)) / dtphys
965 d_qx(i, k, iliq) = (ql_seri(i, k) - qx(i, k, iliq)) / dtphys
966 ENDDO
967 ENDDO
968
969 DO iq = 3, nqmx
970 DO k = 1, llm
971 DO i = 1, klon
972 d_qx(i, k, iq) = (tr_seri(i, k, iq - 2) - qx(i, k, iq)) / dtphys
973 ENDDO
974 ENDDO
975 ENDDO
976
977 ! Sauvegarder les valeurs de t et q a la fin de la physique:
978 DO k = 1, llm
979 DO i = 1, klon
980 t_ancien(i, k) = t_seri(i, k)
981 q_ancien(i, k) = q_seri(i, k)
982 ENDDO
983 ENDDO
984
985 CALL histwrite_phy("phis", pphis)
986 CALL histwrite_phy("aire", airephy)
987 CALL histwrite_phy("psol", paprs(:, 1))
988 CALL histwrite_phy("precip", rain_fall + snow_fall)
989 CALL histwrite_phy("plul", rain_lsc + snow_lsc)
990 CALL histwrite_phy("pluc", rain_con + snow_con)
991 CALL histwrite_phy("tsol", tsol)
992 CALL histwrite_phy("t2m", zt2m)
993 CALL histwrite_phy("q2m", zq2m)
994 CALL histwrite_phy("u10m", u10m)
995 CALL histwrite_phy("v10m", v10m)
996 CALL histwrite_phy("snow", snow_fall)
997 CALL histwrite_phy("cdrm", cdragm)
998 CALL histwrite_phy("cdrh", cdragh)
999 CALL histwrite_phy("topl", toplw)
1000 CALL histwrite_phy("evap", evap)
1001 CALL histwrite_phy("sols", solsw)
1002 CALL histwrite_phy("soll", sollw)
1003 CALL histwrite_phy("solldown", sollwdown)
1004 CALL histwrite_phy("bils", bils)
1005 CALL histwrite_phy("sens", - sens)
1006 CALL histwrite_phy("fder", fder)
1007 CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1008 CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1009 CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1010 CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
1011 CALL histwrite_phy("zxfqcalving", sum(fqcalving * pctsrf, dim = 2))
1012
1013 DO nsrf = 1, nbsrf
1014 CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1015 CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1016 CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1017 CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1018 CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1019 CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1020 CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1021 CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1022 CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1023 CALL histwrite_phy("u10m_"//clnsurf(nsrf), u10m_srf(:, nsrf))
1024 CALL histwrite_phy("v10m_"//clnsurf(nsrf), v10m_srf(:, nsrf))
1025 END DO
1026
1027 CALL histwrite_phy("albs", albsol)
1028 CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1029 CALL histwrite_phy("rugs", zxrugs)
1030 CALL histwrite_phy("s_pblh", s_pblh)
1031 CALL histwrite_phy("s_pblt", s_pblt)
1032 CALL histwrite_phy("s_lcl", s_lcl)
1033 CALL histwrite_phy("s_capCL", s_capCL)
1034 CALL histwrite_phy("s_oliqCL", s_oliqCL)
1035 CALL histwrite_phy("s_cteiCL", s_cteiCL)
1036 CALL histwrite_phy("s_therm", s_therm)
1037
1038 if (conv_emanuel) then
1039 CALL histwrite_phy("ptop", ema_pct)
1040 CALL histwrite_phy("dnwd0", - mp)
1041 end if
1042
1043 CALL histwrite_phy("temp", t_seri)
1044 CALL histwrite_phy("vitu", u_seri)
1045 CALL histwrite_phy("vitv", v_seri)
1046 CALL histwrite_phy("geop", zphi)
1047 CALL histwrite_phy("pres", play)
1048 CALL histwrite_phy("dtvdf", d_t_vdf)
1049 CALL histwrite_phy("dqvdf", d_q_vdf)
1050 CALL histwrite_phy("rhum", zx_rh)
1051 CALL histwrite_phy("d_t_ec", d_t_ec)
1052 CALL histwrite_phy("dtsw0", heat0 / 86400.)
1053 CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1054 CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1055 call histwrite_phy("qsurf", sum(fqsurf * pctsrf, dim = 2))
1056
1057 if (ok_instan) call histsync(nid_ins)
1058
1059 IF (lafin) then
1060 call NF95_CLOSE(ncid_startphy)
1061 CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1062 fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1063 radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1064 t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1065 w01)
1066 end IF
1067
1068 firstcal = .FALSE.
1069
1070 END SUBROUTINE physiq
1071
1072 end module physiq_m

  ViewVC Help
Powered by ViewVC 1.1.21