/[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 174 by guez, Wed Nov 25 20:14:19 2015 UTC revision 206 by guez, Tue Aug 30 12:52:46 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, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ksta, ksta_ter, ok_kzmin, &
22           ecrit_mth, 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, day_step, iphysiq, 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
# Line 43  contains Line 40  contains
40      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
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
52      USE orbite_m, ONLY: orbite      USE orbite_m, ONLY: orbite
53      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
54      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
# Line 55  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 temps, ONLY: itau_phy      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
65      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
66      USE ymds2ju_m, ONLY: ymds2ju      USE ymds2ju_m, ONLY: ymds2ju
67      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
# Line 81  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 107  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      ! "slab" ocean      ! pour phystoke avec thermiques
     REAL, save:: tslab(klon) ! temperature of ocean slab  
     REAL, save:: seaice(klon) ! glace de mer (kg/m2)  
     REAL fluxo(klon) ! flux turbulents ocean-glace de mer  
     REAL fluxg(klon) ! flux turbulents ocean-atmosphere  
   
     logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.  
     ! 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 140  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    
150      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
151    
# Line 189  contains Line 153  contains
153      ! soil temperature of surface fraction      ! soil temperature of surface fraction
154    
155      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
156      REAL fluxlat(klon, nbsrf)      REAL, save:: fluxlat(klon, nbsrf)
     SAVE fluxlat  
157    
158      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
159      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
# Line 210  contains Line 173  contains
173      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
174      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
175      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
176      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
177        INTEGER igwd, itest(klon)
178    
179      INTEGER igwd, idx(klon), itest(klon)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
180        REAL, save:: run_off_lic_0(klon)
     REAL agesno(klon, nbsrf)  
     SAVE agesno ! age de la neige  
181    
182      REAL run_off_lic_0(klon)      ! Variables li\'ees \`a la convection d'Emanuel :
183      SAVE run_off_lic_0      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
184      !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  
185      REAL, save:: sig1(klon, llm), w01(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
     REAL, save:: wd(klon)  
   
     ! Variables locales pour la couche limite (al1):  
   
     ! Variables locales:  
186    
187        ! Variables pour la couche limite (Alain Lahellec) :
188      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
189      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
190    
# Line 241  contains Line 192  contains
192      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
193      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
194      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
195      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige  
196      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL, save:: ffonte(klon, nbsrf)
197      ! !et necessaire pour limiter la      ! flux thermique utilise pour fondre la neige
198      ! !hauteur de neige, en kg/m2/s  
199        REAL, save:: fqcalving(klon, nbsrf)
200        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
201        ! hauteur de neige, en kg / m2 / s
202    
203      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
204    
205      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
206      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
207      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
208      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
209      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
210      save pfrac_1nucl  
211      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
212      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
213    
214      REAL, save:: rain_fall(klon)      REAL, save:: rain_fall(klon)
215      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
216    
217      REAL, save:: snow_fall(klon)      REAL, save:: snow_fall(klon)
218      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg / m2 / s), positive down
219    
220      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
221    
222      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
223      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
224      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
225      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
226        REAL, save:: dlw(klon) ! derivee infra rouge
227      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
228      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
229      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
230      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
231      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
# Line 281  contains Line 237  contains
237      ! Conditions aux limites      ! Conditions aux limites
238    
239      INTEGER julien      INTEGER julien
     INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day  
240      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  
241      REAL, save:: albsol(klon) ! albedo du sol total visible      REAL, save:: albsol(klon) ! albedo du sol total visible
242      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
243    
     ! Declaration des procedures appelees  
   
     EXTERNAL nuage ! calculer les proprietes radiatives  
   
     ! Variables locales  
   
244      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
245      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
246    
# Line 304  contains Line 252  contains
252      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
253      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
254    
255      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
256      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
257      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_u(klon, nbsrf) ! flux turbulent de vitesse u à la surface
258      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)  
259    
260      ! 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
261      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
# Line 325  contains Line 268  contains
268      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
269      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
270      REAL, save:: albpla(klon)      REAL, save:: albpla(klon)
271      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
272      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
273    
274      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
275      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K / s)
276    
277      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
278      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
279    
280      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
281    
282      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
283      real longi      real longi
284      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
285      REAL za, zb      REAL zb
286      REAL zx_t, zx_qs, zcor      REAL zx_t, zx_qs, zcor
287      real zqsat(klon, llm)      real zqsat(klon, llm)
288      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
289      REAL, PARAMETER:: t_coup = 234.      REAL, PARAMETER:: t_coup = 234.
290      REAL zphi(klon, llm)      REAL zphi(klon, llm)
291    
292      ! cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
293    
294      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
295      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 356  contains Line 299  contains
299      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
300      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
301      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
302      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
303      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
304      ! Grdeurs de sorties      ! Grandeurs de sorties
305      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
306      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
307      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
308      REAL s_trmb3(klon)      REAL s_trmb3(klon)
309    
310      ! Variables locales pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
311    
312      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
313      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
314      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
315    
316      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
317    
# Line 382  contains Line 323  contains
323      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
324      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
325      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
326      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
327      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)
328      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
329      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 396  contains Line 337  contains
337      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
338    
339      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
340        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
341    
342      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
343      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
344        REAL, save:: snow_con(klon) ! neige (mm / s)
345        real snow_lsc(klon)
346      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
347    
348      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
# Line 422  contains Line 366  contains
366      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
367      logical ptconv(klon, llm)      logical ptconv(klon, llm)
368    
369      ! Variables locales pour effectuer les appels en s\'erie :      ! Variables pour effectuer les appels en s\'erie :
370    
371      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
372      REAL ql_seri(klon, llm)      REAL ql_seri(klon, llm)
# Line 436  contains Line 380  contains
380      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
381      REAL aam, torsfc      REAL aam, torsfc
382    
     REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique  
   
     INTEGER, SAVE:: nid_ins  
   
