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

Diff of /trunk/phylmd/physiq.f

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

trunk/Sources/phylmd/physiq.f revision 186 by guez, Mon Mar 21 15:36:26 2016 UTC trunk/phylmd/physiq.f revision 302 by guez, Thu Sep 6 13:19:51 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, ecrit_hf, ecrit_ins, ecrit_mth, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ok_instan
22           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, conv_emanuel, 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, ONLY: iflag_thermals, nsplit_thermals
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_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 histsync_m, ONLY: histsync
43        USE histwrite_phy_m, ONLY: histwrite_phy
44      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, &
45           nbsrf           nbsrf
46      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins, nid_ins
47        use lift_noro_m, only: lift_noro
48      use netcdf95, only: NF95_CLOSE      use netcdf95, only: NF95_CLOSE
49      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
50        use nr_util, only: assert
51      use nuage_m, only: nuage      use nuage_m, only: nuage
52      USE orbite_m, ONLY: orbite      USE orbite_m, ONLY: orbite
53      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
54      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0
55      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
56      USE phyredem0_m, ONLY: phyredem0      USE phyredem0_m, ONLY: phyredem0
     USE phystokenc_m, ONLY: phystokenc  
57      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
58      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
     use readsulfate_m, only: readsulfate  
     use readsulfate_preind_m, only: readsulfate_preind  
59      use yoegwd, only: sugwd      use yoegwd, only: sugwd
60      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt, rmo3, md
61        use time_phylmdz, only: itap, increment_itap
62      use transp_m, only: transp      use transp_m, only: transp
63      use transp_lay_m, only: transp_lay      use transp_lay_m, only: transp_lay
64      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
# Line 82  contains Line 79  contains
79      REAL, intent(in):: play(:, :) ! (klon, llm)      REAL, intent(in):: play(:, :) ! (klon, llm)
80      ! pression pour le mileu de chaque couche (en Pa)      ! pression pour le mileu de chaque couche (en Pa)
81    
82      REAL, intent(in):: pphi(:, :) ! (klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
83      ! géopotentiel de chaque couche (référence sol)      ! géopotentiel de chaque couche (référence sol)
84    
85      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
86    
87      REAL, intent(in):: u(:, :) ! (klon, llm)      REAL, intent(in):: u(:, :) ! (klon, llm)
88      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m / s
89    
90      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m/s      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m / s
91      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
92    
93      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
94      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
95    
96      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
97      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
98      REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)      REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
99      REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K/s)      REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K / s)
100    
101      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
102      ! tendance physique de "qx" (s-1)      ! tendance physique de "qx" (s-1)
# Line 108  contains Line 105  contains
105    
106      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
107    
     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  
   
108      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
109      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
110    
111      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.      ! pour phystoke avec thermiques
     ! sorties journalieres, mensuelles et instantanees dans les  
     ! fichiers histday, histmth et histins  
   
     LOGICAL ok_region ! sortir le fichier regional  
     PARAMETER (ok_region = .FALSE.)  
   
     ! pour phsystoke avec thermiques  
112      REAL fm_therm(klon, llm + 1)      REAL fm_therm(klon, llm + 1)
113      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
114      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
# Line 135  contains Line 119  contains
119      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
120      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
121    
122      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
123      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg/kg/s)      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg / kg / s)
124    
125      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
126    
127      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
128      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
     SAVE swdn0, swdn, swup0, swup  
   
     REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)  
     REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)  
     SAVE lwdn0, lwdn, lwup0, lwup  
   
     ! Amip2  
     ! variables a une pression donnee  
129    
130      integer nlevSTD      REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
131      PARAMETER(nlevSTD = 17)      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
132    
133      ! prw: precipitable water      ! prw: precipitable water
134      real prw(klon)      real prw(klon)
135    
136      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
137      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
138      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
139      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
140    
     INTEGER kmax, lmax  
     PARAMETER(kmax = 8, lmax = 8)  
     INTEGER kmaxm1, lmaxm1  
     PARAMETER(kmaxm1 = kmax - 1, lmaxm1 = lmax - 1)  
   
