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

Diff of /trunk/Sources/phylmd/physiq.f

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

trunk/libf/phylmd/physiq.f90 revision 56 by guez, Tue Jan 10 19:02:02 2012 UTC trunk/Sources/phylmd/physiq.f revision 155 by guez, Wed Jul 8 17:03:45 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, paprs, play, pphi, pphis, u, v, t, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)         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 (SVN revision 678)      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! Author: Z.X. Li (LMD/CNRS) 1993      ! (subversion revision 678)
12    
13        ! 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      use aaam_bud_m, only: aaam_bud
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
19        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 comgeomphy, ONLY: airephy, cuphy, cvphy      use clouds_gno_m, only: clouds_gno
28        use comconst, only: dtphys
29        USE comgeomphy, ONLY: airephy
30      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
31      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date, day_step, iphysiq
32      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
33        use conflx_m, only: conflx
34      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
35      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
36      use diagetpq_m, only: diagetpq      use diagetpq_m, only: diagetpq
37      USE dimens_m, ONLY: iim, jjm, llm, nqmx      use diagphy_m, only: diagphy
38      USE dimphy, ONLY: klon, nbtr      USE dimens_m, ONLY: llm, nqmx
39        USE dimphy, ONLY: klon
40      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
41      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
42        use dynetat0_m, only: day_ref, annee_ref
43      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
44        use fisrtilp_m, only: fisrtilp
45      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
     USE histcom, ONLY: histsync  
     USE histwrite_m, ONLY: histwrite  
46      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
47           nbsrf           nbsrf
     USE ini_histhf_m, ONLY: ini_histhf  
     USE ini_histday_m, ONLY: ini_histday  
48      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
49      USE oasis_m, ONLY: ok_oasis      use newmicro_m, only: newmicro
50      USE orbite_m, ONLY: orbite, zenang      USE orbite_m, ONLY: orbite
51      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
52      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
53      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
# Line 51  contains Line 55  contains
55      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
56      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
57      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
58        use readsulfate_m, only: readsulfate
59        use readsulfate_preind_m, only: readsulfate_preind
60      use sugwd_m, only: sugwd      use sugwd_m, only: sugwd
61      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
62      USE temps, ONLY: annee_ref, day_ref, itau_phy      USE temps, ONLY: itau_phy
63        use unit_nml_m, only: unit_nml
64        USE ymds2ju_m, ONLY: ymds2ju
65      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
66        use zenang_m, only: zenang
67    
68      ! Arguments:      logical, intent(in):: lafin ! dernier passage
69    
70      REAL, intent(in):: rdayvrai      integer, intent(in):: dayvrai
71      ! (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
72    
73      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
     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    
     LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl = .TRUE.)  
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), save:: ocean  
     ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")  
   
     logical ok_ocean  
     SAVE ok_ocean  
   
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    
122      ! Modele thermique du sol, a activer pour le cycle diurne:      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
123      logical, save:: ok_veget      ! sorties journalieres, mensuelles et instantanees dans les
124      LOGICAL, save:: ok_journe ! sortir le fichier journalier      ! fichiers histday, histmth et histins
   
     LOGICAL ok_mensuel ! sortir le fichier mensuel  
   
     LOGICAL ok_instan ! sortir le fichier instantane  
     save ok_instan  
125    
126      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
127      PARAMETER (ok_region = .FALSE.)      PARAMETER (ok_region = .FALSE.)
# Line 145  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 158  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    
145      !IM Amip2 PV a theta constante      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
146        REAL swup0(klon, llm + 1), swup(klon, llm + 1)
     CHARACTER(LEN = 3) ctetaSTD(nbteta)  
     DATA ctetaSTD/'350', '380', '405'/  
     REAL rtetaSTD(nbteta)  
     DATA rtetaSTD/350., 380., 405./  
   
     !MI Amip2 PV a theta constante  
   
     INTEGER klevp1  
     PARAMETER(klevp1 = llm + 1)  
   
     REAL swdn0(klon, klevp1), swdn(klon, klevp1)  
     REAL swup0(klon, klevp1), swup(klon, klevp1)  
147      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
148    
149      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
150      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      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 206  contains Line 178  contains
178      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
179    
180      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
181      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./
182      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
183    
184      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# 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 268  contains Line 237  contains
237      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
238      ! soil temperature of surface fraction      ! soil temperature of surface fraction
239    
240      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap ! evaporation  
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
246    
247      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol      REAL, save:: qsol(klon)
248        ! column-density of water in soil, in kg m-2
249    
250      REAL fsnow(klon, nbsrf)      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
251      SAVE fsnow ! epaisseur neigeuse      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
252    
253      REAL falbe(klon, nbsrf)      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
     SAVE falbe ! albedo par type de surface  
     REAL falblw(klon, nbsrf)  
     SAVE falblw ! albedo par type de surface  
   
     ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :  
254      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
255      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
256      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 308  contains Line 272  contains
272      !KE43      !KE43
273      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
274    
     REAL bas, top ! cloud base and top levels  
     SAVE bas  
     SAVE top  
   
