/[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 73 by guez, Fri Nov 15 17:48:30 2013 UTC trunk/Sources/phylmd/physiq.f revision 151 by guez, Tue Jun 23 15:14:20 2015 UTC
# Line 4  module physiq_m Line 4  module physiq_m
4    
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, dayvrai, 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      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! (subversion revision 678)      ! (subversion revision 678)
# Line 18  contains Line 18  contains
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
19      use aeropt_m, only: aeropt      use aeropt_m, only: aeropt
20      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
     USE calendar, ONLY: ymds2ju  
21      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
22      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, 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
26      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
27      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
28      USE comgeomphy, ONLY: airephy, cuphy, cvphy      USE comgeomphy, ONLY: airephy
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
# Line 35  contains Line 34  contains
34      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
35      use diagetpq_m, only: diagetpq      use diagetpq_m, only: diagetpq
36      use diagphy_m, only: diagphy      use diagphy_m, only: diagphy
37      USE dimens_m, ONLY: iim, jjm, llm, nqmx      USE dimens_m, ONLY: llm, nqmx
38      USE dimphy, ONLY: klon, nbtr      USE dimphy, ONLY: klon
39      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
40      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
41        use dynetat0_m, only: day_ref, annee_ref
42      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
43      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
44      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
     USE histsync_m, ONLY: histsync  
     USE histwrite_m, ONLY: histwrite  
45      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, &
46           nbsrf           nbsrf
     USE ini_histhf_m, ONLY: ini_histhf  
     USE ini_histday_m, ONLY: ini_histday  
47      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
48      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
49      USE oasis_m, ONLY: ok_oasis      USE orbite_m, ONLY: orbite
     USE orbite_m, ONLY: orbite, zenang  
50      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
51      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
52      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
# Line 60  contains Line 55  contains
55      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
56      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
57      use readsulfate_m, only: readsulfate      use readsulfate_m, only: readsulfate
58        use readsulfate_preind_m, only: readsulfate_preind
59      use sugwd_m, only: sugwd      use sugwd_m, only: sugwd
60      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
61      USE temps, ONLY: annee_ref, day_ref, itau_phy      USE temps, ONLY: itau_phy
62      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
63        USE ymds2ju_m, ONLY: ymds2ju
64      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
65        use zenang_m, only: zenang
66    
67      ! Arguments:      logical, intent(in):: lafin ! dernier passage
68    
69      REAL, intent(in):: rdayvrai      integer, intent(in):: dayvrai
70      ! (elapsed time since January 1st 0h of the starting year, in days)      ! current day number, based at value 1 on January 1st of annee_ref
71    
72      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
73      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  
74    
75      REAL, intent(in):: paprs(klon, llm + 1)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
76      ! (pression pour chaque inter-couche, en Pa)      ! pression pour chaque inter-couche, en Pa
77    
78      REAL, intent(in):: play(klon, llm)      REAL, intent(in):: play(:, :) ! (klon, llm)
79      ! (input pression pour le mileu de chaque couche (en Pa))      ! pression pour le mileu de chaque couche (en Pa)
80    
81      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
82      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! géopotentiel de chaque couche (référence sol)
83    
84      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
85    
86      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(:, :) ! (klon, llm)
87      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
88    
89      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m/s
90      REAL, intent(in):: t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
91    
92      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
93      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
94    
95      REAL omega(klon, llm) ! input vitesse verticale en Pa/s      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s
96      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
97      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)      REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
98      REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)      REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K/s)
     REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)  
     REAL d_ps(klon) ! output tendance physique de la pression au sol  
99    
100      LOGICAL:: firstcal = .true.      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
101        ! tendance physique de "qx" (s-1)
102    
103      INTEGER nbteta      ! Local:
     PARAMETER(nbteta = 3)  
104    
105      REAL PVteta(klon, nbteta)      LOGICAL:: firstcal = .true.
     ! (output vorticite potentielle a des thetas constantes)  
106    
107      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
108      PARAMETER (ok_gust = .FALSE.)      PARAMETER (ok_gust = .FALSE.)
109    
110      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL, PARAMETER:: check = .FALSE.
111      PARAMETER (check = .FALSE.)      ! Verifier la conservation du modele en eau
112    
113      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
114      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
115    
     ! Parametres lies au coupleur OASIS:  
     INTEGER, SAVE:: npas, nexca  
     logical rnpb  
     parameter(rnpb = .true.)  
   
     character(len = 6):: ocean = 'force '  
     ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")  
   
