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

Diff of /trunk/phylmd/physiq.f

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

revision 202 by guez, Wed Jun 8 12:23:41 2016 UTC revision 244 by guez, Tue Nov 14 14:56:42 2017 UTC
# Line 20  contains Line 20  contains
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, ksta, ksta_ter, ok_kzmin, &
22           ok_instan           ok_instan
23      USE clesphys2, ONLY: cycle_diurne, conv_emanuel, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: conv_emanuel, nbapp_rad, new_oliq, ok_orodr, ok_orolf
          ok_orodr, ok_orolf  
24      USE clmain_m, ONLY: clmain      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, ONLY: iflag_thermals, nsplit_thermals
33      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
     use diagetpq_m, only: diagetpq  
     use diagphy_m, only: diagphy  
34      USE dimens_m, ONLY: llm, nqmx      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_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) ! bilan radiatif au sol calcule par code radiatif
     SAVE radsol ! bilan radiatif au sol calcule par code radiatif  
   
148      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
149    
150      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
# Line 163  contains Line 152  contains
152    
153      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
154      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
     SAVE fluxlat  
155    
156      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
157      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
158    
159      REAL, save:: qsol(klon)      REAL, save:: qsol(klon) ! column-density of water in soil, in kg m-2
160      ! column-density of water in soil, in kg m-2      REAL, save:: fsnow(klon, nbsrf) ! \'epaisseur neigeuse
   
     REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse  
161      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
162    
163      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
# Line 198  contains Line 184  contains
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, save:: fqcalving(klon, nbsrf)
193      ! flux d'eau "perdue" par la surface et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et necessaire pour limiter la
194      ! hauteur de neige, en kg / m2 / s      ! hauteur de neige, en kg / m2 / s
195    
196      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
197    
198      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
199      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
200      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
201      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
202      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
203      save pfrac_1nucl  
204      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fraction d'a\'erosols lessiv\'es (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 devap(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 dsens(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)
# 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      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
251      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u  
252      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v      REAL flux_u(klon, nbsrf), flux_v(klon, nbsrf)
253        ! tension du vent (flux turbulent de vent) à la surface, en Pa
     REAL zxfluxt(klon, llm)  
     REAL zxfluxq(klon, llm)  
     REAL zxfluxu(klon, llm)  
     REAL zxfluxv(klon, llm)  
254    
255      ! 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
256      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
# Line 289  contains Line 272  contains
272      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
273      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
274    
275      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxfluxlat(klon)
   
276      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
277      real longi      real longi
278      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
279      REAL za, zb      REAL zb
280      REAL zx_t, zx_qs, zcor      REAL zx_t, zx_qs, zcor
281      real zqsat(klon, llm)      real zqsat(klon, llm)
282      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
283      REAL zphi(klon, llm)      REAL zphi(klon, llm)
284    
285      ! 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 289  contains
289      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
290      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
291      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
292      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
293      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
294      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
295      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
# Line 323  contains Line 304  contains
304    
305      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
306      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
307      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
308    
309      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
310    
# Line 337  contains Line 316  contains
316      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
317      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
318      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
319      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
320      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)
321      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
322      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 332  contains
332      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
333      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
334    
335      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
336        real rain_lsc(klon)
337      REAL, save:: snow_con(klon) ! neige (mm / s)      REAL, save:: snow_con(klon) ! neige (mm / s)
338      real snow_lsc(klon)      real snow_lsc(klon)
339      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf) ! variation of ftsol
340    
341      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
342      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 370  contains
370    
371      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
372      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
     REAL zustrph(klon), zvstrph(klon)  
