/[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 178 by guez, Fri Mar 11 18:47:26 2016 UTC revision 208 by guez, Wed Dec 7 16:44:53 2016 UTC
# Line 16  contains Line 16  contains
16    
17      use aaam_bud_m, only: aaam_bud      use aaam_bud_m, only: aaam_bud
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
     use aeropt_m, only: aeropt  
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
23      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: cycle_diurne, conv_emanuel, nbapp_rad, new_oliq, &
24           ok_orodr, ok_orolf           ok_orodr, ok_orolf
25      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
26      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
27      use comconst, only: dtphys      use comconst, only: dtphys
28      USE comgeomphy, ONLY: airephy      USE comgeomphy, ONLY: airephy
29      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
30      USE conf_gcm_m, ONLY: offline, raz_date, day_step, iphysiq      USE conf_gcm_m, ONLY: offline, lmt_pas
31      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
32      use conflx_m, only: conflx      use conflx_m, only: conflx
33      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
34      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
     use diagetpq_m, only: diagetpq  
     use diagphy_m, only: diagphy  
35      USE dimens_m, ONLY: llm, nqmx      USE dimens_m, ONLY: llm, nqmx
36      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
37      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
38      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
39      use dynetat0_m, only: day_ref, annee_ref      use dynetat0_m, only: day_ref, annee_ref
40      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats
41      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
42      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
43        USE histsync_m, ONLY: histsync
44        USE histwrite_phy_m, ONLY: histwrite_phy
45      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
46           nbsrf           nbsrf
47      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins, nid_ins
48      use netcdf95, only: NF95_CLOSE      use netcdf95, only: NF95_CLOSE
49      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
50        use nr_util, only: assert
51      use nuage_m, only: nuage      use nuage_m, only: nuage
52      USE orbite_m, ONLY: orbite      USE orbite_m, ONLY: orbite
53      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
# Line 56  contains Line 56  contains
56      USE phyredem0_m, ONLY: phyredem0      USE phyredem0_m, ONLY: phyredem0
57      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
58      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
59      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
     use readsulfate_m, only: readsulfate  
     use readsulfate_preind_m, only: readsulfate_preind  
60      use yoegwd, only: sugwd      use yoegwd, only: sugwd
61      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt
62        use time_phylmdz, only: itap, increment_itap
63      use transp_m, only: transp      use transp_m, only: transp
64      use transp_lay_m, only: transp_lay      use transp_lay_m, only: transp_lay
65      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
# Line 82  contains Line 80  contains
80      REAL, intent(in):: play(:, :) ! (klon, llm)      REAL, intent(in):: play(:, :) ! (klon, llm)
81      ! pression pour le mileu de chaque couche (en Pa)      ! pression pour le mileu de chaque couche (en Pa)
82    
83      REAL, intent(in):: pphi(:, :) ! (klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
84      ! géopotentiel de chaque couche (référence sol)      ! géopotentiel de chaque couche (référence sol)
85    
86      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
87    
88      REAL, intent(in):: u(:, :) ! (klon, llm)      REAL, intent(in):: u(:, :) ! (klon, llm)
89      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m / s
90    
91      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
92      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
93    
94      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
95      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
96    
97      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
98      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)
99      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)
100      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)
101    
102      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
103      ! tendance physique de "qx" (s-1)      ! tendance physique de "qx" (s-1)
# Line 108  contains Line 106  contains
106    
107      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
108    
     LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface  
     PARAMETER (ok_gust = .FALSE.)  
   
     LOGICAL, PARAMETER:: check = .FALSE.  
     ! Verifier la conservation du modele en eau  
   
109      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
110      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
111    
112      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.      ! pour phystoke avec thermiques
     ! sorties journalieres, mensuelles et instantanees dans les  
     ! fichiers histday, histmth et histins  
   
     LOGICAL ok_region ! sortir le fichier regional  
     PARAMETER (ok_region = .FALSE.)  
   
     ! pour phsystoke avec thermiques  
113      REAL fm_therm(klon, llm + 1)      REAL fm_therm(klon, llm + 1)
114      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
115      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
# Line 135  contains Line 120  contains
120      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
121      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
122    
123      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
124      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)
125    
126      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
127    
128      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
129      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
     SAVE swdn0, swdn, swup0, swup  
   
     REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)  
     REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)  
     SAVE lwdn0, lwdn, lwup0, lwup  
   
     ! Amip2  
     ! variables a une pression donnee  
