/[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 134 by guez, Wed Apr 29 15:47:56 2015 UTC revision 190 by guez, Thu Apr 14 15:15:56 2016 UTC
# Line 4  module physiq_m Line 4  module physiq_m
4    
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, dayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, dayvrai, time, paprs, play, pphi, pphis, u, v, t, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx)         qx, omega, d_u, d_v, d_t, d_qx)
9    
10      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! (subversion revision 678)      ! (subversion revision 678)
12    
13      ! Author: Z.X. Li (LMD/CNRS) 1993      ! Author: Z. X. Li (LMD/CNRS) 1993
14    
15      ! This is the main procedure for the "physics" part of the program.      ! This is the main procedure for the "physics" part of the program.
16    
# Line 19  contains Line 19  contains
19      use aeropt_m, only: aeropt      use aeropt_m, only: aeropt
20      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
21      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
22      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_hf, ecrit_ins, ecrit_mth, &
23           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin           ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
24      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: cycle_diurne, conv_emanuel, nbapp_rad, new_oliq, &
25           ok_orodr, ok_orolf           ok_orodr, ok_orolf
26      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
27      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
28      USE comgeomphy, ONLY: airephy, cuphy, cvphy      use comconst, only: dtphys
29        USE comgeomphy, ONLY: airephy
30      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
31      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date, day_step, iphysiq
32      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
33      use conflx_m, only: conflx      use conflx_m, only: conflx
34      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
# Line 45  contains Line 46  contains
46      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, &
47           nbsrf           nbsrf
48      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
49        use netcdf95, only: NF95_CLOSE
50      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
51        use nuage_m, only: nuage
52      USE orbite_m, ONLY: orbite      USE orbite_m, ONLY: orbite
53      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
54      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
55      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
56        USE phyredem0_m, ONLY: phyredem0
57      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
58      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
59      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
60      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
61      use readsulfate_m, only: readsulfate      use readsulfate_m, only: readsulfate
62      use readsulfate_preind_m, only: readsulfate_preind      use readsulfate_preind_m, only: readsulfate_preind
63      use sugwd_m, only: sugwd      use yoegwd, only: sugwd
64      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt
65      USE temps, ONLY: itau_phy      use transp_m, only: transp
66        use transp_lay_m, only: transp_lay
67      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
68      USE ymds2ju_m, ONLY: ymds2ju      USE ymds2ju_m, ONLY: ymds2ju
69      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
# Line 70  contains Line 75  contains
75      ! current day number, based at value 1 on January 1st of annee_ref      ! current day number, based at value 1 on January 1st of annee_ref
76    
77      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
     REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)  
