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

Diff of /trunk/phylmd/physiq.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/Sources/phylmd/physiq.f revision 203 by guez, Wed Jun 8 15:10:12 2016 UTC trunk/phylmd/physiq.f revision 323 by guez, Thu Jan 24 17:19:06 2019 UTC
# Line 18  contains Line 18  contains
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
19      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
20      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
21      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ksta, ksta_ter, ok_kzmin, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ok_instan
22           ok_instan      USE clesphys2, ONLY: conv_emanuel, nbapp_rad, new_oliq, ok_orodr, ok_orolf
23      USE clesphys2, ONLY: cycle_diurne, conv_emanuel, nbapp_rad, new_oliq, &      USE conf_interface_m, ONLY: conf_interface
24           ok_orodr, ok_orolf      USE pbl_surface_m, ONLY: pbl_surface
     USE clmain_m, ONLY: clmain  
25      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
26      use comconst, only: dtphys      use comconst, only: dtphys
27      USE comgeomphy, ONLY: airephy      USE comgeomphy, ONLY: airephy
28      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
29      USE conf_gcm_m, ONLY: offline, day_step, iphysiq, lmt_pas      USE conf_gcm_m, ONLY: lmt_pas
30      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
31      use conflx_m, only: conflx      use conflx_m, only: conflx
32      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm_m, ONLY: iflag_thermals, ctherm
33      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
34      use diagetpq_m, only: diagetpq      USE dimensions, ONLY: llm, nqmx
     use diagphy_m, only: diagphy  
     USE dimens_m, ONLY: llm, nqmx  
35      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
37      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
38      use dynetat0_m, only: day_ref, annee_ref      use dynetat0_chosen_m, only: day_ref, annee_ref
39      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew
40      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
41      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
42      USE histsync_m, ONLY: histsync      USE histsync_m, ONLY: histsync
# Line 47  contains Line 44  contains
44      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
45           nbsrf           nbsrf
46      USE ini_histins_m, ONLY: ini_histins, nid_ins      USE ini_histins_m, ONLY: ini_histins, nid_ins
47        use lift_noro_m, only: lift_noro
48      use netcdf95, only: NF95_CLOSE      use netcdf95, only: NF95_CLOSE
49      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
50      use nr_util, only: assert      use nr_util, only: assert
51      use nuage_m, only: nuage      use nuage_m, only: nuage
52      USE orbite_m, ONLY: orbite      USE orbite_m, ONLY: orbite
53      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
54      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0
55      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
56      USE phyredem0_m, ONLY: phyredem0      USE phyredem0_m, ONLY: phyredem0
     USE phystokenc_m, ONLY: phystokenc  
57      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
58      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
59      use yoegwd, only: sugwd      use yoegwd, only: sugwd
60      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt, rmo3, md
61      use time_phylmdz, only: itap, increment_itap      use time_phylmdz, only: itap, increment_itap
62      use transp_m, only: transp      use transp_m, only: transp
63      use transp_lay_m, only: transp_lay      use transp_lay_m, only: transp_lay
# Line 109  contains Line 105  contains
105    
106      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
107    
     LOGICAL, PARAMETER:: check = .FALSE.  
     ! Verifier la conservation du modele en eau  
   
108      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
109      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
110    
# Line 131  contains Line 124  contains
124    
125      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
126    
127      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
128      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
129      SAVE swdn0, swdn, swup0, swup  
130        REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
131      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
     REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)  
     SAVE lwdn0, lwdn, lwup0, lwup  
132    
133      ! prw: precipitable water      ! prw: precipitable water
134      real prw(klon)      real prw(klon)
# Line 153  contains Line 144  contains
144      ! Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
145      ! "physiq".      ! "physiq".
146    
147      REAL radsol(klon)      REAL, save:: radsol(klon)
148      SAVE radsol ! bilan radiatif au sol calcule par code radiatif      ! bilan radiatif net au sol (W/m2), positif vers le bas
149        
150      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction, in K
151    
152      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
153      ! soil temperature of surface fraction      ! soil temperature of surface fraction
154    
155      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL fluxlat(klon, nbsrf) ! flux de chaleur latente, en W m-2
     REAL fluxlat(klon, nbsrf)  
     SAVE fluxlat  
156    
157      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
158      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
159    
160      REAL, save:: qsol(klon)      REAL, save:: qsol(klon) ! column-density of water in soil, in kg m-2
161      ! column-density of water in soil, in kg m-2      REAL, save:: fsnow(klon, nbsrf) ! \'epaisseur neigeuse
   
     REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse  
162      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
163    
164      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
# Line 184  contains Line 171  contains
171      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
172      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
173      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
174      INTEGER igwd, itest(klon)      INTEGER ktest(klon)
175    
176      REAL, save:: agesno(klon, nbsrf) ! age de la neige      REAL, save:: agesno(klon, nbsrf) ! age de la neige
177      REAL, save:: run_off_lic_0(klon)      REAL, save:: run_off_lic_0(klon)
178    
179      ! Variables li\'ees \`a la convection d'Emanuel :      ! Variables li\'ees \`a la convection d'Emanuel :
180      REAL, save:: Ma(klon, llm) ! undilute upward mass flux      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
     REAL, save:: qcondc(klon, llm) ! in-cld water content from convect  
