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

Diff of /trunk/Sources/phylmd/physiq.f

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

revision 195 by guez, Wed May 18 17:56:44 2016 UTC revision 212 by guez, Thu Jan 12 12:31:31 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)
151      ! soil temperature of surface fraction      ! soil temperature of surface fraction
152    
153      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
154      REAL fluxlat(klon, nbsrf)      REAL, save:: 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
# Line 202  contains Line 190  contains
190      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
191      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
192      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  
193    
194      REAL fqcalving(klon, nbsrf)      REAL, save:: ffonte(klon, nbsrf)
195        ! flux thermique utilise pour fondre la neige
196    
197        REAL, save:: fqcalving(klon, nbsrf)
198      ! flux d'eau "perdue" par la surface et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et necessaire pour limiter la
199      ! hauteur de neige, en kg/m2/s      ! hauteur de neige, en kg / m2 / s
200    
201      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
202    
203      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
204      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
205      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
206      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
207      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
208      save pfrac_1nucl  
209      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
210      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
211    
212      REAL, save:: rain_fall(klon)      REAL, save:: rain_fall(klon)
213      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
214    
215      REAL, save:: snow_fall(klon)      REAL, save:: snow_fall(klon)
216      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg / m2 / s), positive down
217    
218      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
219    
220      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
221      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
222      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
223      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
224        REAL, save:: dlw(klon) ! derivee infra rouge
225      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
226      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
227      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 235  contains
235      ! Conditions aux limites      ! Conditions aux limites
236    
237      INTEGER julien      INTEGER julien
     INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day  
238      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  
239      REAL, save:: albsol(klon) ! albedo du sol total visible      REAL, save:: albsol(klon) ! albedo du sol total visible
240      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
241        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
242    
243      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
244      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
# Line 261  contains Line 251  contains
251      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
252      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
253    
254      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
255      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
256      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_u(klon, nbsrf) ! flux turbulent de vitesse u à la surface
257      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)  
258    
259      ! 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
260      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
# Line 285  contains Line 270  contains
270      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
271      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
272    
273      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
274      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K / s)
275    
276      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
277      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
278    
279      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
280    
281      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
282      real longi      real longi
283      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
284      REAL za, zb      REAL zb
285      REAL zx_t, zx_qs, zcor      REAL zx_t, zx_qs, zcor
286      real zqsat(klon, llm)      real zqsat(klon, llm)
287      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
288      REAL zphi(klon, llm)      REAL zphi(klon, llm)
289    
290      ! cf. Anne Mathieu variables pour la couche limite atmosphérique (hbtm)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
291    
292      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
293      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
294      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
295      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
296      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
297      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
298      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
299      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
300      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
# Line 325  contains Line 309  contains
309    
310      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
311      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
312      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
313    
314      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
315    
# Line 339  contains Line 321  contains
321      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
322      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
323      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
324      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
325      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)
326      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
327      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 337  contains
337      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
338      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
339    
340      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
341        real rain_lsc(klon)
342      REAL, save:: snow_con(klon) ! neige (mm / s)      REAL, save:: snow_con(klon) ! neige (mm / s)
343      real snow_lsc(klon)      real snow_lsc(klon)
344      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
# Line 401  contains Line 384  contains
384      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.
385    
386      real date0      real date0
   
     ! Variables li\'ees au bilan d'\'energie et d'enthalpie :  
