/[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/libf/phylmd/physiq.f90 revision 51 by guez, Tue Sep 20 09:14:34 2011 UTC trunk/phylmd/physiq.f revision 97 by guez, Fri Apr 25 14:58:31 2014 UTC
# Line 5  module physiq_m Line 5  module physiq_m
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)         u, v, t, 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
11        ! (subversion revision 678)
12    
     ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)  
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    
17        use aaam_bud_m, only: aaam_bud
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
19      USE calendar, ONLY: ymds2ju      use aeropt_m, only: aeropt
20        use ajsec_m, only: ajsec
21        use calltherm_m, only: calltherm
22      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
23           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin           ecrit_mth, 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, iflag_con, nbapp_rad, new_oliq, &
25           ok_orodr, ok_orolf, soil_model           ok_orodr, ok_orolf, soil_model
26      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
27        use clouds_gno_m, only: clouds_gno
28      USE comgeomphy, ONLY: airephy, cuphy, cvphy      USE comgeomphy, ONLY: airephy, cuphy, cvphy
29      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
30      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date
31      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
32        use conflx_m, only: conflx
33      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
34        use diagcld2_m, only: diagcld2
35      use diagetpq_m, only: diagetpq      use diagetpq_m, only: diagetpq
36      USE dimens_m, ONLY: iim, jjm, llm, nqmx      use diagphy_m, only: diagphy
37        USE dimens_m, ONLY: llm, nqmx
38      USE dimphy, ONLY: klon, nbtr      USE dimphy, ONLY: klon, nbtr
39      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
40        use drag_noro_m, only: drag_noro
41      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
42        use fisrtilp_m, only: fisrtilp
43      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
     USE histcom, ONLY: histsync  
     USE histwrite_m, ONLY: histwrite  
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
     USE ini_histhf_m, ONLY: ini_histhf  
     USE ini_histday_m, ONLY: ini_histday  
46      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
47        use newmicro_m, only: newmicro
48      USE oasis_m, ONLY: ok_oasis      USE oasis_m, ONLY: ok_oasis
49      USE orbite_m, ONLY: orbite, zenang      USE orbite_m, ONLY: orbite, zenang
50      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
# Line 45  contains Line 53  contains
53      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
54      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
55      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
56        use radlwsw_m, only: radlwsw
57        use readsulfate_m, only: readsulfate
58        use sugwd_m, only: sugwd
59      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
60      USE temps, ONLY: annee_ref, day_ref, itau_phy      USE temps, ONLY: annee_ref, day_ref, itau_phy
61        use unit_nml_m, only: unit_nml
62        USE ymds2ju_m, ONLY: ymds2ju
63      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
64    
65      ! Arguments:      logical, intent(in):: lafin ! dernier passage
66    
67      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
68      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
69    
70      REAL, intent(in):: time ! heure de la journée en fraction de jour      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
71      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
     logical, intent(in):: lafin ! dernier passage  
72    
73      REAL, intent(in):: paprs(klon, llm + 1)      REAL, intent(in):: paprs(klon, llm + 1)
74      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
# Line 65  contains Line 77  contains
77      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
78    
79      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(klon, llm)
80      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! géopotentiel de chaque couche (référence sol)
81    
82      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! géopotentiel du sol
83    
84      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(klon, llm)
85      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
# Line 76  contains Line 88  contains
88      REAL, intent(in):: t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(klon, llm) ! input temperature (K)
89    
90      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
91      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
92    
93      REAL omega(klon, llm) ! input vitesse verticale en Pa/s      REAL, intent(in):: omega(klon, llm) ! vitesse verticale en Pa/s
94      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m s-2)
95      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m s-2)
96      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)
97      REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)      REAL, intent(out):: d_qx(klon, llm, nqmx) ! tendance physique de "qx" (s-1)
98      REAL d_ps(klon) ! output tendance physique de la pression au sol  
99        ! Local:
100    
101      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
102    
103      INTEGER nbteta      INTEGER nbteta
104      PARAMETER(nbteta = 3)      PARAMETER(nbteta = 3)
105    
     REAL PVteta(klon, nbteta)  
     ! (output vorticite potentielle a des thetas constantes)  
   
     LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl = .TRUE.)  