275      REAL Ma(klon, llm) ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
276      SAVE Ma      SAVE Ma
277      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
278      SAVE qcondc      SAVE qcondc
279      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
280      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
281    
282      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
283    
# Line 329  contains Line 286  contains
286      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
287      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
288    
289      !AA Pour phytrac      ! Pour phytrac :
290      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
291      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
292      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
# Line 348  contains Line 305  contains
305      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
306      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
307    
308      !AA      REAL, save:: rain_fall(klon)
309      REAL rain_fall(klon) ! pluie      ! liquid water mass flux (kg/m2/s), positive down
310      REAL snow_fall(klon) ! neige  
311      save snow_fall, rain_fall      REAL, save:: snow_fall(klon)
312      !IM cf FH pour Tiedtke 080604      ! solid water mass flux (kg/m2/s), positive down
313    
314      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
315    
316      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
317      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
318      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
319      SAVE dlw      SAVE dlw
320      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
321      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
     save fder  
322      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
323      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
324      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
325      REAL uq(klon) ! integr. verticale du transport zonal de l'eau      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
326    
327      REAL frugs(klon, nbsrf) ! longueur de rugosite      REAL, save:: frugs(klon, nbsrf) ! longueur de rugosite
     save frugs  
328      REAL zxrugs(klon) ! longueur de rugosite      REAL zxrugs(klon) ! longueur de rugosite
329    
330      ! Conditions aux limites      ! Conditions aux limites
331    
332      INTEGER julien      INTEGER julien
   
333      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
334      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
335      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
336      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL, save:: albsol(klon) ! albedo du sol total visible
   
     SAVE pctsrf ! sous-fraction du sol  
     REAL albsol(klon)  
     SAVE albsol ! albedo du sol total  
     REAL albsollw(klon)  
     SAVE albsollw ! albedo du sol total  
   
337      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
338    
339      ! Declaration des procedures appelees      ! Declaration des procedures appelees
340    
     EXTERNAL alboc ! calculer l'albedo sur ocean  
     !KE43  
     EXTERNAL conema3 ! convect4.3  
     EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)  
341      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
342      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
343    
344      ! Variables locales      ! Variables locales
345    
346      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
347      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
348    
349      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
350      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 422  contains Line 364  contains
364      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
365      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
366    
367      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
368      ! que les variables soient rémanentes      ! les variables soient r\'emanentes.
369      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
370      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
371      REAL cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
372      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
373      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
374      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
375      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      real, save:: sollwdown(klon) ! downward LW flux at surface
376      REAL albpla(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
377        REAL, save:: albpla(klon)
378      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
379      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
     SAVE cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0  
   
     INTEGER itaprad  
     SAVE itaprad  
380    
381      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
382      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
# Line 448  contains Line 386  contains
386    
387      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
388    
389      REAL dist, rmu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
390      REAL zdtime ! pas de temps du rayonnement (s)      real longi
     real zlongi  
   
391      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
392      REAL za, zb      REAL za, zb
393      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zcor
394      real zqsat(klon, llm)      real zqsat(klon, llm)
395      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
396      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup = 234.0)  
   
397      REAL zphi(klon, llm)      REAL zphi(klon, llm)
398    
399      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables locales pour la CLA (hbtm2)
400    
401      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
402      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 482  contains Line 414  contains
414      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
415      REAL s_trmb3(klon)      REAL s_trmb3(klon)
416    
417      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
418    
419      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
420      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
421      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  
422      REAL cape(klon) ! CAPE      REAL cape(klon) ! CAPE
423      SAVE cape      SAVE cape
424    
     REAL pbase(klon) ! cloud base pressure  
     SAVE pbase  
     REAL bbase(klon) ! cloud base buoyancy  
     SAVE bbase  
     REAL rflag(klon) ! flag fonctionnement de convect  
425      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)  
426    
427      ! Variables du changement      ! Variables du changement
428    
429      ! con: convection      ! con: convection
430      ! lsc: large scale condensation      ! lsc: large scale condensation
431      ! ajs: ajustement sec      ! ajs: ajustement sec
432      ! eva: évaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
433      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
434      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
435      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
# Line 516  contains Line 438  contains
438      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
439      REAL rneb(klon, llm)      REAL rneb(klon, llm)
440    
441      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
442      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
443      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
444      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
445      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
446      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
447    
448      INTEGER,save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
449    
450      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
451      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 537  contains Line 459  contains
459      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
460      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
461    
462      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
463      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
464      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
465    
466      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
467      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
468      real, save:: facttemps      real:: facttemps = 1.e-4
469      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
470      real facteur      real facteur
471    
472      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
473      logical ptconv(klon, llm)      logical ptconv(klon, llm)
474    
475      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en s\'erie :
476    
477      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
478      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm)
479      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
480        REAL tr_seri(klon, llm, nqmx - 2)
     REAL tr_seri(klon, llm, nbtr)  
     REAL d_tr(klon, llm, nbtr)  
481    
482      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
483    
# Line 569  contains Line 486  contains
486      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
487      REAL aam, torsfc      REAL aam, torsfc
488    
     REAL dudyn(iim + 1, jjm + 1, llm)  
   
489      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)  
490    
491      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_ins
492    
493      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.
494      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.
495      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.
496      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.
497    
     REAL zsto  
   
     character(len = 20) modname  
     character(len = 80) abort_message  
     logical ok_sync  