130    
131      integer nlevSTD      REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
132      PARAMETER(nlevSTD = 17)      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
133    
134      ! prw: precipitable water      ! prw: precipitable water
135      real prw(klon)      real prw(klon)
136    
137      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
138      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
139      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
140      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
141    
     INTEGER kmax, lmax  
     PARAMETER(kmax = 8, lmax = 8)  
     INTEGER kmaxm1, lmaxm1  
     PARAMETER(kmaxm1 = kmax - 1, lmaxm1 = lmax - 1)  
   
142      ! Variables propres a la physique      ! Variables propres a la physique
143    
144      INTEGER, save:: radpas      INTEGER, save:: radpas
145      ! Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
146      ! "physiq".      ! "physiq".
147    
148      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  
   
     INTEGER:: itap = 0 ! number of calls to "physiq"  
   
149      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
150    
151      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
152      ! soil temperature of surface fraction      ! soil temperature of surface fraction
153    
154      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
155      REAL fluxlat(klon, nbsrf)      REAL, save:: fluxlat(klon, nbsrf)
     SAVE fluxlat  
156    
157      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
158      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
# Line 208  contains Line 175  contains
175      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
176      INTEGER igwd, itest(klon)      INTEGER igwd, itest(klon)
177    
178      REAL agesno(klon, nbsrf)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
179      SAVE agesno ! age de la neige      REAL, save:: run_off_lic_0(klon)
180    
181      REAL run_off_lic_0(klon)      ! Variables li\'ees \`a la convection d'Emanuel :
182      SAVE run_off_lic_0      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
183      !KE43      REAL, save:: qcondc(klon, llm) ! in-cld water content from convect
     ! Variables liees a la convection de K. Emanuel (sb):  
   
     REAL Ma(klon, llm) ! undilute upward mass flux  
     SAVE Ma  
     REAL qcondc(klon, llm) ! in-cld water content from convect  
     SAVE qcondc  
184      REAL, save:: sig1(klon, llm), w01(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
     REAL, save:: wd(klon)  
   
     ! Variables pour la couche limite (al1):  
185    
186        ! Variables pour la couche limite (Alain Lahellec) :
187      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
188      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
189    
# Line 232  contains Line 191  contains
191      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
192      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
193      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
194      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige  
195      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL, save:: ffonte(klon, nbsrf)
196      ! !et necessaire pour limiter la      ! flux thermique utilise pour fondre la neige
197      ! !hauteur de neige, en kg/m2/s  
198        REAL, save:: fqcalving(klon, nbsrf)
199        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
200        ! hauteur de neige, en kg / m2 / s
201    
202      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
203    
204      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
205      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
206      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
207      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
208      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
209      save pfrac_1nucl  
210      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
211      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
212    
213      REAL, save:: rain_fall(klon)      REAL, save:: rain_fall(klon)
214      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
215    
216      REAL, save:: snow_fall(klon)      REAL, save:: snow_fall(klon)
217      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg / m2 / s), positive down
218    
219      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
220    
221      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
222      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
223      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
224      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
225        REAL, save:: dlw(klon) ! derivee infra rouge
226      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
227      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
228      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
229      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
230      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
# Line 272  contains Line 236  contains
236      ! Conditions aux limites      ! Conditions aux limites
237    
238      INTEGER julien      INTEGER julien
     INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day  
239      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  
240      REAL, save:: albsol(klon) ! albedo du sol total visible      REAL, save:: albsol(klon) ! albedo du sol total visible
241      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
242    
# Line 289  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 310  contains Line 267  contains
267      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
268      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
269      REAL, save:: albpla(klon)      REAL, save:: albpla(klon)
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. 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. AM Variables pour la CLA (hbtm2)      ! 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
301      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
302      ! Grdeurs de sorties      ! Grandeurs de sorties
303      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
304      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
305      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
# Line 353  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 367  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 381  contains Line 335  contains
335      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
336    
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
339    
340      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
341      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
342        REAL, save:: snow_con(klon) ! neige (mm / s)
343        real snow_lsc(klon)
344      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
345    
346      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
# Line 421  contains Line 378  contains
378      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
379      REAL aam, torsfc      REAL aam, torsfc
380    
     REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique  
   
     INTEGER, SAVE:: nid_ins  
   