141      ! Variables propres a la physique      ! Variables propres a la physique
142    
143      INTEGER, save:: radpas      INTEGER, save:: radpas
144      ! Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
145      ! "physiq".      ! "physiq".
146    
147      REAL radsol(klon)      REAL, save:: radsol(klon) ! bilan radiatif au sol calcule par code radiatif
     SAVE radsol ! bilan radiatif au sol calcule par code radiatif  
   
     INTEGER:: itap = 0 ! number of calls to "physiq"  
   
148      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
149    
150      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
# Line 185  contains Line 152  contains
152    
153      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
154      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
     SAVE fluxlat  
155    
156      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
157      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
158    
159      REAL, save:: qsol(klon)      REAL, save:: qsol(klon) ! column-density of water in soil, in kg m-2
160      ! column-density of water in soil, in kg m-2      REAL, save:: fsnow(klon, nbsrf) ! \'epaisseur neigeuse
   
     REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse  
161      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
162    
163      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
# Line 206  contains Line 170  contains
170      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
171      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
172      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
173      INTEGER igwd, itest(klon)      INTEGER ktest(klon)
174    
175      REAL agesno(klon, nbsrf)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
176      SAVE agesno ! age de la neige      REAL, save:: run_off_lic_0(klon)
177    
178      REAL run_off_lic_0(klon)      ! Variables li\'ees \`a la convection d'Emanuel :
179      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  
180      REAL, save:: sig1(klon, llm), w01(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
     REAL, save:: wd(klon)  
   
     ! Variables pour la couche limite (al1):  
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 fqcalving(klon, nbsrf)
192      ! !et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et n\'ecessaire pour limiter
193      ! !hauteur de neige, en kg/m2/s      ! la hauteur de neige, en kg / m2 / s
194      REAL zxffonte(klon), zxfqcalving(klon)  
195        REAL zxffonte(klon)
196      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction  
197      save pfrac_impa      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
198      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
199      save pfrac_nucl  
200      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      REAL, save:: pfrac_1nucl(klon, llm)
201      save pfrac_1nucl      ! Produits des coefs lessi nucl (alpha = 1)
202      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)  
203        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 dflux_q(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 dflux_t(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 272  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
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)
239    
240      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humidit\'e relative ciel clair
241      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
242      REAL diafra(klon, llm) ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
243      REAL cldliq(klon, llm) ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
# Line 289  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 310  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. Anne Mathieu variables pour la couche limite atmosphérique (hbtm)      ! 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)
     REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape  
     REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition  
     REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega  
293      ! Grandeurs de sorties      ! Grandeurs de sorties
294      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
295      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
296      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon)
     REAL s_trmb3(klon)  
297    
298      ! Variables pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
299    
300      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
301      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
302      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
303    
304      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
305    
# Line 367  contains Line 311  contains
311      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
312      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
313      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
314      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
315      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)
316      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
317      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 383  contains Line 327  contains
327      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
328      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
329    
330      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
331        real rain_lsc(klon)
332      REAL, save:: snow_con(klon) ! neige (mm / s)      REAL, save:: snow_con(klon) ! neige (mm / s)
333      real snow_lsc(klon)      real snow_lsc(klon)
334      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf) ! variation of ftsol
335    
336      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
337      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)
# Line 420  contains Line 365  contains
365    
366      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
367      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
     REAL zustrph(klon), zvstrph(klon)  
368      REAL aam, torsfc      REAL aam, torsfc
369    
     REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique  
   
     INTEGER, SAVE:: nid_ins  
   