116      ! "slab" ocean      ! "slab" ocean
117      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
118      REAL, save:: seaice(klon) ! glace de mer (kg/m2)      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
119      REAL fluxo(klon) ! flux turbulents ocean-glace de mer      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
120      REAL fluxg(klon) ! flux turbulents ocean-atmosphere      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
121    
     ! Modele thermique du sol, a activer pour le cycle diurne:  
     logical:: ok_veget = .false. ! type de modele de vegetation utilise  
   
122      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
123      ! sorties journalieres, mensuelles et instantanees dans les      ! sorties journalieres, mensuelles et instantanees dans les
124      ! fichiers histday, histmth et histins      ! fichiers histday, histmth et histins
# Line 148  contains Line 131  contains
131      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
132      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
133    
134      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER, PARAMETER:: ivap = 1 ! indice de traceur pour vapeur d'eau
135      PARAMETER (ivap = 1)      INTEGER, PARAMETER:: iliq = 2 ! indice de traceur pour eau liquide
     INTEGER iliq ! indice de traceurs pour eau liquide  
     PARAMETER (iliq = 2)  
136    
137      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
138      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
# Line 161  contains Line 142  contains
142    
143      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
144    
     !IM Amip2 PV a theta constante  
   
     CHARACTER(LEN = 3) ctetaSTD(nbteta)  
     DATA ctetaSTD/'350', '380', '405'/  
     REAL rtetaSTD(nbteta)  
     DATA rtetaSTD/350., 380., 405./  
   
     !MI Amip2 PV a theta constante  
   
145      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
146      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
147      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
# Line 178  contains Line 150  contains
150      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
151      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
152    
153      !IM Amip2      ! Amip2
154      ! variables a une pression donnee      ! variables a une pression donnee
155    
156      integer nlevSTD      integer nlevSTD
# Line 247  contains Line 219  contains
219           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &
220           'pc= 680-800hPa, tau> 60.'/           'pc= 680-800hPa, tau> 60.'/
221    
222      !IM ISCCP simulator v3.4      ! ISCCP simulator v3.4
   
     integer nid_hf, nid_hf3d  
     save nid_hf, nid_hf3d  
223    
224      ! Variables propres a la physique      ! Variables propres a la physique
225    
226      INTEGER, save:: radpas      INTEGER, save:: radpas
227      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
228      ! "physiq".)      ! "physiq".
229    
230      REAL radsol(klon)      REAL radsol(klon)
231      SAVE radsol ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
# Line 272  contains Line 241  contains
241      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
242      SAVE fluxlat      SAVE fluxlat
243    
244      REAL fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
245      SAVE fqsurf ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
   
     REAL, save:: qsol(klon) ! hauteur d'eau dans le sol  
246    
247      REAL fsnow(klon, nbsrf)      REAL, save:: qsol(klon)
248      SAVE fsnow ! epaisseur neigeuse      ! column-density of water in soil, in kg m-2
249    
250      REAL falbe(klon, nbsrf)      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
251      SAVE falbe ! albedo par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface
252      REAL falblw(klon, nbsrf)      REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface
     SAVE falblw ! albedo par type de surface  
253    
254      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
255      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
256      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
257      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 307  contains Line 273  contains
273      !KE43      !KE43
274      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
275    
     REAL bas, top ! cloud base and top levels  
     SAVE bas  
     SAVE top  
   
276      REAL Ma(klon, llm) ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
277      SAVE Ma      SAVE Ma
278      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
# Line 344  contains Line 306  contains
306      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
307      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
308    
309      REAL, save:: rain_fall(klon) ! pluie      REAL, save:: rain_fall(klon)
310      REAL, save:: snow_fall(klon) ! neige      ! liquid water mass flux (kg/m2/s), positive down
311    
312        REAL, save:: snow_fall(klon)
313        ! solid water mass flux (kg/m2/s), positive down
314    
315      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
316    
# Line 361  contains Line 326  contains
326      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
327      REAL uq(klon) ! integr. verticale du transport zonal de l'eau      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
328    
329      REAL frugs(klon, nbsrf) ! longueur de rugosite      REAL, save:: frugs(klon, nbsrf) ! longueur de rugosite
     save frugs  