381      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
382      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
383      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.
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 (pi) aerosols      ! cloud optical thickness for pre-industrial aerosols
410    
411      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
412      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
# Line 466  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
   
     REAL aerindex(klon) ! POLDER aerosol index  
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 479  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    
429      SAVE u10m      real zmasse(klon, llm)
     SAVE v10m  
     SAVE t2m  
     SAVE q2m  
     SAVE ffonte  
     SAVE fqcalving  
     SAVE rain_con  
     SAVE snow_con  
     SAVE topswai  
     SAVE topswad  
     SAVE solswai  
     SAVE solswad  
     SAVE d_u_con  
     SAVE d_v_con  
   
     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      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      integer, save:: ncid_startphy
     integer, save:: ncid_startphy, itau_phy  
433    
434      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
435           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           ratqsbas, ratqshaut, ok_ade, ok_aie, bl95_b0, bl95_b1, &
436           ok_ade, ok_aie, bl95_b0, 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 540  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 559  contains Line 487  contains
487         ! Initialiser les compteurs:         ! Initialiser les compteurs:
488    
489         frugs = 0.         frugs = 0.
490         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, &         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
491              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &              fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
492              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
493              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &              q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
494              run_off_lic_0, sig1, w01, ncid_startphy, itau_phy)              w01, ncid_startphy)
495    
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
        ! On remet le calendrier a zero  
        IF (raz_date) itau_phy = 0  
   
        CALL printflag(radpas, ok_journe, ok_instan, ok_region)  
501    
502         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
503         IF (iflag_con >= 3) THEN         IF (conv_emanuel) THEN
504            ibas_con = 1            ibas_con = 1
505            itop_con = 1            itop_con = 1
506         ENDIF         ENDIF
# Line 591  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    
519         call ini_histins(dtphys, ok_instan, nid_ins, itau_phy)         call ini_histins(dtphys)
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, itau_phy)         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 617  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 659  contains Line 562  contains
562      ! Check temperatures:      ! Check temperatures:
563      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
564    
565      ! Incrémenter le compteur de la physique      call increment_itap
     itap = itap + 1  
566      julien = MOD(dayvrai, 360)      julien = MOD(dayvrai, 360)
567      if (julien == 0) julien = 360      if (julien == 0) julien = 360
568    
# Line 680  contains Line 582  contains
582      ENDDO      ENDDO
583      ql_seri = 0.      ql_seri = 0.
584    
     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  
   
585      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
586      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
587    
588      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
589      ! la surface.      ! la surface.
590    
591      CALL orbite(REAL(julien), longi, dist)      CALL orbite(REAL(julien), longi, dist)
# Line 715  contains Line 609  contains
609    
610      fder = dlw      fder = dlw
611    
612      ! Couche limite:      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
613             ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
614      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
615           v_seri, julien, mu0, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &           snow_fall, fsolsw, fsollw, fder, rlat, frugs, agesno, rugoro, &
616           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, &
617           fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, &           flux_v, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &
618           firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &
619           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &           trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
          ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, &  
          pblT, therm, trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, &  
          run_off_lic_0)  
620    
621      ! Incr\'ementation des flux      ! Incr\'ementation des flux
622    
623      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
624      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
625      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  
626    
627      DO k = 1, llm      DO k = 1, llm
628         DO i = 1, klon         DO i = 1, klon
# Line 758  contains Line 633  contains
633         ENDDO         ENDDO
634      ENDDO      ENDDO
635    
     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  
   
636      ! Update surface temperature:      ! Update surface temperature:
637    
638      DO i = 1, klon      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
639         zxtsol(i) = 0.      ftsol = ftsol + d_ts
640         zxfluxlat(i) = 0.      ztsol = sum(ftsol * pctsrf, dim = 2)
641        zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
642         zt2m(i) = 0.      zt2m = sum(t2m * pctsrf, dim = 2)
643         zq2m(i) = 0.      zq2m = sum(q2m * pctsrf, dim = 2)
644         zu10m(i) = 0.      zu10m = sum(u10m * pctsrf, dim = 2)
645         zv10m(i) = 0.      zv10m = sum(v10m * pctsrf, dim = 2)
646         zxffonte(i) = 0.      zxffonte = sum(ffonte * pctsrf, dim = 2)
647         zxfqcalving(i) = 0.      zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
648        s_pblh = sum(pblh * pctsrf, dim = 2)
649         s_pblh(i) = 0.      s_lcl = sum(plcl * pctsrf, dim = 2)
650         s_lcl(i) = 0.      s_capCL = sum(capCL * pctsrf, dim = 2)
651         s_capCL(i) = 0.      s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
652         s_oliqCL(i) = 0.      s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
653         s_cteiCL(i) = 0.      s_pblT = sum(pblT * pctsrf, dim = 2)
654         s_pblT(i) = 0.      s_therm = sum(therm * pctsrf, dim = 2)
655         s_therm(i) = 0.      s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
656         s_trmb1(i) = 0.      s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
657         s_trmb2(i) = 0.      s_trmb3 = sum(trmb3 * pctsrf, dim = 2)
        s_trmb3(i) = 0.  
   
        IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &  
             + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &  
             'physiq : probl\`eme sous surface au point ', i, &  
             pctsrf(i, 1 : nbsrf)  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)  
           zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
           zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)  
   
           zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)  
           zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)  
           zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)  
           zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)  
           zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)  
           zxfqcalving(i) = zxfqcalving(i) + &  
                fqcalving(i, nsrf)*pctsrf(i, nsrf)  
           s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)  
           s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)  
           s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)  
           s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)  
           s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)  
           s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)  
           s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) *pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