106      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
107      PARAMETER (ok_gust = .FALSE.)      PARAMETER (ok_gust = .FALSE.)
108    
# Line 109  contains Line 117  contains
117      logical rnpb      logical rnpb
118      parameter(rnpb = .true.)      parameter(rnpb = .true.)
119    
120      character(len = 6), save:: ocean      character(len = 6):: ocean = 'force '
121      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      ! (type de mod\`ele oc\'ean \`a utiliser: "force" ou "slab" mais
122        ! pas "couple")
     logical ok_ocean  
     SAVE ok_ocean  
123    
124      ! "slab" ocean      ! "slab" ocean
125      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
# Line 122  contains Line 128  contains
128      REAL fluxg(klon) ! flux turbulents ocean-atmosphere      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
129    
130      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
131      logical, save:: ok_veget      logical:: ok_veget = .false. ! type de modele de vegetation utilise
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
132    
133      LOGICAL ok_mensuel ! sortir le fichier mensuel      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
134        ! sorties journalieres, mensuelles et instantanees dans les
135      LOGICAL ok_instan ! sortir le fichier instantane      ! fichiers histday, histmth et histins
     save ok_instan  
136    
137      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
138      PARAMETER (ok_region = .FALSE.)      PARAMETER (ok_region = .FALSE.)
# Line 151  contains Line 155  contains
155    
156      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
157    
158      !IM Amip2 PV a theta constante      ! Amip2 PV a theta constante
159    
160      CHARACTER(LEN = 3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
161      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
162      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
163      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
164    
165      !MI Amip2 PV a theta constante      ! Amip2 PV a theta constante
   
     INTEGER klevp1  
     PARAMETER(klevp1 = llm + 1)  
166    
167      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
168      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
169      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
170    
171      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
172      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
173      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
174    
175      !IM Amip2      ! Amip2
176      ! variables a une pression donnee      ! variables a une pression donnee
177    
178      integer nlevSTD      integer nlevSTD
# Line 199  contains Line 200  contains
200      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
201    
202      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
203      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./
204      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
205    
206      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# Line 240  contains Line 241  contains
241           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &
242           'pc= 680-800hPa, tau> 60.'/           'pc= 680-800hPa, tau> 60.'/
243    
244      !IM ISCCP simulator v3.4      ! ISCCP simulator v3.4
   
     integer nid_hf, nid_hf3d  
     save nid_hf, nid_hf3d  
245    
246      ! Variables propres a la physique      ! Variables propres a la physique
247    
# Line 261  contains Line 259  contains
259      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
260      ! soil temperature of surface fraction      ! soil temperature of surface fraction
261    
262      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap ! evaporation  
263      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
264      SAVE fluxlat      SAVE fluxlat
265    
# Line 279  contains Line 276  contains
276      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
277      SAVE falblw ! albedo par type de surface      SAVE falblw ! albedo par type de surface
278    
279      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
280      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
281      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
282      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 301  contains Line 298  contains
298      !KE43      !KE43
299      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
300    
     REAL bas, top ! cloud base and top levels  
     SAVE bas  
     SAVE top  
   
301      REAL Ma(klon, llm) ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
302      SAVE Ma      SAVE Ma
303      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
304      SAVE qcondc      SAVE qcondc
305      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
306      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
307    
308      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
309    
# Line 322  contains Line 312  contains
312      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
313      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
314    
315      !AA Pour phytrac      ! Pour phytrac :
316      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
317      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
318      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
# Line 341  contains Line 331  contains
331      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
332      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
333    
334      !AA      REAL, save:: rain_fall(klon) ! pluie
335      REAL rain_fall(klon) ! pluie      REAL, save:: snow_fall(klon) ! neige
336      REAL snow_fall(klon) ! neige  
     save snow_fall, rain_fall  
     !IM cf FH pour Tiedtke 080604  
337      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
338    
339      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
340      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
341      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
342      SAVE dlw      SAVE dlw
# Line 369  contains Line 357  contains
357      INTEGER julien      INTEGER julien
358    
359      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
360      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
361      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
362    
     SAVE pctsrf ! sous-fraction du sol  
363      REAL albsol(klon)      REAL albsol(klon)
364      SAVE albsol ! albedo du sol total      SAVE albsol ! albedo du sol total
365      REAL albsollw(klon)      REAL albsollw(klon)
# Line 383  contains Line 369  contains
369    
370      ! Declaration des procedures appelees      ! Declaration des procedures appelees
371    
     EXTERNAL alboc ! calculer l'albedo sur ocean  
     EXTERNAL ajsec ! ajustement sec  
     !KE43  
     EXTERNAL conema3 ! convect4.3  
     EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)  
372      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
     EXTERNAL radlwsw ! rayonnements solaire et infrarouge  
373      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
374    
375      ! Variables locales      ! Variables locales
376    
377      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
378      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
379    
380      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
381      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 417  contains Line 395  contains
395      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
396      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
397    
398      REAL heat(klon, llm) ! chauffage solaire      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
399        ! les variables soient r\'emanentes.
400        REAL, save:: heat(klon, llm) ! chauffage solaire
401      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
402      REAL cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
403      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
404      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
405      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
406      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      real, save:: sollwdown(klon) ! downward LW flux at surface
407        REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
408      REAL albpla(klon)      REAL albpla(klon)
409      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
410      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
411      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      SAVE albpla
412      ! sauvegarder les sorties du rayonnement      SAVE heat0, cool0
     SAVE heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0  
413    
414      INTEGER itaprad      INTEGER itaprad
415      SAVE itaprad      SAVE itaprad
# Line 446  contains Line 425  contains
425      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
426      REAL zdtime ! pas de temps du rayonnement (s)      REAL zdtime ! pas de temps du rayonnement (s)
427      real zlongi      real zlongi
   
428      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
429      REAL za, zb      REAL za, zb
430      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zdelta, zcor
431      real zqsat(klon, llm)      real zqsat(klon, llm)
432      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
433      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup = 234.0)  
   
434      REAL zphi(klon, llm)      REAL zphi(klon, llm)
435    
436      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables locales pour la CLA (hbtm2)
437    
438      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
439      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 477  contains Line 451  contains
451      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
452      REAL s_trmb3(klon)      REAL s_trmb3(klon)
453    
454      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
455    
456      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
457      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
458      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
     REAL tvp(klon, llm) ! virtual temp of lifted parcel  
459      REAL cape(klon) ! CAPE      REAL cape(klon) ! CAPE
460      SAVE cape      SAVE cape
461    
     REAL pbase(klon) ! cloud base pressure  
     SAVE pbase  
     REAL bbase(klon) ! cloud base buoyancy  
     SAVE bbase  
     REAL rflag(klon) ! flag fonctionnement de convect  
462      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
     ! -- convect43:  
     INTEGER ntra ! nb traceurs pour convect4.3  
     REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)  
     REAL dplcldt(klon), dplcldr(klon)  
463    
464      ! Variables du changement      ! Variables du changement
465    
466      ! con: convection      ! con: convection
467      ! lsc: large scale condensation      ! lsc: large scale condensation
468      ! ajs: ajustement sec      ! ajs: ajustement sec
469      ! eva: évaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
470      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
471      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
472      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
# Line 511  contains Line 475  contains
475      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
476      REAL rneb(klon, llm)      REAL rneb(klon, llm)
477    
478      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
479      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
480      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
481      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
482      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
483      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
484    
485      INTEGER,save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
486    
487      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
488      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 532  contains Line 496  contains
496      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
497      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
498    
499      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
500      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
501      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
502    
503      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
504      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
505      real, save:: facttemps      real:: facttemps = 1.e-4
506      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
507      real facteur      real facteur
508    
509      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
510      logical ptconv(klon, llm)      logical ptconv(klon, llm)
511    
512      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en s\'erie :
513    
514      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
515      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
516      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
   
517      REAL tr_seri(klon, llm, nbtr)      REAL tr_seri(klon, llm, nbtr)
     REAL d_tr(klon, llm, nbtr)  
518    
519      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
520    
# Line 564  contains Line 523  contains
523      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
524      REAL aam, torsfc      REAL aam, torsfc
525    
     REAL dudyn(iim + 1, jjm + 1, llm)  
   
526      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
     REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
527    
528      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_ins
529    
530      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.
531      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.
# Line 577  contains Line 533  contains
533      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.
534    
535      REAL zsto      REAL zsto
   
     character(len = 20) modname  
     character(len = 80) abort_message  
     logical ok_sync  
536      real date0      real date0
537    
538      ! Variables liées au bilan d'énergie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
539      REAL ztsol(klon)      REAL ztsol(klon)
540      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
541      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
542      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
543      REAL zero_v(klon)      REAL zero_v(klon)
544      CHARACTER(LEN = 15) ztit      CHARACTER(LEN = 20) tit
545      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
546      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
547    
548      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique
549      REAL ZRCPD      REAL ZRCPD
550    
551      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
552      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
553      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
554      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
555      !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
556      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      ! Aerosol effects:
557    
558        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
559    
560      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
561      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
562    
563      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
564      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
565    
566      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
567      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
568    
569      ! Aerosol optical properties      ! Aerosol optical properties
570      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
571      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
   
     REAL topswad(klon), solswad(klon) ! Aerosol direct effect.  
     ! ok_ade = True -ADE = topswad-topsw  
572    
573      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
574      ! ok_aie = True ->      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
     ! ok_ade = True -AIE = topswai-topswad  
     ! ok_ade = F -AIE = topswai-topsw  
575    
576      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
577    
578      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
579      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
580      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)  
581        REAL:: bl95_b0 = 2., bl95_b1 = 0.2
582        ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
583        ! B). They link cloud droplet number concentration to aerosol mass
584        ! concentration.
585    
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
586      SAVE u10m      SAVE u10m
587      SAVE v10m      SAVE v10m
588      SAVE t2m      SAVE t2m
589      SAVE q2m      SAVE q2m
590      SAVE ffonte      SAVE ffonte
591      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
592      SAVE rain_con      SAVE rain_con
593      SAVE snow_con      SAVE snow_con
594      SAVE topswai      SAVE topswai
# Line 648  contains Line 597  contains
597      SAVE solswad      SAVE solswad
598      SAVE d_u_con      SAVE d_u_con
599      SAVE d_v_con      SAVE d_v_con
     SAVE rnebcon0  
     SAVE clwcon0  
600    
601      real zmasse(klon, llm)      real zmasse(klon, llm)
602      ! (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)
603    
604      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
605    
606        namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
607             fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
608             ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &
609             nsplit_thermals
610    
611      !----------------------------------------------------------------      !----------------------------------------------------------------
612    
613      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
614      IF (if_ebil >= 1) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
615         DO i = 1, klon           'eaux vapeur et liquide sont indispensables', 1)
           zero_v(i) = 0.  
        END DO  
     END IF  
     ok_sync = .TRUE.  
     IF (nqmx < 2) THEN  
        abort_message = 'eaux vapeur et liquide sont indispensables'  
        CALL abort_gcm(modname, abort_message, 1)  
     ENDIF  
616    
617      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
618         ! initialiser         ! initialiser
# Line 683  contains Line 627  contains
627         cg_ae = 0.         cg_ae = 0.
628         rain_con(:) = 0.         rain_con(:) = 0.
629         snow_con(:) = 0.         snow_con(:) = 0.
        bl95_b0 = 0.  
        bl95_b1 = 0.  
630         topswai(:) = 0.         topswai(:) = 0.
631         topswad(:) = 0.         topswad(:) = 0.
632         solswai(:) = 0.         solswai(:) = 0.
633         solswad(:) = 0.         solswad(:) = 0.
634    
635         d_u_con = 0.0         d_u_con = 0.
636         d_v_con = 0.0         d_v_con = 0.
637         rnebcon0 = 0.0         rnebcon0 = 0.
638         clwcon0 = 0.0         clwcon0 = 0.
639         rnebcon = 0.0         rnebcon = 0.
640         clwcon = 0.0         clwcon = 0.
641    
642         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
643         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 710  contains Line 652  contains
652    
653         IF (if_ebil >= 1) d_h_vcol_phy = 0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
654    
655         ! appel a la lecture du run.def physique         iflag_thermals = 0
656           nsplit_thermals = 1
657           print *, "Enter namelist 'physiq_nml'."
658           read(unit=*, nml=physiq_nml)
659           write(unit_nml, nml=physiq_nml)
660    
661         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         call conf_phys
             ok_instan, fact_cldcon, facttemps, ok_newmicro, &  
             iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &  
             ok_ade, ok_aie, &  
             bl95_b0, bl95_b1, &  
             iflag_thermals, nsplit_thermals)  
662    
663         ! Initialiser les compteurs:         ! Initialiser les compteurs:
664    
# Line 726  contains Line 667  contains
667         itaprad = 0         itaprad = 0
668         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
669              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
670              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &
671              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
672              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
673    
674         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
675         q2 = 1.e-8         q2 = 1e-8
676    
677         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
678    
# Line 739  contains Line 680  contains
680         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
681    
682         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
683           CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &
684                ok_instan, ok_region)
685    
686         IF(ocean.NE.'force ') THEN         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN
687            ok_ocean = .TRUE.            print *, "Au minimum 4 appels par jour si cycle diurne"
688         ENDIF            call abort_gcm('physiq', &
689                   "Nombre d'appels au rayonnement insuffisant", 1)
        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &  
             ok_region)  
   
        IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN  
           print *,'Nbre d appels au rayonnement insuffisant'  
           print *,"Au minimum 4 appels par jour si cycle diurne"  
           abort_message = 'Nbre d appels au rayonnement insuffisant'  
           call abort_gcm(modname, abort_message, 1)  
690         ENDIF         ENDIF
        print *,"Clef pour la convection, iflag_con = ", iflag_con  
        print *,"Clef pour le driver de la convection, ok_cvl = ", &  
             ok_cvl  
691    
692         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le sch\'ema de convection d'Emanuel :
693         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
694              ibas_con = 1
695            print *,"*** Convection de Kerry Emanuel 4.3 "            itop_con = 1
   
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG  
           DO i = 1, klon  
              ibas_con(i) = 1  
              itop_con(i) = 1  
           ENDDO  
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>END  
   
696         ENDIF         ENDIF
697    
698         IF (ok_orodr) THEN         IF (ok_orodr) THEN
699            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
700            CALL SUGWD(klon, llm, paprs, play)            CALL SUGWD(paprs, play)
701         else         else
702            rugoro = 0.            rugoro = 0.
703         ENDIF         ENDIF
# Line 792  contains Line 716  contains
716         npas = 0         npas = 0
717         nexca = 0         nexca = 0
718    
        print *,'AVANT HIST IFLAG_CON = ', iflag_con  
   
719         ! Initialisation des sorties         ! Initialisation des sorties
720    
        call ini_histhf(dtphys, nid_hf, nid_hf3d)  
        call ini_histday(dtphys, ok_journe, nid_day, nqmx)  
721         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
722         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
723         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
724         WRITE(*, *) 'physiq date0: ', date0         print *, 'physiq date0: ', date0
725      ENDIF test_firstcal      ENDIF test_firstcal
726    
727      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
   
     DO i = 1, klon  
        d_ps(i) = 0.0  
     ENDDO  
     DO iq = 1, nqmx  
        DO k = 1, llm  
           DO i = 1, klon  
              d_qx(i, k, iq) = 0.0  
           ENDDO  
        ENDDO  
     ENDDO  
728      da = 0.      da = 0.
729      mp = 0.      mp = 0.
730      phi = 0.      phi = 0.
731    
732      ! Ne pas affecter les valeurs entrées de u, v, h, et q :      ! We will modify variables *_seri and we will not touch variables
733        ! u, v, h, q:
734      DO k = 1, llm      DO k = 1, llm
735         DO i = 1, klon         DO i = 1, klon
736            t_seri(i, k) = t(i, k)            t_seri(i, k) = t(i, k)
# Line 848  contains Line 757  contains
757      ENDDO      ENDDO
758    
759      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
760         ztit = 'after dynamics'         tit = 'after dynamics'
761         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
762              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
763              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
764         ! Comme les tendances de la physique sont ajoutés dans la         ! Comme les tendances de la physique sont ajout\'es dans la
765         !  dynamique, la variation d'enthalpie par la dynamique devrait         !  dynamique, la variation d'enthalpie par la dynamique devrait
766         !  être égale à la variation de la physique au pas de temps         !  \^etre \'egale \`a la variation de la physique au pas de temps
767         !  précédent.  Donc la somme de ces 2 variations devrait être         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre
768         !  nulle.         !  nulle.
769         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
770              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, &
771              d_qt, 0., fs_bound, fq_bound)              d_qt, 0., fs_bound, fq_bound)
772      END IF      END IF
# Line 873  contains Line 782  contains
782      ELSE      ELSE
783         DO k = 1, llm         DO k = 1, llm
784            DO i = 1, klon            DO i = 1, klon
785               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
786               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
787            ENDDO            ENDDO
788         ENDDO         ENDDO
789         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 897  contains Line 806  contains
806    
807      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
808    
809      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst etc.).
810    
811      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
812      if (nqmx >= 5) then      wo = ozonecm(REAL(julien), paprs)
        wo = qx(:, :, 5) * zmasse / dobson_u / 1e3  
     else IF (MOD(itap - 1, lmt_pas) == 0) THEN  
        wo = ozonecm(REAL(julien), paprs)  
     ENDIF  
813    
814      ! Évaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
815      DO k = 1, llm      DO k = 1, llm
816         DO i = 1, klon         DO i = 1, klon
817            zb = MAX(0., ql_seri(i, k))            zb = MAX(0., ql_seri(i, k))
# Line 918  contains Line 823  contains
823      ql_seri = 0.      ql_seri = 0.
824    
825      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
826         ztit = 'after reevap'         tit = 'after reevap'
827         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
828              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
829              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
830         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
831              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
832              fs_bound, fq_bound)              fs_bound, fq_bound)
833    
# Line 931  contains Line 836  contains
836      ! Appeler la diffusion verticale (programme de couche limite)      ! Appeler la diffusion verticale (programme de couche limite)
837    
838      DO i = 1, klon      DO i = 1, klon
839         zxrugs(i) = 0.0         zxrugs(i) = 0.
840      ENDDO      ENDDO
841      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
842         DO i = 1, klon         DO i = 1, klon
# Line 964  contains Line 869  contains
869         ENDDO         ENDDO
870      ENDDO      ENDDO
871    
872      ! Repartition sous maille des flux LW et SW      ! R\'epartition sous maille des flux longwave et shortwave
873      ! Repartition du longwave par sous-surface linearisee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
874    
875      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
876         DO i = 1, klon         DO i = 1, klon
877            fsollw(i, nsrf) = sollw(i) &            fsollw(i, nsrf) = sollw(i) &
878                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))
879            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))
880         ENDDO         ENDDO
881      ENDDO      ENDDO
882    
# Line 979  contains Line 884  contains
884    
885      ! Couche limite:      ! Couche limite:
886    
887      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &
888           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &
889           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
890           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
891           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &
892           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           frugs, firstcal, agesno, rugoro, d_t_vdf, &
893           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
894           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
895           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
896           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
897    
898      ! Incrémentation des flux      ! Incr\'ementation des flux
899    
900      zxfluxt = 0.      zxfluxt = 0.
901      zxfluxq = 0.      zxfluxq = 0.
# Line 999  contains Line 904  contains
904      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
905         DO k = 1, llm         DO k = 1, llm
906            DO i = 1, klon            DO i = 1, klon
907               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
908                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
909               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
910                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxv(i, k) = zxfluxv(i, k) + fluxv(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)  
911            END DO            END DO
912         END DO         END DO
913      END DO      END DO
914      DO i = 1, klon      DO i = 1, klon
915         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
916         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol
917         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
918      ENDDO      ENDDO
919    
# Line 1026  contains Line 927  contains
927      ENDDO      ENDDO
928    
929      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
930         ztit = 'after clmain'         tit = 'after clmain'
931         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
932              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
933              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
934         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
935              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
936              fs_bound, fq_bound)              fs_bound, fq_bound)
937      END IF      END IF
# Line 1038  contains Line 939  contains
939      ! Update surface temperature:      ! Update surface temperature:
940    
941      DO i = 1, klon      DO i = 1, klon
942         zxtsol(i) = 0.0         zxtsol(i) = 0.
943         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
944    
945         zt2m(i) = 0.0         zt2m(i) = 0.
946         zq2m(i) = 0.0         zq2m(i) = 0.
947         zu10m(i) = 0.0         zu10m(i) = 0.
948         zv10m(i) = 0.0         zv10m(i) = 0.
949         zxffonte(i) = 0.0         zxffonte(i) = 0.
950         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
951    
952         s_pblh(i) = 0.0         s_pblh(i) = 0.
953         s_lcl(i) = 0.0         s_lcl(i) = 0.
954         s_capCL(i) = 0.0         s_capCL(i) = 0.
955         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
956         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
957         s_pblT(i) = 0.0         s_pblT(i) = 0.
958         s_therm(i) = 0.0         s_therm(i) = 0.
959         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
960         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
961         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
962    
963         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
964              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
965              THEN              'physiq : probl\`eme sous surface au point ', i, &
966            WRITE(*, *) 'physiq : pb sous surface au point ', i, &              pctsrf(i, 1 : nbsrf)
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
967      ENDDO      ENDDO
968      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
969         DO i = 1, klon         DO i = 1, klon
# Line 1092  contains Line 991  contains
991         ENDDO         ENDDO
992      ENDDO      ENDDO
993    
994      ! Si une sous-fraction n'existe pas, elle prend la temp. moyenne      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :
   
995      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
996         DO i = 1, klon         DO i = 1, klon
997            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
# Line 1121  contains Line 1019  contains
1019      ! Calculer la derive du flux infrarouge      ! Calculer la derive du flux infrarouge
1020    
1021      DO i = 1, klon      DO i = 1, klon
1022         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
1023      ENDDO      ENDDO
1024    
1025      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
1026    
1027      DO k = 1, llm      DO k = 1, llm
1028         DO i = 1, klon         DO i = 1, klon
1029            conv_q(i, k) = d_q_dyn(i, k) &            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys
1030                 + d_q_vdf(i, k)/dtphys            conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k)/dtphys
           conv_t(i, k) = d_t_dyn(i, k) &  
                + d_t_vdf(i, k)/dtphys  
1031         ENDDO         ENDDO
1032      ENDDO      ENDDO
1033    
1034      IF (check) THEN      IF (check) THEN
1035         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1036         print *, "avantcon = ", za         print *, "avantcon = ", za
1037      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
     IF (iflag_con == 2) zx_ajustq = .TRUE.  
     IF (zx_ajustq) THEN  
        DO i = 1, klon  
           z_avant(i) = 0.0  
        ENDDO  
        DO k = 1, llm  
           DO i = 1, klon  
              z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
     ENDIF  
1038    
1039      select case (iflag_con)      if (iflag_con == 2) then
1040      case (1)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1041         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
1042         stop 1              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
1043      case (2)              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
1044         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
1045              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              kdtop, pmflxr, pmflxs)
             pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &  
             pmflxs)  
1046         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1047         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1048         DO i = 1, klon         ibas_con = llm + 1 - kcbot
1049            ibas_con(i) = llm + 1 - kcbot(i)         itop_con = llm + 1 - kctop
1050            itop_con(i) = llm + 1 - kctop(i)      else
1051         ENDDO         ! iflag_con >= 3
     case (3:)  
        ! number of tracers for the Kerry-Emanuel convection:  
        ! la partie traceurs est faite dans phytrac  
        ! on met ntra = 1 pour limiter les appels mais on peut  
        ! supprimer les calculs / ftra.  
        ntra = 1  
        ! Schéma de convection modularisé et vectorisé :  
        ! (driver commun aux versions 3 et 4)  
   
        IF (ok_cvl) THEN  
           ! new driver for convectL  
           CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &  
                d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &  
                itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &  
                bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &  
                pmflxs, da, phi, mp)  
           clwcon0 = qcondc  
           pmfu = upwd + dnwd  
        ELSE  
           ! conema3 ne contient pas les traceurs  
           CALL conema3 (dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, &  
                tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &  
                d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &  
                itop_con, upwd, dnwd, dnwd0, bas, top, Ma, cape, tvp, rflag, &  
                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, clwcon0)  
        ENDIF  
1052    
1053         IF (.NOT. ok_gust) THEN         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
1054            do i = 1, klon              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &
1055               wd(i) = 0.0              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &
1056            enddo              qcondc, wd, pmflxr, pmflxs, da, phi, mp)
1057         ENDIF         clwcon0 = qcondc
1058           mfu = upwd + dnwd
1059           IF (.NOT. ok_gust) wd = 0.
1060    
1061         ! Calcul des propriétés des nuages convectifs         ! Calcul des propri\'et\'es des nuages convectifs
1062    
1063         DO k = 1, llm         DO k = 1, llm
1064            DO i = 1, klon            DO i = 1, klon
              zx_t = t_seri(i, k)  
1065               IF (thermcep) THEN               IF (thermcep) THEN
1066                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt - t_seri(i, k)))
1067                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)                  zqsat(i, k) = r2es * FOEEW(t_seri(i, k), zdelta) / play(i, k)
1068                  zx_qs = MIN(0.5, zx_qs)                  zqsat(i, k) = MIN(0.5, zqsat(i, k))
1069                  zcor = 1./(1.-retv*zx_qs)                  zqsat(i, k) = zqsat(i, k) / (1.-retv*zqsat(i, k))
                 zx_qs = zx_qs*zcor  
1070               ELSE               ELSE
1071                  IF (zx_t < t_coup) THEN                  IF (t_seri(i, k) < t_coup) THEN
1072                     zx_qs = qsats(zx_t)/play(i, k)                     zqsat(i, k) = qsats(t_seri(i, k))/play(i, k)
1073                  ELSE                  ELSE
1074                     zx_qs = qsatl(zx_t)/play(i, k)                     zqsat(i, k) = qsatl(t_seri(i, k))/play(i, k)
1075                  ENDIF                  ENDIF
1076               ENDIF               ENDIF
              zqsat(i, k) = zx_qs  
1077            ENDDO            ENDDO
1078         ENDDO         ENDDO
1079    
1080         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1081         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon * clwcon0
1082         call clouds_gno &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1083              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              rnebcon0)
1084      case default  
1085         print *, "iflag_con non-prevu", iflag_con         mfd = 0.
1086         stop 1         pen_u = 0.
1087      END select         pen_d = 0.
1088           pde_d = 0.
1089           pde_u = 0.
1090        END if
1091    
1092      DO k = 1, llm      DO k = 1, llm
1093         DO i = 1, klon         DO i = 1, klon
# Line 1242  contains Line 1099  contains
1099      ENDDO      ENDDO
1100    
1101      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1102         ztit = 'after convect'         tit = 'after convect'
1103         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1104              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1105              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1106         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1107              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &
1108              fs_bound, fq_bound)              fs_bound, fq_bound)
1109      END IF      END IF
1110    
1111      IF (check) THEN      IF (check) THEN
1112         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1113         print *,"aprescon = ", za         print *, "aprescon = ", za
1114         zx_t = 0.0         zx_t = 0.
1115         za = 0.0         za = 0.
1116         DO i = 1, klon         DO i = 1, klon
1117            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1118            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1119                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1120         ENDDO         ENDDO
1121         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1122         print *,"Precip = ", zx_t         print *, "Precip = ", zx_t
1123      ENDIF      ENDIF
1124      IF (zx_ajustq) THEN  
1125         DO i = 1, klon      IF (iflag_con == 2) THEN
1126            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1127         ENDDO         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
        DO k = 1, llm  
           DO i = 1, klon  
              z_apres(i) = z_apres(i) + (q_seri(i, k) + ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
        DO i = 1, klon  
           z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &  
                /z_apres(i)  
        ENDDO  
1128         DO k = 1, llm         DO k = 1, llm
1129            DO i = 1, klon            DO i = 1, klon
1130               IF (z_factor(i) > (1.0 + 1.0E-08) .OR. &               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
                   z_factor(i) < (1.0-1.0E-08)) THEN  
1131                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1132               ENDIF               ENDIF
1133            ENDDO            ENDDO
1134         ENDDO         ENDDO
1135      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
1136    
1137      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
1138    
1139      d_t_ajs = 0.      d_t_ajs = 0.
1140      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1310  contains Line 1155  contains
1155      endif      endif
1156    
1157      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1158         ztit = 'after dry_adjust'         tit = 'after dry_adjust'
1159         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1160              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1161              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1162      END IF      END IF
1163    
1164      ! Caclul des ratqs      ! Caclul des ratqs
1165    
1166      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
1167      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
1168      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1169         do k = 1, llm         do k = 1, llm
1170            do i = 1, klon            do i = 1, klon
1171               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1172                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1173                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       * (q_seri(i, 1) - q_seri(i, k)) / q_seri(i, k)
1174               else               else
1175                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
1176               endif               endif
# Line 1336  contains Line 1181  contains
1181      ! ratqs stables      ! ratqs stables
1182      do k = 1, llm      do k = 1, llm
1183         do i = 1, klon         do i = 1, klon
1184            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1185                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1186         enddo         enddo
1187      enddo      enddo
1188    
1189      ! ratqs final      ! ratqs final
1190      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1191         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1192         ! ratqs final         ! ratqs final
1193         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1194         ! relaxation des ratqs         ! relaxation des ratqs
1195         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
1196         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1197      else      else
1198         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1199         ratqs = ratqss         ratqs = ratqss
1200      endif      endif
1201    
     ! Processus de condensation à grande echelle et processus de  
     ! précipitation :  
1202      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1203           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1204           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
# Line 1375  contains Line 1217  contains
1217      ENDDO      ENDDO
1218      IF (check) THEN      IF (check) THEN
1219         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1220         print *,"apresilp = ", za         print *, "apresilp = ", za
1221         zx_t = 0.0         zx_t = 0.
1222         za = 0.0         za = 0.
1223         DO i = 1, klon         DO i = 1, klon
1224            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1225            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1226                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1227         ENDDO         ENDDO
1228         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1229         print *,"Precip = ", zx_t         print *, "Precip = ", zx_t
1230      ENDIF      ENDIF
1231    
1232      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1233         ztit = 'after fisrt'         tit = 'after fisrt'
1234         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1235              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1236              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1237         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1238              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &
1239              fs_bound, fq_bound)              fs_bound, fq_bound)
1240      END IF      END IF
# Line 1401  contains Line 1243  contains
1243    
1244      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1245    
1246      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1247           ! seulement pour Tiedtke
1248         snow_tiedtke = 0.         snow_tiedtke = 0.
1249         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1250            rain_tiedtke = rain_con            rain_tiedtke = rain_con
# Line 1418  contains Line 1261  contains
1261         endif         endif
1262    
1263         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1264         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1265              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1266         DO k = 1, llm         DO k = 1, llm
1267            DO i = 1, klon            DO i = 1, klon
1268               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1430  contains Line 1272  contains
1272            ENDDO            ENDDO
1273         ENDDO         ENDDO
1274      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1275         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1276         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
1277         ! facttemps         ! d'un facteur facttemps.
1278         facteur = dtphys *facttemps         facteur = dtphys * facttemps
1279         do k = 1, llm         do k = 1, llm
1280            do i = 1, klon            do i = 1, klon
1281               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1282               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1283                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1284                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1285                  clwcon(i, k) = clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1286               endif               endif
# Line 1465  contains Line 1307  contains
1307      ENDIF      ENDIF
1308    
1309      ! Precipitation totale      ! Precipitation totale
   
1310      DO i = 1, klon      DO i = 1, klon
1311         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1312         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1313      ENDDO      ENDDO
1314    
1315      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1316         ztit = "after diagcld"           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1317         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
   
     ! Calculer l'humidite relative pour diagnostique  
1318    
1319        ! Humidit\'e relative pour diagnostic :
1320      DO k = 1, llm      DO k = 1, llm
1321         DO i = 1, klon         DO i = 1, klon
1322            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1500  contains Line 1337  contains
1337            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
1338         ENDDO         ENDDO
1339      ENDDO      ENDDO
1340      !jq - introduce the aerosol direct and first indirect radiative forcings  
1341      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1342      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1343         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1344         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1345         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1346    
1347         ! Calculate aerosol optical properties (Olivier Boucher)         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1348         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &              aerindex)
             tau_ae, piz_ae, cg_ae, aerindex)  
1349      ELSE      ELSE
1350         tau_ae = 0.0         tau_ae = 0.
1351         piz_ae = 0.0         piz_ae = 0.
1352         cg_ae = 0.0         cg_ae = 0.
1353      ENDIF      ENDIF
1354    
1355      ! Calculer les parametres optiques des nuages et quelques      ! Param\`etres optiques des nuages et quelques param\`etres pour
1356      ! parametres pour diagnostiques:      ! diagnostics :
   
1357      if (ok_newmicro) then      if (ok_newmicro) then
1358         CALL newmicro (paprs, play, ok_newmicro, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1359              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1360              cldh, cldl, cldm, cldt, cldq, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             flwp, fiwp, flwc, fiwc, &  
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1361      else      else
1362         CALL nuage (paprs, play, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1363              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1364              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1365      endif      endif
1366    
1367      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1368      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1369         DO i = 1, klon         DO i = 1, klon
1370            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1552  contains Line 1376  contains
1376                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1377                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1378         ENDDO         ENDDO
1379         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1380         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1381              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1382              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
# Line 1567  contains Line 1391  contains
1391    
1392      DO k = 1, llm      DO k = 1, llm
1393         DO i = 1, klon         DO i = 1, klon
1394            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.
                + (heat(i, k)-cool(i, k)) * dtphys/86400.  
1395         ENDDO         ENDDO
1396      ENDDO      ENDDO
1397    
1398      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1399         ztit = 'after rad'         tit = 'after rad'
1400         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1401              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1402              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1403         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1404              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1405              fs_bound, fq_bound)              fs_bound, fq_bound)
1406      END IF      END IF
1407    
1408      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
1409      DO i = 1, klon      DO i = 1, klon
1410         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1411         zxsnow(i) = 0.0         zxsnow(i) = 0.
1412      ENDDO      ENDDO
1413      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1414         DO i = 1, klon         DO i = 1, klon
# Line 1594  contains Line 1417  contains
1417         ENDDO         ENDDO
1418      ENDDO      ENDDO
1419    
1420      ! Calculer le bilan du sol et la dérive de température (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
1421    
1422      DO i = 1, klon      DO i = 1, klon
1423         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1424      ENDDO      ENDDO
1425    
1426      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1427    
1428      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1429         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1430         igwd = 0         igwd = 0
1431         DO i = 1, klon         DO i = 1, klon
1432            itest(i) = 0            itest(i) = 0
1433            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN
1434               itest(i) = 1               itest(i) = 1
1435               igwd = igwd + 1               igwd = igwd + 1
1436               idx(igwd) = i               idx(igwd) = i
# Line 1629  contains Line 1452  contains
1452      ENDIF      ENDIF
1453    
1454      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1455         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
1456         igwd = 0         igwd = 0
1457         DO i = 1, klon         DO i = 1, klon
1458            itest(i) = 0            itest(i) = 0
# Line 1654  contains Line 1477  contains
1477         ENDDO         ENDDO
1478      ENDIF      ENDIF
1479    
1480      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! Stress n\'ecessaires : toute la physique
1481    
1482      DO i = 1, klon      DO i = 1, klon
1483         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1662  contains Line 1485  contains
1485      ENDDO      ENDDO
1486      DO k = 1, llm      DO k = 1, llm
1487         DO i = 1, klon         DO i = 1, klon
1488            zustrph(i) = zustrph(i) + (u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)            zustrph(i) = zustrph(i) + (u_seri(i, k) - u(i, k)) / dtphys &
1489            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)                 * zmasse(i, k)
1490              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1491                   * zmasse(i, k)
1492         ENDDO         ENDDO
1493      ENDDO      ENDDO
1494    
1495      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1496             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
     CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &  
          zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &  
          aam, torsfc)  
1497    
1498      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1499         ztit = 'after orography'           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1500         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
1501    
1502      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1503      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1504           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &           dtphys, u, t, paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, &
1505           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, &
1506           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &           albsol, rhcl, cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, &
1507           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1508           tr_seri, zmasse)  
1509        IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1510      IF (offline) THEN           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1511         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
             pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &  
             pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
     ENDIF  
1512    
1513      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1514      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
# Line 1700  contains Line 1516  contains
1516    
1517      ! diag. bilKP      ! diag. bilKP
1518    
1519      CALL transp_lay (paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
1520           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1521    
1522      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
# Line 1717  contains Line 1533  contains
1533      END DO      END DO
1534    
1535      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1536         ztit = 'after physic'         tit = 'after physic'
1537         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1538              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1539              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1540         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1541         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1542         ! 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.
1543         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1544         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1545              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1546              fs_bound, fq_bound)              fs_bound, fq_bound)
1547    
# Line 1735  contains Line 1551  contains
1551    
1552      ! SORTIES      ! SORTIES
1553    
1554      !cc prw = eau precipitable      ! prw = eau precipitable
1555      DO i = 1, klon      DO i = 1, klon
1556         prw(i) = 0.         prw(i) = 0.
1557         DO k = 1, llm         DO k = 1, llm
# Line 1774  contains Line 1590  contains
1590      ENDDO      ENDDO
1591    
1592      ! Ecriture des sorties      ! Ecriture des sorties
     call write_histhf  
     call write_histday  
1593      call write_histins      call write_histins
1594    
1595      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
# Line 1783  contains Line 1597  contains
1597         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1598         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1599              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1600              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
1601              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1602              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
1603      ENDIF      ENDIF
1604    
1605      firstcal = .FALSE.      firstcal = .FALSE.
1606    
1607    contains    contains
1608    
     subroutine write_histday  
   
       use gr_phy_write_3d_m, only: gr_phy_write_3d  
       integer itau_w ! pas de temps ecriture  
   
       !------------------------------------------------  
   
       if (ok_journe) THEN  
          itau_w = itau_phy + itap  
          if (nqmx <= 4) then  
             call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &  
                  gr_phy_write_3d(wo) * 1e3)  
             ! (convert "wo" from kDU to DU)  
          end if  
          if (ok_sync) then  
             call histsync(nid_day)  
          endif  
       ENDIF  
   
     End subroutine write_histday  
   
     !****************************  
   
     subroutine write_histhf  
   
       ! From phylmd/write_histhf.h, version 1.5 2005/05/25 13:10:09  
   
       !------------------------------------------------  
   
       call write_histhf3d  
   
       IF (ok_sync) THEN  
          call histsync(nid_hf)  
       ENDIF  
   
     end subroutine write_histhf  
   
     !***************************************************************  
   
1609      subroutine write_histins      subroutine write_histins
1610    
1611        ! 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
1612    
1613          use dimens_m, only: iim, jjm
1614          USE histsync_m, ONLY: histsync
1615          USE histwrite_m, ONLY: histwrite
1616    
1617        real zout        real zout
1618        integer itau_w ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1619          REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1620    
1621        !--------------------------------------------------        !--------------------------------------------------
1622    
# Line 1848  contains Line 1628  contains
1628           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1629    
1630           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1631           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), pphis, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)
1632           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1633    
1634           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1635           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), airephy, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)
1636           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1637    
1638           DO i = 1, klon           DO i = 1, klon
1639              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1640           ENDDO           ENDDO
1641           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1642           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1643    
1644           DO i = 1, klon           DO i = 1, klon
1645              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1646           ENDDO           ENDDO
1647           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1648           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1649    
1650           DO i = 1, klon           DO i = 1, klon
1651              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1652           ENDDO           ENDDO
1653           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1654           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1655    
1656           DO i = 1, klon           DO i = 1, klon
1657              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1658           ENDDO           ENDDO
1659           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1660           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1661    
1662           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)
1663           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1664           !ccIM           !ccIM
1665           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)
1666           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1667    
1668           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)
1669           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1670    
1671           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)
1672           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1673    
1674           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)
1675           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1676    
1677           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)
1678           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1679    
1680           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)
1681           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1682    
1683           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)
1684           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1685    
1686           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)
1687           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1688    
1689           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)
1690           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1691    
1692           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)
1693           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1694    
1695           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)
1696           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1697    
1698           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)
1699           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1700    
1701           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)
1702           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1703    
1704           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1705           ! CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)
1706           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1707           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1708    
1709           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)
1710           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1711    
1712           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)
1713           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1714    
1715           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)
1716           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1717    
1718           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)
1719           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1720    
1721           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)
1722           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1723    
1724           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1725              !XXX              !XXX
1726              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1727              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1728              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1729                   zx_tmp_2d)                   zx_tmp_2d)
1730    
1731              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1732              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1733              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1734                   zx_tmp_2d)                   zx_tmp_2d)
1735    
1736              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1737              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1738              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1739                   zx_tmp_2d)                   zx_tmp_2d)
1740    
1741              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1742              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1743              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1744                   zx_tmp_2d)                   zx_tmp_2d)
1745    
1746              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1747              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1748              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1749                   zx_tmp_2d)                   zx_tmp_2d)
1750    
1751              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1752              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1753              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1754                   zx_tmp_2d)                   zx_tmp_2d)
1755    
1756              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1757              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1758              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1759                   zx_tmp_2d)                   zx_tmp_2d)
1760    
1761              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1762              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1763              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1764                   zx_tmp_2d)                   zx_tmp_2d)
1765    
1766              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1767              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1768              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1769                   zx_tmp_2d)                   zx_tmp_2d)
1770    
1771           END DO           END DO
1772           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)
1773           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1774           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)
1775           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1776    
1777           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)
1778           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1779    
1780           !HBTM2           !HBTM2
1781    
1782           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblh, zx_tmp_2d)
1783           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1784    
1785           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)
1786           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1787    
1788           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)
1789           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1790    
1791           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)
1792           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
1793    
1794           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)
1795           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
1796    
1797           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)
1798           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
1799    
1800           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)
1801           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
1802    
1803           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)
1804           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
1805    
1806           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)
1807           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
1808    
1809           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)
1810           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
1811    
1812           ! Champs 3D:           ! Champs 3D:
1813    
1814           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)
1815           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
1816    
1817           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)
1818           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
1819    
1820           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)
1821           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
1822    
1823           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)
1824           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
1825    
1826           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), play, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)
1827           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
1828    
1829           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)
1830           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
1831    
1832           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)
1833           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1834    
1835           if (ok_sync) then           call histsync(nid_ins)
             call histsync(nid_ins)  
          endif  
1836        ENDIF        ENDIF
1837    
1838      end subroutine write_histins      end subroutine write_histins
1839    
     !****************************************************  
   
     subroutine write_histhf3d  
   
       ! From phylmd/write_histhf3d.h, version 1.2 2005/05/25 13:10:09  
   
       integer itau_w ! pas de temps ecriture  
   
       !-------------------------------------------------------  
   
       itau_w = itau_phy + itap  
   
       ! Champs 3D:  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)  
   
       if (nbtr >= 3) then  
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &  
               zx_tmp_3d)  
          CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)  
       end if  
   
       if (ok_sync) then  
          call histsync(nid_hf3d)  
       endif  
   
     end subroutine write_histhf3d  
   
1840    END SUBROUTINE physiq    END SUBROUTINE physiq
1841    
1842  end module physiq_m  end module physiq_m
Legend:
Removed from v.51  
changed lines
  Added in v.97
  ViewVC Help
Powered by ViewVC 1.1.21