330      REAL zxrugs(klon) ! longueur de rugosite      REAL zxrugs(klon) ! longueur de rugosite
331    
332      ! Conditions aux limites      ! Conditions aux limites
333    
334      INTEGER julien      INTEGER julien
   
335      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
336      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
337      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
338        REAL, save:: albsol(klon) ! albedo du sol total
339      REAL albsol(klon)      REAL, save:: albsollw(klon) ! albedo du sol total
     SAVE albsol ! albedo du sol total  
     REAL albsollw(klon)  
     SAVE albsollw ! albedo du sol total  
   
340      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
341    
342      ! Declaration des procedures appelees      ! Declaration des procedures appelees
343    
     EXTERNAL alboc ! calculer l'albedo sur ocean  
     !KE43  
     EXTERNAL conema3 ! convect4.3  
344      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
345      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
346    
# Line 411  contains Line 367  contains
367      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
368      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
369    
370      ! Le rayonnement n'est pas calculé tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
371      ! les variables soient rémanentes.      ! les variables soient r\'emanentes.
372      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
373      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
374      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
375      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
376      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
377      REAL, save:: sollw(klon) ! rayonnement infrarouge montant à la surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
378      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
379      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
380      REAL albpla(klon)      REAL albpla(klon)
# Line 438  contains Line 394  contains
394    
395      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
396    
397      REAL dist, rmu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
398      REAL zdtime ! pas de temps du rayonnement (s)      real longi
     real zlongi  
399      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
400      REAL za, zb      REAL za, zb
401      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zcor
402      real zqsat(klon, llm)      real zqsat(klon, llm)
403      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
404      REAL, PARAMETER:: t_coup = 234.      REAL, PARAMETER:: t_coup = 234.
405      REAL zphi(klon, llm)      REAL zphi(klon, llm)
406    
407      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables locales pour la CLA (hbtm2)
408    
409      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
410      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 472  contains Line 427  contains
427      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
428      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
429      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  
430      REAL cape(klon) ! CAPE      REAL cape(klon) ! CAPE
431      SAVE cape      SAVE cape
432    
     REAL pbase(klon) ! cloud base pressure  
     SAVE pbase  
     REAL bbase(klon) ! cloud base buoyancy  
     SAVE bbase  
     REAL rflag(klon) ! flag fonctionnement de convect  
433      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
     ! -- convect43:  
     REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)  
     REAL dplcldt(klon), dplcldr(klon)  
434    
435      ! Variables du changement      ! Variables du changement
436    
437      ! con: convection      ! con: convection
438      ! lsc: large scale condensation      ! lsc: large scale condensation
439      ! ajs: ajustement sec      ! ajs: ajustement sec
440      ! eva: évaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
441      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
442      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
443      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
# Line 534  contains Line 480  contains
480      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
481      logical ptconv(klon, llm)      logical ptconv(klon, llm)
482    
483      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en s\'erie :
484    
485      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
486      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm)
487      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
488        REAL tr_seri(klon, llm, nqmx - 2)
     REAL tr_seri(klon, llm, nbtr)  
     REAL d_tr(klon, llm, nbtr)  
489    
490      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
491    
# Line 550  contains Line 494  contains
494      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
495      REAL aam, torsfc      REAL aam, torsfc
496    
     REAL dudyn(iim + 1, jjm + 1, llm)  
   
497      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)  
498    
499      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_ins
500    
501      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.
502      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.
503      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.
504      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.
505    
     REAL zsto  
   
     logical ok_sync  
506      real date0      real date0
507    
508      ! Variables liées au bilan d'énergie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
509      REAL ztsol(klon)      REAL ztsol(klon)
510      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_ec
511      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
     REAL fs_bound, fq_bound  
512      REAL zero_v(klon)      REAL zero_v(klon)
513      CHARACTER(LEN = 15) tit      CHARACTER(LEN = 20) tit
514      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
515      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
516    
517      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
518      REAL ZRCPD      REAL ZRCPD
519    
520      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
# Line 635  contains Line 572  contains
572    
573      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
574    
575      namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &
576           fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
577           ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &           ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals
          nsplit_thermals  
578    
579      !----------------------------------------------------------------      !----------------------------------------------------------------
580    
581      IF (if_ebil >= 1) zero_v = 0.      IF (if_ebil >= 1) zero_v = 0.
     ok_sync = .TRUE.  
