/[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 250 by guez, Fri Jan 5 18:18:53 2018 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
     USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &  
          ok_orodr, ok_orolf  
23      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
24      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
25      use comconst, only: dtphys      use comconst, only: dtphys
26      USE comgeomphy, ONLY: airephy      USE comgeomphy, ONLY: airephy
27      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
28      USE conf_gcm_m, ONLY: offline, raz_date, day_step, iphysiq      USE conf_gcm_m, ONLY: lmt_pas
29      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
30      use conflx_m, only: conflx      use conflx_m, only: conflx
31      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
32      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
     use diagetpq_m, only: diagetpq  
     use diagphy_m, only: diagphy  
33      USE dimens_m, ONLY: llm, nqmx      USE dimens_m, ONLY: llm, nqmx
34      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
35      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
36      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
37      use dynetat0_m, only: day_ref, annee_ref      use dynetat0_m, only: day_ref, annee_ref
38      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew
39      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
40      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
41        USE histsync_m, ONLY: histsync
42        USE histwrite_phy_m, ONLY: histwrite_phy
43      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, &
44           nbsrf           nbsrf
45      USE ini_histins_m, ONLY: ini_histins      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: 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      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 81  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 107  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 140  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) ! 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"  
   
147      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
148    
149      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
# Line 190  contains Line 151  contains
151    
152      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
153      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
     SAVE fluxlat  
154    
155      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
156      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
157    
158      REAL, save:: qsol(klon)      REAL, save:: qsol(klon) ! column-density of water in soil, in kg m-2
159      ! column-density of water in soil, in kg m-2      REAL, save:: fsnow(klon, nbsrf) ! \'epaisseur neigeuse
   
     REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse  
160      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
161    
162      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
# Line 210  contains Line 168  contains
168      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
169      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
170      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
171      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
172        INTEGER ktest(klon)
173    
174      INTEGER igwd, idx(klon), itest(klon)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
175        REAL, save:: run_off_lic_0(klon)
176    
177      REAL agesno(klon, nbsrf)      ! Variables li\'ees \`a la convection d'Emanuel :
178      SAVE agesno ! age de la neige      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
179        REAL, save:: qcondc(klon, llm) ! in-cld water content from convect
     REAL run_off_lic_0(klon)  
     SAVE run_off_lic_0  
     !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  
180      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:  
181    
182        ! Variables pour la couche limite (Alain Lahellec) :
183      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
184      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
185    
186      ! Pour phytrac :      REAL coefh(klon, 2:llm) ! coef d'echange pour phytrac
187      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac  
188      REAL yu1(klon) ! vents dans la premiere couche U      REAL, save:: ffonte(klon, nbsrf)
189      REAL yv1(klon) ! vents dans la premiere couche V      ! flux thermique utilise pour fondre la neige
190      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige  
191      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL, save:: fqcalving(klon, nbsrf)
192      ! !et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et necessaire pour limiter la
193      ! !hauteur de neige, en kg/m2/s      ! hauteur de neige, en kg / m2 / s
194    
195      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
196    
197      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
198      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
199      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
200      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
201      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
202      save pfrac_1nucl  
203      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fraction d'a\'erosols lessiv\'es (impaction)
204      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
205    
206      REAL, save:: rain_fall(klon)      REAL, save:: rain_fall(klon)
207      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
208    
209      REAL, save:: snow_fall(klon)      REAL, save:: snow_fall(klon)
210      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg / m2 / s), positive down
211    
212      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
213    
214      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
215      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
216      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
217      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
218        REAL, save:: dlw(klon) ! derivative of infra-red flux
219      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
220      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
221      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
222      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
223      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 229  contains
229      ! Conditions aux limites      ! Conditions aux limites
230    
231      INTEGER julien      INTEGER julien
     INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day  
232      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
233      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  
234      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
235        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
     ! Declaration des procedures appelees  
   
     EXTERNAL nuage ! calculer les proprietes radiatives  
   
     ! Variables locales  