658    
659      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :      ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
660      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
661         DO i = 1, klon         DO i = 1, klon
662            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
663                 ftsol(i, nsrf) = ztsol(i)
664            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
665            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
666            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m(i, nsrf) = zu10m(i)
667            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m(i, nsrf) = zv10m(i)
668            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
669            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
670                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
671            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
672            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
673            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
674            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
675            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
676            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
677            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
678            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
679            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
680            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
681         ENDDO         ENDDO
682      ENDDO      ENDDO
683    
684      ! Calculer la dérive du flux infrarouge      ! Calculer la dérive du flux infrarouge
685    
686      DO i = 1, klon      DO i = 1, klon
687         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
688      ENDDO      ENDDO
689    
690      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)      ! Appeler la convection
   
     ! Appeler la convection (au choix)  
   
     if (iflag_con == 2) then  
        conv_q = d_q_dyn + d_q_vdf / dtphys  
        conv_t = d_t_dyn + d_t_vdf / dtphys  
        z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)  
        CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &  
             q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &  
             d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &  
             mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &  
             kdtop, pmflxr, pmflxs)  
        WHERE (rain_con < 0.) rain_con = 0.  
        WHERE (snow_con < 0.) snow_con = 0.  
        ibas_con = llm + 1 - kcbot  
        itop_con = llm + 1 - kctop  
     else  
        ! iflag_con >= 3  
691    
692         da = 0.      if (conv_emanuel) then
693         mp = 0.         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
694         phi = 0.              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
695         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &              upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
696              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &         snow_con = 0.
             ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &  
             qcondc, wd, pmflxr, pmflxs, da, phi, mp)  
697         clwcon0 = qcondc         clwcon0 = qcondc
698         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
699    
700         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
701            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  
702    
703         ! Properties of convective clouds         ! Properties of convective clouds
704         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
705         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
706              rnebcon0)              rnebcon0)
707    
708           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
709         mfd = 0.         mfd = 0.
710         pen_u = 0.         pen_u = 0.
711         pen_d = 0.         pen_d = 0.
712         pde_d = 0.         pde_d = 0.
713         pde_u = 0.         pde_u = 0.
714        else
715           conv_q = d_q_dyn + d_q_vdf / dtphys
716           conv_t = d_t_dyn + d_t_vdf / dtphys
717           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
718           CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
719                q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
720                d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
721                mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
722                kdtop, pmflxr, pmflxs)
723           WHERE (rain_con < 0.) rain_con = 0.
724           WHERE (snow_con < 0.) snow_con = 0.
725           ibas_con = llm + 1 - kcbot
726           itop_con = llm + 1 - kctop
727      END if      END if
728    
729      DO k = 1, llm      DO k = 1, llm
# Line 911  contains Line 735  contains
735         ENDDO         ENDDO
736      ENDDO      ENDDO
737    
738      IF (if_ebil >= 2) THEN      IF (.not. conv_emanuel) 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  
   
     IF (iflag_con == 2) THEN  
739         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
740         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
741         DO k = 1, llm         DO k = 1, llm
# Line 960  contains Line 762  contains
762         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
763         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
764      else      else
        ! Thermiques  
765         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
766              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)
767      endif      endif
768    
     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  
   