498      real date0      real date0
499    
500      ! Variables liées au bilan d'énergie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
501      REAL ztsol(klon)      REAL ztsol(klon)
502      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_ec
503      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
     REAL fs_bound, fq_bound  
504      REAL zero_v(klon)      REAL zero_v(klon)
505      CHARACTER(LEN = 15) ztit      CHARACTER(LEN = 20) tit
506      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
507      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
508    
509      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
510      REAL ZRCPD      REAL ZRCPD
511    
512      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
513      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
514      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
515      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
516      !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
517      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      ! Aerosol effects:
518    
519        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
520    
521      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
522      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
523    
524      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
525      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
526    
527      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
528      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
529    
530      ! Aerosol optical properties      ! Aerosol optical properties
531      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
532      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  
533    
534      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
535      ! ok_aie = True ->      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
     ! ok_ade = True -AIE = topswai-topswad  
     ! ok_ade = F -AIE = topswai-topsw  
536    
537      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
538    
539      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
540      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
541      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)  
542        REAL:: bl95_b0 = 2., bl95_b1 = 0.2
543        ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
544        ! B). They link cloud droplet number concentration to aerosol mass
545        ! concentration.
546    
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
547      SAVE u10m      SAVE u10m
548      SAVE v10m      SAVE v10m
549      SAVE t2m      SAVE t2m
550      SAVE q2m      SAVE q2m
551      SAVE ffonte      SAVE ffonte
552      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
553      SAVE rain_con      SAVE rain_con
554      SAVE snow_con      SAVE snow_con
555      SAVE topswai      SAVE topswai
# Line 653  contains Line 558  contains
558      SAVE solswad      SAVE solswad
559      SAVE d_u_con      SAVE d_u_con
560      SAVE d_v_con      SAVE d_v_con
     SAVE rnebcon0  
     SAVE clwcon0  
561    
562      real zmasse(klon, llm)      real zmasse(klon, llm)
563      ! (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)
564    
565      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
566    
567        namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &
568             facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
569             ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals
570    
571      !----------------------------------------------------------------      !----------------------------------------------------------------
572    
573      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
574      IF (if_ebil >= 1) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
575         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  
576    
577      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
578         ! initialiser         ! initialiser
# Line 686  contains Line 585  contains
585         piz_ae = 0.         piz_ae = 0.
586         tau_ae = 0.         tau_ae = 0.
587         cg_ae = 0.         cg_ae = 0.
588         rain_con(:) = 0.         rain_con = 0.
589         snow_con(:) = 0.         snow_con = 0.
590         bl95_b0 = 0.         topswai = 0.
591         bl95_b1 = 0.         topswad = 0.
592         topswai(:) = 0.         solswai = 0.
593         topswad(:) = 0.         solswad = 0.
594         solswai(:) = 0.  
595         solswad(:) = 0.         d_u_con = 0.
596           d_v_con = 0.
597         d_u_con = 0.0         rnebcon0 = 0.
598         d_v_con = 0.0         clwcon0 = 0.
599         rnebcon0 = 0.0         rnebcon = 0.
600         clwcon0 = 0.0         clwcon = 0.
        rnebcon = 0.0  
        clwcon = 0.0  
601    
602         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
603         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 715  contains Line 612  contains
612    
613         IF (if_ebil >= 1) d_h_vcol_phy = 0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
614    
615         ! appel a la lecture du run.def physique         iflag_thermals = 0
616           nsplit_thermals = 1
617           print *, "Enter namelist 'physiq_nml'."
618           read(unit=*, nml=physiq_nml)
619           write(unit_nml, nml=physiq_nml)
620    
621         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)  
622    
623         ! Initialiser les compteurs:         ! Initialiser les compteurs:
624    
625         frugs = 0.         frugs = 0.
626         itap = 0         itap = 0
627         itaprad = 0         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &
628         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, &
629              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &
630              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &              zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &
631              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              run_off_lic_0, sig1, w01)
             ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)  
632    
633         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
634         q2 = 1.e-8         q2 = 1e-8
   
        radpas = NINT(86400. / dtphys / nbapp_rad)  
635    
636         ! on remet le calendrier a zero         lmt_pas = day_step / iphysiq
637         IF (raz_date) itau_phy = 0         print *, 'Number of time steps of "physics" per day: ', lmt_pas
638    
639         PRINT *, 'cycle_diurne = ', cycle_diurne         radpas = lmt_pas / nbapp_rad
640    
641         IF(ocean.NE.'force ') THEN         ! On remet le calendrier a zero
642            ok_ocean = .TRUE.         IF (raz_date) itau_phy = 0
        ENDIF  
   
        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &  
             ok_region)  
643    
644         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN         CALL printflag(radpas, ok_journe, ok_instan, ok_region)
           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)  
        ENDIF  
        print *,"Clef pour la convection, iflag_con = ", iflag_con  
        print *,"Clef pour le driver de la convection, ok_cvl = ", &  
             ok_cvl  
645    
646         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le sch\'ema de convection d'Emanuel :
647         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
648              ibas_con = 1
649            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  
   