181      REAL, save:: sig1(klon, llm), w01(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
182    
183      ! Variables pour la couche limite (Alain Lahellec) :      ! Variables pour la couche limite (Alain Lahellec) :
184      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
185      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
186    
187      ! Pour phytrac :      REAL coefh(klon, 2:llm) ! coef d'echange pour phytrac
188      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac  
189      REAL yu1(klon) ! vents dans la premiere couche U      REAL, save:: ffonte(klon, nbsrf)
190      REAL yv1(klon) ! vents dans la premiere couche V      ! flux thermique utilise pour fondre la neige
     REAL ffonte(klon, nbsrf) ! flux thermique utilise pour fondre la neige  
191    
192      REAL fqcalving(klon, nbsrf)      REAL fqcalving(klon, nbsrf)
193      ! flux d'eau "perdue" par la surface et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et n\'ecessaire pour limiter
194      ! hauteur de neige, en kg / m2 / s      ! la hauteur de neige, en kg / m2 / s
195    
196        REAL zxffonte(klon)
197    
198        REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
199        REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
200    
201      REAL zxffonte(klon), zxfqcalving(klon)      REAL, save:: pfrac_1nucl(klon, llm)
202        ! Produits des coefs lessi nucl (alpha = 1)
203    
204      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL frac_impa(klon, llm) ! fraction d'a\'erosols lessiv\'es (impaction)
     save pfrac_impa  
     REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
     save pfrac_nucl  
     REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)  
     save pfrac_1nucl  
     REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)  
205      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
206    
207      REAL, save:: rain_fall(klon)      REAL, save:: rain_fall(klon)
# Line 227  contains Line 212  contains
212    
213      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
214    
215      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
216      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real dflux_q(klon) ! derivative of the evaporation flux at the surface
217      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
218      SAVE dlw      real dflux_t(klon) ! derivee du flux de chaleur sensible au sol
219        REAL, save:: dlw(klon) ! derivative of infra-red flux
220      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
221      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
222      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
223      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
224      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
# Line 245  contains Line 231  contains
231    
232      INTEGER julien      INTEGER julien
233      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
234      REAL, save:: albsol(klon) ! albedo du sol total visible      REAL, save:: albsol(klon) ! albedo du sol total, visible, moyen par maille
235      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
236        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
237    
238      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
239      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
240    
241      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humidit\'e relative ciel clair
242      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
243      REAL diafra(klon, llm) ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
244      REAL cldliq(klon, llm) ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
# Line 259  contains Line 246  contains
246      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
247      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
248    
249      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
250      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur  
251      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_t(klon, nbsrf)
252      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v      ! flux de chaleur sensible (c_p T) (W / m2) (orientation positive
253        ! vers le bas) à la surface
254      REAL zxfluxt(klon, llm)  
255      REAL zxfluxq(klon, llm)      REAL flux_u(klon, nbsrf), flux_v(klon, nbsrf)
256      REAL zxfluxu(klon, llm)      ! tension du vent (flux turbulent de vent) à la surface, en Pa
     REAL zxfluxv(klon, llm)  
257    
258      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
259      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
# Line 276  contains Line 262  contains
262      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
263      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
264      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
265      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface  
266        REAL, save:: sollw(klon) ! surface net downward longwave flux, in W m-2
267      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
268      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
269      REAL, save:: albpla(klon)      REAL, save:: albpla(klon)
     REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface  
     REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface  
270    
271      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
272      REAL conv_t(klon, llm) ! convergence of temperature (K / s)      REAL conv_t(klon, llm) ! convergence of temperature (K / s)
# Line 289  contains Line 274  contains
274      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
275      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
276    
277      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxfluxlat(klon)
   
278      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
279      real longi      real longi
280      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
281      REAL za, zb      REAL zb
282      REAL zx_t, zx_qs, zcor      REAL zx_qs, zcor
283      real zqsat(klon, llm)      real zqsat(klon, llm)
284      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
285      REAL zphi(klon, llm)      REAL zphi(klon, llm)
286    
287      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
# Line 308  contains Line 291  contains
291      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
292      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
293      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
294      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
295      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
     REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape  
     REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition  
     REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega  
296      ! Grandeurs de sorties      ! Grandeurs de sorties
297      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
298      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
299      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon)
     REAL s_trmb3(klon)  
300    
301      ! Variables pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
302    
303      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
304      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
305      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
306    
307      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
308    
# Line 337  contains Line 314  contains
314      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
315      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
316      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
317      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
318      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
319      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
320      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 353  contains Line 330  contains
330      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
331      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
332    
333      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon)
334      REAL, save:: snow_con(klon) ! neige (mm / s)      real rain_lsc(klon)
335        REAL snow_con(klon) ! neige (mm / s)
336      real snow_lsc(klon)      real snow_lsc(klon)
337      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf) ! variation of ftsol
338    
339      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
340      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)
# Line 390  contains Line 368  contains
368    
369      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
370      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
     REAL zustrph(klon), zvstrph(klon)  
371      REAL aam, torsfc      REAL aam, torsfc
372    
373      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
# Line 398  contains Line 375  contains
375      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.
376      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.
377    
378      real date0      REAL tsol(klon)
   
     ! Variables li\'ees au bilan d'\'energie et d'enthalpie :  
     REAL ztsol(klon)  
     REAL d_h_vcol, d_qt, d_ec  
     REAL, SAVE:: d_h_vcol_phy  
     REAL zero_v(klon)  
     CHARACTER(LEN = 20) tit  
     INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
     INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation  
