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

Diff of /trunk/phylmd/physiq.f90

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

trunk/Sources/phylmd/physiq.f revision 159 by guez, Tue Jul 21 15:29:52 2015 UTC trunk/phylmd/physiq.f90 revision 330 by guez, Wed Jul 31 14:55:23 2019 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, ok_instan
22           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin      USE clesphys2, ONLY: conv_emanuel, nbapp_rad, new_oliq, ok_orodr, ok_orolf
23      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE conf_interface_m, ONLY: conf_interface
24           ok_orodr, ok_orolf      USE pbl_surface_m, ONLY: pbl_surface
     USE clmain_m, ONLY: clmain  
25      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
26      use comconst, only: dtphys      use comconst, only: dtphys
27      USE comgeomphy, ONLY: airephy      USE comgeomphy, ONLY: airephy
28      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
29      USE conf_gcm_m, ONLY: offline, raz_date, day_step, iphysiq      USE conf_gcm_m, ONLY: lmt_pas
30      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
31      use conflx_m, only: conflx      use conflx_m, only: conflx
32      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm_m, ONLY: iflag_thermals, ctherm
33      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
34      use diagetpq_m, only: diagetpq      USE dimensions, ONLY: llm, nqmx
     use diagphy_m, only: diagphy  
     USE dimens_m, ONLY: llm, nqmx  
35      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
37      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
38      use dynetat0_m, only: day_ref, annee_ref      use dynetat0_chosen_m, only: day_ref, annee_ref
39      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew
40      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
41      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
42      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &      USE histsync_m, ONLY: histsync
43           nbsrf      USE histwrite_phy_m, ONLY: histwrite_phy
44      USE ini_histins_m, ONLY: ini_histins      USE indicesol, ONLY: clnsurf, epsfra, nbsrf
45        USE ini_histins_m, ONLY: ini_histins, nid_ins
46        use lift_noro_m, only: lift_noro
47      use netcdf95, only: NF95_CLOSE      use netcdf95, only: NF95_CLOSE
48      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
49        use nr_util, only: assert
50        use nuage_m, only: nuage
51      USE orbite_m, ONLY: orbite      USE orbite_m, ONLY: orbite
52      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
53      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0
54      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
55      USE phyredem0_m, ONLY: phyredem0      USE phyredem0_m, ONLY: phyredem0
     USE phystokenc_m, ONLY: phystokenc  
56      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
57      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
     use readsulfate_m, only: readsulfate  
     use readsulfate_preind_m, only: readsulfate_preind  
58      use yoegwd, only: sugwd      use yoegwd, only: sugwd
59      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt, rmo3, md
60      USE temps, ONLY: itau_phy      use time_phylmdz, only: itap, increment_itap
61        use transp_m, only: transp
62        use transp_lay_m, only: transp_lay
63      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
64      USE ymds2ju_m, ONLY: ymds2ju      USE ymds2ju_m, ONLY: ymds2ju
65      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
# Line 80  contains Line 78  contains
78      REAL, intent(in):: play(:, :) ! (klon, llm)      REAL, intent(in):: play(:, :) ! (klon, llm)
79      ! pression pour le mileu de chaque couche (en Pa)      ! pression pour le mileu de chaque couche (en Pa)
80    
81      REAL, intent(in):: pphi(:, :) ! (klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
82      ! géopotentiel de chaque couche (référence sol)      ! géopotentiel de chaque couche (référence sol)
83    
84      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
85    
86      REAL, intent(in):: u(:, :) ! (klon, llm)      REAL, intent(in):: u(:, :) ! (klon, llm)
87      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m / s
88    
89      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
90      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
91    
92      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
93      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
94    
95      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
96      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)
97      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)
98      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)
99    
100      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
101      ! tendance physique de "qx" (s-1)      ! tendance physique de "qx" (s-1)
# Line 106  contains Line 104  contains
104    
105      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
106    
     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  
   
107      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
108      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
109    
110      ! "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  
111      REAL fm_therm(klon, llm + 1)      REAL fm_therm(klon, llm + 1)
112      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
113      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
# Line 139  contains Line 118  contains
118      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
119      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
120    
121      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
122      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)
123    
124      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
125    
126      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
127      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  
128    
129      ! Amip2      REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
130      ! variables a une pression donnee      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
   
     integer nlevSTD  
     PARAMETER(nlevSTD = 17)  
131    
132      ! prw: precipitable water      ! prw: precipitable water
133      real prw(klon)      real prw(klon)
134    
135      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
136      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
137      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
138      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
139    
     INTEGER kmax, lmax  
     PARAMETER(kmax = 8, lmax = 8)  
     INTEGER kmaxm1, lmaxm1  
     PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)  
   
140      ! Variables propres a la physique      ! Variables propres a la physique
141    
142      INTEGER, save:: radpas      INTEGER, save:: radpas
143      ! Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
144      ! "physiq".      ! "physiq".
145    
146      REAL radsol(klon)      REAL, save:: radsol(klon)
147      SAVE radsol ! bilan radiatif au sol calcule par code radiatif      ! Bilan radiatif net au sol (W/m2), positif vers le bas. Must be
148        ! saved because radlwsw is not called at every time step.
149      INTEGER:: itap = 0 ! number of calls to "physiq"      
150        REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction, in K
     REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction  