582      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
583           'eaux vapeur et liquide sont indispensables', 1)           'eaux vapeur et liquide sont indispensables', 1)
584    
# Line 658  contains Line 593  contains
593         piz_ae = 0.         piz_ae = 0.
594         tau_ae = 0.         tau_ae = 0.
595         cg_ae = 0.         cg_ae = 0.
596         rain_con(:) = 0.         rain_con = 0.
597         snow_con(:) = 0.         snow_con = 0.
598         topswai(:) = 0.         topswai = 0.
599         topswad(:) = 0.         topswad = 0.
600         solswai(:) = 0.         solswai = 0.
601         solswad(:) = 0.         solswad = 0.
602    
603         d_u_con = 0.         d_u_con = 0.
604         d_v_con = 0.         d_v_con = 0.
# Line 698  contains Line 633  contains
633         frugs = 0.         frugs = 0.
634         itap = 0         itap = 0
635         itaprad = 0         itaprad = 0
636         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &
637              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &
638              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &
639              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &
640              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)              run_off_lic_0, sig1, w01)
641    
642         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
643         q2 = 1e-8         q2 = 1e-8
# Line 712  contains Line 647  contains
647         ! on remet le calendrier a zero         ! on remet le calendrier a zero
648         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
649    
650         PRINT *, 'cycle_diurne = ', cycle_diurne         CALL printflag(radpas, ok_journe, ok_instan, ok_region)
        CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &  
             ok_instan, ok_region)  
651    
652         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN         IF (dtphys * radpas > 21600. .AND. cycle_diurne) THEN
653            print *, "Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
654            call abort_gcm('physiq', &            call abort_gcm('physiq', &
655                 "Nombre d'appels au rayonnement insuffisant", 1)                 "Nombre d'appels au rayonnement insuffisant", 1)
656         ENDIF         ENDIF
657    
658         ! Initialisation pour le schéma de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
659         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
660            ibas_con = 1            ibas_con = 1
661            itop_con = 1            itop_con = 1
# Line 744  contains Line 677  contains
677         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
678         ecrit_reg = NINT(ecrit_reg/dtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
679    
        ! Initialiser le couplage si necessaire  
   
        npas = 0  
        nexca = 0  
   
680         ! Initialisation des sorties         ! Initialisation des sorties
681    
        call ini_histhf(dtphys, nid_hf, nid_hf3d)  
        call ini_histday(dtphys, ok_journe, nid_day, nqmx)  
682         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
683         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
684         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
685         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
686      ENDIF test_firstcal      ENDIF test_firstcal
687    
688      ! Mettre a zero des variables de sortie (pour securite)      ! We will modify variables *_seri and we will not touch variables
689        ! u, v, t, qx:
690      DO i = 1, klon      t_seri = t
691         d_ps(i) = 0.      u_seri = u
692      ENDDO      v_seri = v
693      DO iq = 1, nqmx      q_seri = qx(:, :, ivap)
694         DO k = 1, llm      ql_seri = qx(:, :, iliq)
695            DO i = 1, klon      tr_seri = qx(:, :, 3: nqmx)
              d_qx(i, k, iq) = 0.  
           ENDDO  
        ENDDO  
     ENDDO  
     da = 0.  
     mp = 0.  
     phi = 0.  
   
     ! Ne pas affecter les valeurs entrées de u, v, h, et q :  
   
     DO k = 1, llm  
        DO i = 1, klon  
           t_seri(i, k) = t(i, k)  
           u_seri(i, k) = u(i, k)  
           v_seri(i, k) = v(i, k)  
           q_seri(i, k) = qx(i, k, ivap)  
           ql_seri(i, k) = qx(i, k, iliq)  
           qs_seri(i, k) = 0.  
        ENDDO  
     ENDDO  
     IF (nqmx >= 3) THEN  
        tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)  
     ELSE  
        tr_seri(:, :, 1) = 0.  
     ENDIF  
696    
697      DO i = 1, klon      ztsol = sum(ftsol * pctsrf, dim = 2)
        ztsol(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           ztsol(i) = ztsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
698    
699      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
700         tit = 'after dynamics'         tit = 'after dynamics'
701         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
702              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
703              d_ql, d_qs, d_ec)         ! Comme les tendances de la physique sont ajout\'es dans la
        ! Comme les tendances de la physique sont ajoutés dans la  