379    
380      REAL d_t_ec(klon, llm)      REAL d_t_ec(klon, llm)
381      ! tendance due \`a la conversion Ec en énergie thermique      ! tendance due \`a la conversion d'\'energie cin\'etique en
382        ! énergie thermique
383    
384      REAL ZRCPD      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
385        ! temperature and humidity at 2 m
386    
387      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL, save:: u10m_srf(klon, nbsrf), v10m_srf(klon, nbsrf)
388      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m      ! composantes du vent \`a 10 m
389      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille      
390      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille      REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
391        REAL u10m(klon), v10m(klon) ! vent \`a 10 m moyenn\' sur les sous-surfaces
392    
393      ! Aerosol effects:      ! Aerosol effects:
394    
395      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g / m3)      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
   
     REAL, save:: sulfate_pi(klon, llm)  
     ! SO4 aerosol concentration, in \mu g / m3, pre-industrial value  
   
     REAL cldtaupi(klon, llm)  
     ! cloud optical thickness for pre-industrial aerosols  
   
     REAL re(klon, llm) ! Cloud droplet effective radius  
     REAL fl(klon, llm) ! denominator of re  
   
     ! Aerosol optical properties  
     REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)  
     REAL, save:: cg_ae(klon, llm, 2)  
   
     REAL topswad(klon), solswad(klon) ! aerosol direct effect  
     REAL topswai(klon), solswai(klon) ! aerosol indirect effect  
   
396      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
     LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect  
397    
398      REAL:: bl95_b0 = 2., bl95_b1 = 0.2      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
399      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
400      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
401      ! concentration.      ! concentration.
402    
     SAVE u10m  
     SAVE v10m  
     SAVE t2m  
     SAVE q2m  
     SAVE ffonte  
     SAVE fqcalving  
     SAVE rain_con  
     SAVE topswai  
     SAVE topswad  
     SAVE solswai  
     SAVE solswad  
     SAVE d_u_con  
     SAVE d_v_con  
   
403      real zmasse(klon, llm)      real zmasse(klon, llm)
404      ! (column-density of mass of air in a cell, in kg m-2)      ! (column-density of mass of air in a cell, in kg m-2)
405    
406      integer, save:: ncid_startphy      integer, save:: ncid_startphy
407    
408      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
409           iflag_cldcon, ratqsbas, ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, &           ratqsbas, ratqshaut, ok_ade, bl95_b0, bl95_b1
          bl95_b1, iflag_thermals, nsplit_thermals  
410    
411      !----------------------------------------------------------------      !----------------------------------------------------------------
412    
# Line 477  contains Line 415  contains
415    
416      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
417         ! initialiser         ! initialiser
418         u10m = 0.         u10m_srf = 0.
419         v10m = 0.         v10m_srf = 0.
420         t2m = 0.         t2m = 0.
421         q2m = 0.         q2m = 0.
422         ffonte = 0.         ffonte = 0.
        fqcalving = 0.  
        piz_ae = 0.  
        tau_ae = 0.  
        cg_ae = 0.  
        rain_con = 0.  
        snow_con = 0.  
        topswai = 0.  
        topswad = 0.  
        solswai = 0.  
        solswad = 0.  
   
423         d_u_con = 0.         d_u_con = 0.
424         d_v_con = 0.         d_v_con = 0.
425         rnebcon0 = 0.         rnebcon0 = 0.
426         clwcon0 = 0.         clwcon0 = 0.
427         rnebcon = 0.         rnebcon = 0.
428         clwcon = 0.         clwcon = 0.
   
429         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
430         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
431         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
432         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
433         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
434         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
435         therm =0.         therm =0.
        trmb1 =0. ! deep_cape  
        trmb2 =0. ! inhibition  
        trmb3 =0. ! Point Omega  
436    
        iflag_thermals = 0  
        nsplit_thermals = 1  
437         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
438         read(unit=*, nml=physiq_nml)         read(unit=*, nml=physiq_nml)
439         write(unit_nml, nml=physiq_nml)         write(unit_nml, nml=physiq_nml)
440    
441         IF (if_ebil >= 1) d_h_vcol_phy = 0.         call ctherm
442         call conf_phys         call conf_phys
443    
444         ! Initialiser les compteurs:         ! Initialiser les compteurs:
445    
446         frugs = 0.         frugs = 0.
447         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
448              fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, &
449              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
450              q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01, &
451              w01, ncid_startphy)              ncid_startphy)
452    
453         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
454         q2 = 1e-8         q2 = 1e-8
# Line 548  contains Line 469  contains
469            rugoro = 0.            rugoro = 0.
470         ENDIF         ENDIF
471    
        ecrit_ins = NINT(ecrit_ins / dtphys)  
   
472         ! Initialisation des sorties         ! Initialisation des sorties
473           call ini_histins(ok_newmicro)
        call ini_histins(dtphys)  
        CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)  
        ! Positionner date0 pour initialisation de ORCHIDEE  
        print *, 'physiq date0: ', date0  
474         CALL phyredem0         CALL phyredem0
475           call conf_interface
476      ENDIF test_firstcal      ENDIF test_firstcal
477    
     IF (if_ebil >= 1) zero_v = 0.  
   
478      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
479      ! u, v, t, qx:      ! u, v, t, qx:
480      t_seri = t      t_seri = t
# Line 570  contains Line 484  contains
484      ql_seri = qx(:, :, iliq)      ql_seri = qx(:, :, iliq)
485      tr_seri = qx(:, :, 3:nqmx)      tr_seri = qx(:, :, 3:nqmx)
486    
487      ztsol = sum(ftsol * pctsrf, dim = 2)      tsol = sum(ftsol * pctsrf, dim = 2)
   
     IF (if_ebil >= 1) THEN  
        tit = 'after dynamics'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        ! Comme les tendances de la physique sont ajout\'es dans la  
        ! dynamique, la variation d'enthalpie par la dynamique devrait  
        ! \^etre \'egale \`a la variation de la physique au pas de temps  
        ! pr\'ec\'edent. Donc la somme de ces 2 variations devrait \^etre  
        ! nulle.  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &  
             d_qt, 0.)  
     END IF  
488    
489      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
490      IF (ancien_ok) THEN      IF (ancien_ok) THEN
# Line 620  contains Line 520  contains
520    
521      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
522    
     ! Prescrire l'ozone :  
     wo = ozonecm(REAL(julien), paprs)  
   
523      ! \'Evaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
524      DO k = 1, llm      DO k = 1, llm
525         DO i = 1, klon         DO i = 1, klon
# Line 634  contains Line 531  contains
531      ENDDO      ENDDO
532      ql_seri = 0.      ql_seri = 0.
533    
     IF (if_ebil >= 2) THEN  
        tit = 'after reevap'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
534      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
535      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
536    
# Line 649  contains Line 538  contains
538      ! la surface.      ! la surface.
539    
540      CALL orbite(REAL(julien), longi, dist)      CALL orbite(REAL(julien), longi, dist)
541      IF (cycle_diurne) THEN      CALL zenang(longi, time, dtphys * radpas, mu0, fract)
        CALL zenang(longi, time, dtphys * radpas, mu0, fract)  
     ELSE  
        mu0 = - 999.999  
     ENDIF  
   
     ! Calcul de l'abedo moyen par maille  
     albsol = sum(falbe * pctsrf, dim = 2)  
   
     ! R\'epartition sous maille des flux longwave et shortwave  
     ! R\'epartition du longwave par sous-surface lin\'earis\'ee  
542    
543      forall (nsrf = 1: nbsrf)      CALL pbl_surface(pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
544         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &           ftsol, cdmmax, cdhmax, ftsoil, qsol, paprs, play, fsnow, fqsurf, &
545              * (ztsol - ftsol(:, nsrf))           falbe, fluxlat, rain_fall, snow_fall, frugs, agesno, rugoro, d_t_vdf, &
546         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, flux_v, &
547      END forall           cdragh, cdragm, q2, dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, &
548             v10m_srf, pblh, capCL, oliqCL, cteiCL, pblT, therm, plcl, fqcalving, &
549      fder = dlw           ffonte, run_off_lic_0, albsol, sollw, solsw, tsol)
   
     ! Couche limite:  
   
     CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &  
          ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &  
          paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &  
          snow_fall, fsolsw, fsollw, fder, rlat, frugs, agesno, rugoro, &  
          d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, &  
          fluxv, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &  
          u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &  
          trmb3, plcl, fqcalving, ffonte, run_off_lic_0)  
550    
551      ! Incr\'ementation des flux      ! Incr\'ementation des flux
552    
553      zxfluxt = 0.      sens = sum(flux_t * pctsrf, dim = 2)
554      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
555      zxfluxu = 0.      fder = dlw + dflux_t + dflux_q
     zxfluxv = 0.  
     DO nsrf = 1, nbsrf  
        DO k = 1, llm  
           DO i = 1, klon  
              zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxv(i, k) = zxfluxv(i, k) + fluxv(i, k, nsrf) * pctsrf(i, nsrf)  
           END DO  
        END DO  
     END DO  
     DO i = 1, klon  
        sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol  
        evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol  
        fder(i) = dlw(i) + dsens(i) + devap(i)  
     ENDDO  
556    
557      DO k = 1, llm      DO k = 1, llm
558         DO i = 1, klon         DO i = 1, klon
# Line 711  contains Line 563  contains
563         ENDDO         ENDDO
564      ENDDO      ENDDO
565    
     IF (if_ebil >= 2) THEN  
        tit = 'after clmain'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
     ! Update surface temperature:  
   
     DO i = 1, klon  
        zxfluxlat(i) = 0.  
   
        zt2m(i) = 0.  
        zq2m(i) = 0.  
        zu10m(i) = 0.  
        zv10m(i) = 0.  
        zxffonte(i) = 0.  
        zxfqcalving(i) = 0.  
   
        s_pblh(i) = 0.  
        s_lcl(i) = 0.  
        s_capCL(i) = 0.  
        s_oliqCL(i) = 0.  
        s_cteiCL(i) = 0.  
        s_pblT(i) = 0.  
        s_therm(i) = 0.  
        s_trmb1(i) = 0.  
        s_trmb2(i) = 0.  
        s_trmb3(i) = 0.  
     ENDDO  
   
566      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
567        ftsol = ftsol + d_ts ! update surface temperature
568        tsol = sum(ftsol * pctsrf, dim = 2)
569        zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
570        zt2m = sum(t2m * pctsrf, dim = 2)
571        zq2m = sum(q2m * pctsrf, dim = 2)
572        u10m = sum(u10m_srf * pctsrf, dim = 2)
573        v10m = sum(v10m_srf * pctsrf, dim = 2)
574        zxffonte = sum(ffonte * pctsrf, dim = 2)
575        s_pblh = sum(pblh * pctsrf, dim = 2)
576        s_lcl = sum(plcl * pctsrf, dim = 2)
577        s_capCL = sum(capCL * pctsrf, dim = 2)
578        s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
579        s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
580        s_pblT = sum(pblT * pctsrf, dim = 2)
581        s_therm = sum(therm * pctsrf, dim = 2)
582    
583      ftsol = ftsol + d_ts      ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
     zxtsol = sum(ftsol * pctsrf, dim = 2)  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf) * pctsrf(i, nsrf)  
   
           zt2m(i) = zt2m(i) + t2m(i, nsrf) * pctsrf(i, nsrf)  
           zq2m(i) = zq2m(i) + q2m(i, nsrf) * pctsrf(i, nsrf)  
           zu10m(i) = zu10m(i) + u10m(i, nsrf) * pctsrf(i, nsrf)  
           zv10m(i) = zv10m(i) + v10m(i, nsrf) * pctsrf(i, nsrf)  
           zxffonte(i) = zxffonte(i) + ffonte(i, nsrf) * pctsrf(i, nsrf)  
           zxfqcalving(i) = zxfqcalving(i) + &  
                fqcalving(i, nsrf) * pctsrf(i, nsrf)  
           s_pblh(i) = s_pblh(i) + pblh(i, nsrf) * pctsrf(i, nsrf)  
           s_lcl(i) = s_lcl(i) + plcl(i, nsrf) * pctsrf(i, nsrf)  
           s_capCL(i) = s_capCL(i) + capCL(i, nsrf) * pctsrf(i, nsrf)  
           s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) * pctsrf(i, nsrf)  
           s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) * pctsrf(i, nsrf)  
           s_pblT(i) = s_pblT(i) + pblT(i, nsrf) * pctsrf(i, nsrf)  
           s_therm(i) = s_therm(i) + therm(i, nsrf) * pctsrf(i, nsrf)  
           s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) * pctsrf(i, nsrf)  
           s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) * pctsrf(i, nsrf)  
           s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) * pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
   
     ! Si une sous-fraction n'existe pas, elle prend la température moyenne :  
584      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
585         DO i = 1, klon         DO i = 1, klon
586            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
587                 ftsol(i, nsrf) = tsol(i)
588            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
589            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
590            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m_srf(i, nsrf) = u10m(i)
591            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m_srf(i, nsrf) = v10m(i)
592            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
593            IF (pctsrf(i, nsrf) < epsfra) &               pblh(i, nsrf) = s_pblh(i)
594                 fqcalving(i, nsrf) = zxfqcalving(i)               plcl(i, nsrf) = s_lcl(i)
595            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               capCL(i, nsrf) = s_capCL(i)
596            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               oliqCL(i, nsrf) = s_oliqCL(i)
597            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
598            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               pblT(i, nsrf) = s_pblT(i)
599            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               therm(i, nsrf) = s_therm(i)
600            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)            end IF
           IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)  
601         ENDDO         ENDDO
602      ENDDO      ENDDO
603    
604      ! Calculer la dérive du flux infrarouge      dlw = - 4. * RSIGMA * tsol**3
   
     DO i = 1, klon  
        dlw(i) = - 4. * RSIGMA * zxtsol(i)**3  
     ENDDO  
   
     IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)  
605    
606      ! Appeler la convection      ! Appeler la convection
607    
608      if (conv_emanuel) then      if (conv_emanuel) then
        da = 0.  
        mp = 0.  
        phi = 0.  
609         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
610              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
611              upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)              upwd, dnwd, Ma, cape, iflagctrl, clwcon0, pmflxr, da, phi, mp)
612         snow_con = 0.         snow_con = 0.
        clwcon0 = qcondc  
613         mfu = upwd + dnwd         mfu = upwd + dnwd
614    
615         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
616            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)         zqsat = zqsat / (1. - retv * zqsat)
           zqsat = zqsat / (1. - retv * zqsat)  
        ELSE  
           zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play  
        ENDIF  
617    
618         ! Properties of convective clouds         ! Properties of convective clouds
619         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
# Line 839  contains Line 630  contains
630         conv_q = d_q_dyn + d_q_vdf / dtphys         conv_q = d_q_dyn + d_q_vdf / dtphys
631         conv_t = d_t_dyn + d_t_vdf / dtphys         conv_t = d_t_dyn + d_t_vdf / dtphys
632         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
633         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &         CALL conflx(paprs, play, t_seri(:, llm:1:- 1), q_seri(:, llm:1:- 1), &
634              q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &              conv_t, conv_q, - evap, omega, d_t_con, d_q_con, rain_con, &
635              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &              snow_con, mfu(:, llm:1:- 1), mfd(:, llm:1:- 1), pen_u, pde_u, &
636              mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &              pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, pmflxs)
             kdtop, pmflxr, pmflxs)  
637         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
638         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
639         ibas_con = llm + 1 - kcbot         ibas_con = llm + 1 - kcbot
# Line 859  contains Line 649  contains
649         ENDDO         ENDDO
650      ENDDO      ENDDO
651    
     IF (if_ebil >= 2) THEN  
        tit = 'after convect'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        print *, "aprescon = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i) / REAL(klon)  
           zx_t = zx_t + (rain_con(i)+ &  
                snow_con(i)) * airephy(i) / REAL(klon)  
        ENDDO  
        zx_t = zx_t / za * dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
   
652      IF (.not. conv_emanuel) THEN      IF (.not. conv_emanuel) THEN
653         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
654         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
# Line 902  contains Line 670  contains
670      fm_therm = 0.      fm_therm = 0.
671      entr_therm = 0.      entr_therm = 0.
672    
673      if (iflag_thermals == 0) then      if (iflag_thermals) then
674         ! Ajustement sec         call calltherm(play, paprs, pphi, u_seri, v_seri, t_seri, q_seri, &
675                d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
676        else
677         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)
678         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
679         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
     else  
        call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &  
             q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)  
680      endif      endif
681    
     IF (if_ebil >= 2) THEN  
        tit = 'after dry_adjust'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
     END IF  
   
682      ! Caclul des ratqs      ! Caclul des ratqs
683    
     ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q  
     ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno  
684      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
685           ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
686           ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
687         do k = 1, llm         do k = 1, llm
688            do i = 1, klon            do i = 1, klon
689               if(ptconv(i, k)) then               if(ptconv(i, k)) then
# Line 956  contains Line 717  contains
717         ratqs = ratqss         ratqs = ratqss
718      endif      endif
719    
720      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(paprs, play, t_seri, q_seri, ptconv, ratqs, d_t_lsc, &
721           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &           d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, pfrac_impa, &
722           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, psfl, rhcl)
          psfl, rhcl)  
723    
724      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
725      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 972  contains Line 732  contains
732            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
733         ENDDO         ENDDO
734      ENDDO      ENDDO
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        print *, "apresilp = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i) / REAL(klon)  
           zx_t = zx_t + (rain_lsc(i) &  
                + snow_lsc(i)) * airephy(i) / REAL(klon)  
        ENDDO  
        zx_t = zx_t / za * dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
   
     IF (if_ebil >= 2) THEN  
        tit = 'after fisrt'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
735    
736      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
737    
# Line 1067  contains Line 806  contains
806         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
807      ENDDO      ENDDO
808    
     IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &  
          dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &  
          d_qt, d_ec)  
   
809      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
810      DO k = 1, llm      DO k = 1, llm
811         DO i = 1, klon         DO i = 1, klon
812            zx_t = t_seri(i, k)            zx_qs = r2es * FOEEW(t_seri(i, k), rtt >= t_seri(i, k)) / play(i, k)
813            IF (thermcep) THEN            zx_qs = MIN(0.5, zx_qs)
814               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)            zcor = 1. / (1. - retv * zx_qs)
815               zx_qs = MIN(0.5, zx_qs)            zx_qs = zx_qs * zcor
              zcor = 1. / (1. - retv * zx_qs)  
              zx_qs = zx_qs * zcor  
           ELSE  
              IF (zx_t < t_coup) THEN  
                 zx_qs = qsats(zx_t) / play(i, k)  
              ELSE  
                 zx_qs = qsatl(zx_t) / play(i, k)  
              ENDIF  
           ENDIF  
816            zx_rh(i, k) = q_seri(i, k) / zx_qs            zx_rh(i, k) = q_seri(i, k) / zx_qs
817            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
818         ENDDO         ENDDO
819      ENDDO      ENDDO
820    
     ! Introduce the aerosol direct and first indirect radiative forcings:  
     tau_ae = 0.  
     piz_ae = 0.  
     cg_ae = 0.  
   
821      ! Param\`etres optiques des nuages et quelques param\`etres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
822      ! diagnostics :      ! diagnostics :
823      if (ok_newmicro) then      if (ok_newmicro) then
824         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
825              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc)
             sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)  
826      else      else
827         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
828              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq)
             bl95_b1, cldtaupi, re, fl)  
829      endif      endif
830    
831      IF (MOD(itap - 1, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
832         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         wo = ozonecm(REAL(julien), paprs)
        ! Calcul de l'abedo moyen par maille  
833         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
834           CALL radlwsw(dist, mu0, fract, paprs, play, tsol, albsol, t_seri, &
        ! Rayonnement (compatible Arpege-IFS) :  
        CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &  
835              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
836              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
837              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
838              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &              swup0, swup, ok_ade, topswad, solswad)
             solswad, cldtaupi, topswai, solswai)  
839      ENDIF      ENDIF
840    
841      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
842      DO k = 1, llm      DO k = 1, llm
843         DO i = 1, klon         DO i = 1, klon
844            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys &            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys &
# Line 1132  contains Line 846  contains
846         ENDDO         ENDDO
847      ENDDO      ENDDO
848    
     IF (if_ebil >= 2) THEN  
        tit = 'after rad'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
     ! Calculer l'hydrologie de la surface  
     DO i = 1, klon  
        zxqsurf(i) = 0.  
        zxsnow(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf) * pctsrf(i, nsrf)  
           zxsnow(i) = zxsnow(i) + fsnow(i, nsrf) * pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
   
849      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
   
850      DO i = 1, klon      DO i = 1, klon
851         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) + sens(i) + zxfluxlat(i)
852      ENDDO      ENDDO
853    
854      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
855    
856      IF (ok_orodr) THEN      IF (ok_orodr) THEN
857         ! S\'election des points pour lesquels le sch\'ema est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
        igwd = 0  
858         DO i = 1, klon         DO i = 1, klon
859            itest(i) = 0            ktest(i) = 0
860            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
861               itest(i) = 1               ktest(i) = 1
              igwd = igwd + 1  
862            ENDIF            ENDIF
863         ENDDO         ENDDO
864    
865         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(paprs, play, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
866              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &              ktest, t_seri, u_seri, v_seri, zulow, zvlow, zustrdr, zvstrdr, &
867              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              d_t_oro, d_u_oro, d_v_oro)
868    
869         ! ajout des tendances         ! ajout des tendances
870         DO k = 1, llm         DO k = 1, llm
# Line 1187  contains Line 878  contains
878    
879      IF (ok_orolf) THEN      IF (ok_orolf) THEN
880         ! S\'election des points pour lesquels le sch\'ema est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
        igwd = 0  
881         DO i = 1, klon         DO i = 1, klon
882            itest(i) = 0            ktest(i) = 0
883            IF (zpic(i) - zmea(i) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
884               itest(i) = 1               ktest(i) = 1
              igwd = igwd + 1  
885            ENDIF            ENDIF
886         ENDDO         ENDDO
887    
888         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &         CALL lift_noro(paprs, play, zmea, zstd, zpic, ktest, t_seri, u_seri, &
889              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              v_seri, zulow, zvlow, zustrli, zvstrli, d_t_lif, d_u_lif, d_v_lif)
             d_t_lif, d_u_lif, d_v_lif)  
890    
891         ! Ajout des tendances :         ! Ajout des tendances :
892         DO k = 1, llm         DO k = 1, llm
# Line 1210  contains Line 898  contains
898         ENDDO         ENDDO
899      ENDIF      ENDIF
900    
901      ! Stress n\'ecessaires : toute la physique      CALL aaam_bud(rg, romega, pphis, zustrdr, zustrli, &
902             sum((u_seri - u) / dtphys * zmasse, dim = 2), zvstrdr, &
903      DO i = 1, klon           zvstrli, sum((v_seri - v) / dtphys * zmasse, dim = 2), paprs, u, v, &
904         zustrph(i) = 0.           aam, torsfc)
        zvstrph(i) = 0.  
     ENDDO  
     DO k = 1, llm  
        DO i = 1, klon  
           zustrph(i) = zustrph(i) + (u_seri(i, k) - u(i, k)) / dtphys &  
                * zmasse(i, k)  
           zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &  
                * zmasse(i, k)  
        ENDDO  
     ENDDO  
   
     CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &  
          zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)  
   
     IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &  
          2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &  
          d_qt, d_ec)  
905    
906      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
907      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &      call phytrac(julien, time, firstcal, lafin, t, paprs, play, mfu, mfd, &
908           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &           pde_u, pen_d, coefh, cdragh, fm_therm, entr_therm, u(:, 1), v(:, 1), &
909           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &           ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &
910           zmasse, ncid_startphy)           tr_seri, zmasse, ncid_startphy)
   
     IF (offline) call phystokenc(dtphys, t, mfu, mfd, pen_u, pde_u, pen_d, &  
          pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &  
          frac_impa, frac_nucl, pphis, airephy, dtphys)  
911    
912      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
913      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
# Line 1255  contains Line 922  contains
922      ! conversion Ec en énergie thermique      ! conversion Ec en énergie thermique
923      DO k = 1, llm      DO k = 1, llm
924         DO i = 1, klon         DO i = 1, klon
925            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))            d_t_ec(i, k) = 0.5 / (RCPD * (1. + RVTMP2 * q_seri(i, k))) &
           d_t_ec(i, k) = 0.5 / ZRCPD &  
926                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)
927            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)
928            d_t_ec(i, k) = d_t_ec(i, k) / dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
929         END DO         END DO
930      END DO      END DO
931    
     IF (if_ebil >= 1) THEN  
        tit = 'after physic'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        ! Comme les tendances de la physique sont ajoute dans la dynamique,  
        ! on devrait avoir que la variation d'entalpie par la dynamique  
        ! est egale a la variation de la physique au pas de temps precedent.  
        ! Donc la somme de ces 2 variations devrait etre nulle.  
        call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &  
             evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec)  
        d_h_vcol_phy = d_h_vcol  
     END IF  
   
932      ! SORTIES      ! SORTIES
933    
934      ! prw = eau precipitable      ! prw = eau precipitable
# Line 1320  contains Line 973  contains
973      CALL histwrite_phy("precip", rain_fall + snow_fall)      CALL histwrite_phy("precip", rain_fall + snow_fall)
974      CALL histwrite_phy("plul", rain_lsc + snow_lsc)      CALL histwrite_phy("plul", rain_lsc + snow_lsc)
975      CALL histwrite_phy("pluc", rain_con + snow_con)      CALL histwrite_phy("pluc", rain_con + snow_con)
976      CALL histwrite_phy("tsol", zxtsol)      CALL histwrite_phy("tsol", tsol)
977      CALL histwrite_phy("t2m", zt2m)      CALL histwrite_phy("t2m", zt2m)
978      CALL histwrite_phy("q2m", zq2m)      CALL histwrite_phy("q2m", zq2m)
979      CALL histwrite_phy("u10m", zu10m)      CALL histwrite_phy("u10m", u10m)
980      CALL histwrite_phy("v10m", zv10m)      CALL histwrite_phy("v10m", v10m)
981      CALL histwrite_phy("snow", snow_fall)      CALL histwrite_phy("snow", snow_fall)
982      CALL histwrite_phy("cdrm", cdragm)      CALL histwrite_phy("cdrm", cdragm)
983      CALL histwrite_phy("cdrh", cdragh)      CALL histwrite_phy("cdrh", cdragh)
984      CALL histwrite_phy("topl", toplw)      CALL histwrite_phy("topl", toplw)
985      CALL histwrite_phy("evap", evap)      CALL histwrite_phy("evap", evap)
986      CALL histwrite_phy("sols", solsw)      CALL histwrite_phy("sols", solsw)
987      CALL histwrite_phy("soll", sollw)      CALL histwrite_phy("rls", sollw)
988      CALL histwrite_phy("solldown", sollwdown)      CALL histwrite_phy("solldown", sollwdown)
989      CALL histwrite_phy("bils", bils)      CALL histwrite_phy("bils", bils)
990      CALL histwrite_phy("sens", - sens)      CALL histwrite_phy("sens", sens)
991      CALL histwrite_phy("fder", fder)      CALL histwrite_phy("fder", fder)
992      CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))      CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
993      CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))      CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
994      CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))      CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
995      CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))      CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
996        CALL histwrite_phy("zxfqcalving", sum(fqcalving * pctsrf, dim = 2))
     DO nsrf = 1, nbsrf  
        CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)  
        CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))  
        CALL histwrite_phy("sens_"//clnsurf(nsrf), fluxt(:, 1, nsrf))  
        CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))  
        CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))  
        CALL histwrite_phy("taux_"//clnsurf(nsrf), fluxu(:, 1, nsrf))  
        CALL histwrite_phy("tauy_"//clnsurf(nsrf), fluxv(:, 1, nsrf))  
        CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))  
        CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))  
     END DO  
   
997      CALL histwrite_phy("albs", albsol)      CALL histwrite_phy("albs", albsol)
998        CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
999      CALL histwrite_phy("rugs", zxrugs)      CALL histwrite_phy("rugs", zxrugs)
1000      CALL histwrite_phy("s_pblh", s_pblh)      CALL histwrite_phy("s_pblh", s_pblh)
1001      CALL histwrite_phy("s_pblt", s_pblt)      CALL histwrite_phy("s_pblt", s_pblt)
# Line 1362  contains Line 1004  contains
1004      CALL histwrite_phy("s_oliqCL", s_oliqCL)      CALL histwrite_phy("s_oliqCL", s_oliqCL)
1005      CALL histwrite_phy("s_cteiCL", s_cteiCL)      CALL histwrite_phy("s_cteiCL", s_cteiCL)
1006      CALL histwrite_phy("s_therm", s_therm)      CALL histwrite_phy("s_therm", s_therm)
     CALL histwrite_phy("s_trmb1", s_trmb1)  
     CALL histwrite_phy("s_trmb2", s_trmb2)  
     CALL histwrite_phy("s_trmb3", s_trmb3)  
     if (conv_emanuel) CALL histwrite_phy("ptop", ema_pct)  
1007      CALL histwrite_phy("temp", t_seri)      CALL histwrite_phy("temp", t_seri)
1008      CALL histwrite_phy("vitu", u_seri)      CALL histwrite_phy("vitu", u_seri)
1009      CALL histwrite_phy("vitv", v_seri)      CALL histwrite_phy("vitv", v_seri)
# Line 1374  contains Line 1012  contains
1012      CALL histwrite_phy("dtvdf", d_t_vdf)      CALL histwrite_phy("dtvdf", d_t_vdf)
1013      CALL histwrite_phy("dqvdf", d_q_vdf)      CALL histwrite_phy("dqvdf", d_q_vdf)
1014      CALL histwrite_phy("rhum", zx_rh)      CALL histwrite_phy("rhum", zx_rh)
1015        CALL histwrite_phy("d_t_ec", d_t_ec)
1016        CALL histwrite_phy("dtsw0", heat0 / 86400.)
1017        CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1018        CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1019        call histwrite_phy("qsurf", sum(fqsurf * pctsrf, dim = 2))
1020        call histwrite_phy("flat", zxfluxlat)
1021    
1022        DO nsrf = 1, nbsrf
1023           CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1024           CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1025           CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1026           CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1027           CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1028           CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1029           CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1030           CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1031           CALL histwrite_phy("u10m_"//clnsurf(nsrf), u10m_srf(:, nsrf))
1032           CALL histwrite_phy("v10m_"//clnsurf(nsrf), v10m_srf(:, nsrf))
1033        END DO
1034    
1035        if (conv_emanuel) then
1036           CALL histwrite_phy("ptop", ema_pct)
1037           CALL histwrite_phy("dnwd0", - mp)
1038        end if
1039    
1040      if (ok_instan) call histsync(nid_ins)      if (ok_instan) call histsync(nid_ins)
1041    
1042      IF (lafin) then      IF (lafin) then
1043         call NF95_CLOSE(ncid_startphy)         call NF95_CLOSE(ncid_startphy)
1044         CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &         CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
1045              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, &
1046              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
1047              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &              rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
             w01)  
1048      end IF      end IF
1049    
1050      firstcal = .FALSE.      firstcal = .FALSE.
Legend:
Removed from v.203  
changed lines
  Added in v.323
  ViewVC Help
Powered by ViewVC 1.1.21