151    
152      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
153      ! soil temperature of surface fraction      ! soil temperature of surface fraction
154    
155      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL fluxlat(klon, nbsrf) ! flux de chaleur latente, en W m-2
     REAL 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
159    
160      REAL, save:: qsol(klon)      REAL, save:: qsol(klon) ! column-density of water in soil, in kg m-2
161      ! column-density of water in soil, in kg m-2  
162        REAL, save:: fsnow(klon, nbsrf)
163        ! column-density of mass of snow at the surface, in kg m-2
164    
     REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse  
165      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
166    
167      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
# Line 209  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 ktest(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
     !KE43  
     ! 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 locales pour la couche limite (al1):  
   
     ! Variables locales:  
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    
190      ! Pour phytrac :      REAL coefh(klon, 2:llm) ! coef d'echange pour phytrac
191      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac  
192      REAL yu1(klon) ! vents dans la premiere couche U      REAL, save:: ffonte(klon, nbsrf)
193      REAL yv1(klon) ! vents dans la premiere couche V      ! flux thermique utilise pour fondre la neige
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 fqcalving(klon, nbsrf)
196      ! !et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et n\'ecessaire pour limiter
197      ! !hauteur de neige, en kg/m2/s      ! la hauteur de neige, en kg / m2 / s
198      REAL zxffonte(klon), zxfqcalving(klon)  
199        REAL zxffonte(klon)
200      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction  
201      save pfrac_impa      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
202      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
203      save pfrac_nucl  
204      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      REAL, save:: pfrac_1nucl(klon, llm)
205      save pfrac_1nucl      ! Produits des coefs lessi nucl (alpha = 1)
206      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)  
207        REAL frac_impa(klon, llm) ! fraction d'a\'erosols lessiv\'es (impaction)
208      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
209    
210      REAL, save:: rain_fall(klon)      REAL, save:: rain_fall(klon)
211      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
212    
213      REAL, save:: snow_fall(klon)      REAL, save:: snow_fall(klon)
214      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg / m2 / s), positive down
215    
216      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
217    
218      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
219      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real dflux_q(klon) ! derivative of the evaporation flux at the surface
220      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
221      SAVE dlw      real dflux_t(klon) ! derivee du flux de chaleur sensible au sol
222      REAL bils(klon) ! bilan de chaleur au sol      REAL, save:: dlw(klon) ! derivative of infra-red flux
223      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! d\'erive de flux (sensible et latente)
224      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
225      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
226      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
# Line 280  contains Line 232  contains
232      ! Conditions aux limites      ! Conditions aux limites
233    
234      INTEGER julien      INTEGER julien
     INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day  
235      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
236      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE      REAL, save:: albsol(klon) ! albedo du sol total, visible, moyen par maille
     REAL, save:: albsol(klon) ! albedo du sol total visible  
237      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
238        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
     ! Declaration des procedures appelees  
   
     EXTERNAL nuage ! calculer les proprietes radiatives  
     EXTERNAL transp ! transport total de l'eau et de l'energie  
   
     ! Variables locales  
239    
240      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
241      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
242    
243      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humidit\'e relative ciel clair
244      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
245      REAL diafra(klon, llm) ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
246      REAL cldliq(klon, llm) ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
# Line 304  contains Line 248  contains
248      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
249      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
250    
251      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
252      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur  
253      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_t(klon, nbsrf)
254      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v      ! flux de chaleur sensible (c_p T) (W / m2) (orientation positive
255        ! vers le bas) à la surface
256      REAL zxfluxt(klon, llm)  
257      REAL zxfluxq(klon, llm)      REAL flux_u(klon, nbsrf), flux_v(klon, nbsrf)
258      REAL zxfluxu(klon, llm)      ! tension du vent (flux turbulent de vent) à la surface, en Pa
     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 321  contains Line 264  contains
264      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
265      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
266      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
267      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface  
268      real, save:: sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! surface net downward longwave flux, in W m-2
269        real, save:: sollwdown(klon) ! downwelling longwave flux at surface
270      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
271      REAL, save:: albpla(klon)      REAL, save:: albpla(klon)
     REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface  
     REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface  
   
     REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)  
     REAL conv_t(klon, llm) ! convergence of temperature (K/s)  
272    
273      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
274      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL conv_t(klon, llm) ! convergence of temperature (K / s)
275    
276      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
277        REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
278    
279        REAL zxfluxlat(klon)
280      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
281      real longi      real longi
282      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
283      REAL za, zb      REAL zb
284      REAL zx_t, zx_qs, zcor      REAL zx_qs, zcor
285      real zqsat(klon, llm)      real zqsat(klon, llm)
286      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
287      REAL zphi(klon, llm)      REAL zphi(klon, llm)
288    
289      ! cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
290    
291      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
292      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
293      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
294      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
295      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
296      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
297      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
298      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      ! Grandeurs de sorties
     REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition  
     REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega  
     ! Grdeurs de sorties  