650         ENDIF         ENDIF
651    
652         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 783  contains Line 656  contains
656            rugoro = 0.            rugoro = 0.
657         ENDIF         ENDIF
658    
        lmt_pas = NINT(86400. / dtphys) ! tous les jours  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
659         ecrit_ins = NINT(ecrit_ins/dtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
660         ecrit_hf = NINT(ecrit_hf/dtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
661         ecrit_mth = NINT(ecrit_mth/dtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
662         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
663         ecrit_reg = NINT(ecrit_reg/dtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
664    
        ! Initialiser le couplage si necessaire  
   
        npas = 0  
        nexca = 0  
   
        print *,'AVANT HIST IFLAG_CON = ', iflag_con  
   
665         ! Initialisation des sorties         ! Initialisation des sorties
666    
        call ini_histhf(dtphys, nid_hf, nid_hf3d)  
        call ini_histday(dtphys, ok_journe, nid_day, nqmx)  
667         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
668         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
669         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
670         WRITE(*, *) 'physiq date0: ', date0         print *, 'physiq date0: ', date0
671      ENDIF test_firstcal      ENDIF test_firstcal
672    
673      ! Mettre a zero des variables de sortie (pour securite)      ! We will modify variables *_seri and we will not touch variables
674        ! u, v, t, qx:
675      DO i = 1, klon      t_seri = t
676         d_ps(i) = 0.0      u_seri = u
677      ENDDO      v_seri = v
678      DO iq = 1, nqmx      q_seri = qx(:, :, ivap)
679         DO k = 1, llm      ql_seri = qx(:, :, iliq)
680            DO i = 1, klon      tr_seri = qx(:, :, 3: nqmx)
              d_qx(i, k, iq) = 0.0  
           ENDDO  
        ENDDO  
     ENDDO  
     da = 0.  
     mp = 0.  
     phi = 0.  
681    
682      ! Ne pas affecter les valeurs entrées de u, v, h, et q :      ztsol = sum(ftsol * pctsrf, dim = 2)
   
     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  
   
     DO i = 1, klon  
        ztsol(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           ztsol(i) = ztsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
683    
684      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
685         ztit = 'after dynamics'         tit = 'after dynamics'
686         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, &
687              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)
688              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  
689         !  dynamique, la variation d'enthalpie par la dynamique devrait         !  dynamique, la variation d'enthalpie par la dynamique devrait
690         !  être égale à la variation de la physique au pas de temps         !  \^etre \'egale \`a la variation de la physique au pas de temps
691         !  précédent.  Donc la somme de ces 2 variations devrait être         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre
692         !  nulle.         !  nulle.
693         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, &
694              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, &
695              d_qt, 0., fs_bound, fq_bound)              d_qt, 0.)
696      END IF      END IF
697    
698      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
# Line 878  contains Line 706  contains
706      ELSE      ELSE
707         DO k = 1, llm         DO k = 1, llm
708            DO i = 1, klon            DO i = 1, klon
709               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
710               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
711            ENDDO            ENDDO
712         ENDDO         ENDDO
713         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 895  contains Line 723  contains
723      ! Check temperatures:      ! Check temperatures:
724      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
725    
726      ! Incrementer le compteur de la physique      ! Incrémenter le compteur de la physique
727      itap = itap + 1      itap = itap + 1
728      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(dayvrai, 360)
729      if (julien == 0) julien = 360      if (julien == 0) julien = 360
730    
731      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
732    
733      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Prescrire l'ozone :
734        wo = ozonecm(REAL(julien), paprs)
735    
736      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! \'Evaporation de l'eau liquide nuageuse :
     if (nqmx >= 5) then  
        wo = qx(:, :, 5) * zmasse / dobson_u / 1e3  
     else IF (MOD(itap - 1, lmt_pas) == 0) THEN  
        wo = ozonecm(REAL(julien), paprs)  
     ENDIF  
   
     ! Évaporation de l'eau liquide nuageuse :  
737      DO k = 1, llm      DO k = 1, llm
738         DO i = 1, klon         DO i = 1, klon
739            zb = MAX(0., ql_seri(i, k))            zb = MAX(0., ql_seri(i, k))
# Line 923  contains Line 745  contains
745      ql_seri = 0.      ql_seri = 0.
746    
747      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
748         ztit = 'after reevap'         tit = 'after reevap'
749         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, &
750              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)
751              d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
752         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
   
753      END IF      END IF
754    
755      ! Appeler la diffusion verticale (programme de couche limite)      frugs = MAX(frugs, 0.000015)
756        zxrugs = sum(frugs * pctsrf, dim = 2)
     DO i = 1, klon  
        zxrugs(i) = 0.0  
     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  
757    
758      ! calculs necessaires au calcul de l'albedo dans l'interface      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec
759        ! la surface.
760    
761      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), longi, dist)
762      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
763         zdtime = dtphys * REAL(radpas)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
        CALL zenang(zlongi, time, zdtime, rmu0, fract)  
764      ELSE      ELSE
765         rmu0 = -999.999         mu0 = -999.999
766      ENDIF      ENDIF
767    
768      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
769      albsol(:) = 0.      albsol = sum(falbe * pctsrf, dim = 2)
     albsollw(:) = 0.  
     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  