78    
79      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
80      ! pression pour chaque inter-couche, en Pa      ! pression pour chaque inter-couche, en Pa
# Line 78  contains Line 82  contains
82      REAL, intent(in):: play(:, :) ! (klon, llm)      REAL, intent(in):: play(:, :) ! (klon, llm)
83      ! pression pour le mileu de chaque couche (en Pa)      ! pression pour le mileu de chaque couche (en Pa)
84    
85      REAL, intent(in):: pphi(:, :) ! (klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
86      ! géopotentiel de chaque couche (référence sol)      ! géopotentiel de chaque couche (référence sol)
87    
88      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
# Line 104  contains Line 108  contains
108    
109      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
110    
111      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL, PARAMETER:: check = .FALSE.
     PARAMETER (ok_gust = .FALSE.)  
   
     LOGICAL, PARAMETER:: check = .FALSE.  
112      ! Verifier la conservation du modele en eau      ! Verifier la conservation du modele en eau
113    
114      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
115      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
116    
     ! "slab" ocean  
     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  
   
117      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
118      ! sorties journalieres, mensuelles et instantanees dans les      ! sorties journalieres, mensuelles et instantanees dans les
119      ! fichiers histday, histmth et histins      ! fichiers histday, histmth et histins
# Line 148  contains Line 143  contains
143    
144      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
145      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
146      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
   
     ! Amip2  
     ! variables a une pression donnee  
   
     integer nlevSTD  
     PARAMETER(nlevSTD = 17)  
     real rlevSTD(nlevSTD)  
     DATA rlevSTD/100000., 92500., 85000., 70000., &  
          60000., 50000., 40000., 30000., 25000., 20000., &  
          15000., 10000., 7000., 5000., 3000., 2000., 1000./  
     CHARACTER(LEN = 4) clevSTD(nlevSTD)  
     DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &  
          '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &  
          '70 ', '50 ', '30 ', '20 ', '10 '/  
147    
148      ! prw: precipitable water      ! prw: precipitable water
149      real prw(klon)      real prw(klon)
# Line 172  contains Line 153  contains
153      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
154      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
155    
     INTEGER kmax, lmax  
     PARAMETER(kmax = 8, lmax = 8)  
     INTEGER kmaxm1, lmaxm1  
     PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)  
   
     REAL zx_tau(kmaxm1), zx_pc(lmaxm1)  
     DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./  
     DATA zx_pc/50., 180., 310., 440., 560., 680., 800./  
   
     ! cldtopres pression au sommet des nuages  
     REAL cldtopres(lmaxm1)  
     DATA cldtopres/50., 180., 310., 440., 560., 680., 800./  
   
     ! taulev: numero du niveau de tau dans les sorties ISCCP  
     CHARACTER(LEN = 4) taulev(kmaxm1)  
   
     DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/  
     CHARACTER(LEN = 3) pclev(lmaxm1)  
     DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/  
   
     CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)  
     DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &  
          'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &  
          'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &  
          'pc= 680-800hPa, tau< 0.3', 'pc< 50hPa, tau= 0.3-1.3', &  
          'pc= 50-180hPa, tau= 0.3-1.3', 'pc= 180-310hPa, tau= 0.3-1.3', &  
          'pc= 310-440hPa, tau= 0.3-1.3', 'pc= 440-560hPa, tau= 0.3-1.3', &  
          'pc= 560-680hPa, tau= 0.3-1.3', 'pc= 680-800hPa, tau= 0.3-1.3', &  
          'pc< 50hPa, tau= 1.3-3.6', 'pc= 50-180hPa, tau= 1.3-3.6', &  
          'pc= 180-310hPa, tau= 1.3-3.6', 'pc= 310-440hPa, tau= 1.3-3.6', &  
          'pc= 440-560hPa, tau= 1.3-3.6', 'pc= 560-680hPa, tau= 1.3-3.6', &  
          'pc= 680-800hPa, tau= 1.3-3.6', 'pc< 50hPa, tau= 3.6-9.4', &  
          'pc= 50-180hPa, tau= 3.6-9.4', 'pc= 180-310hPa, tau= 3.6-9.4', &  
          'pc= 310-440hPa, tau= 3.6-9.4', 'pc= 440-560hPa, tau= 3.6-9.4', &  
          'pc= 560-680hPa, tau= 3.6-9.4', 'pc= 680-800hPa, tau= 3.6-9.4', &  
          'pc< 50hPa, tau= 9.4-23', 'pc= 50-180hPa, tau= 9.4-23', &  
          'pc= 180-310hPa, tau= 9.4-23', 'pc= 310-440hPa, tau= 9.4-23', &  
          'pc= 440-560hPa, tau= 9.4-23', 'pc= 560-680hPa, tau= 9.4-23', &  
          'pc= 680-800hPa, tau= 9.4-23', 'pc< 50hPa, tau= 23-60', &  
          'pc= 50-180hPa, tau= 23-60', 'pc= 180-310hPa, tau= 23-60', &  
          'pc= 310-440hPa, tau= 23-60', 'pc= 440-560hPa, tau= 23-60', &  
          'pc= 560-680hPa, tau= 23-60', 'pc= 680-800hPa, tau= 23-60', &  
          'pc< 50hPa, tau> 60.', 'pc= 50-180hPa, tau> 60.', &  
          'pc= 180-310hPa, tau> 60.', 'pc= 310-440hPa, tau> 60.', &  
          'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &  
          'pc= 680-800hPa, tau> 60.'/  
   
     ! ISCCP simulator v3.4  
   
156      ! Variables propres a la physique      ! Variables propres a la physique
157    
158      INTEGER, save:: radpas      INTEGER, save:: radpas
# Line 230  contains Line 162  contains
162      REAL radsol(klon)      REAL radsol(klon)
163      SAVE radsol ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
164    
165      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER:: itap = 0 ! number of calls to "physiq"
166    
167      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
168    
# Line 248  contains Line 180  contains
180      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
181    
182      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
183      REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
     REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface  
184    
185      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
186      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 260  contains Line 191  contains
191      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
192      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
193      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
194      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
195        INTEGER igwd, itest(klon)
196    
197      INTEGER igwd, idx(klon), itest(klon)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
198        REAL, save:: run_off_lic_0(klon)
199    
200      REAL agesno(klon, nbsrf)      ! Variables li\'ees \`a la convection d'Emanuel :
201      SAVE agesno ! age de la neige      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
202        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  
203      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:  
204    
205        ! Variables pour la couche limite (Alain Lahellec) :
206      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
207      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
208    
# Line 292  contains Line 211  contains
211      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
212      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
213      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige
214      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface
215      ! !et necessaire pour limiter la      ! !et necessaire pour limiter la
216      ! !hauteur de neige, en kg/m2/s      ! !hauteur de neige, en kg/m2/s
217      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
# Line 319  contains Line 238  contains
238      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
239      SAVE dlw      SAVE dlw
240      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
241      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
     save fder  