373      REAL aam, torsfc      REAL aam, torsfc
374    
375      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 399  contains Line 378  contains
378      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.
379    
380      real date0      real date0
381        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  
382    
383      REAL d_t_ec(klon, llm)      REAL d_t_ec(klon, llm)
384      ! tendance due \`a la conversion Ec en énergie thermique      ! tendance due \`a la conversion d'\'energie cin\'etique en
385        ! énergie thermique
386    
387      REAL ZRCPD      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
388        ! temperature and humidity at 2 m
389    
390      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL, save:: u10m_srf(klon, nbsrf), v10m_srf(klon, nbsrf)
391      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m      ! composantes du vent \`a 10 m
392      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille      
393      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
394        REAL u10m(klon), v10m(klon) ! vent \`a 10 m moyenn\' sur les sous-surfaces
395    
396      ! Aerosol effects:      ! Aerosol effects:
397    
398      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  
   
399      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
     LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect  
400    
401      REAL:: bl95_b0 = 2., bl95_b1 = 0.2      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
402      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
403      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
404      ! concentration.      ! concentration.
405    
     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  
   
406      real zmasse(klon, llm)      real zmasse(klon, llm)
407      ! (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)
408    
409      integer, save:: ncid_startphy      integer, save:: ncid_startphy
410    
411      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
412           iflag_cldcon, ratqsbas, ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, &           ratqsbas, ratqshaut, ok_ade, bl95_b0, bl95_b1, iflag_thermals, &
413           bl95_b1, iflag_thermals, nsplit_thermals           nsplit_thermals
414    
415      !----------------------------------------------------------------      !----------------------------------------------------------------
416    
     IF (if_ebil >= 1) zero_v = 0.  
417      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
418           'eaux vapeur et liquide sont indispensables')           'eaux vapeur et liquide sont indispensables')
419    
420      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
421         ! initialiser         ! initialiser
422         u10m = 0.         u10m_srf = 0.
423         v10m = 0.         v10m_srf = 0.
424         t2m = 0.         t2m = 0.
425         q2m = 0.         q2m = 0.
426         ffonte = 0.         ffonte = 0.
427         fqcalving = 0.         fqcalving = 0.
        piz_ae = 0.  
        tau_ae = 0.  
        cg_ae = 0.  
428         rain_con = 0.         rain_con = 0.
429         snow_con = 0.         snow_con = 0.
        topswai = 0.  
        topswad = 0.  
        solswai = 0.  
        solswad = 0.  
   
430         d_u_con = 0.         d_u_con = 0.
431         d_v_con = 0.         d_v_con = 0.
432         rnebcon0 = 0.         rnebcon0 = 0.
433         clwcon0 = 0.         clwcon0 = 0.
434         rnebcon = 0.         rnebcon = 0.
435         clwcon = 0.         clwcon = 0.
   
436         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
437         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
438         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
439         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
440         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
441         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
442         therm =0.         therm =0.
443         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
444         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
445         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
446    
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
   
447         iflag_thermals = 0         iflag_thermals = 0
448         nsplit_thermals = 1         nsplit_thermals = 1
449         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
# Line 554  contains Line 484  contains
484    
485         ! Initialisation des sorties         ! Initialisation des sorties
486    
487         call ini_histins(dtphys)         call ini_histins(dtphys, ok_newmicro)
488         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
489         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
490         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
# Line 570  contains Line 500  contains
500      ql_seri = qx(:, :, iliq)      ql_seri = qx(:, :, iliq)
501      tr_seri = qx(:, :, 3:nqmx)      tr_seri = qx(:, :, 3:nqmx)
502    
503      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  
504    
505      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
506      IF (ancien_ok) THEN      IF (ancien_ok) THEN
# Line 620  contains Line 536  contains
536    
537      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
538    
     ! Prescrire l'ozone :  
     wo = ozonecm(REAL(julien), paprs)  
   
539      ! \'Evaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
540      DO k = 1, llm      DO k = 1, llm
541         DO i = 1, klon         DO i = 1, klon
# Line 634  contains Line 547  contains
547      ENDDO      ENDDO
548      ql_seri = 0.      ql_seri = 0.
549    
     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  
   
550      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
551      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
552    
# Line 649  contains Line 554  contains
554      ! la surface.      ! la surface.
555    
556      CALL orbite(REAL(julien), longi, dist)      CALL orbite(REAL(julien), longi, dist)
557      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  
558      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
559    
560      ! R\'epartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
561      ! R\'epartition du longwave par sous-surface lin\'earis\'ee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
562    
563      forall (nsrf = 1: nbsrf)      forall (nsrf = 1: nbsrf)
564         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &         fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
565              * (ztsol - ftsol(:, nsrf))              * (tsol - ftsol(:, nsrf))
566         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
567      END forall      END forall
568    
     fder = dlw  
   
     ! Couche limite:  
   
569      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
570           ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &           ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
571           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
572           snow_fall, fsolsw, fsollw, fder, rlat, frugs, agesno, rugoro, &           snow_fall, fsolsw, fsollw, frugs, agesno, rugoro, d_t_vdf, d_q_vdf, &
573           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, &           d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, &
574           fluxv, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &           cdragm, q2, dsens, devap, coefh, t2m, q2m, u10m_srf, v10m_srf, &
575           u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
576           trmb3, plcl, fqcalving, ffonte, run_off_lic_0)           fqcalving, ffonte, run_off_lic_0)
577    
578      ! Incr\'ementation des flux      ! Incr\'ementation des flux
579    
580      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
581      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
582      zxfluxu = 0.      fder = dlw + dsens + devap
     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  
583    
584      DO k = 1, llm      DO k = 1, llm
585         DO i = 1, klon         DO i = 1, klon
# Line 711  contains Line 590  contains
590         ENDDO         ENDDO
591      ENDDO      ENDDO
592    
     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  
   
593      ! Update surface temperature:      ! Update surface temperature:
594    
     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  
   
595      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
   
596      ftsol = ftsol + d_ts      ftsol = ftsol + d_ts
597      zxtsol = sum(ftsol * pctsrf, dim = 2)      tsol = sum(ftsol * pctsrf, dim = 2)
598      DO nsrf = 1, nbsrf      zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
599         DO i = 1, klon      zt2m = sum(t2m * pctsrf, dim = 2)
600            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf) * pctsrf(i, nsrf)      zq2m = sum(q2m * pctsrf, dim = 2)
601        u10m = sum(u10m_srf * pctsrf, dim = 2)
602        v10m = sum(v10m_srf * pctsrf, dim = 2)
603        zxffonte = sum(ffonte * pctsrf, dim = 2)
604        zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
605        s_pblh = sum(pblh * pctsrf, dim = 2)
606        s_lcl = sum(plcl * pctsrf, dim = 2)
607        s_capCL = sum(capCL * pctsrf, dim = 2)
608        s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
609        s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
610        s_pblT = sum(pblT * pctsrf, dim = 2)
611        s_therm = sum(therm * pctsrf, dim = 2)
612        s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
613        s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
614        s_trmb3 = sum(trmb3 * pctsrf, dim = 2)
615    
616            zt2m(i) = zt2m(i) + t2m(i, nsrf) * pctsrf(i, nsrf)      ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
           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 :  
617      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
618         DO i = 1, klon         DO i = 1, klon
619            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
620                 ftsol(i, nsrf) = tsol(i)
621            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
622            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
623            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m_srf(i, nsrf) = u10m(i)
624            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m_srf(i, nsrf) = v10m(i)
625            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
626            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
627                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
628            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
629            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
630            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
631            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
632            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
633            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
634            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
635            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
636            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
637            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
638         ENDDO         ENDDO
639      ENDDO      ENDDO
640    
641      ! 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)  
642    
643      ! Appeler la convection      ! Appeler la convection
644    
645      if (conv_emanuel) then      if (conv_emanuel) then
        da = 0.  
        mp = 0.  
        phi = 0.  
646         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, &
647              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, &
648              upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)              upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
649         snow_con = 0.         snow_con = 0.
650         clwcon0 = qcondc         clwcon0 = qcondc
651         mfu = upwd + dnwd         mfu = upwd + dnwd
652    
653         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
654            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  
655    
656         ! Properties of convective clouds         ! Properties of convective clouds
657         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
# Line 840  contains Line 669  contains
669         conv_t = d_t_dyn + d_t_vdf / dtphys         conv_t = d_t_dyn + d_t_vdf / dtphys
670         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
671         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
672              q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &              q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
673              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
674              mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &              mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
675              kdtop, pmflxr, pmflxs)              kdtop, pmflxr, pmflxs)
# Line 859  contains Line 688  contains
688         ENDDO         ENDDO
689      ENDDO      ENDDO
690    
     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  
   
691      IF (.not. conv_emanuel) THEN      IF (.not. conv_emanuel) THEN
692         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
693         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
# Line 912  contains Line 719  contains
719              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
720      endif      endif
721    
     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  
   
722      ! Caclul des ratqs      ! Caclul des ratqs
723    
724      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
# Line 972  contains Line 773  contains
773            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
774         ENDDO         ENDDO
775      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  
776    
777      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
778    
# Line 1067  contains Line 847  contains
847         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
848      ENDDO      ENDDO
849    
     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)  
   
850      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
851      DO k = 1, llm      DO k = 1, llm
852         DO i = 1, klon         DO i = 1, klon
853            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
854            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
855               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)            zx_qs = MIN(0.5, zx_qs)
856               zx_qs = MIN(0.5, zx_qs)            zcor = 1. / (1. - retv * zx_qs)
857               zcor = 1. / (1. - retv * zx_qs)            zx_qs = zx_qs * zcor
              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  
858            zx_rh(i, k) = q_seri(i, k) / zx_qs            zx_rh(i, k) = q_seri(i, k) / zx_qs
859            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
860         ENDDO         ENDDO
861      ENDDO      ENDDO
862    
     ! Introduce the aerosol direct and first indirect radiative forcings:  
     tau_ae = 0.  
     piz_ae = 0.  
     cg_ae = 0.  
   
863      ! Param\`etres optiques des nuages et quelques param\`etres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
864      ! diagnostics :      ! diagnostics :
865      if (ok_newmicro) then      if (ok_newmicro) then
866         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
867              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)  
868      else      else
869         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
870              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq)
             bl95_b1, cldtaupi, re, fl)  
871      endif      endif
872    
873      IF (MOD(itap - 1, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
874         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         wo = ozonecm(REAL(julien), paprs)
        ! Calcul de l'abedo moyen par maille  
875         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
876           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, &  
877              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
878              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
879              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
880              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &              swup0, swup, ok_ade, topswad, solswad)
             solswad, cldtaupi, topswai, solswai)  
881      ENDIF      ENDIF
882    
883      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
884      DO k = 1, llm      DO k = 1, llm
885         DO i = 1, klon         DO i = 1, klon
886            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 888  contains
888         ENDDO         ENDDO
889      ENDDO      ENDDO
890    
     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  
   
891      ! 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)
   
892      DO i = 1, klon      DO i = 1, klon
893         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
894      ENDDO      ENDDO
# Line 1196  contains Line 931  contains
931            ENDIF            ENDIF
932         ENDDO         ENDDO
933    
934         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &         CALL lift_noro(dtphys, paprs, play, zmea, zstd, zpic, itest, t_seri, &
935              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, d_t_lif, &
936              d_t_lif, d_u_lif, d_v_lif)              d_u_lif, d_v_lif)
937    
938         ! Ajout des tendances :         ! Ajout des tendances :
939         DO k = 1, llm         DO k = 1, llm
# Line 1210  contains Line 945  contains
945         ENDDO         ENDDO
946      ENDIF      ENDIF
947    
948      ! Stress n\'ecessaires : toute la physique      CALL aaam_bud(rg, romega, pphis, zustrdr, zustrli, &
949             sum((u_seri - u) / dtphys * zmasse, dim = 2), zvstrdr, &
950      DO i = 1, klon           zvstrli, sum((v_seri - v) / dtphys * zmasse, dim = 2), paprs, u, v, &
951         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)  
952    
953      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
954      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
955           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &           mfd, pde_u, pen_d, coefh, cdragh, fm_therm, entr_therm, u(:, 1), &
956           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &           v(:, 1), ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, &
957           zmasse, ncid_startphy)           dnwd, 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)  
958    
959      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
960      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 969  contains
969      ! conversion Ec en énergie thermique      ! conversion Ec en énergie thermique
970      DO k = 1, llm      DO k = 1, llm
971         DO i = 1, klon         DO i = 1, klon
972            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 &  
973                 * (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)
974            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)
975            d_t_ec(i, k) = d_t_ec(i, k) / dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
976         END DO         END DO
977      END DO      END DO
978    
     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  
   
979      ! SORTIES      ! SORTIES
980    
981      ! prw = eau precipitable      ! prw = eau precipitable
# Line 1320  contains Line 1020  contains
1020      CALL histwrite_phy("precip", rain_fall + snow_fall)      CALL histwrite_phy("precip", rain_fall + snow_fall)
1021      CALL histwrite_phy("plul", rain_lsc + snow_lsc)      CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1022      CALL histwrite_phy("pluc", rain_con + snow_con)      CALL histwrite_phy("pluc", rain_con + snow_con)
1023      CALL histwrite_phy("tsol", zxtsol)      CALL histwrite_phy("tsol", tsol)
1024      CALL histwrite_phy("t2m", zt2m)      CALL histwrite_phy("t2m", zt2m)
1025      CALL histwrite_phy("q2m", zq2m)      CALL histwrite_phy("q2m", zq2m)
1026      CALL histwrite_phy("u10m", zu10m)      CALL histwrite_phy("u10m", u10m)
1027      CALL histwrite_phy("v10m", zv10m)      CALL histwrite_phy("v10m", v10m)
1028      CALL histwrite_phy("snow", snow_fall)      CALL histwrite_phy("snow", snow_fall)
1029      CALL histwrite_phy("cdrm", cdragm)      CALL histwrite_phy("cdrm", cdragm)
1030      CALL histwrite_phy("cdrh", cdragh)      CALL histwrite_phy("cdrh", cdragh)
# Line 1344  contains Line 1044  contains
1044      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1045         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1046         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1047         CALL histwrite_phy("sens_"//clnsurf(nsrf), fluxt(:, 1, nsrf))         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1048         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1049         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1050         CALL histwrite_phy("taux_"//clnsurf(nsrf), fluxu(:, 1, nsrf))         CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1051         CALL histwrite_phy("tauy_"//clnsurf(nsrf), fluxv(:, 1, nsrf))         CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1052         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1053         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1054           CALL histwrite_phy("u10m_"//clnsurf(nsrf), u10m_srf(:, nsrf))
1055           CALL histwrite_phy("v10m_"//clnsurf(nsrf), v10m_srf(:, nsrf))
1056      END DO      END DO
1057    
1058      CALL histwrite_phy("albs", albsol)      CALL histwrite_phy("albs", albsol)
1059        CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1060      CALL histwrite_phy("rugs", zxrugs)      CALL histwrite_phy("rugs", zxrugs)
1061      CALL histwrite_phy("s_pblh", s_pblh)      CALL histwrite_phy("s_pblh", s_pblh)
1062      CALL histwrite_phy("s_pblt", s_pblt)      CALL histwrite_phy("s_pblt", s_pblt)
# Line 1365  contains Line 1068  contains
1068      CALL histwrite_phy("s_trmb1", s_trmb1)      CALL histwrite_phy("s_trmb1", s_trmb1)
1069      CALL histwrite_phy("s_trmb2", s_trmb2)      CALL histwrite_phy("s_trmb2", s_trmb2)
1070      CALL histwrite_phy("s_trmb3", s_trmb3)      CALL histwrite_phy("s_trmb3", s_trmb3)
1071      if (conv_emanuel) CALL histwrite_phy("ptop", ema_pct)  
1072        if (conv_emanuel) then
1073           CALL histwrite_phy("ptop", ema_pct)
1074           CALL histwrite_phy("dnwd0", - mp)
1075        end if
1076    
1077      CALL histwrite_phy("temp", t_seri)      CALL histwrite_phy("temp", t_seri)
1078      CALL histwrite_phy("vitu", u_seri)      CALL histwrite_phy("vitu", u_seri)
1079      CALL histwrite_phy("vitv", v_seri)      CALL histwrite_phy("vitv", v_seri)
# Line 1374  contains Line 1082  contains
1082      CALL histwrite_phy("dtvdf", d_t_vdf)      CALL histwrite_phy("dtvdf", d_t_vdf)
1083      CALL histwrite_phy("dqvdf", d_q_vdf)      CALL histwrite_phy("dqvdf", d_q_vdf)
1084      CALL histwrite_phy("rhum", zx_rh)      CALL histwrite_phy("rhum", zx_rh)
1085        CALL histwrite_phy("d_t_ec", d_t_ec)
1086        CALL histwrite_phy("dtsw0", heat0 / 86400.)
1087        CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1088        CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1089        call histwrite_phy("qsurf", sum(fqsurf * pctsrf, dim = 2))
1090    
1091      if (ok_instan) call histsync(nid_ins)      if (ok_instan) call histsync(nid_ins)
1092    

Legend:
Removed from v.202  
changed lines
  Added in v.244

  ViewVC Help
Powered by ViewVC 1.1.21