770    
771      ! Repartition sous maille des flux LW et SW      ! R\'epartition sous maille des flux longwave et shortwave
772      ! Repartition du longwave par sous-surface linearisee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
773    
774      DO nsrf = 1, nbsrf      forall (nsrf = 1: nbsrf)
775         DO i = 1, klon         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &
776            fsollw(i, nsrf) = sollw(i) &              * (ztsol - ftsol(:, nsrf))
777                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
778            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))      END forall
        ENDDO  
     ENDDO  
779    
780      fder = dlw      fder = dlw
781    
782      ! Couche limite:      ! Couche limite:
783    
784      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &
785           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &
786           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &
787           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, &
788           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &
789           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &
790           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, &
791           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           pblT, therm, trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, &
792           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           run_off_lic_0, fluxo, fluxg, tslab)
          fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)  
793    
794      ! Incrémentation des flux      ! Incr\'ementation des flux
795    
796      zxfluxt = 0.      zxfluxt = 0.
797      zxfluxq = 0.      zxfluxq = 0.
# Line 1004  contains Line 800  contains
800      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
801         DO k = 1, llm         DO k = 1, llm
802            DO i = 1, klon            DO i = 1, klon
803               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
804                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
805               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
806                    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)  
807            END DO            END DO
808         END DO         END DO
809      END DO      END DO
810      DO i = 1, klon      DO i = 1, klon
811         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
812         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol
813         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
814      ENDDO      ENDDO
815    
# Line 1031  contains Line 823  contains
823      ENDDO      ENDDO
824    
825      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
826         ztit = 'after clmain'         tit = 'after clmain'
827         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, &
828              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)
829              d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
830         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &              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)  
831      END IF      END IF
832    
833      ! Update surface temperature:      ! Update surface temperature:
834    
835      DO i = 1, klon      DO i = 1, klon
836         zxtsol(i) = 0.0         zxtsol(i) = 0.
837         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
838    
839         zt2m(i) = 0.0         zt2m(i) = 0.
840         zq2m(i) = 0.0         zq2m(i) = 0.
841         zu10m(i) = 0.0         zu10m(i) = 0.
842         zv10m(i) = 0.0         zv10m(i) = 0.
843         zxffonte(i) = 0.0         zxffonte(i) = 0.
844         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
845    
846         s_pblh(i) = 0.0         s_pblh(i) = 0.
847         s_lcl(i) = 0.0         s_lcl(i) = 0.
848         s_capCL(i) = 0.0         s_capCL(i) = 0.
849         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
850         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
851         s_pblT(i) = 0.0         s_pblT(i) = 0.
852         s_therm(i) = 0.0         s_therm(i) = 0.
853         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
854         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
855         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
856    
857         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
858              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
859              THEN              'physiq : probl\`eme sous surface au point ', i, &
860            WRITE(*, *) 'physiq : pb sous surface au point ', i, &              pctsrf(i, 1 : nbsrf)
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
861      ENDDO      ENDDO
862      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
863         DO i = 1, klon         DO i = 1, klon
# Line 1097  contains Line 885  contains
885         ENDDO         ENDDO
886      ENDDO      ENDDO
887    
888      ! 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 :
   
889      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
890         DO i = 1, klon         DO i = 1, klon
891            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
# Line 1123  contains Line 910  contains
910         ENDDO         ENDDO
911      ENDDO      ENDDO
912    
913      ! Calculer la derive du flux infrarouge      ! Calculer la dérive du flux infrarouge
914    
915      DO i = 1, klon      DO i = 1, klon
916         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
917      ENDDO      ENDDO
918    
919      ! Appeler la convection (au choix)      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)
920    
921      DO k = 1, llm      ! Appeler la convection (au choix)
        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  
     IF (check) THEN  
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *, "avantcon = ", za  
     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  
922    
923      select case (iflag_con)      if (iflag_con == 2) then
924      case (1)         conv_q = d_q_dyn + d_q_vdf / dtphys
925         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'         conv_t = d_t_dyn + d_t_vdf / dtphys
926         stop 1         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
927      case (2)         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
928         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
929              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
930              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
931              pmflxs)              kdtop, pmflxr, pmflxs)
932         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
933         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
934         DO i = 1, klon         ibas_con = llm + 1 - kcbot
935            ibas_con(i) = llm + 1 - kcbot(i)         itop_con = llm + 1 - kctop
936            itop_con(i) = llm + 1 - kctop(i)      else
937         ENDDO         ! iflag_con >= 3
     case (3:)  
        ! number of tracers for the convection scheme of Kerry Emanuel:  
        ! 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  