242      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
243      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
244      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
# Line 335  contains Line 253  contains
253      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
254      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
255      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
256      REAL, save:: albsol(klon) ! albedo du sol total      REAL, save:: albsol(klon) ! albedo du sol total visible
     REAL, save:: albsollw(klon) ! albedo du sol total  
257      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
258    
     ! Declaration des procedures appelees  
   
     EXTERNAL nuage ! calculer les proprietes radiatives  
     EXTERNAL transp ! transport total de l'eau et de l'energie  
   
     ! Variables locales  
   
259      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
260      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
261    
# Line 370  contains Line 280  contains
280      ! 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
281      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
282      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
283      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
284      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
285      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
286      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
287      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
288      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
289      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
290      REAL albpla(klon)      REAL, save:: albpla(klon)
291      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
292      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
     SAVE albpla  
     SAVE heat0, cool0  
   
     INTEGER itaprad  
     SAVE itaprad  
293    
294      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
295      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
# Line 404  contains Line 309  contains
309      REAL, PARAMETER:: t_coup = 234.      REAL, PARAMETER:: t_coup = 234.
310      REAL zphi(klon, llm)      REAL zphi(klon, llm)
311    
312      ! cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu variables pour la couche limite atmosphérique (hbtm)
313    
314      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
315      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 414  contains Line 319  contains
319      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
320      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
321      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
322      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
323      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
324      ! Grdeurs de sorties      ! Grandeurs de sorties
325      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
326      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
327      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
328      REAL s_trmb3(klon)      REAL s_trmb3(klon)
329    
330      ! Variables locales pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
331    
332      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
333      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
# Line 454  contains Line 359  contains
359      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
360    
361      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
362        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
363    
364      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
365      REAL snow_con(klon), snow_lsc(klon)      REAL, save:: snow_con(klon) ! neige (mm / s)
366        real snow_lsc(klon)
367      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
368    
369      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
# Line 480  contains Line 387  contains
387      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
388      logical ptconv(klon, llm)      logical ptconv(klon, llm)
389    
390      ! Variables locales pour effectuer les appels en s\'erie :      ! Variables pour effectuer les appels en s\'erie :
391    
392      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
393      REAL ql_seri(klon, llm)      REAL ql_seri(klon, llm)
# Line 494  contains Line 401  contains
401      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
402      REAL aam, torsfc      REAL aam, torsfc
403    
     REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique  
   
404      INTEGER, SAVE:: nid_ins      INTEGER, SAVE:: nid_ins
405    
406      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.
# Line 503  contains Line 408  contains
408      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.
409      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.
410    
     REAL zsto  
411      real date0      real date0
412    
413      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
# Line 513  contains Line 417  contains
417      REAL zero_v(klon)      REAL zero_v(klon)
418      CHARACTER(LEN = 20) tit      CHARACTER(LEN = 20) tit
419      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
420      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
421    
422      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique
423      REAL ZRCPD      REAL ZRCPD
# Line 528  contains Line 432  contains
432      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
433    
434      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
435      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value      ! SO4 aerosol concentration, in \mu g/m3, pre-industrial value
436    
437      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
438      ! cloud optical thickness for pre-industrial (pi) aerosols      ! cloud optical thickness for pre-industrial (pi) aerosols
# Line 560  contains Line 464  contains
464      SAVE ffonte      SAVE ffonte
465      SAVE fqcalving      SAVE fqcalving
466      SAVE rain_con      SAVE rain_con
     SAVE snow_con  
