/[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 192 by guez, Thu May 12 13:00:07 2016 UTC revision 215 by guez, Tue Mar 28 12:46:28 2017 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_hf, ecrit_ins, ecrit_mth, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ksta, ksta_ter, ok_kzmin, &
22           ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin, 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      USE conf_gcm_m, ONLY: offline, 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, qsatl, qsats
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 58  contains Line 55  contains
55      USE phyredem0_m, ONLY: phyredem0      USE phyredem0_m, ONLY: phyredem0
56      USE phystokenc_m, ONLY: phystokenc      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 89  contains Line 85  contains
85      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
86    
87      REAL, intent(in):: u(:, :) ! (klon, llm)      REAL, intent(in):: u(:, :) ! (klon, llm)
88      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m / s
89    
90      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m/s      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m / s
91      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
92    
93      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
94      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
95    
96      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
97      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
98      REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)      REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
99      REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K/s)      REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K / s)
100    
101      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
102      ! tendance physique de "qx" (s-1)      ! tendance physique de "qx" (s-1)
# 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    
111      ! pour phsystoke avec thermiques      ! pour phystoke avec thermiques
112      REAL fm_therm(klon, llm + 1)      REAL fm_therm(klon, llm + 1)
113      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
114      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
# Line 126  contains Line 119  contains
119      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
120      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
121    
122      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
123      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg/kg/s)      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg / kg / s)
124    
125      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      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)
135    
136      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
137      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
138      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
139      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
140    
# 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 202  contains Line 188  contains
188      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
189      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
190      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
     REAL ffonte(klon, nbsrf) ! flux thermique utilise pour fondre la neige  
191    
192      REAL fqcalving(klon, nbsrf)      REAL, save:: ffonte(klon, nbsrf)
193        ! flux thermique utilise pour fondre la neige
194    
195        REAL, save:: fqcalving(klon, nbsrf)
196      ! flux d'eau "perdue" par la surface et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et necessaire pour limiter la
197      ! hauteur de neige, en kg/m2/s      ! hauteur de neige, en kg / m2 / s
198    
199      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
200    
201      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
202      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
203      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
204      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
205      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
206      save pfrac_1nucl  
207      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fraction d'a\'erosols lessiv\'es (impaction)
208      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
209    
210      REAL, save:: rain_fall(klon)      REAL, save:: rain_fall(klon)
211      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
212    
213      REAL, save:: snow_fall(klon)      REAL, save:: snow_fall(klon)
214      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg / m2 / s), positive down
215    
216      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
217    
218      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
219      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
220      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
221      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
222        REAL, save:: dlw(klon) ! derivee infra rouge
223      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
224      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
225      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
# Line 244  contains Line 233  contains
233      ! Conditions aux limites      ! Conditions aux limites
234    
235      INTEGER julien      INTEGER julien
     INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day  
236      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
     REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE  
237      REAL, save:: albsol(klon) ! albedo du sol total visible      REAL, save:: albsol(klon) ! albedo du sol total visible
238      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
239        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
240    
241      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
242      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
# Line 261  contains Line 249  contains
249      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
250      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
251    
252      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
253      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
254      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_u(klon, nbsrf) ! flux turbulent de vitesse u à la surface
255      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v      REAL flux_v(klon, nbsrf) ! flux turbulent de vitesse v à la surface
   
     REAL zxfluxt(klon, llm)  
     REAL zxfluxq(klon, llm)  
     REAL zxfluxu(klon, llm)  
     REAL zxfluxv(klon, llm)  
256    
257      ! 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
258      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
# Line 285  contains Line 268  contains
268      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
269      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e 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)
273    
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 zxqsurf(klon), zxfluxlat(klon)
278    
279      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
280      real longi      real longi
281      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
282      REAL za, zb      REAL zb
283      REAL zx_t, zx_qs, zcor      REAL zx_t, zx_qs, zcor
284      real zqsat(klon, llm)      real zqsat(klon, llm)
285      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
286      REAL zphi(klon, llm)      REAL zphi(klon, llm)
287    
288      ! cf. Anne Mathieu variables pour la couche limite atmosphérique (hbtm)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
289    
290      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
291      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
292      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
293      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
294      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
295      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
296      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
297      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
298      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
# Line 325  contains Line 307  contains
307    
308      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
309      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
310      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
311    
312      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
313    
# Line 339  contains Line 319  contains
319      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
320      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
321      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
322      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
323      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)
324      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
325      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 355  contains Line 335  contains
335      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
336      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
337    
338      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
339        real rain_lsc(klon)
340      REAL, save:: snow_con(klon) ! neige (mm / s)      REAL, save:: snow_con(klon) ! neige (mm / s)
341      real snow_lsc(klon)      real snow_lsc(klon)
342      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
# Line 401  contains Line 382  contains
382      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.
383    
384      real date0      real date0
   
     ! Variables li\'ees au bilan d'\'energie et d'enthalpie :  