938    
939         IF (.NOT. ok_gust) THEN         da = 0.
940            do i = 1, klon         mp = 0.
941               wd(i) = 0.0         phi = 0.
942            enddo         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
943                w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &
944                ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &
945                qcondc, wd, pmflxr, pmflxs, da, phi, mp)
946           clwcon0 = qcondc
947           mfu = upwd + dnwd
948           IF (.NOT. ok_gust) wd = 0.
949    
950           IF (thermcep) THEN
951              zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
952              zqsat = zqsat / (1. - retv * zqsat)
953           ELSE
954              zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play
955         ENDIF         ENDIF
956    
957         ! Calcul des propriétés des nuages convectifs         ! Properties of convective clouds
958           clwcon0 = fact_cldcon * clwcon0
959         DO k = 1, llm         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
960            DO i = 1, klon              rnebcon0)
961               zx_t = t_seri(i, k)  
962               IF (thermcep) THEN         mfd = 0.
963                  zdelta = MAX(0., SIGN(1., rtt-zx_t))         pen_u = 0.
964                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)         pen_d = 0.
965                  zx_qs = MIN(0.5, zx_qs)         pde_d = 0.
966                  zcor = 1./(1.-retv*zx_qs)         pde_u = 0.
967                  zx_qs = zx_qs*zcor      END if
              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  
   
        ! calcul des proprietes des nuages convectifs  
        clwcon0 = fact_cldcon*clwcon0  
        call clouds_gno &  
             (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)  
     case default  
        print *, "iflag_con non-prevu", iflag_con  
        stop 1  
     END select  
968    
969      DO k = 1, llm      DO k = 1, llm
970         DO i = 1, klon         DO i = 1, klon
# Line 1247  contains Line 976  contains
976      ENDDO      ENDDO
977    
978      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
979         ztit = 'after convect'         tit = 'after convect'
980         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, &
981              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)
982              d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
983         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec)
             zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
984      END IF      END IF
985    
986      IF (check) THEN      IF (check) THEN
987         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(paprs, q_seri, ql_seri)
988         print *,"aprescon = ", za         print *, "aprescon = ", za
989         zx_t = 0.0         zx_t = 0.
990         za = 0.0         za = 0.
991         DO i = 1, klon         DO i = 1, klon
992            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
993            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
994                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
995         ENDDO         ENDDO
996         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
997         print *,"Precip = ", zx_t         print *, "Precip = ", zx_t
998      ENDIF      ENDIF
999      IF (zx_ajustq) THEN  
1000         DO i = 1, klon      IF (iflag_con == 2) THEN
1001            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1002         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  
1003         DO k = 1, llm         DO k = 1, llm
1004            DO i = 1, klon            DO i = 1, klon
1005               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
# Line 1291  contains Line 1008  contains
1008            ENDDO            ENDDO
1009         ENDDO         ENDDO
1010      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
1011    
1012      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
1013    
1014      d_t_ajs = 0.      d_t_ajs = 0.
1015      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1314  contains Line 1030  contains
1030      endif      endif
1031    
1032      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1033         ztit = 'after dry_adjust'         tit = 'after dry_adjust'
1034         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, &
1035              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)  
1036      END IF      END IF
1037    
1038      ! Caclul des ratqs      ! Caclul des ratqs
1039    
1040      ! 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
1041      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
1042      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1043         do k = 1, llm         do k = 1, llm
1044            do i = 1, klon            do i = 1, klon
1045               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1046                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1047                       +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)
1048               else               else
1049                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
1050               endif               endif
# Line 1340  contains Line 1055  contains
1055      ! ratqs stables      ! ratqs stables
1056      do k = 1, llm      do k = 1, llm
1057         do i = 1, klon         do i = 1, klon
1058            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1059                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1060         enddo         enddo
1061      enddo      enddo
1062    
1063      ! ratqs final      ! ratqs final
1064      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1065         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1066         ! ratqs final         ! ratqs final
1067         ! 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
1068         ! relaxation des ratqs         ! relaxation des ratqs
1069         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
1070         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1071      else      else
1072         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1073         ratqs = ratqss         ratqs = ratqss
1074      endif      endif
1075    
     ! Processus de condensation à grande echelle et processus de  
     ! précipitation :  
1076      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1077           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, &
1078           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
# Line 1378  contains Line 1090  contains
1090         ENDDO         ENDDO
1091      ENDDO      ENDDO
1092      IF (check) THEN      IF (check) THEN
1093         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(paprs, q_seri, ql_seri)
1094         print *,"apresilp = ", za         print *, "apresilp = ", za
1095         zx_t = 0.0         zx_t = 0.
1096         za = 0.0         za = 0.
1097         DO i = 1, klon         DO i = 1, klon
1098            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1099            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1100                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1101         ENDDO         ENDDO
1102         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1103         print *,"Precip = ", zx_t         print *, "Precip = ", zx_t
1104      ENDIF      ENDIF
1105    
1106      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1107         ztit = 'after fisrt'         tit = 'after fisrt'
1108         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, &
1109              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)
1110              d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1111         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec)
             zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
1112      END IF      END IF
1113    
1114      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1115    
1116      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1117    
1118      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1119           ! seulement pour Tiedtke
1120         snow_tiedtke = 0.         snow_tiedtke = 0.
1121         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1122            rain_tiedtke = rain_con            rain_tiedtke = rain_con
# Line 1422  contains Line 1133  contains
1133         endif         endif
1134    
1135         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1136         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1137              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1138         DO k = 1, llm         DO k = 1, llm
1139            DO i = 1, klon            DO i = 1, klon
1140               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1434  contains Line 1144  contains
1144            ENDDO            ENDDO
1145         ENDDO         ENDDO
1146      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1147         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1148         ! 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
1149         ! facttemps         ! d'un facteur facttemps.
1150         facteur = dtphys *facttemps         facteur = dtphys * facttemps
1151         do k = 1, llm         do k = 1, llm
1152            do i = 1, klon            do i = 1, klon
1153               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1154               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1155                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1156                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1157                  clwcon(i, k) = clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1158               endif               endif
# Line 1469  contains Line 1179  contains
1179      ENDIF      ENDIF
1180    
1181      ! Precipitation totale      ! Precipitation totale
   