769      ! Caclul des ratqs      ! Caclul des ratqs
770    
771      ! 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 992  contains Line 787  contains
787      do k = 1, llm      do k = 1, llm
788         do i = 1, klon         do i = 1, klon
789            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
790                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
791         enddo         enddo
792      enddo      enddo
793    
# Line 1025  contains Line 820  contains
820            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
821         ENDDO         ENDDO
822      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  
823    
824      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
825    
# Line 1061  contains Line 835  contains
835            do k = 1, llm            do k = 1, llm
836               do i = 1, klon               do i = 1, klon
837                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
838                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
839                          *zmasse(i, k)                          * zmasse(i, k)
840                  endif                  endif
841               enddo               enddo
842            enddo            enddo
# Line 1097  contains Line 871  contains
871    
872         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
873         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
874         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
875      ENDIF      ENDIF
876    
877      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1120  contains Line 894  contains
894         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
895      ENDDO      ENDDO
896    
     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)  
   
897      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
898      DO k = 1, llm      DO k = 1, llm
899         DO i = 1, klon         DO i = 1, klon
900            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
901            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
902               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)            zx_qs = MIN(0.5, zx_qs)
903               zx_qs = MIN(0.5, zx_qs)            zcor = 1. / (1. - retv * zx_qs)
904               zcor = 1./(1. - retv*zx_qs)            zx_qs = zx_qs * zcor
905               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  
906            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
907         ENDDO         ENDDO
908      ENDDO      ENDDO
909    
910      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
911      IF (ok_ade .OR. ok_aie) THEN      tau_ae = 0.
912         ! Get sulfate aerosol distribution :      piz_ae = 0.
913         CALL readsulfate(dayvrai, time, firstcal, sulfate)      cg_ae = 0.
        CALL readsulfate_preind(dayvrai, time, firstcal, sulfate_pi)  
   
        CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &  
             aerindex)  
     ELSE  
        tau_ae = 0.  
        piz_ae = 0.  
        cg_ae = 0.  
     ENDIF  