704         !  dynamique, la variation d'enthalpie par la dynamique devrait         !  dynamique, la variation d'enthalpie par la dynamique devrait
705         !  être égale à la variation de la physique au pas de temps         !  \^etre \'egale \`a la variation de la physique au pas de temps
706         !  précédent.  Donc la somme de ces 2 variations devrait être         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre
707         !  nulle.         !  nulle.
708         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
709              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, &
710              d_qt, 0., fs_bound, fq_bound)              d_qt, 0.)
711      END IF      END IF
712    
713      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
# Line 845  contains Line 738  contains
738      ! Check temperatures:      ! Check temperatures:
739      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
740    
741      ! Incrementer le compteur de la physique      ! Incrémenter le compteur de la physique
742      itap = itap + 1      itap = itap + 1
743      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(dayvrai, 360)
744      if (julien == 0) julien = 360      if (julien == 0) julien = 360
745    
746      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
747    
748      ! Mettre en action les conditions aux limites (albedo, sst etc.).      ! Prescrire l'ozone :
   
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
749      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
750    
751      ! Évaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
752      DO k = 1, llm      DO k = 1, llm
753         DO i = 1, klon         DO i = 1, klon
754            zb = MAX(0., ql_seri(i, k))            zb = MAX(0., ql_seri(i, k))
# Line 871  contains Line 762  contains
762      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
763         tit = 'after reevap'         tit = 'after reevap'
764         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
765              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
766         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
767              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)
             fs_bound, fq_bound)  
   
768      END IF      END IF
769    
770      ! Appeler la diffusion verticale (programme de couche limite)      frugs = MAX(frugs, 0.000015)
771        zxrugs = sum(frugs * pctsrf, dim = 2)
772    
773      DO i = 1, klon      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec
774         zxrugs(i) = 0.      ! la surface.
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           frugs(i, nsrf) = MAX(frugs(i, nsrf), 0.000015)  
        ENDDO  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxrugs(i) = zxrugs(i) + frugs(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
775    
776      ! calculs necessaires au calcul de l'albedo dans l'interface      CALL orbite(REAL(julien), longi, dist)
   
     CALL orbite(REAL(julien), zlongi, dist)  
777      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
778         zdtime = dtphys * REAL(radpas)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
        CALL zenang(zlongi, time, zdtime, rmu0, fract)  
779      ELSE      ELSE
780         rmu0 = -999.999         mu0 = -999.999
781      ENDIF      ENDIF
782    
783      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
784      albsol(:) = 0.      albsol = sum(falbe * pctsrf, dim = 2)
785      albsollw(:) = 0.      albsollw = sum(falblw * pctsrf, dim = 2)
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)  
           albsollw(i) = albsollw(i) + falblw(i, nsrf) * pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
786    
787      ! Répartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
788      ! Répartition du longwave par sous-surface linéarisée      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
789    
790      DO nsrf = 1, nbsrf      forall (nsrf = 1: nbsrf)
791         DO i = 1, klon         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &
792            fsollw(i, nsrf) = sollw(i) &              * (ztsol - ftsol(:, nsrf))
793                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
794            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))      END forall
        ENDDO  
     ENDDO  
795    
796      fder = dlw      fder = dlw
797    
798      ! Couche limite:      ! Couche limite:
799    
800      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &
801           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, &
802           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, &
803           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, &
804           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &           fder, rlat, frugs, firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, &
805           frugs, firstcal, agesno, rugoro, d_t_vdf, &           d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &
806           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, &
807           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
808           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab)
          fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)  
809    
810      ! Incrémentation des flux      ! Incr\'ementation des flux
811    
812      zxfluxt = 0.      zxfluxt = 0.
813      zxfluxq = 0.      zxfluxq = 0.
# Line 959  contains Line 825  contains
825      END DO      END DO
826      DO i = 1, klon      DO i = 1, klon
827         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
828         evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol
829         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
830      ENDDO      ENDDO
831    
# Line 975  contains Line 841  contains
841      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
842         tit = 'after clmain'         tit = 'after clmain'
843         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
844              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
845         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
846              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)
             fs_bound, fq_bound)  
847      END IF      END IF
848    
849      ! Update surface temperature:      ! Update surface temperature:
# Line 1008  contains Line 872  contains
872    
873         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
874              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
875              'physiq : problème sous surface au point ', i, pctsrf(i, 1 : nbsrf)              'physiq : probl\`eme sous surface au point ', i, &
876                pctsrf(i, 1 : nbsrf)
877      ENDDO      ENDDO
878      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
879         DO i = 1, klon         DO i = 1, klon
# Line 1036  contains Line 901  contains
901         ENDDO         ENDDO
902      ENDDO      ENDDO
903    
904      ! 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 :
   