1182      DO i = 1, klon      DO i = 1, klon
1183         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1184         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1185      ENDDO      ENDDO
1186    
1187      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1188         ztit = "after diagcld"           dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1189         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &           d_qt, 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  
1190    
1191      ! Humidité relative pour diagnostic:      ! Humidit\'e relative pour diagnostic :
1192      DO k = 1, llm      DO k = 1, llm
1193         DO i = 1, klon         DO i = 1, klon
1194            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1195            IF (thermcep) THEN            IF (thermcep) THEN
1196               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)  
1197               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1198               zcor = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1199               zx_qs = zx_qs*zcor               zx_qs = zx_qs*zcor
# Line 1505  contains Line 1210  contains
1210      ENDDO      ENDDO
1211    
1212      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
     ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)  
1213      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1214         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1215         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(dayvrai, time, firstcal, sulfate)
1216         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(dayvrai, time, firstcal, sulfate_pi)
1217    
        ! Calculate aerosol optical properties (Olivier Boucher)  
1218         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, &
1219              aerindex)              aerindex)
1220      ELSE      ELSE
# Line 1520  contains Line 1223  contains
1223         cg_ae = 0.         cg_ae = 0.
1224      ENDIF      ENDIF
1225    
1226      ! Paramètres optiques des nuages et quelques paramètres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
1227      ! diagnostics :      ! diagnostics :
1228      if (ok_newmicro) then      if (ok_newmicro) then
1229         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1230              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1231              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             re, fl)  
1232      else      else
1233         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1234              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1235              bl95_b1, cldtaupi, re, fl)              bl95_b1, cldtaupi, re, fl)
1236      endif      endif
1237    
1238      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
1239      IF (MOD(itaprad, radpas) == 0) THEN         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
1240         DO i = 1, klon         ! Calcul de l'abedo moyen par maille
1241            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &         albsol = sum(falbe * pctsrf, dim = 2)
1242                 + falbe(i, is_lic) * pctsrf(i, is_lic) &  
1243                 + falbe(i, is_ter) * pctsrf(i, is_ter) &         ! Rayonnement (compatible Arpege-IFS) :
1244                 + falbe(i, is_sic) * pctsrf(i, is_sic)         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &
1245            albsollw(i) = falblw(i, is_oce) * pctsrf(i, is_oce) &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
1246                 + falblw(i, is_lic) * pctsrf(i, is_lic) &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
1247                 + falblw(i, is_ter) * pctsrf(i, is_ter) &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
1248                 + falblw(i, is_sic) * pctsrf(i, is_sic)              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &
1249         ENDDO              solswad, cldtaupi, topswai, solswai)
        ! nouveau rayonnement (compatible Arpege-IFS):  
        CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &  
             albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &  
             heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &  
             sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &  
             lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &  
             cg_ae, topswad, solswad, cldtaupi, topswai, solswai)  
        itaprad = 0  
1250      ENDIF      ENDIF
     itaprad = itaprad + 1  
1251    
1252      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
1253    
# Line 1565  contains Line 1258  contains
1258      ENDDO      ENDDO
1259    
1260      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1261         ztit = 'after rad'         tit = 'after rad'
1262         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, &
1263              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)
1264              d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1265         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &              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)  
1266      END IF      END IF
1267    
1268      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
1269      DO i = 1, klon      DO i = 1, klon
1270         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1271         zxsnow(i) = 0.0         zxsnow(i) = 0.
1272      ENDDO      ENDDO
1273      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1274         DO i = 1, klon         DO i = 1, klon
# Line 1586  contains Line 1277  contains
1277         ENDDO         ENDDO
1278      ENDDO      ENDDO
1279    
1280      ! 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)
1281    
1282      DO i = 1, klon      DO i = 1, klon
1283         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1284      ENDDO      ENDDO
1285    
1286      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1287    
1288      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1289         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1290         igwd = 0         igwd = 0
1291         DO i = 1, klon         DO i = 1, klon
1292            itest(i) = 0            itest(i) = 0
1293            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN
1294               itest(i) = 1               itest(i) = 1
1295               igwd = igwd + 1               igwd = igwd + 1
1296               idx(igwd) = i               idx(igwd) = i
# Line 1607  contains Line 1298  contains
1298         ENDDO         ENDDO
1299    
1300         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1301              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1302              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
1303    
1304         ! ajout des tendances         ! ajout des tendances
1305         DO k = 1, llm         DO k = 1, llm
# Line 1621  contains Line 1312  contains
1312      ENDIF      ENDIF
1313    
1314      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1315         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
1316         igwd = 0         igwd = 0
1317         DO i = 1, klon         DO i = 1, klon
1318            itest(i) = 0            itest(i) = 0
# Line 1646  contains Line 1337  contains
1337         ENDDO         ENDDO
1338      ENDIF      ENDIF
1339    
1340      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! Stress n\'ecessaires : toute la physique
1341    
1342      DO i = 1, klon      DO i = 1, klon
1343         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1654  contains Line 1345  contains
1345      ENDDO      ENDDO
1346      DO k = 1, llm      DO k = 1, llm
1347         DO i = 1, klon         DO i = 1, klon
1348            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 &
1349            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)                 * zmasse(i, k)
1350              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1351                   * zmasse(i, k)
1352         ENDDO         ENDDO
1353      ENDDO      ENDDO
1354    
1355      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1356           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1357    
1358      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1359         ztit = 'after orography'           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1360         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &           d_qt, 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  
1361    
1362      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1363      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &
1364           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &
1365           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, da, phi, mp, &
1366           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &           upwd, dnwd, tr_seri, zmasse)
1367           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &  
1368           tr_seri, zmasse)      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1369             pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1370      IF (offline) THEN           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
        call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &  
             pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &  
             pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
     ENDIF  