467      SAVE topswai      SAVE topswai
468      SAVE topswad      SAVE topswad
469      SAVE solswai      SAVE solswai
# Line 568  contains Line 471  contains
471      SAVE d_u_con      SAVE d_u_con
472      SAVE d_v_con      SAVE d_v_con
473    
474      real zmasse(klon, llm)      real zmasse(klon, llm)
475      ! (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)
476    
477      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      integer, save:: ncid_startphy, itau_phy
478    
479      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &
480           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
# Line 581  contains Line 484  contains
484    
485      IF (if_ebil >= 1) zero_v = 0.      IF (if_ebil >= 1) zero_v = 0.
486      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
487           'eaux vapeur et liquide sont indispensables', 1)           'eaux vapeur et liquide sont indispensables')
488    
489      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
490         ! initialiser         ! initialiser
# Line 616  contains Line 519  contains
519         pblt =0. ! T a la Hauteur de couche limite         pblt =0. ! T a la Hauteur de couche limite
520         therm =0.         therm =0.
521         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
522         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
523         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
524    
525         IF (if_ebil >= 1) d_h_vcol_phy = 0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
# Line 632  contains Line 535  contains
535         ! Initialiser les compteurs:         ! Initialiser les compteurs:
536    
537         frugs = 0.         frugs = 0.
538         itap = 0         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
539         itaprad = 0              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
540         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
541              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &
542              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &              run_off_lic_0, sig1, w01, ncid_startphy, itau_phy)
             zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &  
             run_off_lic_0, sig1, w01)  
543    
544         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
545         q2 = 1e-8         q2 = 1e-8
546    
547         radpas = NINT(86400. / dtphys / nbapp_rad)         lmt_pas = day_step / iphysiq
548           print *, 'Number of time steps of "physics" per day: ', lmt_pas
549    
550           radpas = lmt_pas / nbapp_rad
551    
552         ! on remet le calendrier a zero         ! On remet le calendrier a zero
553         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
554    
555         CALL printflag(radpas, ok_journe, ok_instan, ok_region)         CALL printflag(radpas, ok_journe, ok_instan, ok_region)
556    
        IF (dtphys * radpas > 21600. .AND. cycle_diurne) THEN  
           print *, "Au minimum 4 appels par jour si cycle diurne"  
           call abort_gcm('physiq', &  
                "Nombre d'appels au rayonnement insuffisant", 1)  
        ENDIF  
   
557         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
558         IF (iflag_con >= 3) THEN         IF (conv_emanuel) THEN
559            ibas_con = 1            ibas_con = 1
560            itop_con = 1            itop_con = 1
561         ENDIF         ENDIF
# Line 669  contains Line 567  contains
567            rugoro = 0.            rugoro = 0.
568         ENDIF         ENDIF
569    
        lmt_pas = NINT(86400. / dtphys) ! tous les jours  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
570         ecrit_ins = NINT(ecrit_ins/dtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
571         ecrit_hf = NINT(ecrit_hf/dtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
572         ecrit_mth = NINT(ecrit_mth/dtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
# Line 680  contains Line 575  contains
575    
576         ! Initialisation des sorties         ! Initialisation des sorties
577    
578         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins, itau_phy)
579         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
580         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
581         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
582           CALL phyredem0(lmt_pas, itau_phy)
583      ENDIF test_firstcal      ENDIF test_firstcal
584    
585      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
# Line 693  contains Line 589  contains
589      v_seri = v      v_seri = v
590      q_seri = qx(:, :, ivap)      q_seri = qx(:, :, ivap)
591      ql_seri = qx(:, :, iliq)      ql_seri = qx(:, :, iliq)
592      tr_seri = qx(:, :, 3: nqmx)      tr_seri = qx(:, :, 3:nqmx)
593    
594      ztsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
595    
596      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
597         tit = 'after dynamics'         tit = 'after dynamics'
598         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
599              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
600         ! Comme les tendances de la physique sont ajout\'es dans la         ! Comme les tendances de la physique sont ajout\'es dans la
601         !  dynamique, la variation d'enthalpie par la dynamique devrait         ! dynamique, la variation d'enthalpie par la dynamique devrait
602         !  \^etre \'egale \`a la variation de la physique au pas de temps         ! \^etre \'egale \`a la variation de la physique au pas de temps
603         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre         ! pr\'ec\'edent. Donc la somme de ces 2 variations devrait \^etre
604         !  nulle.         ! nulle.
605         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
606              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
607              d_qt, 0.)              d_qt, 0.)
# Line 760  contains Line 656  contains
656      ENDDO      ENDDO
657      ql_seri = 0.      ql_seri = 0.
658    
659      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
660         tit = 'after reevap'         tit = 'after reevap'
661         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
662              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
# Line 778  contains Line 674  contains
674      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
675         CALL zenang(longi, time, dtphys * radpas, mu0, fract)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
676      ELSE      ELSE
677         mu0 = -999.999         mu0 = - 999.999
678      ENDIF      ENDIF
679    
680      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
681      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
     albsollw = sum(falblw * pctsrf, dim = 2)  