385      REAL ztsol(klon)      REAL ztsol(klon)
386      REAL d_h_vcol, d_qt, d_ec  
387      REAL, SAVE:: d_h_vcol_phy      REAL d_t_ec(klon, llm)
388      REAL zero_v(klon)      ! tendance due \`a la conversion d'\'energie cin\'etique en
389      CHARACTER(LEN = 20) tit      ! énergie thermique
390      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
391      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
392        ! temperature and humidity at 2 m
393      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique  
394      REAL ZRCPD      REAL, save:: u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
395        REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
396      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes sur 1 maille
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m  
     REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille  
     REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille  
397    
398      ! Aerosol effects:      ! Aerosol effects:
399    
400      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g / m3)
401    
402      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
403      ! SO4 aerosol concentration, in \mu g/m3, pre-industrial value      ! SO4 aerosol concentration, in \mu g / m3, pre-industrial value
404    
405      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
406      ! cloud optical thickness for pre-industrial aerosols      ! cloud optical thickness for pre-industrial aerosols
# Line 436  contains Line 412  contains
412      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
413      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
414    
415      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
416      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL, save:: topswai(klon), solswai(klon) ! aerosol indirect effect
417    
418      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
419      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
# Line 447  contains Line 423  contains
423      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
424      ! concentration.      ! concentration.
425    
     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  
   
426      real zmasse(klon, llm)      real zmasse(klon, llm)
427      ! (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)
428    
429      integer, save:: ncid_startphy      integer, save:: ncid_startphy
430    
431      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
432           iflag_cldcon, ratqsbas, ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, &           ratqsbas, ratqshaut, ok_ade, ok_aie, bl95_b0, bl95_b1, &
433           bl95_b1, iflag_thermals, nsplit_thermals           iflag_thermals, nsplit_thermals
434    
435      !----------------------------------------------------------------      !----------------------------------------------------------------
436    
     IF (if_ebil >= 1) zero_v = 0.  
437      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
438           'eaux vapeur et liquide sont indispensables')           'eaux vapeur et liquide sont indispensables')
439    
# Line 506  contains Line 467  contains
467         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
468         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
469         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
470         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
471         therm =0.         therm =0.
472         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
473         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
474         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
475    
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
   
476         iflag_thermals = 0         iflag_thermals = 0
477         nsplit_thermals = 1         nsplit_thermals = 1
478         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
# Line 534  contains Line 493  contains
493         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
494         q2 = 1e-8         q2 = 1e-8
495    
        lmt_pas = day_step / iphysiq  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
496         radpas = lmt_pas / nbapp_rad         radpas = lmt_pas / nbapp_rad
497         print *, "radpas = ", radpas         print *, "radpas = ", radpas
498    
# Line 553  contains Line 509  contains
509            rugoro = 0.            rugoro = 0.
510         ENDIF         ENDIF
511    
512         ecrit_ins = NINT(ecrit_ins/dtphys)         ecrit_ins = NINT(ecrit_ins / dtphys)
        ecrit_hf = NINT(ecrit_hf/dtphys)  
        ecrit_mth = NINT(ecrit_mth/dtphys)  
        ecrit_tra = NINT(86400.*ecrit_tra/dtphys)  
        ecrit_reg = NINT(ecrit_reg/dtphys)  
513    
514         ! Initialisation des sorties         ! Initialisation des sorties
515    
# Line 565  contains Line 517  contains
517         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
518         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
519         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
520         CALL phyredem0(lmt_pas)         CALL phyredem0
521      ENDIF test_firstcal      ENDIF test_firstcal
522    
523      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
# Line 579  contains Line 531  contains
531    
532      ztsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
533    
     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  
   
534      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
535      IF (ancien_ok) THEN      IF (ancien_ok) THEN
536         DO k = 1, llm         DO k = 1, llm
# Line 627  contains Line 565  contains
565    
566      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
567    
     ! Prescrire l'ozone :  
     wo = ozonecm(REAL(julien), paprs)  
   
568      ! \'Evaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
569      DO k = 1, llm      DO k = 1, llm
570         DO i = 1, klon         DO i = 1, klon
# Line 641  contains Line 576  contains
576      ENDDO      ENDDO
577      ql_seri = 0.      ql_seri = 0.
578    
     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  
   
579      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
580      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
581    
# Line 656  contains Line 583  contains
583      ! la surface.      ! la surface.
584    
585      CALL orbite(REAL(julien), longi, dist)      CALL orbite(REAL(julien), longi, dist)
586      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  
587    
588      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
589      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
# Line 676  contains Line 599  contains
599    
600      fder = dlw      fder = dlw
601    
602      ! Couche limite:      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
603             ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
604      CALL clmain(dtphys, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, v_seri, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
605           julien, mu0, ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, &           snow_fall, fsolsw, fsollw, fder, frugs, agesno, rugoro, d_t_vdf, &
606           ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, flux_v, &
607           rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, firstcal, &           cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, &
608           agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, &           v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, &
609           fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, &           plcl, fqcalving, ffonte, run_off_lic_0)
          yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, &  
          trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)  
610    
611      ! Incr\'ementation des flux      ! Incr\'ementation des flux
612    
613      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
614      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
615      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  
616    
617      DO k = 1, llm      DO k = 1, llm
618         DO i = 1, klon         DO i = 1, klon
# Line 718  contains Line 623  contains
623         ENDDO         ENDDO
624      ENDDO      ENDDO
625    
     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  
   
626      ! Update surface temperature:      ! Update surface temperature:
627    
     DO i = 1, klon  
        zxtsol(i) = 0.  
        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  
   
628      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
629        ftsol = ftsol + d_ts
630        ztsol = sum(ftsol * pctsrf, dim = 2)
631        zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
632        zt2m = sum(t2m * pctsrf, dim = 2)
633        zq2m = sum(q2m * pctsrf, dim = 2)
634        zu10m = sum(u10m * pctsrf, dim = 2)
635        zv10m = sum(v10m * pctsrf, dim = 2)
636        zxffonte = sum(ffonte * pctsrf, dim = 2)
637        zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
638        s_pblh = sum(pblh * pctsrf, dim = 2)
639        s_lcl = sum(plcl * pctsrf, dim = 2)
640        s_capCL = sum(capCL * pctsrf, dim = 2)
641        s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
642        s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
643        s_pblT = sum(pblT * pctsrf, dim = 2)
644        s_therm = sum(therm * pctsrf, dim = 2)
645        s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
646        s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
647        s_trmb3 = sum(trmb3 * pctsrf, dim = 2)
648    
649        ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
650      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
651         DO i = 1, klon         DO i = 1, klon
652            ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)            IF (pctsrf(i, nsrf) < epsfra) then
653            zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)               ftsol(i, nsrf) = ztsol(i)
654            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)               t2m(i, nsrf) = zt2m(i)
655                 q2m(i, nsrf) = zq2m(i)
656            zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)               u10m(i, nsrf) = zu10m(i)
657            zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)               v10m(i, nsrf) = zv10m(i)
658            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)               ffonte(i, nsrf) = zxffonte(i)
659            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)               fqcalving(i, nsrf) = zxfqcalving(i)
660            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)               pblh(i, nsrf) = s_pblh(i)
661            zxfqcalving(i) = zxfqcalving(i) + &               plcl(i, nsrf) = s_lcl(i)
662                 fqcalving(i, nsrf)*pctsrf(i, nsrf)               capCL(i, nsrf) = s_capCL(i)
663            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)               oliqCL(i, nsrf) = s_oliqCL(i)
664            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)               cteiCL(i, nsrf) = s_cteiCL(i)
665            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)               pblT(i, nsrf) = s_pblT(i)
666            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)               therm(i, nsrf) = s_therm(i)
667            s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)               trmb1(i, nsrf) = s_trmb1(i)
668            s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)               trmb2(i, nsrf) = s_trmb2(i)
669            s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)               trmb3(i, nsrf) = s_trmb3(i)
670            s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) *pctsrf(i, nsrf)            end IF
           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 :  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)  
   
           IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)  
           IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)  
           IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)  
           IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)  
           IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)  
           IF (pctsrf(i, nsrf) < epsfra) &  
                fqcalving(i, nsrf) = zxfqcalving(i)  
           IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)  
           IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)  
           IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)  
           IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)  
           IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)  
           IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)  
           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)  
671         ENDDO         ENDDO
672      ENDDO      ENDDO
673    
674      ! Calculer la dérive du flux infrarouge      ! Calculer la dérive du flux infrarouge
675    
676      DO i = 1, klon      DO i = 1, klon
677         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
678      ENDDO      ENDDO
679    
     IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)  
   
680      ! Appeler la convection      ! Appeler la convection
681    
682      if (conv_emanuel) then      if (conv_emanuel) then
683         da = 0.         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
684         mp = 0.              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
685         phi = 0.              upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
        CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &  
             w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, &  
             itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, pmflxr, &  
             da, phi, mp)  
686         snow_con = 0.         snow_con = 0.
687         clwcon0 = qcondc         clwcon0 = qcondc
688         mfu = upwd + dnwd         mfu = upwd + dnwd
689    
690         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
691            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  
692    
693         ! Properties of convective clouds         ! Properties of convective clouds
694         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
# Line 849  contains Line 706  contains
706         conv_t = d_t_dyn + d_t_vdf / dtphys         conv_t = d_t_dyn + d_t_vdf / dtphys
707         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
708         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
709              q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &              q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
710              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), &
711              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, &
712              kdtop, pmflxr, pmflxs)              kdtop, pmflxr, pmflxs)
# Line 868  contains Line 725  contains
725         ENDDO         ENDDO
726      ENDDO      ENDDO
727    
     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  
   
728      IF (.not. conv_emanuel) THEN      IF (.not. conv_emanuel) THEN
729         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
730         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
# Line 917  contains Line 752  contains
752         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
753         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
754      else      else
        ! Thermiques  
755         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
756              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)
757      endif      endif
758    
     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  
   
759      ! Caclul des ratqs      ! Caclul des ratqs
760    
761      ! 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 982  contains Line 810  contains
810            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
811         ENDDO         ENDDO
812      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  
813    
814      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
815    
# Line 1018  contains Line 825  contains
825            do k = 1, llm            do k = 1, llm
826               do i = 1, klon               do i = 1, klon
827                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
828                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
829                          *zmasse(i, k)                          * zmasse(i, k)
830                  endif                  endif
831               enddo               enddo
832            enddo            enddo
# Line 1054  contains Line 861  contains
861    
862         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
863         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
864         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
865      ENDIF      ENDIF
866    
867      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1077  contains Line 884  contains
884         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
885      ENDDO      ENDDO
886    
     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)  
   
887      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
888      DO k = 1, llm      DO k = 1, llm
889         DO i = 1, klon         DO i = 1, klon
890            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
891            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
892               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)            zx_qs = MIN(0.5, zx_qs)
893               zx_qs = MIN(0.5, zx_qs)            zcor = 1. / (1. - retv * zx_qs)
894               zcor = 1./(1. - retv*zx_qs)            zx_qs = zx_qs * zcor
895               zx_qs = zx_qs*zcor            zx_rh(i, k) = q_seri(i, k) / zx_qs
           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  
           zx_rh(i, k) = q_seri(i, k)/zx_qs  
896            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
897         ENDDO         ENDDO
898      ENDDO      ENDDO
# Line 1120  contains Line 915  contains
915      endif      endif
916    
917      IF (MOD(itap - 1, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
918           ! Prescrire l'ozone :
919           wo = ozonecm(REAL(julien), paprs)
920    
921         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
922         ! Calcul de l'abedo moyen par maille         ! Calcul de l'abedo moyen par maille
923         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
924    
925         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
926         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
927              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
928              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
929              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
# Line 1134  contains Line 932  contains
932      ENDIF      ENDIF
933    
934      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
935      DO k = 1, llm      DO k = 1, llm
936         DO i = 1, klon         DO i = 1, klon
937            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys/86400.            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys &
938                   / 86400.
939         ENDDO         ENDDO
940      ENDDO      ENDDO
941    
     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  
   
942      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
943      DO i = 1, klon      zxqsurf = sum(fqsurf * pctsrf, dim = 2)
        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  
944    
945      ! 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)
   
946      DO i = 1, klon      DO i = 1, klon
947         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
948      ENDDO      ENDDO
# Line 1237  contains Line 1017  contains
1017      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1018           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1019    
     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)  
   
1020      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1021      call phytrac(lmt_pas, julien, time, firstcal, lafin, dtphys, t, paprs, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
1022           play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, &           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &
1023           yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &
1024           tr_seri, zmasse, ncid_startphy)           zmasse, ncid_startphy)
1025    
1026      IF (offline) call phystokenc(dtphys, t, mfu, mfd, pen_u, pde_u, pen_d, &      IF (offline) call phystokenc(dtphys, t, mfu, mfd, pen_u, pde_u, pen_d, &
1027           pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &           pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &
# Line 1261  contains Line 1037  contains
1037    
1038      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1039    
1040      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
1041      DO k = 1, llm      DO k = 1, llm
1042         DO i = 1, klon         DO i = 1, klon
1043            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 &  
1044                 * (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)
1045            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)
1046            d_t_ec(i, k) = d_t_ec(i, k) / dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1047         END DO         END DO
1048      END DO      END DO
1049    
     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  
   
1050      ! SORTIES      ! SORTIES
1051    
1052      ! prw = eau precipitable      ! prw = eau precipitable
1053      DO i = 1, klon      DO i = 1, klon
1054         prw(i) = 0.         prw(i) = 0.
1055         DO k = 1, llm         DO k = 1, llm
1056            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1057         ENDDO         ENDDO
1058      ENDDO      ENDDO
1059    
# Line 1329  contains Line 1091  contains
1091      CALL histwrite_phy("precip", rain_fall + snow_fall)      CALL histwrite_phy("precip", rain_fall + snow_fall)
1092      CALL histwrite_phy("plul", rain_lsc + snow_lsc)      CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1093      CALL histwrite_phy("pluc", rain_con + snow_con)      CALL histwrite_phy("pluc", rain_con + snow_con)
1094      CALL histwrite_phy("tsol", zxtsol)      CALL histwrite_phy("tsol", ztsol)
1095      CALL histwrite_phy("t2m", zt2m)      CALL histwrite_phy("t2m", zt2m)
1096      CALL histwrite_phy("q2m", zq2m)      CALL histwrite_phy("q2m", zq2m)
1097      CALL histwrite_phy("u10m", zu10m)      CALL histwrite_phy("u10m", zu10m)
# Line 1351  contains Line 1113  contains
1113      CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))      CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
1114    
1115      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1116         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf)*100.)         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1117         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1118         CALL histwrite_phy("sens_"//clnsurf(nsrf), fluxt(:, 1, nsrf))         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1119         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1120         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1121         CALL histwrite_phy("taux_"//clnsurf(nsrf), fluxu(:, 1, nsrf))         CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1122         CALL histwrite_phy("tauy_"//clnsurf(nsrf), fluxv(:, 1, nsrf))         CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1123         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1124         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1125      END DO      END DO
1126    
1127      CALL histwrite_phy("albs", albsol)      CALL histwrite_phy("albs", albsol)
1128        CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1129      CALL histwrite_phy("rugs", zxrugs)      CALL histwrite_phy("rugs", zxrugs)
1130      CALL histwrite_phy("s_pblh", s_pblh)      CALL histwrite_phy("s_pblh", s_pblh)
1131      CALL histwrite_phy("s_pblt", s_pblt)      CALL histwrite_phy("s_pblt", s_pblt)
# Line 1374  contains Line 1137  contains
1137      CALL histwrite_phy("s_trmb1", s_trmb1)      CALL histwrite_phy("s_trmb1", s_trmb1)
1138      CALL histwrite_phy("s_trmb2", s_trmb2)      CALL histwrite_phy("s_trmb2", s_trmb2)
1139      CALL histwrite_phy("s_trmb3", s_trmb3)      CALL histwrite_phy("s_trmb3", s_trmb3)
1140      if (conv_emanuel) CALL histwrite_phy("ptop", ema_pct)  
1141        if (conv_emanuel) then
1142           CALL histwrite_phy("ptop", ema_pct)
1143           CALL histwrite_phy("dnwd0", - mp)
1144        end if
1145    
1146      CALL histwrite_phy("temp", t_seri)      CALL histwrite_phy("temp", t_seri)
1147      CALL histwrite_phy("vitu", u_seri)      CALL histwrite_phy("vitu", u_seri)
1148      CALL histwrite_phy("vitv", v_seri)      CALL histwrite_phy("vitv", v_seri)
# Line 1383  contains Line 1151  contains
1151      CALL histwrite_phy("dtvdf", d_t_vdf)      CALL histwrite_phy("dtvdf", d_t_vdf)
1152      CALL histwrite_phy("dqvdf", d_q_vdf)      CALL histwrite_phy("dqvdf", d_q_vdf)
1153      CALL histwrite_phy("rhum", zx_rh)      CALL histwrite_phy("rhum", zx_rh)
1154        CALL histwrite_phy("d_t_ec", d_t_ec)
1155        CALL histwrite_phy("dtsw0", heat0 / 86400.)
1156        CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1157        CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1158    
1159      if (ok_instan) call histsync(nid_ins)      if (ok_instan) call histsync(nid_ins)
1160    

Legend:
Removed from v.192  
changed lines
  Added in v.215

  ViewVC Help
Powered by ViewVC 1.1.21