1371    
1372      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1373      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 1706  contains Line 1392  contains
1392      END DO      END DO
1393    
1394      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1395         ztit = 'after physic'         tit = 'after physic'
1396         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, &
1397              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)  
1398         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1399         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1400         ! 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.
1401         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1402         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1403              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)  
   
1404         d_h_vcol_phy = d_h_vcol         d_h_vcol_phy = d_h_vcol
   
1405      END IF      END IF
1406    
1407      ! SORTIES      ! SORTIES
1408    
1409      !cc prw = eau precipitable      ! prw = eau precipitable
1410      DO i = 1, klon      DO i = 1, klon
1411         prw(i) = 0.         prw(i) = 0.
1412         DO k = 1, llm         DO k = 1, llm
# Line 1744  contains Line 1426  contains
1426         ENDDO         ENDDO
1427      ENDDO      ENDDO
1428    
1429      IF (nqmx >= 3) THEN      DO iq = 3, nqmx
1430         DO iq = 3, nqmx         DO k = 1, llm
1431            DO k = 1, llm            DO i = 1, klon
1432               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  
1433            ENDDO            ENDDO
1434         ENDDO         ENDDO
1435      ENDIF      ENDDO
1436    
1437      ! 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:
1438      DO k = 1, llm      DO k = 1, llm
# Line 1763  contains Line 1443  contains
1443      ENDDO      ENDDO
1444    
1445      ! Ecriture des sorties      ! Ecriture des sorties
     call write_histhf  
     call write_histday  
1446      call write_histins      call write_histins
1447    
1448      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1449      IF (lafin) THEN      IF (lafin) THEN
1450         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1451         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", pctsrf, ftsol, ftsoil, tslab, seaice, &
1452              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              fqsurf, qsol, fsnow, falbe, fevap, rain_fall, snow_fall, &
1453              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &              solsw, sollw, dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, &
1454              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, &
1455              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              run_off_lic_0, sig1, w01)
1456      ENDIF      ENDIF
1457    
1458      firstcal = .FALSE.      firstcal = .FALSE.
1459    
1460    contains    contains
1461    
     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  
   
     !***************************************************************  
   
1462      subroutine write_histins      subroutine write_histins
1463    
1464        ! 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
1465    
1466        real zout        use dimens_m, only: iim, jjm
1467        integer itau_w ! pas de temps ecriture        USE histsync_m, ONLY: histsync
1468          USE histwrite_m, ONLY: histwrite
1469    
1470          integer i, itau_w ! pas de temps ecriture
1471          REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1472    
1473        !--------------------------------------------------        !--------------------------------------------------
1474    
1475        IF (ok_instan) THEN        IF (ok_instan) THEN
1476           ! Champs 2D:           ! Champs 2D:
1477    
          zsto = dtphys * ecrit_ins  
          zout = dtphys * ecrit_ins  
1478           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1479    
          i = NINT(zout/zsto)  
1480           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)
1481           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1482    
          i = NINT(zout/zsto)  
1483           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)
1484           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1485    
# Line 1972  contains Line 1611  contains
1611              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1612                   zx_tmp_2d)                   zx_tmp_2d)
1613    
1614              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(:, nsrf)
1615              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)
1616              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1617                   zx_tmp_2d)                   zx_tmp_2d)
# Line 1980  contains Line 1619  contains
1619           END DO           END DO
1620           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)
1621           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)  
1622    
1623           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)
1624           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
# Line 2041  contains Line 1678  contains
1678           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)
1679           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1680    
1681           if (ok_sync) then           call histsync(nid_ins)
             call histsync(nid_ins)  
          endif  
1682        ENDIF        ENDIF
1683    
1684      end subroutine write_histins      end subroutine write_histins
1685    
     !****************************************************  
   
     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  
   
1686    END SUBROUTINE physiq    END SUBROUTINE physiq
1687    
1688  end module physiq_m  end module physiq_m
Legend:
Removed from v.56  
changed lines
  Added in v.155
  ViewVC Help
Powered by ViewVC 1.1.21