682    
683      ! R\'epartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
684      ! R\'epartition du longwave par sous-surface lin\'earis\'ee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
# Line 799  contains Line 694  contains
694      ! Couche limite:      ! Couche limite:
695    
696      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &
697           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, &           v_seri, julien, mu0, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &
698           ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, &           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &
699           fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, &           fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, &
700           fder, rlat, frugs, firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, &           firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &
701           d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &
702           q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, &           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, &
703           capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblT, therm, trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, &
704           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab)           run_off_lic_0)
705    
706      ! Incr\'ementation des flux      ! Incr\'ementation des flux
707    
# Line 839  contains Line 734  contains
734         ENDDO         ENDDO
735      ENDDO      ENDDO
736    
737      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
738         tit = 'after clmain'         tit = 'after clmain'
739         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
740              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
# Line 860  contains Line 755  contains
755         zxffonte(i) = 0.         zxffonte(i) = 0.
756         zxfqcalving(i) = 0.         zxfqcalving(i) = 0.
757    
758         s_pblh(i) = 0.         s_pblh(i) = 0.
759         s_lcl(i) = 0.         s_lcl(i) = 0.
760         s_capCL(i) = 0.         s_capCL(i) = 0.
761         s_oliqCL(i) = 0.         s_oliqCL(i) = 0.
762         s_cteiCL(i) = 0.         s_cteiCL(i) = 0.
# Line 872  contains Line 767  contains
767         s_trmb3(i) = 0.         s_trmb3(i) = 0.
768    
769         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
770              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &              + pctsrf(i, is_sic) - 1.) > EPSFRA) print *, &
771              'physiq : probl\`eme sous surface au point ', i, &              'physiq : probl\`eme sous surface au point ', i, &
772              pctsrf(i, 1 : nbsrf)              pctsrf(i, 1 : nbsrf)
773      ENDDO      ENDDO
# Line 930  contains Line 825  contains
825      ! Calculer la dérive du flux infrarouge      ! Calculer la dérive du flux infrarouge
826    
827      DO i = 1, klon      DO i = 1, klon
828         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
829      ENDDO      ENDDO
830    
831      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)
832    
833      ! Appeler la convection (au choix)      ! Appeler la convection
   
     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  
834    
835        if (conv_emanuel) then
836         da = 0.         da = 0.
837         mp = 0.         mp = 0.
838         phi = 0.         phi = 0.
839         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
840              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, &
841              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &              itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, pmflxr, &
842              qcondc, wd, pmflxr, pmflxs, da, phi, mp)              da, phi, mp)
843           snow_con = 0.
844         clwcon0 = qcondc         clwcon0 = qcondc
845         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
846    
847         IF (thermcep) THEN         IF (thermcep) THEN
848            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
# Line 976  contains Line 856  contains
856         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
857              rnebcon0)              rnebcon0)
858    
859           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
860         mfd = 0.         mfd = 0.
861         pen_u = 0.         pen_u = 0.
862         pen_d = 0.         pen_d = 0.
863         pde_d = 0.         pde_d = 0.
864         pde_u = 0.         pde_u = 0.
865        else
866           conv_q = d_q_dyn + d_q_vdf / dtphys
867           conv_t = d_t_dyn + d_t_vdf / dtphys
868           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
869           CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
870                q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &
871                d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
872                mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
873                kdtop, pmflxr, pmflxs)
874           WHERE (rain_con < 0.) rain_con = 0.
875           WHERE (snow_con < 0.) snow_con = 0.
876           ibas_con = llm + 1 - kcbot
877           itop_con = llm + 1 - kctop
878      END if      END if
879    
880      DO k = 1, llm      DO k = 1, llm
# Line 992  contains Line 886  contains
886         ENDDO         ENDDO
887      ENDDO      ENDDO
888    
889      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
890         tit = 'after convect'         tit = 'after convect'
891         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
892              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
# Line 1014  contains Line 908  contains
908         print *, "Precip = ", zx_t         print *, "Precip = ", zx_t
909      ENDIF      ENDIF
910    
911      IF (iflag_con == 2) THEN      IF (.not. conv_emanuel) THEN
912         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
913         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
914         DO k = 1, llm         DO k = 1, llm
# Line 1046  contains Line 940  contains
940              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)
941      endif      endif
942    
943      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
944         tit = 'after dry_adjust'         tit = 'after dry_adjust'
945         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
946              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
# Line 1073  contains Line 967  contains
967      do k = 1, llm      do k = 1, llm
968         do i = 1, klon         do i = 1, klon
969            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
970                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
971         enddo         enddo
972      enddo      enddo
973    
# Line 1120  contains Line 1014  contains
1014         print *, "Precip = ", zx_t         print *, "Precip = ", zx_t
1015      ENDIF      ENDIF
1016    
1017      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1018         tit = 'after fisrt'         tit = 'after fisrt'
1019         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1020              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
# Line 1132  contains Line 1026  contains
1026    
1027      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1028    
1029      IF (iflag_cldcon <= -1) THEN      IF (iflag_cldcon <= - 1) THEN
1030         ! seulement pour Tiedtke         ! seulement pour Tiedtke
1031         snow_tiedtke = 0.         snow_tiedtke = 0.
1032         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
1033            rain_tiedtke = rain_con            rain_tiedtke = rain_con
1034         else         else
1035            rain_tiedtke = 0.            rain_tiedtke = 0.
1036            do k = 1, llm            do k = 1, llm
1037               do i = 1, klon               do i = 1, klon
1038                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1039                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k)/dtphys &
1040                          *zmasse(i, k)                          *zmasse(i, k)
1041                  endif                  endif
1042               enddo               enddo
# Line 1212  contains Line 1106  contains
1106            IF (thermcep) THEN            IF (thermcep) THEN
1107               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)
1108               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1109               zcor = 1./(1.-retv*zx_qs)               zcor = 1./(1. - retv*zx_qs)
1110               zx_qs = zx_qs*zcor               zx_qs = zx_qs*zcor
1111            ELSE            ELSE
1112               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
# Line 1252  contains Line 1146  contains
1146              bl95_b1, cldtaupi, re, fl)              bl95_b1, cldtaupi, re, fl)
1147      endif      endif
1148    
1149      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
1150         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
1151         DO i = 1, klon         ! Calcul de l'abedo moyen par maille
1152            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &         albsol = sum(falbe * pctsrf, dim = 2)
1153                 + falbe(i, is_lic) * pctsrf(i, is_lic) &  
                + falbe(i, is_ter) * pctsrf(i, is_ter) &  
                + falbe(i, is_sic) * pctsrf(i, is_sic)  
           albsollw(i) = falblw(i, is_oce) * pctsrf(i, is_oce) &  
                + falblw(i, is_lic) * pctsrf(i, is_lic) &  
                + falblw(i, is_ter) * pctsrf(i, is_ter) &  
                + falblw(i, is_sic) * pctsrf(i, is_sic)  
        ENDDO  