905      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
906         DO i = 1, klon         DO i = 1, klon
907            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
# Line 1062  contains Line 926  contains
926         ENDDO         ENDDO
927      ENDDO      ENDDO
928    
929      ! Calculer la derive du flux infrarouge      ! Calculer la dérive du flux infrarouge
930    
931      DO i = 1, klon      DO i = 1, klon
932         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
933      ENDDO      ENDDO
934    
935      ! Appeler la convection (au choix)      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)
   
     DO k = 1, llm  
        DO i = 1, klon  
           conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys  
           conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k)/dtphys  
        ENDDO  
     ENDDO  
936    
937      IF (check) THEN      ! Appeler la convection (au choix)
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *, "avantcon = ", za  
     ENDIF  
938    
939      if (iflag_con == 2) then      if (iflag_con == 2) then
940           conv_q = d_q_dyn + d_q_vdf / dtphys
941           conv_t = d_t_dyn + d_t_vdf / dtphys
942         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
943         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
944              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
# Line 1096  contains Line 952  contains
952      else      else
953         ! iflag_con >= 3         ! iflag_con >= 3
954    
955         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &         da = 0.
956              v_seri, tr_seri, sig1, w01, d_t_con, d_q_con, &         mp = 0.
957              d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &         phi = 0.
958              itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
959              pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &
960              wd, pmflxr, pmflxs, da, phi, mp, ntra=1)              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &
961         ! (number of tracers for the convection scheme of Kerry Emanuel:              qcondc, wd, pmflxr, pmflxs, da, phi, mp)
        ! la partie traceurs est faite dans phytrac  
        ! on met ntra = 1 pour limiter les appels mais on peut  
        ! supprimer les calculs / ftra.)  
   
962         clwcon0 = qcondc         clwcon0 = qcondc
963         mfu = upwd + dnwd         mfu = upwd + dnwd
964         IF (.NOT. ok_gust) wd = 0.         IF (.NOT. ok_gust) wd = 0.
965    
966         ! Calcul des propriétés des nuages convectifs         IF (thermcep) THEN
967              zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
968         DO k = 1, llm            zqsat = zqsat / (1. - retv * zqsat)
969            DO i = 1, klon         ELSE
970               zx_t = t_seri(i, k)            zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play
971               IF (thermcep) THEN         ENDIF
                 zdelta = MAX(0., SIGN(1., rtt-zx_t))  
                 zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k)  
                 zx_qs = MIN(0.5, zx_qs)  
                 zcor = 1./(1.-retv*zx_qs)  
                 zx_qs = zx_qs*zcor  
              ELSE  
                 IF (zx_t < t_coup) THEN  
                    zx_qs = qsats(zx_t)/play(i, k)  
                 ELSE  
                    zx_qs = qsatl(zx_t)/play(i, k)  
                 ENDIF  
              ENDIF  
              zqsat(i, k) = zx_qs  
           ENDDO  
        ENDDO  
972    
973         ! calcul des proprietes des nuages convectifs         ! Properties of convective clouds
974         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
975         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
976              rnebcon0)              rnebcon0)
# Line 1157  contains Line 994  contains
994      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
995         tit = 'after convect'         tit = 'after convect'
996         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
997              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
998         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
999              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)
             fs_bound, fq_bound)  
1000      END IF      END IF
1001    
1002      IF (check) THEN      IF (check) THEN
1003         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(paprs, q_seri, ql_seri)
1004         print *, "aprescon = ", za         print *, "aprescon = ", za
1005         zx_t = 0.         zx_t = 0.
1006         za = 0.         za = 0.
# Line 1190  contains Line 1025  contains
1025         ENDDO         ENDDO
1026      ENDIF      ENDIF
1027    
1028      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
1029    
1030      d_t_ajs = 0.      d_t_ajs = 0.
1031      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1213  contains Line 1048  contains
1048      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1049         tit = 'after dry_adjust'         tit = 'after dry_adjust'
1050         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1051              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1052      END IF      END IF
1053    
1054      ! Caclul des ratqs      ! Caclul des ratqs
1055    
1056      ! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
1057      ! on écrase le tableau ratqsc calculé par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
1058      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1059         do k = 1, llm         do k = 1, llm
1060            do i = 1, klon            do i = 1, klon
# Line 1272  contains Line 1106  contains
1106         ENDDO         ENDDO
1107      ENDDO      ENDDO
1108      IF (check) THEN      IF (check) THEN
1109         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(paprs, q_seri, ql_seri)
1110         print *, "apresilp = ", za         print *, "apresilp = ", za
1111         zx_t = 0.         zx_t = 0.
1112         za = 0.         za = 0.
# Line 1288  contains Line 1122  contains
1122      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1123         tit = 'after fisrt'         tit = 'after fisrt'
1124         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1125              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1126         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1127              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)
             fs_bound, fq_bound)  