299      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
300      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
301      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon)
     REAL s_trmb3(klon)  
302    
303      ! Variables locales pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
304    
305      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
306      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
307      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
308    
309      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
310    
# Line 382  contains Line 316  contains
316      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
317      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
318      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
319      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
320      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
321      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
322      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 396  contains Line 330  contains
330      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
331    
332      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
333        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
334    
335      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon)
336      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
337      REAL d_ts(klon, nbsrf)      REAL snow_con(klon) ! neige (mm / s)
338        real snow_lsc(klon)
339    
340      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
341      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)
# Line 422  contains Line 358  contains
358      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
359      logical ptconv(klon, llm)      logical ptconv(klon, llm)
360    
361      ! Variables locales pour effectuer les appels en s\'erie :      ! Variables pour effectuer les appels en s\'erie :
362    
363      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
364      REAL ql_seri(klon, llm)      REAL ql_seri(klon, llm)
# Line 433  contains Line 369  contains
369    
370      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
371      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
     REAL zustrph(klon), zvstrph(klon)  
372      REAL aam, torsfc      REAL aam, torsfc
373    
     REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique  
   
     INTEGER, SAVE:: nid_ins  
   
374      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.
375      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.
376      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.
377      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.
378    
379      real date0      REAL tsol(klon)
380    
381      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :      REAL d_t_ec(klon, llm)
382      REAL ztsol(klon)      ! tendance due \`a la conversion d'\'energie cin\'etique en
383      REAL d_h_vcol, d_qt, d_ec      ! énergie thermique
384      REAL, SAVE:: d_h_vcol_phy  
385      REAL zero_v(klon)      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
386      CHARACTER(LEN = 20) tit      ! temperature and humidity at 2 m
387      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
388      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      REAL, save:: u10m_srf(klon, nbsrf), v10m_srf(klon, nbsrf)
389        ! composantes du vent \`a 10 m
390      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique      
391      REAL ZRCPD      REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
392        REAL u10m(klon), v10m(klon) ! vent \`a 10 m moyenn\' sur les sous-surfaces
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m  
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m  
     REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille  
     REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille  
393    
394      ! Aerosol effects:      ! Aerosol effects:
395    
396      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
   
     REAL, save:: sulfate_pi(klon, llm)  
     ! SO4 aerosol concentration, in micro g/m3, pre-industrial value  
   
     REAL cldtaupi(klon, llm)  
     ! cloud optical thickness for pre-industrial (pi) aerosols  
   
     REAL re(klon, llm) ! Cloud droplet effective radius  
     REAL fl(klon, llm) ! denominator of re  
   
     ! Aerosol optical properties  
     REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)  
     REAL, save:: cg_ae(klon, llm, 2)  
   
     REAL topswad(klon), solswad(klon) ! aerosol direct effect  
     REAL topswai(klon), solswai(klon) ! aerosol indirect effect  
   
     REAL aerindex(klon) ! POLDER aerosol index  
   
397      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
     LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect  
398    
399      REAL:: bl95_b0 = 2., bl95_b1 = 0.2      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
400      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
401      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
402      ! concentration.      ! concentration.
403    
404      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)  
405      ! (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)
406    
     real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2  
407      integer, save:: ncid_startphy      integer, save:: ncid_startphy
408    
409      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
410           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           ratqsbas, ratqshaut, ok_ade, bl95_b0, bl95_b1
          ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals  
411    
412      !----------------------------------------------------------------      !----------------------------------------------------------------
413    
     IF (if_ebil >= 1) zero_v = 0.  
414      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
415           'eaux vapeur et liquide sont indispensables', 1)           'eaux vapeur et liquide sont indispensables')
416    
417      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
418         ! initialiser         ! initialiser
419         u10m = 0.         u10m_srf = 0.
420         v10m = 0.         v10m_srf = 0.
421         t2m = 0.         t2m = 0.
422         q2m = 0.         q2m = 0.
423         ffonte = 0.         ffonte = 0.
        fqcalving = 0.  
        piz_ae = 0.  
        tau_ae = 0.  
        cg_ae = 0.  
        rain_con = 0.  
        snow_con = 0.  
        topswai = 0.  
        topswad = 0.  
        solswai = 0.  
        solswad = 0.  
   
424         d_u_con = 0.         d_u_con = 0.
425         d_v_con = 0.         d_v_con = 0.
426         rnebcon0 = 0.         rnebcon0 = 0.
427         clwcon0 = 0.         clwcon0 = 0.
428         rnebcon = 0.         rnebcon = 0.
429         clwcon = 0.         clwcon = 0.
   
430         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
431         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
432         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
433         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
434         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
435         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
436         therm =0.         therm =0.
        trmb1 =0. ! deep_cape  
        trmb2 =0. ! inhibition  
        trmb3 =0. ! Point Omega  
   
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
437    
        iflag_thermals = 0  
        nsplit_thermals = 1  
438         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
439         read(unit=*, nml=physiq_nml)         read(unit=*, nml=physiq_nml)
440         write(unit_nml, nml=physiq_nml)         write(unit_nml, nml=physiq_nml)
441    
442           call ctherm
443         call conf_phys         call conf_phys
444    
445         ! Initialiser les compteurs:         ! Initialiser les compteurs:
446    
447         frugs = 0.         frugs = 0.
448         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
449              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, &
450              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
451              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01, &
452              run_off_lic_0, sig1, w01, ncid_startphy)              ncid_startphy)
453    
454         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
455         q2 = 1e-8         q2 = 1e-8
456    
        lmt_pas = day_step / iphysiq  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
457         radpas = lmt_pas / nbapp_rad         radpas = lmt_pas / nbapp_rad
458           print *, "radpas = ", radpas
        ! On remet le calendrier a zero  
        IF (raz_date) itau_phy = 0  
   
        CALL printflag(radpas, ok_journe, ok_instan, ok_region)  
459    
460         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
461         IF (iflag_con >= 3) THEN         IF (conv_emanuel) THEN
462            ibas_con = 1            ibas_con = 1
463            itop_con = 1            itop_con = 1
464         ENDIF         ENDIF
# Line 606  contains Line 470  contains
470            rugoro = 0.            rugoro = 0.
471         ENDIF         ENDIF
472    
        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)  
   
473         ! Initialisation des sorties         ! Initialisation des sorties
474           call ini_histins(ok_newmicro)
475         call ini_histins(dtphys, ok_instan, nid_ins)         CALL phyredem0
476         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)         call conf_interface
        ! Positionner date0 pour initialisation de ORCHIDEE  
        print *, 'physiq date0: ', date0  
        CALL phyredem0(lmt_pas)  
477      ENDIF test_firstcal      ENDIF test_firstcal
478    
479      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
# Line 630  contains Line 485  contains
485      ql_seri = qx(:, :, iliq)      ql_seri = qx(:, :, iliq)
486      tr_seri = qx(:, :, 3:nqmx)      tr_seri = qx(:, :, 3:nqmx)
487    
488      ztsol = sum(ftsol * pctsrf, dim = 2)      tsol = sum(ftsol * pctsrf, dim = 2)
   
     IF (if_ebil >= 1) THEN  
        tit = 'after dynamics'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        ! Comme les tendances de la physique sont ajout\'es dans la  
        !  dynamique, la variation d'enthalpie par la dynamique devrait  
        !  \^etre \'egale \`a la variation de la physique au pas de temps  
        !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre  
        !  nulle.  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &  
             d_qt, 0.)  
     END IF  
489    
490      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
491      IF (ancien_ok) THEN      IF (ancien_ok) THEN
# Line 674  contains Line 515  contains
515      ! Check temperatures:      ! Check temperatures:
516      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
517    
518      ! Incrémenter le compteur de la physique      call increment_itap
     itap = itap + 1  
519      julien = MOD(dayvrai, 360)      julien = MOD(dayvrai, 360)
520      if (julien == 0) julien = 360      if (julien == 0) julien = 360
521    
522      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
523    
     ! Prescrire l'ozone :  
     wo = ozonecm(REAL(julien), paprs)  
   
524      ! \'Evaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
525      DO k = 1, llm      DO k = 1, llm
526         DO i = 1, klon         DO i = 1, klon
# Line 695  contains Line 532  contains
532      ENDDO      ENDDO
533      ql_seri = 0.      ql_seri = 0.
534    
     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  
   
535      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
536      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
537    
538      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
539      ! la surface.      ! la surface.
540    
541      CALL orbite(REAL(julien), longi, dist)      CALL orbite(REAL(julien), longi, dist)
542      IF (cycle_diurne) THEN      CALL zenang(longi, time, dtphys * radpas, mu0, fract)
        CALL zenang(longi, time, dtphys * radpas, mu0, fract)  
     ELSE  
        mu0 = -999.999  
     ENDIF  
   
     ! Calcul de l'abedo moyen par maille  
     albsol = sum(falbe * pctsrf, dim = 2)  
543    
544      ! R\'epartition sous maille des flux longwave et shortwave      CALL pbl_surface(pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
545      ! R\'epartition du longwave par sous-surface lin\'earis\'ee           ftsol, cdmmax, cdhmax, ftsoil, qsol, paprs, play, fsnow, fqsurf, &
546             falbe, fluxlat, rain_fall, snow_fall, frugs, agesno, rugoro, d_t_vdf, &
547      forall (nsrf = 1: nbsrf)           d_q_vdf, d_u_vdf, d_v_vdf, flux_t, flux_q, flux_u, flux_v, cdragh, &
548         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &           cdragm, q2, dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, v10m_srf, &
549              * (ztsol - ftsol(:, nsrf))           pblh, capCL, oliqCL, cteiCL, pblT, therm, plcl, fqcalving, ffonte, &
550         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)           run_off_lic_0, albsol, sollw, solsw, tsol)
     END forall  
   
     fder = dlw  
   
     ! Couche limite:  
   
     CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &  
          v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &  
          ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &  
          fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, &  
          firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &  
          fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &  
          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)  
551    
552      ! Incr\'ementation des flux      ! Incr\'ementation des flux
553    
554      zxfluxt = 0.      sens = sum(flux_t * pctsrf, dim = 2)
555      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
556      zxfluxu = 0.      fder = dlw + dflux_t + dflux_q
     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  
557    
558      DO k = 1, llm      DO k = 1, llm
559         DO i = 1, klon         DO i = 1, klon
# Line 773  contains Line 564  contains
564         ENDDO         ENDDO
565      ENDDO      ENDDO
566    
567      IF (if_ebil >= 2) THEN      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
568         tit = 'after clmain'      tsol = sum(ftsol * pctsrf, dim = 2)
569         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &      zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
570              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)      zt2m = sum(t2m * pctsrf, dim = 2)
571         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &      zq2m = sum(q2m * pctsrf, dim = 2)
572              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)      u10m = sum(u10m_srf * pctsrf, dim = 2)
573      END IF      v10m = sum(v10m_srf * pctsrf, dim = 2)
574        zxffonte = sum(ffonte * pctsrf, dim = 2)
575      ! Update surface temperature:      s_pblh = sum(pblh * pctsrf, dim = 2)
576        s_lcl = sum(plcl * pctsrf, dim = 2)
577      DO i = 1, klon      s_capCL = sum(capCL * pctsrf, dim = 2)
578         zxtsol(i) = 0.      s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
579         zxfluxlat(i) = 0.      s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
580        s_pblT = sum(pblT * pctsrf, dim = 2)
581         zt2m(i) = 0.      s_therm = sum(therm * pctsrf, dim = 2)
        zq2m(i) = 0.  
        zu10m(i) = 0.  
        zv10m(i) = 0.  
        zxffonte(i) = 0.  
        zxfqcalving(i) = 0.  
   
        s_pblh(i) = 0.  
        s_lcl(i) = 0.  
        s_capCL(i) = 0.  
        s_oliqCL(i) = 0.  
        s_cteiCL(i) = 0.  
        s_pblT(i) = 0.  
        s_therm(i) = 0.  
        s_trmb1(i) = 0.  
        s_trmb2(i) = 0.  
        s_trmb3(i) = 0.  
   
        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  
582    
583      ! 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 :
584      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
585         DO i = 1, klon         DO i = 1, klon
586            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
587                 ftsol(i, nsrf) = tsol(i)
588            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
589            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
590            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m_srf(i, nsrf) = u10m(i)
591            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m_srf(i, nsrf) = v10m(i)
592            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
593            IF (pctsrf(i, nsrf) < epsfra) &               pblh(i, nsrf) = s_pblh(i)
594                 fqcalving(i, nsrf) = zxfqcalving(i)               plcl(i, nsrf) = s_lcl(i)
595            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               capCL(i, nsrf) = s_capCL(i)
596            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               oliqCL(i, nsrf) = s_oliqCL(i)
597            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
598            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               pblT(i, nsrf) = s_pblT(i)
599            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               therm(i, nsrf) = s_therm(i)
600            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)            end IF
           IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)  
601         ENDDO         ENDDO
602      ENDDO      ENDDO
603    
604      ! Calculer la dérive du flux infrarouge      dlw = - 4. * RSIGMA * tsol**3
605    
606      DO i = 1, klon      ! Appeler la convection
607         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3  
608      ENDDO      if (conv_emanuel) then
609           CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
610      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
611                upwd, dnwd, Ma, cape, iflagctrl, clwcon0, pmflxr, da, phi, mp)
612      ! Appeler la convection (au choix)         snow_con = 0.
   
     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  
   
        da = 0.  
        mp = 0.  
        phi = 0.  
        CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &  
             w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &  
             ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &  
             qcondc, wd, pmflxr, pmflxs, da, phi, mp)  
        clwcon0 = qcondc  
613         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
614    
615         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
616            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  
617    
618         ! Properties of convective clouds         ! Properties of convective clouds
619         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
620         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
621              rnebcon0)              rnebcon0)
622    
623           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
624         mfd = 0.         mfd = 0.
625         pen_u = 0.         pen_u = 0.
626         pen_d = 0.         pen_d = 0.
627         pde_d = 0.         pde_d = 0.
628         pde_u = 0.         pde_u = 0.
629        else
630           conv_q = d_q_dyn + d_q_vdf / dtphys
631           conv_t = d_t_dyn + d_t_vdf / dtphys
632           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
633           CALL conflx(paprs, play, t_seri(:, llm:1:- 1), q_seri(:, llm:1:- 1), &
634                conv_t, conv_q, - evap, omega, d_t_con, d_q_con, rain_con, &
635                snow_con, mfu(:, llm:1:- 1), mfd(:, llm:1:- 1), pen_u, pde_u, &
636                pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, pmflxs)
637           WHERE (rain_con < 0.) rain_con = 0.
638           WHERE (snow_con < 0.) snow_con = 0.
639           ibas_con = llm + 1 - kcbot
640           itop_con = llm + 1 - kctop
641      END if      END if
642    
643      DO k = 1, llm      DO k = 1, llm
# Line 926  contains Line 649  contains
649         ENDDO         ENDDO
650      ENDDO      ENDDO
651    
652      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  
653         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
654         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
655         DO k = 1, llm         DO k = 1, llm
656            DO i = 1, klon            DO i = 1, klon
657               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN               IF (z_factor(i) /= 1.) THEN
658                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
659               ENDIF               ENDIF
660            ENDDO            ENDDO
# Line 969  contains Line 670  contains
670      fm_therm = 0.      fm_therm = 0.
671      entr_therm = 0.      entr_therm = 0.
672    
673      if (iflag_thermals == 0) then      if (iflag_thermals) then
674         ! Ajustement sec         call calltherm(play, paprs, pphi, u_seri, v_seri, t_seri, q_seri, &
675                d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
676        else
677         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)
678         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
679         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
     else  
        ! Thermiques  
        call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &  
             q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)  
680      endif      endif
681    
     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  
   
682      ! Caclul des ratqs      ! Caclul des ratqs
683    
     ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q  
     ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno  
684      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
685           ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
686           ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
687         do k = 1, llm         do k = 1, llm
688            do i = 1, klon            do i = 1, klon
689               if(ptconv(i, k)) then               if(ptconv(i, k)) then
# Line 1007  contains Line 700  contains
700      do k = 1, llm      do k = 1, llm
701         do i = 1, klon         do i = 1, klon
702            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
703                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
704         enddo         enddo
705      enddo      enddo
706    
# Line 1024  contains Line 717  contains
717         ratqs = ratqss         ratqs = ratqss
718      endif      endif
719    
720      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(paprs, play, t_seri, q_seri, ptconv, ratqs, d_t_lsc, &
721           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &           d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, pfrac_impa, &
722           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, psfl, rhcl)
          psfl, rhcl)  
723    
724      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
725      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1040  contains Line 732  contains
732            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
733         ENDDO         ENDDO
734      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  
735    
736      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
737    
738      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
739    
740      IF (iflag_cldcon <= -1) THEN      IF (iflag_cldcon <= - 1) THEN
741         ! seulement pour Tiedtke         ! seulement pour Tiedtke
742         snow_tiedtke = 0.         snow_tiedtke = 0.
743         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
744            rain_tiedtke = rain_con            rain_tiedtke = rain_con
745         else         else
746            rain_tiedtke = 0.            rain_tiedtke = 0.
747            do k = 1, llm            do k = 1, llm
748               do i = 1, klon               do i = 1, klon
749                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
750                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
751                          *zmasse(i, k)                          * zmasse(i, k)
752                  endif                  endif
753               enddo               enddo
754            enddo            enddo
# Line 1112  contains Line 783  contains
783    
784         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
785         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
786         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
787      ENDIF      ENDIF
788    
789      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1135  contains Line 806  contains
806         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
807      ENDDO      ENDDO
808    
     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)  
   
809      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
810      DO k = 1, llm      DO k = 1, llm
811         DO i = 1, klon         DO i = 1, klon
812            zx_t = t_seri(i, k)            zx_qs = r2es * FOEEW(t_seri(i, k), rtt >= t_seri(i, k)) / play(i, k)
813            IF (thermcep) THEN            zx_qs = MIN(0.5, zx_qs)
814               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)            zcor = 1. / (1. - retv * zx_qs)
815               zx_qs = MIN(0.5, zx_qs)            zx_qs = zx_qs * zcor
816               zcor = 1./(1.-retv*zx_qs)            zx_rh(i, k) = q_seri(i, k) / zx_qs
              zx_qs = zx_qs*zcor  
           ELSE  
              IF (zx_t < t_coup) THEN  
                 zx_qs = qsats(zx_t)/play(i, k)  
              ELSE  
                 zx_qs = qsatl(zx_t)/play(i, k)  
              ENDIF  
           ENDIF  
           zx_rh(i, k) = q_seri(i, k)/zx_qs  
817            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
818         ENDDO         ENDDO
819      ENDDO      ENDDO
820    
     ! Introduce the aerosol direct and first indirect radiative forcings:  
     IF (ok_ade .OR. ok_aie) THEN  
        ! Get sulfate aerosol distribution :  
        CALL readsulfate(dayvrai, time, firstcal, sulfate)  
        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  
   
821      ! Param\`etres optiques des nuages et quelques param\`etres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
822      ! diagnostics :      ! diagnostics :
823      if (ok_newmicro) then      if (ok_newmicro) then
824         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
825              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc)
             sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)  
826      else      else
827         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
828              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq)
             bl95_b1, cldtaupi, re, fl)  
829      endif      endif
830    
831      IF (MOD(itap - 1, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
832         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         wo = ozonecm(REAL(julien), paprs)
        ! Calcul de l'abedo moyen par maille  
833         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
834           CALL radlwsw(dist, mu0, fract, paprs, play, tsol, albsol, t_seri, &
        ! Rayonnement (compatible Arpege-IFS) :  
        CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &  
835              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
836              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
837              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
838              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &              swup0, swup, ok_ade, topswad, solswad)
             solswad, cldtaupi, topswai, solswai)  
839      ENDIF      ENDIF
840    
841      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
842      DO k = 1, llm      DO k = 1, llm
843         DO i = 1, klon         DO i = 1, klon
844            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 &
845                   / 86400.
846         ENDDO         ENDDO
847      ENDDO      ENDDO
848    
     IF (if_ebil >= 2) THEN  
        tit = 'after rad'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
     ! Calculer l'hydrologie de la surface  
     DO i = 1, klon  
        zxqsurf(i) = 0.  
        zxsnow(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf)*pctsrf(i, nsrf)  
           zxsnow(i) = zxsnow(i) + fsnow(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
   
     ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)  
   
     DO i = 1, klon  
        bils(i) = radsol(i) - sens(i) + zxfluxlat(i)  
     ENDDO  
   
849      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
850    
851      IF (ok_orodr) THEN      IF (ok_orodr) THEN
852         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
        igwd = 0  
853         DO i = 1, klon         DO i = 1, klon
854            itest(i) = 0            ktest(i) = 0
855            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
856               itest(i) = 1               ktest(i) = 1
              igwd = igwd + 1  
              idx(igwd) = i  
857            ENDIF            ENDIF
858         ENDDO         ENDDO
859    
860         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(paprs, play, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
861              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &              ktest, t_seri, u_seri, v_seri, zulow, zvlow, zustrdr, zvstrdr, &
862              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              d_t_oro, d_u_oro, d_v_oro)
863    
864         ! ajout des tendances         ! ajout des tendances
865         DO k = 1, llm         DO k = 1, llm
# Line 1264  contains Line 873  contains
873    
874      IF (ok_orolf) THEN      IF (ok_orolf) THEN
875         ! S\'election des points pour lesquels le sch\'ema est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
        igwd = 0  
876         DO i = 1, klon         DO i = 1, klon
877            itest(i) = 0            ktest(i) = 0
878            IF ((zpic(i) - zmea(i)) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
879               itest(i) = 1               ktest(i) = 1
              igwd = igwd + 1  
              idx(igwd) = i  
880            ENDIF            ENDIF
881         ENDDO         ENDDO
882    
883         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &         CALL lift_noro(paprs, play, zmea, zstd, zpic, ktest, t_seri, u_seri, &
884              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              v_seri, zulow, zvlow, zustrli, zvstrli, d_t_lif, d_u_lif, d_v_lif)
             d_t_lif, d_u_lif, d_v_lif)  
885    
886         ! Ajout des tendances :         ! Ajout des tendances :
887         DO k = 1, llm         DO k = 1, llm
# Line 1288  contains Line 893  contains
893         ENDDO         ENDDO
894      ENDIF      ENDIF
895    
896      ! Stress n\'ecessaires : toute la physique      CALL aaam_bud(rg, romega, pphis, zustrdr, zustrli, &
897             sum((u_seri - u) / dtphys * zmasse, dim = 2), zvstrdr, &
898      DO i = 1, klon           zvstrli, sum((v_seri - v) / dtphys * zmasse, dim = 2), paprs, u, v, &
899         zustrph(i) = 0.           aam, torsfc)
        zvstrph(i) = 0.  
     ENDDO  
     DO k = 1, llm  
        DO i = 1, klon  
           zustrph(i) = zustrph(i) + (u_seri(i, k) - u(i, k)) / dtphys &  
                * zmasse(i, k)  
           zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &  
                * zmasse(i, k)  
        ENDDO  
     ENDDO  
   
     CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &  
          zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)  
   
     IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &  
          2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &  
          d_qt, d_ec)  
900    
901      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
902      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &      call phytrac(julien, time, firstcal, lafin, t, paprs, play, mfu, mfd, &
903           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &           pde_u, pen_d, coefh, cdragh, fm_therm, entr_therm, u(:, 1), v(:, 1), &
904           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, &           ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &
905           dnwd, tr_seri, zmasse, ncid_startphy, nid_ins)           tr_seri, zmasse, ncid_startphy)
   
     IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &  
          pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &  
          pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
906    
907      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
908      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
          ue, uq)  
909    
910      ! diag. bilKP      ! diag. bilKP
911    
912      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, ve_lay, &
913           ve_lay, vq_lay, ue_lay, uq_lay)           vq_lay, ue_lay, uq_lay)
914    
915      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
916    
917      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
918      DO k = 1, llm      DO k = 1, llm
919         DO i = 1, klon         DO i = 1, klon
920            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))            d_t_ec(i, k) = 0.5 / (RCPD * (1. + RVTMP2 * q_seri(i, k))) &
           d_t_ec(i, k) = 0.5 / ZRCPD &  
921                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)
922            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)
923            d_t_ec(i, k) = d_t_ec(i, k) / dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
924         END DO         END DO
925      END DO      END DO
926    
     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  
   
927      ! SORTIES      ! SORTIES
928    
929      ! prw = eau precipitable      ! prw = eau precipitable
930      DO i = 1, klon      DO i = 1, klon
931         prw(i) = 0.         prw(i) = 0.
932         DO k = 1, llm         DO k = 1, llm
933            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
934         ENDDO         ENDDO
935      ENDDO      ENDDO
936    
# Line 1380  contains Line 949  contains
949      DO iq = 3, nqmx      DO iq = 3, nqmx
950         DO k = 1, llm         DO k = 1, llm
951            DO i = 1, klon            DO i = 1, klon
952               d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys               d_qx(i, k, iq) = (tr_seri(i, k, iq - 2) - qx(i, k, iq)) / dtphys
953            ENDDO            ENDDO
954         ENDDO         ENDDO
955      ENDDO      ENDDO
# Line 1393  contains Line 962  contains
962         ENDDO         ENDDO
963      ENDDO      ENDDO
964    
965      call write_histins      CALL histwrite_phy("phis", pphis)
966        CALL histwrite_phy("aire", airephy)
967        CALL histwrite_phy("psol", paprs(:, 1))
968        CALL histwrite_phy("precip", rain_fall + snow_fall)
969        CALL histwrite_phy("plul", rain_lsc + snow_lsc)
970        CALL histwrite_phy("pluc", rain_con + snow_con)
971        CALL histwrite_phy("tsol", tsol)
972        CALL histwrite_phy("t2m", zt2m)
973        CALL histwrite_phy("q2m", zq2m)
974        CALL histwrite_phy("u10m", u10m)
975        CALL histwrite_phy("v10m", v10m)
976        CALL histwrite_phy("snow", snow_fall)
977        CALL histwrite_phy("cdrm", cdragm)
978        CALL histwrite_phy("cdrh", cdragh)
979        CALL histwrite_phy("topl", toplw)
980        CALL histwrite_phy("evap", evap)
981        CALL histwrite_phy("sols", solsw)
982        CALL histwrite_phy("rls", sollw)
983        CALL histwrite_phy("solldown", sollwdown)
984        CALL histwrite_phy("bils", radsol + sens + zxfluxlat)
985        CALL histwrite_phy("sens", sens)
986        CALL histwrite_phy("fder", fder)
987        CALL histwrite_phy("zxfqcalving", sum(fqcalving * pctsrf, dim = 2))
988        CALL histwrite_phy("albs", albsol)
989        CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
990        CALL histwrite_phy("rugs", zxrugs)
991        CALL histwrite_phy("s_pblh", s_pblh)
992        CALL histwrite_phy("s_pblt", s_pblt)
993        CALL histwrite_phy("s_lcl", s_lcl)
994        CALL histwrite_phy("s_capCL", s_capCL)
995        CALL histwrite_phy("s_oliqCL", s_oliqCL)
996        CALL histwrite_phy("s_cteiCL", s_cteiCL)
997        CALL histwrite_phy("s_therm", s_therm)
998        CALL histwrite_phy("temp", t_seri)
999        CALL histwrite_phy("vitu", u_seri)
1000        CALL histwrite_phy("vitv", v_seri)
1001        CALL histwrite_phy("geop", zphi)
1002        CALL histwrite_phy("pres", play)
1003        CALL histwrite_phy("dtvdf", d_t_vdf)
1004        CALL histwrite_phy("dqvdf", d_q_vdf)
1005        CALL histwrite_phy("rhum", zx_rh)
1006        CALL histwrite_phy("d_t_ec", d_t_ec)
1007        CALL histwrite_phy("dtsw0", heat0 / 86400.)
1008        CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1009        call histwrite_phy("pmflxr", pmflxr(:, :llm))
1010        CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1011        call histwrite_phy("qsurf", sum(fqsurf * pctsrf, dim = 2))
1012        call histwrite_phy("flat", zxfluxlat)
1013    
1014        DO nsrf = 1, nbsrf
1015           CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1016           CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1017           CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1018           CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1019           CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1020           CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1021           CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1022           CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1023           CALL histwrite_phy("u10m_"//clnsurf(nsrf), u10m_srf(:, nsrf))
1024           CALL histwrite_phy("v10m_"//clnsurf(nsrf), v10m_srf(:, nsrf))
1025        END DO
1026    
1027        if (conv_emanuel) then
1028           CALL histwrite_phy("ptop", ema_pct)
1029           CALL histwrite_phy("dnwd0", - mp)
1030        end if
1031    
1032        if (ok_instan) call histsync(nid_ins)
1033    
1034      IF (lafin) then      IF (lafin) then
1035         call NF95_CLOSE(ncid_startphy)         call NF95_CLOSE(ncid_startphy)
1036         CALL phyredem(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &         CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
1037              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, &
1038              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
1039              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &              rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
             w01)  
1040      end IF      end IF
1041    
1042      firstcal = .FALSE.      firstcal = .FALSE.
1043    
   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) = -1*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  
   
1044    END SUBROUTINE physiq    END SUBROUTINE physiq
1045    
1046  end module physiq_m  end module physiq_m
Legend:
Removed from v.159  
changed lines
  Added in v.330
  ViewVC Help
Powered by ViewVC 1.1.21