1154         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
1155         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &
1156              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
1157              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
1158              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
1159              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &
1160              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)              solswad, cldtaupi, topswai, solswai)
        itaprad = 0  
1161      ENDIF      ENDIF
1162    
     itaprad = itaprad + 1  
   
1163      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
1164    
1165      DO k = 1, llm      DO k = 1, llm
1166         DO i = 1, klon         DO i = 1, klon
1167            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/86400.
1168         ENDDO         ENDDO
1169      ENDDO      ENDDO
1170    
1171      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1172         tit = 'after rad'         tit = 'after rad'
1173         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1174              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
# Line 1313  contains Line 1197  contains
1197      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1198    
1199      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1200         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
1201         igwd = 0         igwd = 0
1202         DO i = 1, klon         DO i = 1, klon
1203            itest(i) = 0            itest(i) = 0
1204            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
1205               itest(i) = 1               itest(i) = 1
1206               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1207            ENDIF            ENDIF
1208         ENDDO         ENDDO
1209    
1210         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1211              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1212              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
1213    
1214         ! ajout des tendances         ! ajout des tendances
1215         DO k = 1, llm         DO k = 1, llm
# Line 1343  contains Line 1226  contains
1226         igwd = 0         igwd = 0
1227         DO i = 1, klon         DO i = 1, klon
1228            itest(i) = 0            itest(i) = 0
1229            IF ((zpic(i) - zmea(i)) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
1230               itest(i) = 1               itest(i) = 1
1231               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1232            ENDIF            ENDIF
1233         ENDDO         ENDDO
1234    
# Line 1379  contains Line 1261  contains
1261         ENDDO         ENDDO
1262      ENDDO      ENDDO
1263    
1264      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1265           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1266    
1267      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1268           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
# Line 1389  contains Line 1271  contains
1271      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1272      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &
1273           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &
1274           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, da, phi, mp, &           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, &
1275           upwd, dnwd, tr_seri, zmasse)           dnwd, tr_seri, zmasse, ncid_startphy, nid_ins, itau_phy)
1276    
1277      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &      IF (offline) call phystokenc(dtphys, t, mfu, mfd, pen_u, pde_u, pen_d, &
1278           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &
1279           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)           frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
1280    
1281      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1282      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
          ue, uq)  