1128      END IF      END IF
1129    
1130      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
# Line 1329  contains Line 1161  contains
1161         ENDDO         ENDDO
1162      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1163         ! On prend pour les nuages convectifs le maximum du calcul de         ! On prend pour les nuages convectifs le maximum du calcul de
1164         ! la convection et du calcul du pas de temps précédent diminué         ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
1165         ! d'un facteur facttemps.         ! d'un facteur facttemps.
1166         facteur = dtphys * facttemps         facteur = dtphys * facttemps
1167         do k = 1, llm         do k = 1, llm
# Line 1369  contains Line 1201  contains
1201      ENDDO      ENDDO
1202    
1203      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1204           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &           dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1205           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)           d_qt, d_ec)
1206    
1207      ! Humidité relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
1208      DO k = 1, llm      DO k = 1, llm
1209         DO i = 1, klon         DO i = 1, klon
1210            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1211            IF (thermcep) THEN            IF (thermcep) THEN
1212               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)
              zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)  
1213               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1214               zcor = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1215               zx_qs = zx_qs*zcor               zx_qs = zx_qs*zcor
# Line 1397  contains Line 1228  contains
1228      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
1229      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1230         ! Get sulfate aerosol distribution :         ! Get sulfate aerosol distribution :
1231         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(dayvrai, time, firstcal, sulfate)
1232         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(dayvrai, time, firstcal, sulfate_pi)
1233    
1234         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1235              aerindex)              aerindex)
# Line 1408  contains Line 1239  contains
1239         cg_ae = 0.         cg_ae = 0.
1240      ENDIF      ENDIF
1241    
1242      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :      ! Param\`etres optiques des nuages et quelques param\`etres pour
1243        ! diagnostics :
1244      if (ok_newmicro) then      if (ok_newmicro) then
1245         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1246              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
# Line 1419  contains Line 1251  contains
1251              bl95_b1, cldtaupi, re, fl)              bl95_b1, cldtaupi, re, fl)
1252      endif      endif
1253    
     ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.  
1254      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1255           ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
1256         DO i = 1, klon         DO i = 1, klon
1257            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
1258                 + falbe(i, is_lic) * pctsrf(i, is_lic) &                 + falbe(i, is_lic) * pctsrf(i, is_lic) &
# Line 1432  contains Line 1264  contains
1264                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1265         ENDDO         ENDDO
1266         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
1267         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, &
1268              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1269              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1270              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
# Line 1440  contains Line 1272  contains
1272              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)
1273         itaprad = 0         itaprad = 0
1274      ENDIF      ENDIF
1275    
1276      itaprad = itaprad + 1      itaprad = itaprad + 1
1277    
1278      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
# Line 1453  contains Line 1286  contains
1286      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1287         tit = 'after rad'         tit = 'after rad'
1288         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1289              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1290         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1291              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)
             fs_bound, fq_bound)  
1292      END IF      END IF
1293    
1294      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
# Line 1472  contains Line 1303  contains
1303         ENDDO         ENDDO
1304      ENDDO      ENDDO
1305    
1306      ! 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)
1307    
1308      DO i = 1, klon      DO i = 1, klon
1309         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1310      ENDDO      ENDDO
1311    
1312      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1313    
1314      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1315         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
# Line 1493  contains Line 1324  contains
1324         ENDDO         ENDDO
1325    
1326         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1327              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1328              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
1329    
1330         ! ajout des tendances         ! ajout des tendances
1331         DO k = 1, llm         DO k = 1, llm
# Line 1507  contains Line 1338  contains
1338      ENDIF      ENDIF
1339    
1340      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1341         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
1342         igwd = 0         igwd = 0
1343         DO i = 1, klon         DO i = 1, klon
1344            itest(i) = 0            itest(i) = 0
# Line 1532  contains Line 1363  contains
1363         ENDDO         ENDDO
1364      ENDIF      ENDIF
1365    
1366      ! Stress nécessaires : toute la physique      ! Stress n\'ecessaires : toute la physique
1367    
1368      DO i = 1, klon      DO i = 1, klon
1369         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1551  contains Line 1382  contains
1382           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1383    
1384      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1385           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1386           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)           d_qt, d_ec)
1387    
1388      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1389      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &
1390           dtphys, u, t, paprs, play, mfu, mfd, pen_u, pde_u, pen_d, pde_d, &           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &
1391           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, da, phi, mp, &
1392           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &           upwd, dnwd, tr_seri, zmasse)
1393           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)  
1394        IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1395      IF (offline) THEN           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1396         call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, 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  
1397    
1398      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1399      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 1592  contains Line 1420  contains
1420      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1421         tit = 'after physic'         tit = 'after physic'
1422         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1423              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1424         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1425         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1426         ! 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.
1427         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1428         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1429              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)
             fs_bound, fq_bound)  
   
1430         d_h_vcol_phy = d_h_vcol         d_h_vcol_phy = d_h_vcol
   
1431      END IF      END IF
1432    
1433      ! SORTIES      ! SORTIES
# Line 1628  contains Line 1452  contains
1452         ENDDO         ENDDO
1453      ENDDO      ENDDO
1454    
1455      IF (nqmx >= 3) THEN      DO iq = 3, nqmx
1456         DO iq = 3, nqmx         DO k = 1, llm
1457            DO k = 1, llm            DO i = 1, klon
1458               DO i = 1, klon               d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys
                 d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys  
              ENDDO  
1459            ENDDO            ENDDO
1460         ENDDO         ENDDO
1461      ENDIF      ENDDO
1462    
1463      ! Sauvegarder les valeurs de t et q a la fin de la physique:      ! Sauvegarder les valeurs de t et q a la fin de la physique:
1464      DO k = 1, llm      DO k = 1, llm
# Line 1647  contains Line 1469  contains
1469      ENDDO      ENDDO
1470    
1471      ! Ecriture des sorties      ! Ecriture des sorties
     call write_histhf  
     call write_histday  
1472      call write_histins      call write_histins
1473    
1474      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1475      IF (lafin) THEN      IF (lafin) THEN
1476         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1477         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", pctsrf, ftsol, ftsoil, tslab, seaice, &
1478              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
1479              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &              solsw, sollw, dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, &
1480              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, &
1481              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)              run_off_lic_0, sig1, w01)
1482      ENDIF      ENDIF
1483    
1484      firstcal = .FALSE.      firstcal = .FALSE.
1485    
1486    contains    contains
1487    
     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  
   
     !***************************************************************  
   
1488      subroutine write_histins      subroutine write_histins
1489    
1490        ! 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
1491    
1492        real zout        use dimens_m, only: iim, jjm
1493        integer itau_w ! pas de temps ecriture        USE histsync_m, ONLY: histsync
1494          USE histwrite_m, ONLY: histwrite
1495    
1496          integer i, itau_w ! pas de temps ecriture
1497          REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1498    
1499        !--------------------------------------------------        !--------------------------------------------------
1500    
1501        IF (ok_instan) THEN        IF (ok_instan) THEN
1502           ! Champs 2D:           ! Champs 2D:
1503    
          zsto = dtphys * ecrit_ins  
          zout = dtphys * ecrit_ins  
1504           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1505    
          i = NINT(zout/zsto)  
1506           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)
1507           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1508    
          i = NINT(zout/zsto)  
1509           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)
1510           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1511    
# Line 1925  contains Line 1706  contains
1706           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)
1707           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1708    
1709           if (ok_sync) then           call histsync(nid_ins)
             call histsync(nid_ins)  
          endif  
1710        ENDIF        ENDIF
1711    
1712      end subroutine write_histins      end subroutine write_histins
1713    
     !****************************************************  
   
     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  
   
1714    END SUBROUTINE physiq    END SUBROUTINE physiq
1715    
1716  end module physiq_m  end module physiq_m
Legend:
Removed from v.73  
changed lines
  Added in v.151
  ViewVC Help
Powered by ViewVC 1.1.21