236    
237      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
238      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
# Line 304  contains Line 245  contains
245      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
246      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
247    
248      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
249      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
250      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u  
251      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v      REAL flux_u(klon, nbsrf), flux_v(klon, nbsrf)
252        ! tension du vent (flux turbulent de vent) à la surface, en Pa
     REAL zxfluxt(klon, llm)  
     REAL zxfluxq(klon, llm)  
     REAL zxfluxu(klon, llm)  
     REAL zxfluxv(klon, llm)  
253    
254      ! 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
255      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
# Line 325  contains Line 262  contains
262      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
263      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
264      REAL, save:: albpla(klon)      REAL, save:: albpla(klon)
265      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
266      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
267    
268      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
269      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K / s)
270    
271      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
272      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
   
     REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)  
273    
274        REAL zxfluxlat(klon)
275      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
276      real longi      real longi
277      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
278      REAL za, zb      REAL zb
279      REAL zx_t, zx_qs, zcor      REAL zx_t, zx_qs, zcor
280      real zqsat(klon, llm)      real zqsat(klon, llm)
281      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
282      REAL zphi(klon, llm)      REAL zphi(klon, llm)
283    
284      ! cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
285    
286      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
287      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
288      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
289      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
290      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
291      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
292      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
293      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
294      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
295      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
296      ! Grdeurs de sorties      ! Grandeurs de sorties
297      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
298      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
299      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
300      REAL s_trmb3(klon)      REAL s_trmb3(klon)
301    
302      ! Variables locales pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
303    
304      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
305      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
306      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
307    
308      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
309    
# Line 382  contains Line 315  contains
315      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
316      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
317      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
318      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
319      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)
320      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
321      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 329  contains
329      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
330    
331      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
332        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
333    
334      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
335      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
336      REAL d_ts(klon, nbsrf)      REAL, save:: snow_con(klon) ! neige (mm / s)
337        real snow_lsc(klon)
338        REAL d_ts(klon, nbsrf) ! variation of ftsol
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 date0
380        REAL tsol(klon)
381    
382      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :      REAL d_t_ec(klon, llm)
383      REAL ztsol(klon)      ! tendance due \`a la conversion d'\'energie cin\'etique en
384      REAL d_h_vcol, d_qt, d_ec      ! énergie thermique
385      REAL, SAVE:: d_h_vcol_phy  
386      REAL zero_v(klon)      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
387      CHARACTER(LEN = 20) tit      ! temperature and humidity at 2 m
388      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
389      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      REAL, save:: u10m_srf(klon, nbsrf), v10m_srf(klon, nbsrf)
390        ! composantes du vent \`a 10 m
391      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique      
392      REAL ZRCPD      REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
393        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  
394    
395      ! Aerosol effects:      ! Aerosol effects:
396    
397      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  
   
398      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
     LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect  
399    
400      REAL:: bl95_b0 = 2., bl95_b1 = 0.2      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
401      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
402      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
403      ! concentration.      ! concentration.
404    
405      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)  
406      ! (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)
407    
     real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2  
408      integer, save:: ncid_startphy      integer, save:: ncid_startphy
409    
410      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
411           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           ratqsbas, ratqshaut, ok_ade, bl95_b0, bl95_b1, iflag_thermals, &
412           ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals           nsplit_thermals
413    
414      !----------------------------------------------------------------      !----------------------------------------------------------------
415    
     IF (if_ebil >= 1) zero_v = 0.  
416      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
417           'eaux vapeur et liquide sont indispensables')           'eaux vapeur et liquide sont indispensables')
418    
419      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
420         ! initialiser         ! initialiser
421         u10m = 0.         u10m_srf = 0.
422         v10m = 0.         v10m_srf = 0.
423         t2m = 0.         t2m = 0.
424         q2m = 0.         q2m = 0.
425         ffonte = 0.         ffonte = 0.
426         fqcalving = 0.         fqcalving = 0.
        piz_ae = 0.  
        tau_ae = 0.  
        cg_ae = 0.  
427         rain_con = 0.         rain_con = 0.
428         snow_con = 0.         snow_con = 0.
        topswai = 0.  
        topswad = 0.  
        solswai = 0.  
        solswad = 0.  
   
429         d_u_con = 0.         d_u_con = 0.
430         d_v_con = 0.         d_v_con = 0.
431         rnebcon0 = 0.         rnebcon0 = 0.
432         clwcon0 = 0.         clwcon0 = 0.
433         rnebcon = 0.         rnebcon = 0.
434         clwcon = 0.         clwcon = 0.
   
435         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
436         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
437         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
438         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
439         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
440         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
441         therm =0.         therm =0.
442         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
443         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
444         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
445    
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
   
446         iflag_thermals = 0         iflag_thermals = 0
447         nsplit_thermals = 1         nsplit_thermals = 1
448         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
# Line 574  contains Line 454  contains
454         ! Initialiser les compteurs:         ! Initialiser les compteurs:
455    
456         frugs = 0.         frugs = 0.
457         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
458              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &              fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
459              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
460              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &              q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
461              run_off_lic_0, sig1, w01, ncid_startphy)              w01, ncid_startphy)
462    
463         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
464         q2 = 1e-8         q2 = 1e-8
465    
        lmt_pas = day_step / iphysiq  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
466         radpas = lmt_pas / nbapp_rad         radpas = lmt_pas / nbapp_rad
467           print *, "radpas = ", radpas
        ! On remet le calendrier a zero  
        IF (raz_date) itau_phy = 0  
   
        CALL printflag(radpas, ok_journe, ok_instan, ok_region)  
468    
469         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
470         IF (iflag_con >= 3) THEN         IF (conv_emanuel) THEN
471            ibas_con = 1            ibas_con = 1
472            itop_con = 1            itop_con = 1
473         ENDIF         ENDIF
# Line 606  contains Line 479  contains
479            rugoro = 0.            rugoro = 0.
480         ENDIF         ENDIF
481    
482         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)  
483    
484         ! Initialisation des sorties         ! Initialisation des sorties
485    
486         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_newmicro)
487         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
488         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
489         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
490         CALL phyredem0(lmt_pas)         CALL phyredem0
491      ENDIF test_firstcal      ENDIF test_firstcal
492    
493      ! 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 499  contains
499      ql_seri = qx(:, :, iliq)      ql_seri = qx(:, :, iliq)
500      tr_seri = qx(:, :, 3:nqmx)      tr_seri = qx(:, :, 3:nqmx)
501    
502      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  
503    
504      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
505      IF (ancien_ok) THEN      IF (ancien_ok) THEN
# Line 674  contains Line 529  contains
529      ! Check temperatures:      ! Check temperatures:
530      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
531    
532      ! Incrémenter le compteur de la physique      call increment_itap
     itap = itap + 1  
533      julien = MOD(dayvrai, 360)      julien = MOD(dayvrai, 360)
534      if (julien == 0) julien = 360      if (julien == 0) julien = 360
535    
536      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
537    
     ! Prescrire l'ozone :  
     wo = ozonecm(REAL(julien), paprs)  
   
538      ! \'Evaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
539      DO k = 1, llm      DO k = 1, llm
540         DO i = 1, klon         DO i = 1, klon
# Line 695  contains Line 546  contains
546      ENDDO      ENDDO
547      ql_seri = 0.      ql_seri = 0.
548    
     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  
   
549      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
550      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
551    
552      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
553      ! la surface.      ! la surface.
554    
555      CALL orbite(REAL(julien), longi, dist)      CALL orbite(REAL(julien), longi, dist)
556      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  
557      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
558    
559      ! R\'epartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
560      ! R\'epartition du longwave par sous-surface lin\'earis\'ee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
561    
562      forall (nsrf = 1: nbsrf)      forall (nsrf = 1: nbsrf)
563         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &         fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
564              * (ztsol - ftsol(:, nsrf))              * (tsol - ftsol(:, nsrf))
565         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
566      END forall      END forall
567    
568      fder = dlw      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
569             ftsol, cdmmax, cdhmax, ftsoil, qsol, paprs, play, fsnow, fqsurf, &
570      ! Couche limite:           fevap, falbe, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, frugs, &
571             agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, &
572      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &           flux_q, flux_u, flux_v, cdragh, cdragm, q2, dsens, devap, coefh, t2m, &
573           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &           q2m, u10m_srf, v10m_srf, pblh, capCL, oliqCL, cteiCL, pblT, therm, &
574           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &           trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
          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)  
575    
576      ! Incr\'ementation des flux      ! Incr\'ementation des flux
577    
578      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
579      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
580      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  
581    
582      DO k = 1, llm      DO k = 1, llm
583         DO i = 1, klon         DO i = 1, klon
# Line 773  contains Line 588  contains
588         ENDDO         ENDDO
589      ENDDO      ENDDO
590    
     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  
   
591      ! Update surface temperature:      ! Update surface temperature:
592    
593      DO i = 1, klon      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
594         zxtsol(i) = 0.      ftsol = ftsol + d_ts
595         zxfluxlat(i) = 0.      tsol = sum(ftsol * pctsrf, dim = 2)
596        zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
597         zt2m(i) = 0.      zt2m = sum(t2m * pctsrf, dim = 2)
598         zq2m(i) = 0.      zq2m = sum(q2m * pctsrf, dim = 2)
599         zu10m(i) = 0.      u10m = sum(u10m_srf * pctsrf, dim = 2)
600         zv10m(i) = 0.      v10m = sum(v10m_srf * pctsrf, dim = 2)
601         zxffonte(i) = 0.      zxffonte = sum(ffonte * pctsrf, dim = 2)
602         zxfqcalving(i) = 0.      zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
603        s_pblh = sum(pblh * pctsrf, dim = 2)
604         s_pblh(i) = 0.      s_lcl = sum(plcl * pctsrf, dim = 2)
605         s_lcl(i) = 0.      s_capCL = sum(capCL * pctsrf, dim = 2)
606         s_capCL(i) = 0.      s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
607         s_oliqCL(i) = 0.      s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
608         s_cteiCL(i) = 0.      s_pblT = sum(pblT * pctsrf, dim = 2)
609         s_pblT(i) = 0.      s_therm = sum(therm * pctsrf, dim = 2)
610         s_therm(i) = 0.      s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
611         s_trmb1(i) = 0.      s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
612         s_trmb2(i) = 0.      s_trmb3 = sum(trmb3 * pctsrf, dim = 2)
        s_trmb3(i) = 0.  
   
        IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &  
             + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &  
             'physiq : probl\`eme sous surface au point ', i, &  
             pctsrf(i, 1 : nbsrf)  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)  
           zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
           zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)  
   
           zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)  
           zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)  
           zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)  
           zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)  
           zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)  
           zxfqcalving(i) = zxfqcalving(i) + &  
                fqcalving(i, nsrf)*pctsrf(i, nsrf)  
           s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)  
           s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)  
           s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)  
           s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)  
           s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)  
           s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)  
           s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) *pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
613    
614      ! 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 :
615      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
616         DO i = 1, klon         DO i = 1, klon
617            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
618                 ftsol(i, nsrf) = tsol(i)
619            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
620            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
621            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m_srf(i, nsrf) = u10m(i)
622            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m_srf(i, nsrf) = v10m(i)
623            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
624            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
625                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
626            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
627            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
628            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
629            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
630            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
631            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
632            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
633            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
634            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
635            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
636         ENDDO         ENDDO
637      ENDDO      ENDDO
638    
639      ! Calculer la dérive du flux infrarouge      dlw = - 4. * RSIGMA * tsol**3
640    
641      DO i = 1, klon      ! Appeler la convection
642         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3  
643      ENDDO      if (conv_emanuel) then
644           CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
645      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, &
646                upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
647      ! 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)  
648         clwcon0 = qcondc         clwcon0 = qcondc
649         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
650    
651         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
652            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  
653    
654         ! Properties of convective clouds         ! Properties of convective clouds
655         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
656         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
657              rnebcon0)              rnebcon0)
658    
659           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
660         mfd = 0.         mfd = 0.
661         pen_u = 0.         pen_u = 0.
662         pen_d = 0.         pen_d = 0.
663         pde_d = 0.         pde_d = 0.
664         pde_u = 0.         pde_u = 0.
665        else
666           conv_q = d_q_dyn + d_q_vdf / dtphys
667           conv_t = d_t_dyn + d_t_vdf / dtphys
668           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
669           CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
670                q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
671                d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
672                mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
673                kdtop, pmflxr, pmflxs)
674           WHERE (rain_con < 0.) rain_con = 0.
675           WHERE (snow_con < 0.) snow_con = 0.
676           ibas_con = llm + 1 - kcbot
677           itop_con = llm + 1 - kctop
678      END if      END if
679    
680      DO k = 1, llm      DO k = 1, llm
# Line 926  contains Line 686  contains
686         ENDDO         ENDDO
687      ENDDO      ENDDO
688    
689      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  
690         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
691         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
692         DO k = 1, llm         DO k = 1, llm
# Line 975  contains Line 713  contains
713         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
714         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
715      else      else
        ! Thermiques  
716         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
717              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)
718      endif      endif
719    
     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  
   
720      ! Caclul des ratqs      ! Caclul des ratqs
721    
722      ! 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 738  contains
738      do k = 1, llm      do k = 1, llm
739         do i = 1, klon         do i = 1, klon
740            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
741                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
742         enddo         enddo
743      enddo      enddo
744    
# Line 1040  contains Line 771  contains
771            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
772         ENDDO         ENDDO
773      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  
774    
775      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
776    
# Line 1076  contains Line 786  contains
786            do k = 1, llm            do k = 1, llm
787               do i = 1, klon               do i = 1, klon
788                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
789                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
790                          *zmasse(i, k)                          * zmasse(i, k)
791                  endif                  endif
792               enddo               enddo
793            enddo            enddo
# Line 1112  contains Line 822  contains
822    
823         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
824         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
825         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
826      ENDIF      ENDIF
827    
828      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1135  contains Line 845  contains
845         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
846      ENDDO      ENDDO
847    
     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)  
   
848      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
849      DO k = 1, llm      DO k = 1, llm
850         DO i = 1, klon         DO i = 1, klon
851            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
852            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
853               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)            zx_qs = MIN(0.5, zx_qs)
854               zx_qs = MIN(0.5, zx_qs)            zcor = 1. / (1. - retv * zx_qs)
855               zcor = 1./(1. - retv*zx_qs)            zx_qs = zx_qs * zcor
856               zx_qs = zx_qs*zcor            zx_rh(i, k) = q_seri(i, k) / zx_qs
           ELSE  
              IF (zx_t < t_coup) THEN  
                 zx_qs = qsats(zx_t)/play(i, k)  
              ELSE  
                 zx_qs = qsatl(zx_t)/play(i, k)  
              ENDIF  
           ENDIF  
           zx_rh(i, k) = q_seri(i, k)/zx_qs  
857            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
858         ENDDO         ENDDO
859      ENDDO      ENDDO
860    
     ! 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  
   
861      ! Param\`etres optiques des nuages et quelques param\`etres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
862      ! diagnostics :      ! diagnostics :
863      if (ok_newmicro) then      if (ok_newmicro) then
864         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
865              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)  
866      else      else
867         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
868              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq)
             bl95_b1, cldtaupi, re, fl)  
869      endif      endif
870    
871      IF (MOD(itap - 1, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
872         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         wo = ozonecm(REAL(julien), paprs)
        ! Calcul de l'abedo moyen par maille  
873         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
874           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, &  
875              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
876              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
877              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
878              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &              swup0, swup, ok_ade, topswad, solswad)
             solswad, cldtaupi, topswai, solswai)  
879      ENDIF      ENDIF
880    
881      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
882      DO k = 1, llm      DO k = 1, llm
883         DO i = 1, klon         DO i = 1, klon
884            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 &
885         ENDDO                 / 86400.
     ENDDO  
   
     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)  
886         ENDDO         ENDDO
887      ENDDO      ENDDO
888    
889      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
   
890      DO i = 1, klon      DO i = 1, klon
891         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
892      ENDDO      ENDDO
# Line 1238  contains Line 895  contains
895    
896      IF (ok_orodr) THEN      IF (ok_orodr) THEN
897         ! S\'election des points pour lesquels le sch\'ema est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
        igwd = 0  
898         DO i = 1, klon         DO i = 1, klon
899            itest(i) = 0            ktest(i) = 0
900            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
901               itest(i) = 1               ktest(i) = 1
              igwd = igwd + 1  
              idx(igwd) = i  
902            ENDIF            ENDIF
903         ENDDO         ENDDO
904    
905         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(dtphys, paprs, play, zmea, zstd, zsig, zgam, zthe, &
906              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &              zpic, zval, ktest, t_seri, u_seri, v_seri, zulow, zvlow, zustrdr, &
907              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zvstrdr, d_t_oro, d_u_oro, d_v_oro)
908    
909         ! ajout des tendances         ! ajout des tendances
910         DO k = 1, llm         DO k = 1, llm
# Line 1264  contains Line 918  contains
918    
919      IF (ok_orolf) THEN      IF (ok_orolf) THEN
920         ! S\'election des points pour lesquels le sch\'ema est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
        igwd = 0  
921         DO i = 1, klon         DO i = 1, klon
922            itest(i) = 0            ktest(i) = 0
923            IF (zpic(i) - zmea(i) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
924               itest(i) = 1               ktest(i) = 1
              igwd = igwd + 1  
              idx(igwd) = i  
925            ENDIF            ENDIF
926         ENDDO         ENDDO
927    
928         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &         CALL lift_noro(dtphys, paprs, play, zmea, zstd, zpic, ktest, t_seri, &
929              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, d_t_lif, &
930              d_t_lif, d_u_lif, d_v_lif)              d_u_lif, d_v_lif)
931    
932         ! Ajout des tendances :         ! Ajout des tendances :
933         DO k = 1, llm         DO k = 1, llm
# Line 1288  contains Line 939  contains
939         ENDDO         ENDDO
940      ENDIF      ENDIF
941    
942      ! Stress n\'ecessaires : toute la physique      CALL aaam_bud(rg, romega, pphis, zustrdr, zustrli, &
943             sum((u_seri - u) / dtphys * zmasse, dim = 2), zvstrdr, &
944      DO i = 1, klon           zvstrli, sum((v_seri - v) / dtphys * zmasse, dim = 2), paprs, u, v, &
945         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(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)  
946    
947      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
948      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
949           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &           mfd, pde_u, pen_d, coefh, cdragh, fm_therm, entr_therm, u(:, 1), &
950           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, &           v(:, 1), ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, &
951           dnwd, tr_seri, zmasse, ncid_startphy, nid_ins)           dnwd, 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)  
952    
953      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
954      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)
955    
956      ! diag. bilKP      ! diag. bilKP
957    
958      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, &
959           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
960    
961      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
962    
963      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
964      DO k = 1, llm      DO k = 1, llm
965         DO i = 1, klon         DO i = 1, klon
966            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 &  
967                 * (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)
968            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)
969            d_t_ec(i, k) = d_t_ec(i, k) / dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
970         END DO         END DO
971      END DO      END DO
972    
     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  
   
973      ! SORTIES      ! SORTIES
974    
975      ! prw = eau precipitable      ! prw = eau precipitable
976      DO i = 1, klon      DO i = 1, klon
977         prw(i) = 0.         prw(i) = 0.
978         DO k = 1, llm         DO k = 1, llm
979            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
980         ENDDO         ENDDO
981      ENDDO      ENDDO
982    
# Line 1392  contains Line 1008  contains
1008         ENDDO         ENDDO
1009      ENDDO      ENDDO
1010    
1011      call write_histins      CALL histwrite_phy("phis", pphis)
1012        CALL histwrite_phy("aire", airephy)
1013        CALL histwrite_phy("psol", paprs(:, 1))
1014        CALL histwrite_phy("precip", rain_fall + snow_fall)
1015        CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1016        CALL histwrite_phy("pluc", rain_con + snow_con)
1017        CALL histwrite_phy("tsol", tsol)
1018        CALL histwrite_phy("t2m", zt2m)
1019        CALL histwrite_phy("q2m", zq2m)
1020        CALL histwrite_phy("u10m", u10m)
1021        CALL histwrite_phy("v10m", v10m)
1022        CALL histwrite_phy("snow", snow_fall)
1023        CALL histwrite_phy("cdrm", cdragm)
1024        CALL histwrite_phy("cdrh", cdragh)
1025        CALL histwrite_phy("topl", toplw)
1026        CALL histwrite_phy("evap", evap)
1027        CALL histwrite_phy("sols", solsw)
1028        CALL histwrite_phy("soll", sollw)
1029        CALL histwrite_phy("solldown", sollwdown)
1030        CALL histwrite_phy("bils", bils)
1031        CALL histwrite_phy("sens", - sens)
1032        CALL histwrite_phy("fder", fder)
1033        CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1034        CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1035        CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1036        CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
1037    
1038        DO nsrf = 1, nbsrf
1039           CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1040           CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1041           CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1042           CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1043           CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1044           CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1045           CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1046           CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1047           CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1048           CALL histwrite_phy("u10m_"//clnsurf(nsrf), u10m_srf(:, nsrf))
1049           CALL histwrite_phy("v10m_"//clnsurf(nsrf), v10m_srf(:, nsrf))
1050        END DO
1051    
1052        CALL histwrite_phy("albs", albsol)
1053        CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1054        CALL histwrite_phy("rugs", zxrugs)
1055        CALL histwrite_phy("s_pblh", s_pblh)
1056        CALL histwrite_phy("s_pblt", s_pblt)
1057        CALL histwrite_phy("s_lcl", s_lcl)
1058        CALL histwrite_phy("s_capCL", s_capCL)
1059        CALL histwrite_phy("s_oliqCL", s_oliqCL)
1060        CALL histwrite_phy("s_cteiCL", s_cteiCL)
1061        CALL histwrite_phy("s_therm", s_therm)
1062        CALL histwrite_phy("s_trmb1", s_trmb1)
1063        CALL histwrite_phy("s_trmb2", s_trmb2)
1064        CALL histwrite_phy("s_trmb3", s_trmb3)
1065    
1066        if (conv_emanuel) then
1067           CALL histwrite_phy("ptop", ema_pct)
1068           CALL histwrite_phy("dnwd0", - mp)
1069        end if
1070    
1071        CALL histwrite_phy("temp", t_seri)
1072        CALL histwrite_phy("vitu", u_seri)
1073        CALL histwrite_phy("vitv", v_seri)
1074        CALL histwrite_phy("geop", zphi)
1075        CALL histwrite_phy("pres", play)
1076        CALL histwrite_phy("dtvdf", d_t_vdf)
1077        CALL histwrite_phy("dqvdf", d_q_vdf)
1078        CALL histwrite_phy("rhum", zx_rh)
1079        CALL histwrite_phy("d_t_ec", d_t_ec)
1080        CALL histwrite_phy("dtsw0", heat0 / 86400.)
1081        CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1082        CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1083        call histwrite_phy("qsurf", sum(fqsurf * pctsrf, dim = 2))
1084    
1085        if (ok_instan) call histsync(nid_ins)
1086    
1087      IF (lafin) then      IF (lafin) then
1088         call NF95_CLOSE(ncid_startphy)         call NF95_CLOSE(ncid_startphy)
1089         CALL phyredem(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &         CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1090              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1091              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1092              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 1095  contains
1095    
1096      firstcal = .FALSE.      firstcal = .FALSE.
1097    
   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  
   
1098    END SUBROUTINE physiq    END SUBROUTINE physiq
1099    
1100  end module physiq_m  end module physiq_m
Legend:
Removed from v.174  
changed lines
  Added in v.250
  ViewVC Help
Powered by ViewVC 1.1.21