1283    
1284      ! diag. bilKP      ! diag. bilKP
1285    
1286      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, &
1287           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1288    
1289      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
# Line 1418  contains Line 1299  contains
1299         END DO         END DO
1300      END DO      END DO
1301    
1302      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1303         tit = 'after physic'         tit = 'after physic'
1304         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1305              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
1306         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1307         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1308         ! est egale a la variation de la physique au pas de temps precedent.         ! est egale a la variation de la physique au pas de temps precedent.
1309         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
# Line 1456  contains Line 1337  contains
1337      DO iq = 3, nqmx      DO iq = 3, nqmx
1338         DO k = 1, llm         DO k = 1, llm
1339            DO i = 1, klon            DO i = 1, klon
1340               d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys               d_qx(i, k, iq) = (tr_seri(i, k, iq - 2) - qx(i, k, iq)) / dtphys
1341            ENDDO            ENDDO
1342         ENDDO         ENDDO
1343      ENDDO      ENDDO
# Line 1469  contains Line 1350  contains
1350         ENDDO         ENDDO
1351      ENDDO      ENDDO
1352    
     ! Ecriture des sorties  
1353      call write_histins      call write_histins
1354    
1355      ! Si c'est la fin, il faut conserver l'etat de redemarrage      IF (lafin) then
1356      IF (lafin) THEN         call NF95_CLOSE(ncid_startphy)
1357         itau_phy = itau_phy + itap         CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1358         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1359              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1360              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1361              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              w01)
1362              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)      end IF
     ENDIF  
1363    
1364      firstcal = .FALSE.      firstcal = .FALSE.
1365    
# Line 1490  contains Line 1369  contains
1369    
1370        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09
1371    
1372        use dimens_m, only: iim, jjm        ! Ecriture des sorties
1373    
1374          use gr_phy_write_m, only: gr_phy_write
1375        USE histsync_m, ONLY: histsync        USE histsync_m, ONLY: histsync
1376        USE histwrite_m, ONLY: histwrite        USE histwrite_m, ONLY: histwrite
1377    
1378        real zout        integer itau_w ! pas de temps d'\'ecriture
       integer itau_w ! pas de temps ecriture  
       REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
1379    
1380        !--------------------------------------------------        !--------------------------------------------------
1381    
1382        IF (ok_instan) THEN        IF (ok_instan) THEN
          ! Champs 2D:  
   
          zsto = dtphys * ecrit_ins  
          zout = dtphys * ecrit_ins  
1383           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1384             CALL histwrite(nid_ins, "phis", itau_w, gr_phy_write(pphis))
1385           i = NINT(zout/zsto)           CALL histwrite(nid_ins, "aire", itau_w, gr_phy_write(airephy))
1386           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, gr_phy_write(paprs(:, 1)))
1387           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, &
1388                  gr_phy_write(rain_fall + snow_fall))
1389           i = NINT(zout/zsto)           CALL histwrite(nid_ins, "plul", itau_w, &
1390           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)                gr_phy_write(rain_lsc + snow_lsc))
1391           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, &
1392                  gr_phy_write(rain_con + snow_con))
1393           DO i = 1, klon           CALL histwrite(nid_ins, "tsol", itau_w, gr_phy_write(zxtsol))
1394              zx_tmp_fi2d(i) = paprs(i, 1)           CALL histwrite(nid_ins, "t2m", itau_w, gr_phy_write(zt2m))
1395           ENDDO           CALL histwrite(nid_ins, "q2m", itau_w, gr_phy_write(zq2m))
1396           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, gr_phy_write(zu10m))
1397           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, gr_phy_write(zv10m))
1398             CALL histwrite(nid_ins, "snow", itau_w, gr_phy_write(snow_fall))
1399           DO i = 1, klon           CALL histwrite(nid_ins, "cdrm", itau_w, gr_phy_write(cdragm))
1400              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)           CALL histwrite(nid_ins, "cdrh", itau_w, gr_phy_write(cdragh))
1401           ENDDO           CALL histwrite(nid_ins, "topl", itau_w, gr_phy_write(toplw))
1402           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, gr_phy_write(evap))
1403           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, gr_phy_write(solsw))
1404             CALL histwrite(nid_ins, "soll", itau_w, gr_phy_write(sollw))
1405           DO i = 1, klon           CALL histwrite(nid_ins, "solldown", itau_w, gr_phy_write(sollwdown))
1406              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)           CALL histwrite(nid_ins, "bils", itau_w, gr_phy_write(bils))
1407           ENDDO           CALL histwrite(nid_ins, "sens", itau_w, gr_phy_write(- sens))
1408           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, gr_phy_write(fder))
1409           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, &
1410                  gr_phy_write(d_ts(:, is_oce)))
1411           DO i = 1, klon           CALL histwrite(nid_ins, "dtsvdft", itau_w, &
1412              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)                gr_phy_write(d_ts(:, is_ter)))
1413           ENDDO           CALL histwrite(nid_ins, "dtsvdfg", itau_w, &
1414           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)                gr_phy_write(d_ts(:, is_lic)))
1415           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, &
1416                  gr_phy_write(d_ts(:, is_sic)))
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)  
          CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)  
          !ccIM  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)  
          CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)  
          CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)  
          CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)  
          CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)  
   
          zx_tmp_fi2d(1:klon) = -1*sens(1:klon)  
          ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)  
          CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)  