387      REAL ztsol(klon)      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  
388    
389      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique      REAL d_t_ec(klon, llm)
390        ! tendance due \`a la conversion Ec en énergie thermique
391    
392      REAL ZRCPD      REAL ZRCPD
393    
394      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
395      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m      ! temperature and humidity at 2 m
396      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille  
397      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille      REAL, save:: u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
398        REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
399        REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes sur 1 maille
400    
401      ! Aerosol effects:      ! Aerosol effects:
402    
403      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g / m3)
404    
405      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
406      ! SO4 aerosol concentration, in \mu g/m3, pre-industrial value      ! SO4 aerosol concentration, in \mu g / m3, pre-industrial value
407    
408      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
409      ! cloud optical thickness for pre-industrial aerosols      ! cloud optical thickness for pre-industrial aerosols
# Line 436  contains Line 415  contains
415      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
416      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
417    
418      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
419      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL, save:: topswai(klon), solswai(klon) ! aerosol indirect effect
420    
421      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
422      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
# Line 447  contains Line 426  contains
426      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
427      ! concentration.      ! concentration.
428    
     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  
   
429      real zmasse(klon, llm)      real zmasse(klon, llm)
430      ! (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)
431    
432      integer, save:: ncid_startphy      integer, save:: ncid_startphy
433    
434      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
435           iflag_cldcon, ratqsbas, ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, &           ratqsbas, ratqshaut, ok_ade, ok_aie, bl95_b0, bl95_b1, &
436           bl95_b1, iflag_thermals, nsplit_thermals           iflag_thermals, nsplit_thermals
437    
438      !----------------------------------------------------------------      !----------------------------------------------------------------
439    
     IF (if_ebil >= 1) zero_v = 0.  
440      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
441           'eaux vapeur et liquide sont indispensables')           'eaux vapeur et liquide sont indispensables')
442    
# Line 506  contains Line 470  contains
470         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
471         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
472         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
473         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
474         therm =0.         therm =0.
475         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
476         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
477         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
478    
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
   
479         iflag_thermals = 0         iflag_thermals = 0
480         nsplit_thermals = 1         nsplit_thermals = 1
481         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
# Line 534  contains Line 496  contains
496         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
497         q2 = 1e-8         q2 = 1e-8
498    
        lmt_pas = day_step / iphysiq  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
499         radpas = lmt_pas / nbapp_rad         radpas = lmt_pas / nbapp_rad
500         print *, "radpas = ", radpas         print *, "radpas = ", radpas
501    
# Line 553  contains Line 512  contains
512            rugoro = 0.            rugoro = 0.
513         ENDIF         ENDIF
514    
515         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)  
516    
517         ! Initialisation des sorties         ! Initialisation des sorties
518    
# Line 565  contains Line 520  contains
520         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
521         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
522         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
523         CALL phyredem0(lmt_pas)         CALL phyredem0
524      ENDIF test_firstcal      ENDIF test_firstcal
525    
526      ! 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 534  contains
534    
535      ztsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
536    
     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  
   
537      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
538      IF (ancien_ok) THEN      IF (ancien_ok) THEN
539         DO k = 1, llm         DO k = 1, llm
# Line 627  contains Line 568  contains
568    
569      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
570    
     ! Prescrire l'ozone :  
     wo = ozonecm(REAL(julien), paprs)  
   
571      ! \'Evaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
572      DO k = 1, llm      DO k = 1, llm
573         DO i = 1, klon         DO i = 1, klon
# Line 641  contains Line 579  contains
579      ENDDO      ENDDO
580      ql_seri = 0.      ql_seri = 0.
581    
     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  
   
582      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
583      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
584    
# Line 656  contains Line 586  contains
586      ! la surface.      ! la surface.
587    
588      CALL orbite(REAL(julien), longi, dist)      CALL orbite(REAL(julien), longi, dist)
589      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  
590    
591      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
592      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
# Line 676  contains Line 602  contains
602    
603      fder = dlw      fder = dlw
604    
605      ! Couche limite:      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
606             ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
607      CALL clmain(dtphys, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, v_seri, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
608           julien, mu0, ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, &           snow_fall, fsolsw, fsollw, fder, frugs, agesno, rugoro, d_t_vdf, &
609           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, &
610           rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, firstcal, &           cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, &
611           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, &
612           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)  
613    
614      ! Incr\'ementation des flux      ! Incr\'ementation des flux
615    
616      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
617      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
618      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  
619    
620      DO k = 1, llm      DO k = 1, llm
621         DO i = 1, klon         DO i = 1, klon
# Line 718  contains Line 626  contains
626         ENDDO         ENDDO
627      ENDDO      ENDDO
628    
     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  
   
629      ! Update surface temperature:      ! Update surface temperature:
630    
     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  
   
631      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
632        ftsol = ftsol + d_ts
633        ztsol = sum(ftsol * pctsrf, dim = 2)
634        zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
635        zt2m = sum(t2m * pctsrf, dim = 2)
636        zq2m = sum(q2m * pctsrf, dim = 2)
637        zu10m = sum(u10m * pctsrf, dim = 2)
638        zv10m = sum(v10m * pctsrf, dim = 2)
639        zxffonte = sum(ffonte * pctsrf, dim = 2)
640        zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
641        s_pblh = sum(pblh * pctsrf, dim = 2)
642        s_lcl = sum(plcl * pctsrf, dim = 2)
643        s_capCL = sum(capCL * pctsrf, dim = 2)
644        s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
645        s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
646        s_pblT = sum(pblT * pctsrf, dim = 2)
647        s_therm = sum(therm * pctsrf, dim = 2)
648        s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
649        s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
650        s_trmb3 = sum(trmb3 * pctsrf, dim = 2)
651    
652        ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
653      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
654         DO i = 1, klon         DO i = 1, klon
655            ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)            IF (pctsrf(i, nsrf) < epsfra) then
656            zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)               ftsol(i, nsrf) = ztsol(i)
657            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)               t2m(i, nsrf) = zt2m(i)
658                 q2m(i, nsrf) = zq2m(i)
659            zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)               u10m(i, nsrf) = zu10m(i)
660            zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)               v10m(i, nsrf) = zv10m(i)
661            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)               ffonte(i, nsrf) = zxffonte(i)
662            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)               fqcalving(i, nsrf) = zxfqcalving(i)
663            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)               pblh(i, nsrf) = s_pblh(i)
664            zxfqcalving(i) = zxfqcalving(i) + &               plcl(i, nsrf) = s_lcl(i)
665                 fqcalving(i, nsrf)*pctsrf(i, nsrf)               capCL(i, nsrf) = s_capCL(i)
666            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)               oliqCL(i, nsrf) = s_oliqCL(i)
667            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)               cteiCL(i, nsrf) = s_cteiCL(i)
668            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)               pblT(i, nsrf) = s_pblT(i)
669            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)               therm(i, nsrf) = s_therm(i)
670            s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)               trmb1(i, nsrf) = s_trmb1(i)
671            s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)               trmb2(i, nsrf) = s_trmb2(i)
672            s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)               trmb3(i, nsrf) = s_trmb3(i)
673            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)  
674         ENDDO         ENDDO
675      ENDDO      ENDDO
676    
677      ! Calculer la dérive du flux infrarouge      ! Calculer la dérive du flux infrarouge
678    
679      DO i = 1, klon      DO i = 1, klon
680         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
681      ENDDO      ENDDO
682    
     IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)  
   
683      ! Appeler la convection      ! Appeler la convection
684    
685      if (conv_emanuel) then      if (conv_emanuel) then
        da = 0.  
        mp = 0.  
        phi = 0.  
686         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, &
687              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, &
688              upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)              upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
689         snow_con = 0.         snow_con = 0.
690         clwcon0 = qcondc         clwcon0 = qcondc
691         mfu = upwd + dnwd         mfu = upwd + dnwd
692    
693         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
694            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  
695    
696         ! Properties of convective clouds         ! Properties of convective clouds
697         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
# Line 848  contains Line 709  contains
709         conv_t = d_t_dyn + d_t_vdf / dtphys         conv_t = d_t_dyn + d_t_vdf / dtphys
710         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
711         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
712              q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &              q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
713              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), &
714              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, &
715              kdtop, pmflxr, pmflxs)              kdtop, pmflxr, pmflxs)
# Line 867  contains Line 728  contains
728         ENDDO         ENDDO
729      ENDDO      ENDDO
730    
     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  
   
731      IF (.not. conv_emanuel) THEN      IF (.not. conv_emanuel) THEN
732         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
733         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
# Line 916  contains Line 755  contains
755         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
756         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
757      else      else
        ! Thermiques  
758         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
759              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)
760      endif      endif
761    
     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  
   
762      ! Caclul des ratqs      ! Caclul des ratqs
763    
764      ! 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 981  contains Line 813  contains
813            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
814         ENDDO         ENDDO
815      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  
816    
817      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
818    
# Line 1017  contains Line 828  contains
828            do k = 1, llm            do k = 1, llm
829               do i = 1, klon               do i = 1, klon
830                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
831                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
832                          *zmasse(i, k)                          * zmasse(i, k)
833                  endif                  endif
834               enddo               enddo
835            enddo            enddo
# Line 1053  contains Line 864  contains
864    
865         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
866         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
867         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
868      ENDIF      ENDIF
869    
870      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1076  contains Line 887  contains
887         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
888      ENDDO      ENDDO
889    
     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)  
   
890      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
891      DO k = 1, llm      DO k = 1, llm
892         DO i = 1, klon         DO i = 1, klon
893            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
894            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
895               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)            zx_qs = MIN(0.5, zx_qs)
896               zx_qs = MIN(0.5, zx_qs)            zcor = 1. / (1. - retv * zx_qs)
897               zcor = 1./(1. - retv*zx_qs)            zx_qs = zx_qs * zcor
898               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  
899            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
900         ENDDO         ENDDO
901      ENDDO      ENDDO
# Line 1119  contains Line 918  contains
918      endif      endif
919    
920      IF (MOD(itap - 1, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
921           ! Prescrire l'ozone :
922           wo = ozonecm(REAL(julien), paprs)
923    
924         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
925         ! Calcul de l'abedo moyen par maille         ! Calcul de l'abedo moyen par maille
926         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
927    
928         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
929         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
930              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
931              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
932              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
# Line 1133  contains Line 935  contains
935      ENDIF      ENDIF
936    
937      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
938      DO k = 1, llm      DO k = 1, llm
939         DO i = 1, klon         DO i = 1, klon
940            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 &
941                   / 86400.
942         ENDDO         ENDDO
943      ENDDO      ENDDO
944    
     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  
   
945      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
946      DO i = 1, klon      zxqsurf = sum(fqsurf * pctsrf, dim = 2)
947         zxqsurf(i) = 0.      zxsnow = sum(fsnow * pctsrf, dim = 2)
        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  
948    
949      ! 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)
   
950      DO i = 1, klon      DO i = 1, klon
951         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
952      ENDDO      ENDDO
# Line 1236  contains Line 1021  contains
1021      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1022           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1023    
     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)  
   
1024      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1025      call phytrac(lmt_pas, julien, time, firstcal, lafin, dtphys, t, paprs, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
1026           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, &
1027           yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &
1028           tr_seri, zmasse, ncid_startphy)           zmasse, ncid_startphy)
1029    
1030      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, &
1031           pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &           pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &
# Line 1260  contains Line 1041  contains
1041    
1042      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1043    
1044      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
1045      DO k = 1, llm      DO k = 1, llm
1046         DO i = 1, klon         DO i = 1, klon
1047            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
# Line 1271  contains Line 1052  contains
1052         END DO         END DO
1053      END DO      END DO
1054    
     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  
   
1055      ! SORTIES      ! SORTIES
1056    
1057      ! prw = eau precipitable      ! prw = eau precipitable
1058      DO i = 1, klon      DO i = 1, klon
1059         prw(i) = 0.         prw(i) = 0.
1060         DO k = 1, llm         DO k = 1, llm
1061            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1062         ENDDO         ENDDO
1063      ENDDO      ENDDO
1064    
# Line 1328  contains Line 1096  contains
1096      CALL histwrite_phy("precip", rain_fall + snow_fall)      CALL histwrite_phy("precip", rain_fall + snow_fall)
1097      CALL histwrite_phy("plul", rain_lsc + snow_lsc)      CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1098      CALL histwrite_phy("pluc", rain_con + snow_con)      CALL histwrite_phy("pluc", rain_con + snow_con)
1099      CALL histwrite_phy("tsol", zxtsol)      CALL histwrite_phy("tsol", ztsol)
1100      CALL histwrite_phy("t2m", zt2m)      CALL histwrite_phy("t2m", zt2m)
1101      CALL histwrite_phy("q2m", zq2m)      CALL histwrite_phy("q2m", zq2m)
1102      CALL histwrite_phy("u10m", zu10m)      CALL histwrite_phy("u10m", zu10m)
# Line 1350  contains Line 1118  contains
1118      CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))      CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
1119    
1120      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1121         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf)*100.)         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1122         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1123         CALL histwrite_phy("sens_"//clnsurf(nsrf), fluxt(:, 1, nsrf))         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1124         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1125         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1126         CALL histwrite_phy("taux_"//clnsurf(nsrf), fluxu(:, 1, nsrf))         CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1127         CALL histwrite_phy("tauy_"//clnsurf(nsrf), fluxv(:, 1, nsrf))         CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1128         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1129         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1130      END DO      END DO
1131    
1132      CALL histwrite_phy("albs", albsol)      CALL histwrite_phy("albs", albsol)
1133        CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1134      CALL histwrite_phy("rugs", zxrugs)      CALL histwrite_phy("rugs", zxrugs)
1135      CALL histwrite_phy("s_pblh", s_pblh)      CALL histwrite_phy("s_pblh", s_pblh)
1136      CALL histwrite_phy("s_pblt", s_pblt)      CALL histwrite_phy("s_pblt", s_pblt)
# Line 1373  contains Line 1142  contains
1142      CALL histwrite_phy("s_trmb1", s_trmb1)      CALL histwrite_phy("s_trmb1", s_trmb1)
1143      CALL histwrite_phy("s_trmb2", s_trmb2)      CALL histwrite_phy("s_trmb2", s_trmb2)
1144      CALL histwrite_phy("s_trmb3", s_trmb3)      CALL histwrite_phy("s_trmb3", s_trmb3)
1145      if (conv_emanuel) CALL histwrite_phy("ptop", ema_pct)  
1146        if (conv_emanuel) then
1147           CALL histwrite_phy("ptop", ema_pct)
1148           CALL histwrite_phy("dnwd0", - mp)
1149        end if
1150    
1151      CALL histwrite_phy("temp", t_seri)      CALL histwrite_phy("temp", t_seri)
1152      CALL histwrite_phy("vitu", u_seri)      CALL histwrite_phy("vitu", u_seri)
1153      CALL histwrite_phy("vitv", v_seri)      CALL histwrite_phy("vitv", v_seri)

Legend:
Removed from v.195  
changed lines
  Added in v.212

  ViewVC Help
Powered by ViewVC 1.1.21