383      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.
384      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.
385      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.
386      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.
387    
388      real date0      real date0
   
     ! Variables li\'ees au bilan d'\'energie et d'enthalpie :  
389      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  
390    
391      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique      REAL d_t_ec(klon, llm)
392        ! tendance due \`a la conversion Ec en énergie thermique
393    
394      REAL ZRCPD      REAL ZRCPD
395    
396      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
397      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m      ! temperature and humidity at 2 m
398    
399        REAL, save:: u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
400      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
401      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
402    
403      ! Aerosol effects:      ! Aerosol effects:
404    
405      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g / m3)
406    
407      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
408      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value      ! SO4 aerosol concentration, in \mu g / m3, pre-industrial value
409    
410      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
411      ! cloud optical thickness for pre-industrial (pi) aerosols      ! cloud optical thickness for pre-industrial aerosols
412    
413      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
414      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
# Line 481  contains Line 417  contains
417      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
418      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
419    
420      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
421      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL, save:: topswai(klon), solswai(klon) ! aerosol indirect effect
   
     REAL aerindex(klon) ! POLDER aerosol index  
422    
423      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
424      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
# Line 494  contains Line 428  contains
428      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
429      ! concentration.      ! concentration.
430    
431      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)  
432      ! (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)
433    
     real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2  
434      integer, save:: ncid_startphy      integer, save:: ncid_startphy
435    
436      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
437           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           ratqsbas, ratqshaut, ok_ade, ok_aie, bl95_b0, bl95_b1, &
438           ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals           iflag_thermals, nsplit_thermals
439    
440      !----------------------------------------------------------------      !----------------------------------------------------------------
441    
     IF (if_ebil >= 1) zero_v = 0.  
442      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
443           'eaux vapeur et liquide sont indispensables')           'eaux vapeur et liquide sont indispensables')
444    
# Line 558  contains Line 475  contains
475         pblt =0. ! T a la Hauteur de couche limite         pblt =0. ! T a la Hauteur de couche limite
476         therm =0.         therm =0.
477         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
478         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
479         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
480    
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
   
481         iflag_thermals = 0         iflag_thermals = 0
482         nsplit_thermals = 1         nsplit_thermals = 1
483         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
# Line 574  contains Line 489  contains
489         ! Initialiser les compteurs:         ! Initialiser les compteurs:
490    
491         frugs = 0.         frugs = 0.
492         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
493              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &              fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
494              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
495              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &              q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
496              run_off_lic_0, sig1, w01, ncid_startphy)              w01, ncid_startphy)
497    
498         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
499         q2 = 1e-8         q2 = 1e-8
500    
        lmt_pas = day_step / iphysiq  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
501         radpas = lmt_pas / nbapp_rad         radpas = lmt_pas / nbapp_rad
502           print *, "radpas = ", radpas
        ! On remet le calendrier a zero  
        IF (raz_date) itau_phy = 0  
   
        CALL printflag(radpas, ok_journe, ok_instan, ok_region)  
503    
504         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
505         IF (iflag_con >= 3) THEN         IF (conv_emanuel) THEN
506            ibas_con = 1            ibas_con = 1
507            itop_con = 1            itop_con = 1
508         ENDIF         ENDIF
# Line 606  contains Line 514  contains
514            rugoro = 0.            rugoro = 0.
515         ENDIF         ENDIF
516    
517         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)  
518    
519         ! Initialisation des sorties         ! Initialisation des sorties
520    
521         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys)
522         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
523         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
524         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
525         CALL phyredem0(lmt_pas)         CALL phyredem0
526      ENDIF test_firstcal      ENDIF test_firstcal
527    
528      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
# Line 632  contains Line 536  contains
536    
537      ztsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
538    
     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  
   
539      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
540      IF (ancien_ok) THEN      IF (ancien_ok) THEN
541         DO k = 1, llm         DO k = 1, llm
# Line 674  contains Line 564  contains
564      ! Check temperatures:      ! Check temperatures:
565      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
566    
567      ! Incrémenter le compteur de la physique      call increment_itap
     itap = itap + 1  
568      julien = MOD(dayvrai, 360)      julien = MOD(dayvrai, 360)
569      if (julien == 0) julien = 360      if (julien == 0) julien = 360
570    
# Line 695  contains Line 584  contains
584      ENDDO      ENDDO
585      ql_seri = 0.      ql_seri = 0.
586    
     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  
   
587      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
588      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
589    
590      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
591      ! la surface.      ! la surface.
592    
593      CALL orbite(REAL(julien), longi, dist)      CALL orbite(REAL(julien), longi, dist)
# Line 730  contains Line 611  contains
611    
612      fder = dlw      fder = dlw
613    
614      ! Couche limite:      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
615             ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
616      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
617           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &           snow_fall, fsolsw, fsollw, fder, rlat, frugs, agesno, rugoro, &
618           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, &
619           fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, &           flux_v, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &
620           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, &
621           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, fluxo, fluxg, tslab)  
622    
623      ! Incr\'ementation des flux      ! Incr\'ementation des flux
624    
625      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
626      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
627      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  
628    
629      DO k = 1, llm      DO k = 1, llm
630         DO i = 1, klon         DO i = 1, klon
# Line 773  contains Line 635  contains
635         ENDDO         ENDDO
636      ENDDO      ENDDO
637    
     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  
   
638      ! Update surface temperature:      ! Update surface temperature:
639    
640      DO i = 1, klon      DO i = 1, klon
        zxtsol(i) = 0.  
641         zxfluxlat(i) = 0.         zxfluxlat(i) = 0.
642    
643         zt2m(i) = 0.         zt2m(i) = 0.
# Line 794  contains Line 647  contains
647         zxffonte(i) = 0.         zxffonte(i) = 0.
648         zxfqcalving(i) = 0.         zxfqcalving(i) = 0.
649    
650         s_pblh(i) = 0.         s_pblh(i) = 0.
651         s_lcl(i) = 0.         s_lcl(i) = 0.
652         s_capCL(i) = 0.         s_capCL(i) = 0.
653         s_oliqCL(i) = 0.         s_oliqCL(i) = 0.
654         s_cteiCL(i) = 0.         s_cteiCL(i) = 0.
# Line 804  contains Line 657  contains
657         s_trmb1(i) = 0.         s_trmb1(i) = 0.
658         s_trmb2(i) = 0.         s_trmb2(i) = 0.
659         s_trmb3(i) = 0.         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)  
660      ENDDO      ENDDO
661    
662        call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
663    
664        ftsol = ftsol + d_ts
665        ztsol = sum(ftsol * pctsrf, dim = 2)
666      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
667         DO i = 1, klon         DO i = 1, klon
668            ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf) * pctsrf(i, nsrf)
669            zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
670            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)            zt2m(i) = zt2m(i) + t2m(i, nsrf) * pctsrf(i, nsrf)
671              zq2m(i) = zq2m(i) + q2m(i, nsrf) * pctsrf(i, nsrf)
672            zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf) * pctsrf(i, nsrf)
673            zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf) * pctsrf(i, nsrf)
674            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(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)  
675            zxfqcalving(i) = zxfqcalving(i) + &            zxfqcalving(i) = zxfqcalving(i) + &
676                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf) * pctsrf(i, nsrf)
677            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf) * pctsrf(i, nsrf)
678            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)            s_lcl(i) = s_lcl(i) + plcl(i, nsrf) * pctsrf(i, nsrf)
679            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) * pctsrf(i, nsrf)
680            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) * pctsrf(i, nsrf)
681            s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)            s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) * pctsrf(i, nsrf)
682            s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)            s_pblT(i) = s_pblT(i) + pblT(i, nsrf) * pctsrf(i, nsrf)
683            s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)            s_therm(i) = s_therm(i) + therm(i, nsrf) * pctsrf(i, nsrf)
684            s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) *pctsrf(i, nsrf)            s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) * pctsrf(i, nsrf)
685            s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) *pctsrf(i, nsrf)            s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) * pctsrf(i, nsrf)
686            s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) *pctsrf(i, nsrf)            s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) * pctsrf(i, nsrf)
687         ENDDO         ENDDO
688      ENDDO      ENDDO
689    
690      ! 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 :
691      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
692         DO i = 1, klon         DO i = 1, klon
693            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
694                 ftsol(i, nsrf) = ztsol(i)
695            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
696            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
697            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m(i, nsrf) = zu10m(i)
698            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m(i, nsrf) = zv10m(i)
699            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
700            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
701                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
702            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
703            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
704            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
705            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
706            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
707            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
708            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
709            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
710            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
711            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
712         ENDDO         ENDDO
713      ENDDO      ENDDO
714    
715      ! Calculer la dérive du flux infrarouge      ! Calculer la dérive du flux infrarouge
716    
717      DO i = 1, klon      DO i = 1, klon
718         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
719      ENDDO      ENDDO
720    
721      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  
722    
723         da = 0.      if (conv_emanuel) then
724         mp = 0.         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
725         phi = 0.              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
726         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &              upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
727              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)  
728         clwcon0 = qcondc         clwcon0 = qcondc
729         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
730    
731         IF (thermcep) THEN         IF (thermcep) THEN
732            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
# Line 910  contains Line 740  contains
740         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
741              rnebcon0)              rnebcon0)
742    
743           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
744         mfd = 0.         mfd = 0.
745         pen_u = 0.         pen_u = 0.
746         pen_d = 0.         pen_d = 0.
747         pde_d = 0.         pde_d = 0.
748         pde_u = 0.         pde_u = 0.
749        else
750           conv_q = d_q_dyn + d_q_vdf / dtphys
751           conv_t = d_t_dyn + d_t_vdf / dtphys
752           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
753           CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
754                q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
755                d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
756                mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
757                kdtop, pmflxr, pmflxs)
758           WHERE (rain_con < 0.) rain_con = 0.
759           WHERE (snow_con < 0.) snow_con = 0.
760           ibas_con = llm + 1 - kcbot
761           itop_con = llm + 1 - kctop
762      END if      END if
763    
764      DO k = 1, llm      DO k = 1, llm
# Line 926  contains Line 770  contains
770         ENDDO         ENDDO
771      ENDDO      ENDDO
772    
773      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  
774         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
775         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
776         DO k = 1, llm         DO k = 1, llm
# Line 975  contains Line 797  contains
797         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
798         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
799      else      else
        ! Thermiques  
800         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
801              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)
802      endif      endif
803    
     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  
   
804      ! Caclul des ratqs      ! Caclul des ratqs
805    
806      ! 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 1007  contains Line 822  contains
822      do k = 1, llm      do k = 1, llm
823         do i = 1, klon         do i = 1, klon
824            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
825                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
826         enddo         enddo
827      enddo      enddo
828    
# Line 1040  contains Line 855  contains
855            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
856         ENDDO         ENDDO
857      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  
858    
859      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
860    
# Line 1076  contains Line 870  contains
870            do k = 1, llm            do k = 1, llm
871               do i = 1, klon               do i = 1, klon
872                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
873                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
874                          *zmasse(i, k)                          * zmasse(i, k)
875                  endif                  endif
876               enddo               enddo
877            enddo            enddo
# Line 1112  contains Line 906  contains
906    
907         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
908         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
909         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
910      ENDIF      ENDIF
911    
912      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1135  contains Line 929  contains
929         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
930      ENDDO      ENDDO
931    
     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)  
   
932      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
933      DO k = 1, llm      DO k = 1, llm
934         DO i = 1, klon         DO i = 1, klon
935            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
936            IF (thermcep) THEN            IF (thermcep) THEN
937               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
938               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
939               zcor = 1./(1. - retv*zx_qs)               zcor = 1. / (1. - retv * zx_qs)
940               zx_qs = zx_qs*zcor               zx_qs = zx_qs * zcor
941            ELSE            ELSE
942               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
943                  zx_qs = qsats(zx_t)/play(i, k)                  zx_qs = qsats(zx_t) / play(i, k)
944               ELSE               ELSE
945                  zx_qs = qsatl(zx_t)/play(i, k)                  zx_qs = qsatl(zx_t) / play(i, k)
946               ENDIF               ENDIF
947            ENDIF            ENDIF
948            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k) / zx_qs
949            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
950         ENDDO         ENDDO
951      ENDDO      ENDDO
952    
953      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
954      IF (ok_ade .OR. ok_aie) THEN      tau_ae = 0.
955         ! Get sulfate aerosol distribution :      piz_ae = 0.
956         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  
957    
958      ! Param\`etres optiques des nuages et quelques param\`etres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
959      ! diagnostics :      ! diagnostics :
# Line 1192  contains Line 973  contains
973         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
974    
975         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
976         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
977              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
978              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
979              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
# Line 1204  contains Line 985  contains
985    
986      DO k = 1, llm      DO k = 1, llm
987         DO i = 1, klon         DO i = 1, klon
988            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 &
989                   / 86400.
990         ENDDO         ENDDO
991      ENDDO      ENDDO
992    
     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  
   
993      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
994      DO i = 1, klon      DO i = 1, klon
995         zxqsurf(i) = 0.         zxqsurf(i) = 0.
# Line 1223  contains Line 997  contains
997      ENDDO      ENDDO
998      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
999         DO i = 1, klon         DO i = 1, klon
1000            zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf)*pctsrf(i, nsrf)            zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf) * pctsrf(i, nsrf)
1001            zxsnow(i) = zxsnow(i) + fsnow(i, nsrf)*pctsrf(i, nsrf)            zxsnow(i) = zxsnow(i) + fsnow(i, nsrf) * pctsrf(i, nsrf)
1002         ENDDO         ENDDO
1003      ENDDO      ENDDO
1004    
# Line 1244  contains Line 1018  contains
1018            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
1019               itest(i) = 1               itest(i) = 1
1020               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1021            ENDIF            ENDIF
1022         ENDDO         ENDDO
1023    
# Line 1270  contains Line 1043  contains
1043            IF (zpic(i) - zmea(i) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
1044               itest(i) = 1               itest(i) = 1
1045               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1046            ENDIF            ENDIF
1047         ENDDO         ENDDO
1048    
# Line 1306  contains Line 1078  contains
1078      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1079           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1080    
     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)  
   
1081      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1082      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
1083           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, &
1084           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, &           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &
1085           dnwd, tr_seri, zmasse, ncid_startphy, nid_ins)           zmasse, ncid_startphy)
1086    
1087      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, &
1088           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, &
1089           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)           frac_impa, frac_nucl, pphis, airephy, dtphys)
1090    
1091      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1092      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)
1093    
1094      ! diag. bilKP      ! diag. bilKP
1095    
1096      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &      CALL transp_lay(paprs, t_seri, q_seri, u_seri, v_seri, zphi, &
1097           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1098    
1099      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1100    
1101      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
1102      DO k = 1, llm      DO k = 1, llm
1103         DO i = 1, klon         DO i = 1, klon
1104            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
# Line 1341  contains Line 1109  contains
1109         END DO         END DO
1110      END DO      END DO
1111    
     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  
   
1112      ! SORTIES      ! SORTIES
1113    
1114      ! prw = eau precipitable      ! prw = eau precipitable
1115      DO i = 1, klon      DO i = 1, klon
1116         prw(i) = 0.         prw(i) = 0.
1117         DO k = 1, llm         DO k = 1, llm
1118            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1119         ENDDO         ENDDO
1120      ENDDO      ENDDO
1121    
# Line 1392  contains Line 1147  contains
1147         ENDDO         ENDDO
1148      ENDDO      ENDDO
1149    
1150      call write_histins      CALL histwrite_phy("phis", pphis)
1151        CALL histwrite_phy("aire", airephy)
1152        CALL histwrite_phy("psol", paprs(:, 1))
1153        CALL histwrite_phy("precip", rain_fall + snow_fall)
1154        CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1155        CALL histwrite_phy("pluc", rain_con + snow_con)
1156        CALL histwrite_phy("tsol", ztsol)
1157        CALL histwrite_phy("t2m", zt2m)
1158        CALL histwrite_phy("q2m", zq2m)
1159        CALL histwrite_phy("u10m", zu10m)
1160        CALL histwrite_phy("v10m", zv10m)
1161        CALL histwrite_phy("snow", snow_fall)
1162        CALL histwrite_phy("cdrm", cdragm)
1163        CALL histwrite_phy("cdrh", cdragh)
1164        CALL histwrite_phy("topl", toplw)
1165        CALL histwrite_phy("evap", evap)
1166        CALL histwrite_phy("sols", solsw)
1167        CALL histwrite_phy("soll", sollw)
1168        CALL histwrite_phy("solldown", sollwdown)
1169        CALL histwrite_phy("bils", bils)
1170        CALL histwrite_phy("sens", - sens)
1171        CALL histwrite_phy("fder", fder)
1172        CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1173        CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1174        CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1175        CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
1176    
1177        DO nsrf = 1, nbsrf
1178           CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1179           CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1180           CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1181           CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1182           CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1183           CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1184           CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1185           CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1186           CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1187        END DO
1188    
1189        CALL histwrite_phy("albs", albsol)
1190        CALL histwrite_phy("rugs", zxrugs)
1191        CALL histwrite_phy("s_pblh", s_pblh)
1192        CALL histwrite_phy("s_pblt", s_pblt)
1193        CALL histwrite_phy("s_lcl", s_lcl)
1194        CALL histwrite_phy("s_capCL", s_capCL)
1195        CALL histwrite_phy("s_oliqCL", s_oliqCL)
1196        CALL histwrite_phy("s_cteiCL", s_cteiCL)
1197        CALL histwrite_phy("s_therm", s_therm)
1198        CALL histwrite_phy("s_trmb1", s_trmb1)
1199        CALL histwrite_phy("s_trmb2", s_trmb2)
1200        CALL histwrite_phy("s_trmb3", s_trmb3)
1201    
1202        if (conv_emanuel) then
1203           CALL histwrite_phy("ptop", ema_pct)
1204           CALL histwrite_phy("dnwd0", - mp)
1205        end if
1206    
1207        CALL histwrite_phy("temp", t_seri)
1208        CALL histwrite_phy("vitu", u_seri)
1209        CALL histwrite_phy("vitv", v_seri)
1210        CALL histwrite_phy("geop", zphi)
1211        CALL histwrite_phy("pres", play)
1212        CALL histwrite_phy("dtvdf", d_t_vdf)
1213        CALL histwrite_phy("dqvdf", d_q_vdf)
1214        CALL histwrite_phy("rhum", zx_rh)
1215    
1216        if (ok_instan) call histsync(nid_ins)
1217    
1218      IF (lafin) then      IF (lafin) then
1219         call NF95_CLOSE(ncid_startphy)         call NF95_CLOSE(ncid_startphy)
1220         CALL phyredem(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &         CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1221              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1222              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1223              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
# Line 1405  contains Line 1226  contains
1226    
1227      firstcal = .FALSE.      firstcal = .FALSE.
1228    
   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 histsync(nid_ins)  
       ENDIF  
   
     end subroutine write_histins  
   
1229    END SUBROUTINE physiq    END SUBROUTINE physiq
1230    
1231  end module physiq_m  end module physiq_m
Legend:
Removed from v.174  
changed lines
  Added in v.206
  ViewVC Help
Powered by ViewVC 1.1.21