1417    
1418           DO nsrf = 1, nbsrf           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)  
1419              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1420                   zx_tmp_2d)                   gr_phy_write(pctsrf(:, nsrf)*100.))
   
             zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
1421              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1422                   zx_tmp_2d)                   gr_phy_write(pctsrf(:, nsrf)))
   
             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)  
1423              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1424                   zx_tmp_2d)                   gr_phy_write(fluxt(:, 1, nsrf)))
   
             zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
1425              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1426                   zx_tmp_2d)                   gr_phy_write(fluxlat(:, nsrf)))
   
             zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
1427              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1428                   zx_tmp_2d)                   gr_phy_write(ftsol(:, nsrf)))
   
             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)  
1429              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1430                   zx_tmp_2d)                   gr_phy_write(fluxu(:, 1, nsrf)))
   
             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)  
1431              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1432                   zx_tmp_2d)                   gr_phy_write(fluxv(:, 1, nsrf)))
   
             zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
1433              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1434                   zx_tmp_2d)                   gr_phy_write(frugs(:, nsrf)))
   
             zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
1435              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1436                   zx_tmp_2d)                   gr_phy_write(falbe(:, nsrf)))
   
1437           END DO           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, albsollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albslw", 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)  
1438    
1439             CALL histwrite(nid_ins, "albs", itau_w, gr_phy_write(albsol))
1440             CALL histwrite(nid_ins, "rugs", itau_w, gr_phy_write(zxrugs))
1441             CALL histwrite(nid_ins, "s_pblh", itau_w, gr_phy_write(s_pblh))
1442             CALL histwrite(nid_ins, "s_pblt", itau_w, gr_phy_write(s_pblt))
1443             CALL histwrite(nid_ins, "s_lcl", itau_w, gr_phy_write(s_lcl))
1444             CALL histwrite(nid_ins, "s_capCL", itau_w, gr_phy_write(s_capCL))
1445             CALL histwrite(nid_ins, "s_oliqCL", itau_w, gr_phy_write(s_oliqCL))
1446             CALL histwrite(nid_ins, "s_cteiCL", itau_w, gr_phy_write(s_cteiCL))
1447             CALL histwrite(nid_ins, "s_therm", itau_w, gr_phy_write(s_therm))
1448             CALL histwrite(nid_ins, "s_trmb1", itau_w, gr_phy_write(s_trmb1))
1449             CALL histwrite(nid_ins, "s_trmb2", itau_w, gr_phy_write(s_trmb2))
1450             CALL histwrite(nid_ins, "s_trmb3", itau_w, gr_phy_write(s_trmb3))
1451             if (conv_emanuel) CALL histwrite(nid_ins, "ptop", itau_w, &
1452                  gr_phy_write(ema_pct))
1453             CALL histwrite(nid_ins, "temp", itau_w, gr_phy_write(t_seri))
1454             CALL histwrite(nid_ins, "vitu", itau_w, gr_phy_write(u_seri))
1455             CALL histwrite(nid_ins, "vitv", itau_w, gr_phy_write(v_seri))
1456             CALL histwrite(nid_ins, "geop", itau_w, gr_phy_write(zphi))
1457             CALL histwrite(nid_ins, "pres", itau_w, gr_phy_write(play))
1458             CALL histwrite(nid_ins, "dtvdf", itau_w, gr_phy_write(d_t_vdf))
1459             CALL histwrite(nid_ins, "dqvdf", itau_w, gr_phy_write(d_q_vdf))
1460             CALL histwrite(nid_ins, "rhum", itau_w, gr_phy_write(zx_rh))
1461           call histsync(nid_ins)           call histsync(nid_ins)
1462        ENDIF        ENDIF
1463    
Legend:
Removed from v.134  
changed lines
  Added in v.190
  ViewVC Help
Powered by ViewVC 1.1.21