914    
915      ! Param\`etres optiques des nuages et quelques param\`etres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
916      ! diagnostics :      ! diagnostics :
# Line 1177  contains Line 930  contains
930         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
931    
932         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
933         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
934              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
935              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
936              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
# Line 1186  contains Line 939  contains
939      ENDIF      ENDIF
940    
941      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
942      DO k = 1, llm      DO k = 1, llm
943         DO i = 1, klon         DO i = 1, klon
944            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 &
945                   / 86400.
946         ENDDO         ENDDO
947      ENDDO      ENDDO
948    
     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  
   
949      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
950      DO i = 1, klon      zxqsurf = sum(fqsurf * pctsrf, dim = 2)
951         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  
952    
953      ! 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)
   
954      DO i = 1, klon      DO i = 1, klon
955         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
956      ENDDO      ENDDO
# Line 1289  contains Line 1025  contains
1025      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1026           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1027    
     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)  
   
1028      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1029      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
1030           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &
1031           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, &           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &
1032           dnwd, tr_seri, zmasse, ncid_startphy, nid_ins, itau_phy)           zmasse, ncid_startphy)
1033    
1034      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &      IF (offline) call phystokenc(dtphys, t, mfu, mfd, pen_u, pde_u, pen_d, &
1035           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &
1036           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)           frac_impa, frac_nucl, pphis, airephy, dtphys)
1037    
1038      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1039      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
# Line 1313  contains Line 1045  contains
1045    
1046      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1047    
1048      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
1049      DO k = 1, llm      DO k = 1, llm
1050         DO i = 1, klon         DO i = 1, klon
1051            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
# Line 1324  contains Line 1056  contains
1056         END DO         END DO
1057      END DO      END DO
1058    
     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  
   
1059      ! SORTIES      ! SORTIES
1060    
1061      ! prw = eau precipitable      ! prw = eau precipitable
1062      DO i = 1, klon      DO i = 1, klon
1063         prw(i) = 0.         prw(i) = 0.
1064         DO k = 1, llm         DO k = 1, llm
1065            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1066         ENDDO         ENDDO
1067      ENDDO      ENDDO
1068    
# Line 1375  contains Line 1094  contains
1094         ENDDO         ENDDO
1095      ENDDO      ENDDO
1096    
1097      call write_histins      CALL histwrite_phy("phis", pphis)
1098        CALL histwrite_phy("aire", airephy)
1099        CALL histwrite_phy("psol", paprs(:, 1))
1100        CALL histwrite_phy("precip", rain_fall + snow_fall)
1101        CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1102        CALL histwrite_phy("pluc", rain_con + snow_con)
1103        CALL histwrite_phy("tsol", ztsol)
1104        CALL histwrite_phy("t2m", zt2m)
1105        CALL histwrite_phy("q2m", zq2m)
1106        CALL histwrite_phy("u10m", zu10m)
1107        CALL histwrite_phy("v10m", zv10m)
1108        CALL histwrite_phy("snow", snow_fall)
1109        CALL histwrite_phy("cdrm", cdragm)
1110        CALL histwrite_phy("cdrh", cdragh)
1111        CALL histwrite_phy("topl", toplw)
1112        CALL histwrite_phy("evap", evap)
1113        CALL histwrite_phy("sols", solsw)
1114        CALL histwrite_phy("soll", sollw)
1115        CALL histwrite_phy("solldown", sollwdown)
1116        CALL histwrite_phy("bils", bils)
1117        CALL histwrite_phy("sens", - sens)
1118        CALL histwrite_phy("fder", fder)
1119        CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1120        CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1121        CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1122        CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
1123    
1124        DO nsrf = 1, nbsrf
1125           CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1126           CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1127           CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1128           CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1129           CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1130           CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1131           CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1132           CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1133           CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1134        END DO
1135    
1136        CALL histwrite_phy("albs", albsol)
1137        CALL histwrite_phy("rugs", zxrugs)
1138        CALL histwrite_phy("s_pblh", s_pblh)
1139        CALL histwrite_phy("s_pblt", s_pblt)
1140        CALL histwrite_phy("s_lcl", s_lcl)
1141        CALL histwrite_phy("s_capCL", s_capCL)
1142        CALL histwrite_phy("s_oliqCL", s_oliqCL)
1143        CALL histwrite_phy("s_cteiCL", s_cteiCL)
1144        CALL histwrite_phy("s_therm", s_therm)
1145        CALL histwrite_phy("s_trmb1", s_trmb1)
1146        CALL histwrite_phy("s_trmb2", s_trmb2)
1147        CALL histwrite_phy("s_trmb3", s_trmb3)
1148    
1149        if (conv_emanuel) then
1150           CALL histwrite_phy("ptop", ema_pct)
1151           CALL histwrite_phy("dnwd0", - mp)
1152        end if
1153    
1154        CALL histwrite_phy("temp", t_seri)
1155        CALL histwrite_phy("vitu", u_seri)
1156        CALL histwrite_phy("vitv", v_seri)
1157        CALL histwrite_phy("geop", zphi)
1158        CALL histwrite_phy("pres", play)
1159        CALL histwrite_phy("dtvdf", d_t_vdf)
1160        CALL histwrite_phy("dqvdf", d_q_vdf)
1161        CALL histwrite_phy("rhum", zx_rh)
1162    
1163        if (ok_instan) call histsync(nid_ins)
1164    
1165      IF (lafin) then      IF (lafin) then
1166         call NF95_CLOSE(ncid_startphy)         call NF95_CLOSE(ncid_startphy)
# Line 1388  contains Line 1173  contains
1173    
1174      firstcal = .FALSE.      firstcal = .FALSE.
1175    
   contains  
   
     subroutine write_histins  
   
       ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09  
   
       ! Ecriture des sorties  
   
       use dimens_m, only: iim, jjm  
       USE histsync_m, ONLY: histsync  
       USE histwrite_m, ONLY: histwrite  
   
       integer i, itau_w ! pas de temps ecriture  
       REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
   
       !--------------------------------------------------  
   
       IF (ok_instan) THEN  
          ! Champs 2D:  
   
          itau_w = itau_phy + itap  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)  
          CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)  
          CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = paprs(i, 1)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)  
          CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)  
          !ccIM  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)  
          CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)  
          CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)  
          CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)  
          CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)  
   
          zx_tmp_fi2d(1:klon) = - sens(1:klon)  
          ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)  
          CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)  
   
          DO nsrf = 1, nbsrf  
             !XXX  
             zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = falbe(:, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
          END DO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)  
          CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)  
   
          !HBTM2  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)  
   
          ! Champs 3D:  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)  
          CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)  
          CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zx_rh, zx_tmp_3d)  
          CALL histwrite(nid_ins, "rhum", itau_w, zx_tmp_3d)  
   
          call histsync(nid_ins)  
       ENDIF  
   
     end subroutine write_histins  
   
1176    END SUBROUTINE physiq    END SUBROUTINE physiq
1177    
1178  end module physiq_m  end module physiq_m

Legend:
Removed from v.178  
changed lines
  Added in v.208

  ViewVC Help
Powered by ViewVC 1.1.21