370      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.
371      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.
372      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.
373      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.
374    
375      real date0      REAL tsol(klon)
376    
377      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :      REAL d_t_ec(klon, llm)
378      REAL ztsol(klon)      ! tendance due \`a la conversion d'\'energie cin\'etique en
379      REAL d_h_vcol, d_qt, d_ec      ! énergie thermique
380      REAL, SAVE:: d_h_vcol_phy  
381      REAL zero_v(klon)      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
382      CHARACTER(LEN = 20) tit      ! temperature and humidity at 2 m
383      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
384      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      REAL, save:: u10m_srf(klon, nbsrf), v10m_srf(klon, nbsrf)
385        ! composantes du vent \`a 10 m
386      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique      
387      REAL ZRCPD      REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
388        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  
389    
390      ! Aerosol effects:      ! Aerosol effects:
391    
392      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 \mu 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  
   
393      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
     LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect  
394    
395      REAL:: bl95_b0 = 2., bl95_b1 = 0.2      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
396      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
397      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
398      ! concentration.      ! concentration.
399    
400      SAVE u10m      real zmasse(klon, llm)
     SAVE v10m  
     SAVE t2m  
     SAVE q2m  
     SAVE ffonte  
     SAVE fqcalving  
     SAVE rain_con  
     SAVE topswai  
     SAVE topswad  
     SAVE solswai  
     SAVE solswad  
     SAVE d_u_con  
     SAVE d_v_con  
   
     real zmasse(klon, llm)  
401      ! (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)
402    
403      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      integer, save:: ncid_startphy
     integer, save:: ncid_startphy, itau_phy  
404    
405      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
406           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           ratqsbas, ratqshaut, ok_ade, bl95_b0, bl95_b1, iflag_thermals, &
407           ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals           nsplit_thermals
408    
409      !----------------------------------------------------------------      !----------------------------------------------------------------
410    
     IF (if_ebil >= 1) zero_v = 0.  
411      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
412           'eaux vapeur et liquide sont indispensables')           'eaux vapeur et liquide sont indispensables')
413    
414      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
415         ! initialiser         ! initialiser
416         u10m = 0.         u10m_srf = 0.
417         v10m = 0.         v10m_srf = 0.
418         t2m = 0.         t2m = 0.
419         q2m = 0.         q2m = 0.
420         ffonte = 0.         ffonte = 0.
        fqcalving = 0.  
        piz_ae = 0.  
        tau_ae = 0.  
        cg_ae = 0.  
421         rain_con = 0.         rain_con = 0.
422         snow_con = 0.         snow_con = 0.
        topswai = 0.  
        topswad = 0.  
        solswai = 0.  
        solswad = 0.  
   
423         d_u_con = 0.         d_u_con = 0.
424         d_v_con = 0.         d_v_con = 0.
425         rnebcon0 = 0.         rnebcon0 = 0.
426         clwcon0 = 0.         clwcon0 = 0.
427         rnebcon = 0.         rnebcon = 0.
428         clwcon = 0.         clwcon = 0.
   
429         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
430         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
431         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
432         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
433         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
434         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
435         therm =0.         therm =0.
        trmb1 =0. ! deep_cape  
        trmb2 =0. ! inhibition  
        trmb3 =0. ! Point Omega  
   
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
436    
437         iflag_thermals = 0         iflag_thermals = 0
438         nsplit_thermals = 1         nsplit_thermals = 1
# Line 560  contains Line 445  contains
445         ! Initialiser les compteurs:         ! Initialiser les compteurs:
446    
447         frugs = 0.         frugs = 0.
448         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, &         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
449              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &              fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
450              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
451              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &              q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
452              run_off_lic_0, sig1, w01, ncid_startphy, itau_phy)              w01, 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 (conv_emanuel) THEN         IF (conv_emanuel) THEN
# Line 592  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, itau_phy)         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, itau_phy)  
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 616  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 660  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 681  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  
543      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
544    
545      ! R\'epartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
546      ! R\'epartition du longwave par sous-surface lin\'earis\'ee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
547    
548      forall (nsrf = 1: nbsrf)      forall (nsrf = 1: nbsrf)
549         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &         fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
550              * (ztsol - ftsol(:, nsrf))              * (tsol - ftsol(:, nsrf))
551         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
552      END forall      END forall
553    
554      fder = dlw      CALL pbl_surface(pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
555             ftsol, cdmmax, cdhmax, ftsoil, qsol, paprs, play, fsnow, fqsurf, &
556      ! Couche limite:           fevap, falbe, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, frugs, &
557             agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, &
558      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &           flux_q, flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, coefh, &
559           v_seri, julien, mu0, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &           t2m, q2m, u10m_srf, v10m_srf, pblh, capCL, oliqCL, cteiCL, pblT, &
560           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &           therm, 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)  
561    
562      ! Incr\'ementation des flux      ! Incr\'ementation des flux
563    
564      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
565      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
566      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  
567    
568      DO k = 1, llm      DO k = 1, llm
569         DO i = 1, klon         DO i = 1, klon
# Line 759  contains Line 574  contains
574         ENDDO         ENDDO
575      ENDDO      ENDDO
576    
577      IF (if_ebil >= 2) THEN      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
578         tit = 'after clmain'      ftsol = ftsol + d_ts ! update surface temperature
579         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &      tsol = sum(ftsol * pctsrf, dim = 2)
580              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)      zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
581         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &      zt2m = sum(t2m * pctsrf, dim = 2)
582              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)      zq2m = sum(q2m * pctsrf, dim = 2)
583      END IF      u10m = sum(u10m_srf * pctsrf, dim = 2)
584        v10m = sum(v10m_srf * pctsrf, dim = 2)
585      ! Update surface temperature:      zxffonte = sum(ffonte * pctsrf, dim = 2)
586        s_pblh = sum(pblh * pctsrf, dim = 2)
587      DO i = 1, klon      s_lcl = sum(plcl * pctsrf, dim = 2)
588         zxtsol(i) = 0.      s_capCL = sum(capCL * pctsrf, dim = 2)
589         zxfluxlat(i) = 0.      s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
590        s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
591        s_pblT = sum(pblT * pctsrf, dim = 2)
592        s_therm = sum(therm * pctsrf, dim = 2)
593    
594         zt2m(i) = 0.      ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
        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  
595      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
596         DO i = 1, klon         DO i = 1, klon
597            ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)            IF (pctsrf(i, nsrf) < epsfra) then
598            zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)               ftsol(i, nsrf) = tsol(i)
599            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)               t2m(i, nsrf) = zt2m(i)
600                 q2m(i, nsrf) = zq2m(i)
601            zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)               u10m_srf(i, nsrf) = u10m(i)
602            zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)               v10m_srf(i, nsrf) = v10m(i)
603            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)               ffonte(i, nsrf) = zxffonte(i)
604            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)               pblh(i, nsrf) = s_pblh(i)
605            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)               plcl(i, nsrf) = s_lcl(i)
606            zxfqcalving(i) = zxfqcalving(i) + &               capCL(i, nsrf) = s_capCL(i)
607                 fqcalving(i, nsrf)*pctsrf(i, nsrf)               oliqCL(i, nsrf) = s_oliqCL(i)
608            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)               cteiCL(i, nsrf) = s_cteiCL(i)
609            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)               pblT(i, nsrf) = s_pblT(i)
610            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)               therm(i, nsrf) = s_therm(i)
611            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)            end IF
           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)  
612         ENDDO         ENDDO
613      ENDDO      ENDDO
614    
615      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :      dlw = - 4. * RSIGMA * tsol**3
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)  
   
           IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)  
           IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)  
           IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)  
           IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)  
           IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)  
           IF (pctsrf(i, nsrf) < epsfra) &  
                fqcalving(i, nsrf) = zxfqcalving(i)  
           IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)  
           IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)  
           IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)  
           IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)  
           IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)  
           IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)  
           IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)  
        ENDDO  
     ENDDO  
   
     ! Calculer la dérive du flux infrarouge  
   
     DO i = 1, klon  
        dlw(i) = - 4. * RSIGMA * zxtsol(i)**3  
     ENDDO  
   
     IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)  
616    
617      ! Appeler la convection (au choix)      ! Appeler la convection
618    
619      if (conv_emanuel) then      if (conv_emanuel) then
620         da = 0.         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
621         mp = 0.              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
622         phi = 0.              upwd, dnwd, Ma, cape, iflagctrl, clwcon0, pmflxr, da, phi, mp)
        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, ibas_con, &  
             itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, wd, &  
             pmflxr, da, phi, mp)  
623         snow_con = 0.         snow_con = 0.
        clwcon0 = qcondc  
624         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
625    
626         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
627            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  
628    
629         ! Properties of convective clouds         ! Properties of convective clouds
630         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
631         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
632              rnebcon0)              rnebcon0)
633    
634         forall (i = 1:klon) ema_pct(i) = paprs(i,itop_con(i) + 1)         forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
635         mfd = 0.         mfd = 0.
636         pen_u = 0.         pen_u = 0.
637         pen_d = 0.         pen_d = 0.
# Line 892  contains Line 641  contains
641         conv_q = d_q_dyn + d_q_vdf / dtphys         conv_q = d_q_dyn + d_q_vdf / dtphys
642         conv_t = d_t_dyn + d_t_vdf / dtphys         conv_t = d_t_dyn + d_t_vdf / dtphys
643         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
644         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &         CALL conflx(paprs, play, t_seri(:, llm:1:- 1), q_seri(:, llm:1:- 1), &
645              q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &              conv_t, conv_q, - evap, omega, d_t_con, d_q_con, rain_con, &
646              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &              snow_con, mfu(:, llm:1:- 1), mfd(:, llm:1:- 1), pen_u, pde_u, &
647              mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &              pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, pmflxs)
             kdtop, pmflxr, pmflxs)  
648         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
649         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
650         ibas_con = llm + 1 - kcbot         ibas_con = llm + 1 - kcbot
# Line 912  contains Line 660  contains
660         ENDDO         ENDDO
661      ENDDO      ENDDO
662    
     IF (if_ebil >= 2) THEN  
        tit = 'after convect'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        print *, "aprescon = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i)/REAL(klon)  
           zx_t = zx_t + (rain_con(i)+ &  
                snow_con(i))*airephy(i)/REAL(klon)  
        ENDDO  
        zx_t = zx_t/za*dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
   
663      IF (.not. conv_emanuel) THEN      IF (.not. conv_emanuel) THEN
664         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
665         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
# Line 961  contains Line 687  contains
687         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
688         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
689      else      else
690         ! Thermiques         call calltherm(play, paprs, pphi, u_seri, v_seri, t_seri, q_seri, &
691         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_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)  
692      endif      endif
693    
     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  
   
694      ! Caclul des ratqs      ! Caclul des ratqs
695    
     ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q  
     ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno  
696      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
697           ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
698           ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
699         do k = 1, llm         do k = 1, llm
700            do i = 1, klon            do i = 1, klon
701               if(ptconv(i, k)) then               if(ptconv(i, k)) then
# Line 993  contains Line 712  contains
712      do k = 1, llm      do k = 1, llm
713         do i = 1, klon         do i = 1, klon
714            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
715                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
716         enddo         enddo
717      enddo      enddo
718    
# Line 1010  contains Line 729  contains
729         ratqs = ratqss         ratqs = ratqss
730      endif      endif
731    
732      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(paprs, play, t_seri, q_seri, ptconv, ratqs, d_t_lsc, &
733           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, &
734           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, psfl, rhcl)
          psfl, rhcl)  
735    
736      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
737      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1026  contains Line 744  contains
744            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
745         ENDDO         ENDDO
746      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  
747    
748      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
749    
# Line 1062  contains Line 759  contains
759            do k = 1, llm            do k = 1, llm
760               do i = 1, klon               do i = 1, klon
761                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
762                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
763                          *zmasse(i, k)                          * zmasse(i, k)
764                  endif                  endif
765               enddo               enddo
766            enddo            enddo
# Line 1098  contains Line 795  contains
795    
796         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
797         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
798         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
799      ENDIF      ENDIF
800    
801      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1121  contains Line 818  contains
818         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
819      ENDDO      ENDDO
820    
     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)  
   
821      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
822      DO k = 1, llm      DO k = 1, llm
823         DO i = 1, klon         DO i = 1, klon
824            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
825            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
826               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)            zx_qs = MIN(0.5, zx_qs)
827               zx_qs = MIN(0.5, zx_qs)            zcor = 1. / (1. - retv * zx_qs)
828               zcor = 1./(1. - retv*zx_qs)            zx_qs = zx_qs * zcor
829               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  
830            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
831         ENDDO         ENDDO
832      ENDDO      ENDDO
833    
     ! 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  
   
834      ! Param\`etres optiques des nuages et quelques param\`etres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
835      ! diagnostics :      ! diagnostics :
836      if (ok_newmicro) then      if (ok_newmicro) then
837         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
838              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)  
839      else      else
840         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
841              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq)
             bl95_b1, cldtaupi, re, fl)  
842      endif      endif
843    
844      IF (MOD(itap - 1, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
845         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         wo = ozonecm(REAL(julien), paprs)
        ! Calcul de l'abedo moyen par maille  
846         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
847           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, &  
848              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
849              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
850              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
851              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &              swup0, swup, ok_ade, topswad, solswad)
             solswad, cldtaupi, topswai, solswai)  
852      ENDIF      ENDIF
853    
854      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
855      DO k = 1, llm      DO k = 1, llm
856         DO i = 1, klon         DO i = 1, klon
857            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 &
858         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)  
859         ENDDO         ENDDO
860      ENDDO      ENDDO
861    
862      ! 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)
   
863      DO i = 1, klon      DO i = 1, klon
864         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
865      ENDDO      ENDDO
# Line 1224  contains Line 868  contains
868    
869      IF (ok_orodr) THEN      IF (ok_orodr) THEN
870         ! S\'election des points pour lesquels le sch\'ema est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
        igwd = 0  
871         DO i = 1, klon         DO i = 1, klon
872            itest(i) = 0            ktest(i) = 0
873            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
874               itest(i) = 1               ktest(i) = 1
              igwd = igwd + 1  
875            ENDIF            ENDIF
876         ENDDO         ENDDO
877    
878         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(paprs, play, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
879              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &              ktest, t_seri, u_seri, v_seri, zulow, zvlow, zustrdr, zvstrdr, &
880              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              d_t_oro, d_u_oro, d_v_oro)
881    
882         ! ajout des tendances         ! ajout des tendances
883         DO k = 1, llm         DO k = 1, llm
# Line 1249  contains Line 891  contains
891    
892      IF (ok_orolf) THEN      IF (ok_orolf) THEN
893         ! S\'election des points pour lesquels le sch\'ema est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
        igwd = 0  
894         DO i = 1, klon         DO i = 1, klon
895            itest(i) = 0            ktest(i) = 0
896            IF (zpic(i) - zmea(i) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
897               itest(i) = 1               ktest(i) = 1
              igwd = igwd + 1  
898            ENDIF            ENDIF
899         ENDDO         ENDDO
900    
901         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, &
902              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)  
903    
904         ! Ajout des tendances :         ! Ajout des tendances :
905         DO k = 1, llm         DO k = 1, llm
# Line 1272  contains Line 911  contains
911         ENDDO         ENDDO
912      ENDIF      ENDIF
913    
914      ! Stress n\'ecessaires : toute la physique      CALL aaam_bud(rg, romega, pphis, zustrdr, zustrli, &
915             sum((u_seri - u) / dtphys * zmasse, dim = 2), zvstrdr, &
916      DO i = 1, klon           zvstrli, sum((v_seri - v) / dtphys * zmasse, dim = 2), paprs, u, v, &
917         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)  
918    
919      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
920      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &      call phytrac(julien, time, firstcal, lafin, t, paprs, play, mfu, mfd, &
921           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), &
922           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, &           ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &
923           dnwd, tr_seri, zmasse, ncid_startphy, nid_ins, itau_phy)           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)  
924    
925      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
926      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
# Line 1314  contains Line 932  contains
932    
933      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
934    
935      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
936      DO k = 1, llm      DO k = 1, llm
937         DO i = 1, klon         DO i = 1, klon
938            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 &  
939                 * (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)
940            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)
941            d_t_ec(i, k) = d_t_ec(i, k) / dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
942         END DO         END DO
943      END DO      END DO
944    
     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  
   
945      ! SORTIES      ! SORTIES
946    
947      ! prw = eau precipitable      ! prw = eau precipitable
948      DO i = 1, klon      DO i = 1, klon
949         prw(i) = 0.         prw(i) = 0.
950         DO k = 1, llm         DO k = 1, llm
951            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
952         ENDDO         ENDDO
953      ENDDO      ENDDO
954    
# Line 1376  contains Line 980  contains
980         ENDDO         ENDDO
981      ENDDO      ENDDO
982    
983      call write_histins      CALL histwrite_phy("phis", pphis)
984        CALL histwrite_phy("aire", airephy)
985        CALL histwrite_phy("psol", paprs(:, 1))
986        CALL histwrite_phy("precip", rain_fall + snow_fall)
987        CALL histwrite_phy("plul", rain_lsc + snow_lsc)
988        CALL histwrite_phy("pluc", rain_con + snow_con)
989        CALL histwrite_phy("tsol", tsol)
990        CALL histwrite_phy("t2m", zt2m)
991        CALL histwrite_phy("q2m", zq2m)
992        CALL histwrite_phy("u10m", u10m)
993        CALL histwrite_phy("v10m", v10m)
994        CALL histwrite_phy("snow", snow_fall)
995        CALL histwrite_phy("cdrm", cdragm)
996        CALL histwrite_phy("cdrh", cdragh)
997        CALL histwrite_phy("topl", toplw)
998        CALL histwrite_phy("evap", evap)
999        CALL histwrite_phy("sols", solsw)
1000        CALL histwrite_phy("soll", sollw)
1001        CALL histwrite_phy("solldown", sollwdown)
1002        CALL histwrite_phy("bils", bils)
1003        CALL histwrite_phy("sens", - sens)
1004        CALL histwrite_phy("fder", fder)
1005        CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1006        CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1007        CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1008        CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
1009        CALL histwrite_phy("zxfqcalving", sum(fqcalving * pctsrf, dim = 2))
1010    
1011        DO nsrf = 1, nbsrf
1012           CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1013           CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1014           CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1015           CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1016           CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1017           CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1018           CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1019           CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1020           CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1021           CALL histwrite_phy("u10m_"//clnsurf(nsrf), u10m_srf(:, nsrf))
1022           CALL histwrite_phy("v10m_"//clnsurf(nsrf), v10m_srf(:, nsrf))
1023        END DO
1024    
1025        CALL histwrite_phy("albs", albsol)
1026        CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1027        CALL histwrite_phy("rugs", zxrugs)
1028        CALL histwrite_phy("s_pblh", s_pblh)
1029        CALL histwrite_phy("s_pblt", s_pblt)
1030        CALL histwrite_phy("s_lcl", s_lcl)
1031        CALL histwrite_phy("s_capCL", s_capCL)
1032        CALL histwrite_phy("s_oliqCL", s_oliqCL)
1033        CALL histwrite_phy("s_cteiCL", s_cteiCL)
1034        CALL histwrite_phy("s_therm", s_therm)
1035    
1036        if (conv_emanuel) then
1037           CALL histwrite_phy("ptop", ema_pct)
1038           CALL histwrite_phy("dnwd0", - mp)
1039        end if
1040    
1041        CALL histwrite_phy("temp", t_seri)
1042        CALL histwrite_phy("vitu", u_seri)
1043        CALL histwrite_phy("vitv", v_seri)
1044        CALL histwrite_phy("geop", zphi)
1045        CALL histwrite_phy("pres", play)
1046        CALL histwrite_phy("dtvdf", d_t_vdf)
1047        CALL histwrite_phy("dqvdf", d_q_vdf)
1048        CALL histwrite_phy("rhum", zx_rh)
1049        CALL histwrite_phy("d_t_ec", d_t_ec)
1050        CALL histwrite_phy("dtsw0", heat0 / 86400.)
1051        CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1052        CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1053        call histwrite_phy("qsurf", sum(fqsurf * pctsrf, dim = 2))
1054    
1055        if (ok_instan) call histsync(nid_ins)
1056    
1057      IF (lafin) then      IF (lafin) then
1058         call NF95_CLOSE(ncid_startphy)         call NF95_CLOSE(ncid_startphy)
# Line 1389  contains Line 1065  contains
1065    
1066      firstcal = .FALSE.      firstcal = .FALSE.
1067    
   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 gr_fi_ecrit_m, only: gr_fi_ecrit  
       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)  
   
          if (conv_emanuel) then  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, ema_pct, zx_tmp_2d)  
             CALL histwrite(nid_ins, "ptop", itau_w, zx_tmp_2d)  
          end if  
   
          ! Champs 3D:  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)  
          CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)  
          CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zx_rh, zx_tmp_3d)  
          CALL histwrite(nid_ins, "rhum", itau_w, zx_tmp_3d)  
   
          call histsync(nid_ins)  
       ENDIF  
   
     end subroutine write_histins  
   
1068    END SUBROUTINE physiq    END SUBROUTINE physiq
1069    
1070  end module physiq_m  end module physiq_m
Legend:
Removed from v.186  
changed lines
  Added in v.302
  ViewVC Help
Powered by ViewVC 1.1.21